From 3d72b89e29c5fd47408fb77ba22d1c81eef4792f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20G=2E=20Dorais?= Date: Fri, 27 Sep 2024 15:39:49 -0400 Subject: [PATCH] chore: merge main --- .github/workflows/build.yml | 3 +- .github/workflows/nightly_detect_failure.yml | 6 +- .github/workflows/test_mathlib.yml | 97 ++ .gitpod.yml | 5 + Batteries.lean | 14 +- Batteries/Classes/BEq.lean | 18 - Batteries/Classes/Order.lean | 7 +- Batteries/CodeAction/Attr.lean | 4 +- Batteries/CodeAction/Basic.lean | 127 +- Batteries/CodeAction/Deprecated.lean | 9 +- Batteries/CodeAction/Misc.lean | 3 +- Batteries/Data/Array.lean | 2 + Batteries/Data/Array/Basic.lean | 18 - Batteries/Data/Array/Lemmas.lean | 204 ++- Batteries/Data/Array/Merge.lean | 14 +- Batteries/Data/Array/Monadic.lean | 2 +- Batteries/Data/Array/OfFn.lean | 23 + Batteries/Data/Array/Pairwise.lean | 61 + Batteries/Data/BitVec.lean | 1 - Batteries/Data/BitVec/Lemmas.lean | 19 - Batteries/Data/Bool.lean | 19 - Batteries/Data/ByteArray.lean | 69 +- Batteries/Data/ByteSubarray.lean | 105 ++ Batteries/Data/Char.lean | 19 +- Batteries/Data/Fin/Lemmas.lean | 21 +- Batteries/Data/FloatArray.lean | 40 + Batteries/Data/HashMap/Basic.lean | 1 - Batteries/Data/HashMap/Lemmas.lean | 15 +- Batteries/Data/HashMap/WF.lean | 53 +- Batteries/Data/Int.lean | 3 - Batteries/Data/Int/DivMod.lean | 84 -- Batteries/Data/Int/Lemmas.lean | 6 - Batteries/Data/Int/Order.lean | 10 - Batteries/Data/LazyList.lean | 165 ++- Batteries/Data/List.lean | 2 +- Batteries/Data/List/Basic.lean | 325 +---- Batteries/Data/List/Count.lean | 219 +--- Batteries/Data/List/EraseIdx.lean | 72 +- Batteries/Data/List/Init/Attach.lean | 44 - Batteries/Data/List/Lemmas.lean | 1240 +++--------------- Batteries/Data/List/OfFn.lean | 49 + Batteries/Data/List/Pairwise.lean | 223 +--- Batteries/Data/List/Perm.lean | 418 +----- Batteries/Data/Nat/Basic.lean | 10 - Batteries/Data/Nat/Lemmas.lean | 25 +- Batteries/Data/Option.lean | 1 - Batteries/Data/Option/Lemmas.lean | 13 - Batteries/Data/RBMap/Basic.lean | 18 +- Batteries/Data/RBMap/Lemmas.lean | 130 +- Batteries/Data/Range/Lemmas.lean | 1 - Batteries/Data/Rat/Basic.lean | 1 - Batteries/Data/Rat/Lemmas.lean | 8 +- Batteries/Data/String/Basic.lean | 23 + Batteries/Data/String/Lemmas.lean | 284 ++-- Batteries/Data/Sum/Lemmas.lean | 8 +- Batteries/Data/Thunk.lean | 10 - Batteries/Data/UInt.lean | 70 +- Batteries/Data/UnionFind/Basic.lean | 112 +- Batteries/Data/Vector.lean | 2 + Batteries/Data/Vector/Basic.lean | 321 +++++ Batteries/Data/Vector/Lemmas.lean | 72 + Batteries/Lean/AttributeExtra.lean | 10 +- Batteries/Lean/Delaborator.lean | 2 +- Batteries/Lean/HashMap.lean | 19 +- Batteries/Lean/HashSet.lean | 13 +- Batteries/Lean/Meta/AssertHypotheses.lean | 2 +- Batteries/Lean/Meta/Basic.lean | 4 +- Batteries/Lean/Meta/Clear.lean | 1 + Batteries/Lean/Meta/Inaccessible.lean | 6 +- Batteries/Lean/Name.lean | 28 - Batteries/Lean/PersistentHashMap.lean | 9 - Batteries/Lean/PersistentHashSet.lean | 10 - Batteries/Lean/Position.lean | 1 - Batteries/Lean/SMap.lean | 17 - Batteries/Lean/System/IO.lean | 1 - Batteries/Lean/Util/EnvSearch.lean | 3 +- Batteries/Lean/Util/Path.lean | 34 - Batteries/Linter/UnnecessarySeqFocus.lean | 10 +- Batteries/Linter/UnreachableTactic.lean | 10 +- Batteries/Logic.lean | 15 +- Batteries/StdDeprecations.lean | 66 +- Batteries/Tactic/Alias.lean | 3 +- Batteries/Tactic/Case.lean | 2 +- Batteries/Tactic/Classical.lean | 2 +- Batteries/Tactic/Init.lean | 6 +- Batteries/Tactic/Lemma.lean | 50 + Batteries/Tactic/Lint/Basic.lean | 4 +- Batteries/Tactic/Lint/Frontend.lean | 66 +- Batteries/Tactic/Lint/Misc.lean | 10 +- Batteries/Tactic/Lint/Simp.lean | 8 +- Batteries/Tactic/Lint/TypeClass.lean | 2 +- Batteries/Tactic/NoMatch.lean | 3 +- Batteries/Tactic/PrintDependents.lean | 1 - Batteries/Tactic/PrintPrefix.lean | 2 - Batteries/Tactic/SeqFocus.lean | 2 +- Batteries/Tactic/ShowUnused.lean | 1 - Batteries/Tactic/SqueezeScope.lean | 3 +- Batteries/Tactic/Unreachable.lean | 2 +- Batteries/Tactic/Where.lean | 10 +- Batteries/Util/Cache.lean | 2 +- Batteries/Util/CheckTactic.lean | 124 -- Batteries/Util/ExtendedBinder.lean | 2 - Batteries/Util/LibraryNote.lean | 2 +- GNUmakefile | 12 - README.md | 4 +- lakefile.lean | 5 +- lean-toolchain | 2 +- scripts/check_imports.lean | 10 +- scripts/runLinter.lean | 22 +- test/MLList.lean | 7 +- test/absurd.lean | 2 +- test/array.lean | 1 - test/congr.lean | 4 +- test/lemma_cmd.lean | 34 + test/lintTC.lean | 2 +- test/lint_lean.lean | 47 + test/lintsimp.lean | 2 +- test/where.lean | 1 + 118 files changed, 2246 insertions(+), 3425 deletions(-) create mode 100644 .github/workflows/test_mathlib.yml delete mode 100644 Batteries/Classes/BEq.lean create mode 100644 Batteries/Data/Array/OfFn.lean create mode 100644 Batteries/Data/Array/Pairwise.lean delete mode 100644 Batteries/Data/BitVec.lean delete mode 100644 Batteries/Data/BitVec/Lemmas.lean delete mode 100644 Batteries/Data/Bool.lean create mode 100644 Batteries/Data/ByteSubarray.lean create mode 100644 Batteries/Data/FloatArray.lean delete mode 100644 Batteries/Data/Int.lean delete mode 100644 Batteries/Data/Int/DivMod.lean delete mode 100644 Batteries/Data/Int/Lemmas.lean delete mode 100644 Batteries/Data/Int/Order.lean delete mode 100644 Batteries/Data/List/Init/Attach.lean create mode 100644 Batteries/Data/List/OfFn.lean delete mode 100644 Batteries/Data/Option.lean delete mode 100644 Batteries/Data/Option/Lemmas.lean delete mode 100644 Batteries/Data/Thunk.lean create mode 100644 Batteries/Data/Vector.lean create mode 100644 Batteries/Data/Vector/Basic.lean create mode 100644 Batteries/Data/Vector/Lemmas.lean delete mode 100644 Batteries/Lean/Name.lean delete mode 100644 Batteries/Lean/SMap.lean delete mode 100644 Batteries/Lean/Util/Path.lean create mode 100644 Batteries/Tactic/Lemma.lean delete mode 100644 Batteries/Util/CheckTactic.lean delete mode 100644 GNUmakefile create mode 100644 test/lemma_cmd.lean create mode 100644 test/lint_lean.lean diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 58ca29d3d1..15d72c6876 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -18,10 +18,9 @@ jobs: - id: lean-action name: build, test, and lint batteries - uses: leanprover/lean-action@v1-beta + uses: leanprover/lean-action@v1 with: build-args: '-Kwerror' - lint-module: 'Batteries' - name: Check that all files are imported run: lake env lean scripts/check_imports.lean diff --git a/.github/workflows/nightly_detect_failure.yml b/.github/workflows/nightly_detect_failure.yml index 9a01257e21..98aaf457f0 100644 --- a/.github/workflows/nightly_detect_failure.yml +++ b/.github/workflows/nightly_detect_failure.yml @@ -24,7 +24,7 @@ jobs: type: 'stream' topic: 'Batteries status updates' content: | - ❌ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has [failed](https://github.com/${{ github.repository }}/actions/runs/${{ github.event.workflow_run.id }}). + ❌️ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has [failed](https://github.com/${{ github.repository }}/actions/runs/${{ github.event.workflow_run.id }}). # Whenever `nightly-testing` passes CI, # push it to `nightly-testing-YYYY-MM-DD` so we have a known good version of Batteries on that nightly release. @@ -77,13 +77,13 @@ jobs: } response = client.get_messages(request) messages = response['messages'] - if not messages or messages[0]['content'] != "✅ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has succeeded!": + if not messages or messages[0]['content'] != "✅️ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has succeeded!": # Post the success message request = { 'type': 'stream', 'to': 'nightly-testing', 'topic': 'Batteries status updates', - 'content': "✅ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has succeeded!" + 'content': "✅️ The latest CI for Batteries' [`nightly-testing`](https://github.com/leanprover-community/batteries/tree/nightly-testing) branch has succeeded!" } result = client.send_message(request) print(result) diff --git a/.github/workflows/test_mathlib.yml b/.github/workflows/test_mathlib.yml new file mode 100644 index 0000000000..15062cb521 --- /dev/null +++ b/.github/workflows/test_mathlib.yml @@ -0,0 +1,97 @@ +# Test Mathlib against a Batteries PR + +name: Test Mathlib + +on: + workflow_run: + workflows: [ci] + types: [completed] + +jobs: + on-success: + 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 + with: + token: ${{ secrets.GITHUB_TOKEN }} + sourceRunId: ${{ github.event.workflow_run.id }} + + - name: Checkout mathlib4 repository + if: steps.workflow-info.outputs.pullRequestNumber != '' + uses: actions/checkout@v4 + with: + repository: leanprover-community/mathlib4 + token: ${{ secrets.MATHLIB4_BOT }} + ref: master + fetch-depth: 0 + + - name: install elan + 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 != '' + id: check_mathlib_tag + env: + PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }} + HEAD_REPO: ${{ env.HEAD_REPO }} + HEAD_BRANCH: ${{ env.HEAD_BRANCH }} + run: | + git config user.name "leanprover-community-mathlib4-bot" + git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com" + + echo "PR info: $HEAD_REPO $HEAD_BRANCH" + + BASE=master + echo "Using base tag: $BASE" + + EXISTS="$(git ls-remote --heads origin batteries-pr-testing-$PR_NUMBER | wc -l)" + echo "Branch exists: $EXISTS" + if [ "$EXISTS" = "0" ]; then + 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 + 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 + git add lakefile.lean lake-manifest.json + git commit -m "Update Batteries branch for testing https://github.com/leanprover-community/batteries/pull/$PR_NUMBER" + else + echo "Branch already exists, merging $BASE and bumping Batteries." + git switch batteries-pr-testing-$PR_NUMBER + git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories + lake update batteries + git add lake-manifest.json + git commit --allow-empty -m "Trigger CI for https://github.com/leanprover-community/batteries/pull/$PR_NUMBER" + fi + + - name: Push changes + if: steps.workflow-info.outputs.pullRequestNumber != '' + env: + PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }} + run: | + git push origin batteries-pr-testing-$PR_NUMBER diff --git a/.gitpod.yml b/.gitpod.yml index 5170403ac3..f9614f0d9b 100644 --- a/.gitpod.yml +++ b/.gitpod.yml @@ -4,3 +4,8 @@ image: vscode: extensions: - leanprover.lean4 + +tasks: + - init: | + elan self update + lake build diff --git a/Batteries.lean b/Batteries.lean index 706e967883..3bd1f4ef79 100644 --- a/Batteries.lean +++ b/Batteries.lean @@ -1,4 +1,3 @@ -import Batteries.Classes.BEq import Batteries.Classes.Cast import Batteries.Classes.Order import Batteries.Classes.RatCast @@ -17,28 +16,26 @@ import Batteries.Data.Array import Batteries.Data.AssocList import Batteries.Data.BinaryHeap import Batteries.Data.BinomialHeap -import Batteries.Data.BitVec -import Batteries.Data.Bool import Batteries.Data.ByteArray +import Batteries.Data.ByteSubarray import Batteries.Data.Char import Batteries.Data.DList import Batteries.Data.Fin +import Batteries.Data.FloatArray import Batteries.Data.HashMap -import Batteries.Data.Int import Batteries.Data.LazyList import Batteries.Data.List import Batteries.Data.MLList import Batteries.Data.Nat -import Batteries.Data.Option import Batteries.Data.PairingHeap import Batteries.Data.RBMap import Batteries.Data.Range import Batteries.Data.Rat import Batteries.Data.String import Batteries.Data.Sum -import Batteries.Data.Thunk import Batteries.Data.UInt import Batteries.Data.UnionFind +import Batteries.Data.Vector import Batteries.Lean.AttributeExtra import Batteries.Lean.Delaborator import Batteries.Lean.Except @@ -59,18 +56,15 @@ import Batteries.Lean.Meta.SavedState import Batteries.Lean.Meta.Simp import Batteries.Lean.Meta.UnusedNames import Batteries.Lean.MonadBacktrack -import Batteries.Lean.Name import Batteries.Lean.NameMap import Batteries.Lean.NameMapAttribute import Batteries.Lean.PersistentHashMap import Batteries.Lean.PersistentHashSet import Batteries.Lean.Position -import Batteries.Lean.SMap import Batteries.Lean.Syntax import Batteries.Lean.System.IO import Batteries.Lean.TagAttribute import Batteries.Lean.Util.EnvSearch -import Batteries.Lean.Util.Path import Batteries.Linter import Batteries.Linter.UnnecessarySeqFocus import Batteries.Linter.UnreachableTactic @@ -84,6 +78,7 @@ import Batteries.Tactic.Congr import Batteries.Tactic.Exact import Batteries.Tactic.Init import Batteries.Tactic.Instances +import Batteries.Tactic.Lemma import Batteries.Tactic.Lint import Batteries.Tactic.Lint.Basic import Batteries.Tactic.Lint.Frontend @@ -102,7 +97,6 @@ import Batteries.Tactic.Unreachable import Batteries.Tactic.Where import Batteries.Test.Internal.DummyLabelAttr import Batteries.Util.Cache -import Batteries.Util.CheckTactic import Batteries.Util.ExtendedBinder import Batteries.Util.LibraryNote import Batteries.Util.Pickle diff --git a/Batteries/Classes/BEq.lean b/Batteries/Classes/BEq.lean deleted file mode 100644 index 98318f97c9..0000000000 --- a/Batteries/Classes/BEq.lean +++ /dev/null @@ -1,18 +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 --/ - -/-! ## Boolean equality -/ - -/-- `PartialEquivBEq α` says that the `BEq` implementation is a -partial equivalence relation, that is: -* it is symmetric: `a == b → b == a` -* it is transitive: `a == b → b == c → a == c`. --/ -class PartialEquivBEq (α) [BEq α] : Prop where - /-- Symmetry for `BEq`. If `a == b` then `b == a`. -/ - symm : (a : α) == b → b == a - /-- Transitivity for `BEq`. If `a == b` and `b == c` then `a == c`. -/ - trans : (a : α) == b → b == c → a == c diff --git a/Batteries/Classes/Order.lean b/Batteries/Classes/Order.lean index f54f82eb24..1296bd7a9d 100644 --- a/Batteries/Classes/Order.lean +++ b/Batteries/Classes/Order.lean @@ -102,7 +102,7 @@ theorem cmp_congr_left (xy : cmp x y = .eq) : cmp x z = cmp y z := theorem cmp_congr_left' (xy : cmp x y = .eq) : cmp x = cmp y := funext fun _ => cmp_congr_left xy -theorem cmp_congr_right [TransCmp cmp] (yz : cmp y z = .eq) : cmp x y = cmp x z := by +theorem cmp_congr_right (yz : cmp y z = .eq) : cmp x y = cmp x z := by rw [← Ordering.swap_inj, symm, symm, cmp_congr_left yz] end TransCmp @@ -278,11 +278,8 @@ instance [Ord β] [OrientedOrd β] (f : α → β) : OrientedCmp (compareOn f) w instance [Ord β] [TransOrd β] (f : α → β) : TransCmp (compareOn f) where le_trans := TransCmp.le_trans (α := β) --- FIXME: remove after lean4#3882 is merged theorem _root_.lexOrd_def [Ord α] [Ord β] : - (lexOrd : Ord (α × β)).compare = compareLex (compareOn (·.1)) (compareOn (·.2)) := by - funext a b - simp [lexOrd, compareLex, compareOn] + (lexOrd : Ord (α × β)).compare = compareLex (compareOn (·.1)) (compareOn (·.2)) := rfl section «non-canonical instances» -- Note: the following instances seem to cause lean to fail, see: diff --git a/Batteries/CodeAction/Attr.lean b/Batteries/CodeAction/Attr.lean index ad5e0f62d3..308c4c7ad3 100644 --- a/Batteries/CodeAction/Attr.lean +++ b/Batteries/CodeAction/Attr.lean @@ -3,7 +3,7 @@ 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.Server.CodeActions +import Lean.Server.CodeActions.Basic /-! # Initial setup for code action attributes @@ -14,7 +14,7 @@ import Lean.Server.CodeActions * Attribute `@[tactic_code_action]` collects code actions which will be called on each occurrence of a tactic. -/ -namespace Std.CodeAction +namespace Batteries.CodeAction open Lean Elab Server Lsp RequestM Snapshots diff --git a/Batteries/CodeAction/Basic.lean b/Batteries/CodeAction/Basic.lean index 1a7488bd87..120de7eb05 100644 --- a/Batteries/CodeAction/Basic.lean +++ b/Batteries/CodeAction/Basic.lean @@ -6,6 +6,7 @@ Authors: Mario Carneiro import Lean.Elab.BuiltinTerm import Lean.Elab.BuiltinNotation import Lean.Server.InfoUtils +import Lean.Server.CodeActions.Provider import Batteries.CodeAction.Attr /-! @@ -18,131 +19,9 @@ on each occurrence of a hole (`_`, `?_` or `sorry`). attempt to use this code action provider when browsing the `Batteries.CodeAction.Hole.Attr` file itself.) -/ -namespace Std.CodeAction +namespace Batteries.CodeAction -open Lean Elab Term Server RequestM - -/-- -The return value of `findTactic?`. -This is the syntax for which code actions will be triggered. --/ -inductive FindTacticResult - /-- The nearest enclosing tactic is a tactic, with the given syntax stack. -/ - | tactic : Syntax.Stack → FindTacticResult - /-- The cursor is between tactics, and the nearest enclosing range is a tactic sequence. - Code actions will insert tactics at index `insertIdx` into the syntax - (which is a nullNode of `tactic;*` inside a `tacticSeqBracketed` or `tacticSeq1Indented`). -/ - | tacticSeq : (preferred : Bool) → (insertIdx : Nat) → Syntax.Stack → FindTacticResult - -/-- -Find the syntax on which to trigger tactic code actions. -This is a pure syntax pass, without regard to elaboration information. - -* `preferred : String.Pos → Bool`: used to select "preferred `tacticSeq`s" based on the cursor - column, when the cursor selection would otherwise be ambiguous. For example, in: - ``` - · foo - · bar - baz - | - ``` - where the cursor is at the `|`, we select the `tacticSeq` starting with `foo`, while if the - cursor was indented to align with `baz` then we would select the `bar; baz` sequence instead. - -* `range`: the cursor selection. We do not do much with range selections; if a range selection - covers more than one tactic then we abort. - -* `root`: the root syntax to process - -The return value is either a selected tactic, or a selected point in a tactic sequence. --/ -partial def findTactic? (preferred : String.Pos → Bool) (range : String.Range) - (root : Syntax) : Option FindTacticResult := do _ ← visit root; ← go [] root -where - /-- Returns `none` if we should not visit this syntax at all, and `some false` if we only - want to visit it in "extended" mode (where we include trailing characters). -/ - visit (stx : Syntax) (prev? : Option String.Pos := none) : Option Bool := do - let left ← stx.getPos? true - guard <| prev?.getD left ≤ range.start - let .original (endPos := right) (trailing := trailing) .. := stx.getTailInfo | none - guard <| right.byteIdx + trailing.bsize ≥ range.stop.byteIdx - return left ≤ range.start && right ≥ range.stop - - /-- Merges the results of two `FindTacticResult`s. This just prefers the second (inner) one, - unless the inner tactic is a dispreferred tactic sequence and the outer one is preferred. - This is used to implement whitespace-sensitive selection of tactic sequences. -/ - merge : (r₁ : Option FindTacticResult) → (r₂ : FindTacticResult) → FindTacticResult - | some r₁@(.tacticSeq (preferred := true) ..), .tacticSeq (preferred := false) .. => r₁ - | _, r₂ => r₂ - - /-- Main recursion for `findTactic?`. This takes a `stack` context and a root syntax `stx`, - and returns the best `FindTacticResult` it can find. It returns `none` (abort) if two or more - results are found, and `some none` (none yet) if no results are found. -/ - go (stack : Syntax.Stack) (stx : Syntax) (prev? : Option String.Pos := none) : - Option (Option FindTacticResult) := do - if stx.getKind == ``Parser.Tactic.tacticSeq then - -- TODO: this implementation is a bit too strict about the beginning of tacticSeqs. - -- We would like to be able to parse - -- · | - -- foo - -- (where `|` is the cursor position) as an insertion into the sequence containing foo - -- at index 0, but we currently use the start of the tacticSeq, which is the foo token, - -- as the earliest possible location that will be associated to the sequence. - let bracket := stx[0].getKind == ``Parser.Tactic.tacticSeqBracketed - let argIdx := if bracket then 1 else 0 - let (stack, stx) := ((stx[0], argIdx) :: (stx, 0) :: stack, stx[0][argIdx]) - let mainRes := stx[0].getPos?.map fun pos => - let i := Id.run do - for i in [0:stx.getNumArgs] do - if let some pos' := stx[2*i].getPos? then - if range.stop < pos' then - return i - (stx.getNumArgs + 1) / 2 - .tacticSeq (bracket || preferred pos) i ((stx, 0) :: stack) - let mut childRes := none - for i in [0:stx.getNumArgs:2] do - if let some inner := visit stx[i] then - let stack := (stx, i) :: stack - if let some child := (← go stack stx[i]) <|> - (if inner then some (.tactic ((stx[i], 0) :: stack)) else none) - then - if childRes.isSome then failure - childRes := merge mainRes child - return childRes <|> mainRes - else - let mut childRes := none - let mut prev? := prev? - for i in [0:stx.getNumArgs] do - if let some _ := visit stx[i] prev? then - if let some child ← go ((stx, i) :: stack) stx[i] prev? then - if childRes.isSome then failure - childRes := child - prev? := stx[i].getTailPos? true <|> prev? - return childRes - -/-- -Returns the info tree corresponding to a syntax, using `kind` and `range` for identification. -(This is not foolproof, but it is a fairly accurate proxy for `Syntax` equality and a lot cheaper -than deep comparison.) --/ -partial def findInfoTree? (kind : SyntaxNodeKind) (tgtRange : String.Range) - (ctx? : Option ContextInfo) (t : InfoTree) - (f : ContextInfo → Info → Bool) (canonicalOnly := false) : - Option (ContextInfo × InfoTree) := - match t with - | .context ctx t => findInfoTree? kind tgtRange (ctx.mergeIntoOuter? ctx?) t f canonicalOnly - | node@(.node i ts) => do - if let some ctx := ctx? then - if let some range := i.stx.getRange? canonicalOnly then - -- FIXME: info tree needs to be organized better so that this works - -- guard <| range.includes tgtRange - if i.stx.getKind == kind && range == tgtRange && f ctx i then - return (ctx, node) - for t in ts do - if let some res := findInfoTree? kind tgtRange (i.updateContext? ctx?) t f canonicalOnly then - return res - none - | _ => none +open Lean Elab Server RequestM CodeAction /-- A code action which calls `@[tactic_code_action]` code actions. -/ @[code_action_provider] def tacticCodeActionProvider : CodeActionProvider := fun params snap => do diff --git a/Batteries/CodeAction/Deprecated.lean b/Batteries/CodeAction/Deprecated.lean index f308992885..30745d161d 100644 --- a/Batteries/CodeAction/Deprecated.lean +++ b/Batteries/CodeAction/Deprecated.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Server.CodeActions import Batteries.CodeAction.Basic -import Batteries.Lean.Position /-! # Code action for @[deprecated] replacements @@ -15,8 +14,10 @@ This is an opt-in mechanism for making machine-applicable `@[deprecated]` defini whenever the deprecation lint also fires, allowing the user to replace the usage of the deprecated constant. -/ -namespace Std -open Lean Elab Server Lsp RequestM + +namespace Batteries + +open Lean Elab Server Lsp RequestM CodeAction /-- An environment extension for identifying `@[deprecated]` definitions which can be auto-fixed -/ initialize machineApplicableDeprecated : TagDeclarationExtension ← mkTagDeclarationExtension @@ -32,7 +33,7 @@ def deprecatedCodeActionProvider : CodeActionProvider := fun params snap => do for m in snap.msgLog.toList do if m.data.isDeprecationWarning then if h : _ then - msgs := msgs.push (snap.cmdState.messages.toList[i]) + msgs := msgs.push (snap.cmdState.messages.toList[i]'h) i := i + 1 if msgs.isEmpty then return #[] let start := doc.meta.text.lspPosToUtf8Pos params.range.start diff --git a/Batteries/CodeAction/Misc.lean b/Batteries/CodeAction/Misc.lean index 1b5be55ce6..4ad0a8099d 100644 --- a/Batteries/CodeAction/Misc.lean +++ b/Batteries/CodeAction/Misc.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Elab.BuiltinTerm import Lean.Elab.BuiltinNotation -import Batteries.Lean.Name import Batteries.Lean.Position import Batteries.CodeAction.Attr import Lean.Meta.Tactic.TryThis @@ -16,7 +15,7 @@ import Lean.Server.CodeActions.Provider This declares some basic tactic code actions, using the `@[tactic_code_action]` API. -/ -namespace Std.CodeAction +namespace Batteries.CodeAction open Lean Meta Elab Server RequestM CodeAction diff --git a/Batteries/Data/Array.lean b/Batteries/Data/Array.lean index 3a9bb1fef1..1f500b700a 100644 --- a/Batteries/Data/Array.lean +++ b/Batteries/Data/Array.lean @@ -4,3 +4,5 @@ import Batteries.Data.Array.Lemmas import Batteries.Data.Array.Match import Batteries.Data.Array.Merge import Batteries.Data.Array.Monadic +import Batteries.Data.Array.OfFn +import Batteries.Data.Array.Pairwise diff --git a/Batteries/Data/Array/Basic.lean b/Batteries/Data/Array/Basic.lean index 1dddea3c14..ad6b8129e6 100644 --- a/Batteries/Data/Array/Basic.lean +++ b/Batteries/Data/Array/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ -import Batteries.Data.List.Init.Attach import Batteries.Data.Array.Init.Lemmas /-! @@ -130,23 +129,6 @@ protected def maxI [ord : Ord α] [Inhabited α] (xs : Array α) (start := 0) (stop := xs.size) : α := xs.minI (ord := ord.opposite) start stop -/-- -Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of -`Array {x // P x}` is the same as the input `Array α`. --/ -@[inline] private unsafe def attachWithImpl - (xs : Array α) (P : α → Prop) (_ : ∀ x ∈ xs, P x) : Array {x // P x} := unsafeCast xs - -/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `xs` to produce a new array - with the same elements but in the type `{x // P x}`. -/ -@[implemented_by attachWithImpl] def attachWith - (xs : Array α) (P : α → Prop) (H : ∀ x ∈ xs, P x) : Array {x // P x} := - ⟨xs.data.attachWith P fun x h => H x (Array.Mem.mk h)⟩ - -/-- `O(1)`. "Attach" the proof that the elements of `xs` are in `xs` to produce a new array - with the same elements but in the type `{x // x ∈ xs}`. -/ -@[inline] def attach (xs : Array α) : Array {x // x ∈ xs} := xs.attachWith _ fun _ => id - /-- `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]` diff --git a/Batteries/Data/Array/Lemmas.lean b/Batteries/Data/Array/Lemmas.lean index 5a16a355e1..869c35b37e 100644 --- a/Batteries/Data/Array/Lemmas.lean +++ b/Batteries/Data/Array/Lemmas.lean @@ -11,7 +11,7 @@ import Batteries.Util.ProofWanted namespace Array -theorem forIn_eq_data_forIn [Monad m] +theorem forIn_eq_forIn_data [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 → @@ -22,15 +22,16 @@ theorem forIn_eq_data_forIn [Monad m] 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.get_cons_drop _ ⟨_, this⟩ + 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 +@[deprecated (since := "2024-08-13")] alias forIn_eq_data_forIn := forIn_eq_forIn_data /-! ### zipWith / zip -/ -theorem zipWith_eq_zipWith_data (f : α → β → γ) (as : Array α) (bs : Array β) : +theorem data_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : (as.zipWith bs f).data = as.data.zipWith f bs.data := 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 @@ -64,21 +65,22 @@ theorem zipWith_eq_zipWith_data (f : α → β → γ) (as : Array α) (bs : Arr let i_bs : Fin bs.data.length := ⟨i, hbs⟩ rw [h₁, List.append_assoc] congr - rw [← List.zipWith_append (h := by simp), getElem_eq_data_get, getElem_eq_data_get] - show List.zipWith f ((List.get as.data i_as) :: List.drop (i_as + 1) as.data) + 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 [List.get_cons_drop] - termination_by as.size - i + simp only [data_length, Fin.getElem_fin, List.getElem_cons_drop, List.get_eq_getElem] simp [zipWith, loop 0 #[] (by simp) (by simp)] +@[deprecated (since := "2024-08-13")] alias zipWith_eq_zipWith_data := data_zipWith theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : (as.zipWith bs f).size = min as.size bs.size := by - rw [size_eq_length_data, zipWith_eq_zipWith_data, List.length_zipWith] + rw [size_eq_length_data, data_zipWith, List.length_zipWith] -theorem zip_eq_zip_data (as : Array α) (bs : Array β) : +theorem data_zip (as : Array α) (bs : Array β) : (as.zip bs).data = as.data.zip bs.data := - zipWith_eq_zipWith_data Prod.mk as bs + data_zipWith Prod.mk as bs +@[deprecated (since := "2024-08-13")] alias zip_eq_zip_data := data_zip theorem size_zip (as : Array α) (bs : Array β) : (as.zip bs).size = min as.size bs.size := @@ -93,7 +95,7 @@ theorem size_filter_le (p : α → Bool) (l : Array α) : /-! ### join -/ -@[simp] theorem join_data {l : Array (Array α)} : l.join.data = (l.data.map data).join := by +@[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 @@ -102,9 +104,10 @@ theorem size_filter_le (p : α → Bool) (l : Array α) : 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, join_data, List.mem_join, List.mem_map] + simp only [mem_def, data_join, List.mem_join, List.mem_map] intro l constructor · rintro ⟨_, ⟨s, m, rfl⟩, h⟩ @@ -112,9 +115,64 @@ theorem mem_join : ∀ {L : Array (Array α)}, a ∈ L.join ↔ ∃ l, l ∈ L · rintro ⟨s, h₁, h₂⟩ refine ⟨s.data, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩ +/-! ### indexOf? -/ + +theorem indexOf?_data [BEq α] {a : α} {l : Array α} : + l.data.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 + rw [indexOfAux] + if h : i < l.size then + rw [List.drop_eq_getElem_cons h, ←getElem_eq_data_getElem, List.indexOf?_cons] + if h' : l[i] == a then + simp [h, h'] + else + simp [h, h', ←aux l (i+1), Function.comp_def, ←Nat.add_assoc, Nat.add_right_comm] + else + have h' : l.size ≤ i := Nat.le_of_not_lt h + simp [h, List.drop_of_length_le h', List.indexOf?] + termination_by l.size - i + /-! ### erase -/ -@[simp] proof_wanted erase_data [BEq α] {l : Array α} {a : α} : (l.erase a).data = l.data.erase a +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 + apply List.erase_of_forall_bne + rw [←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 -/ @@ -127,3 +185,123 @@ theorem size_shrink_loop (a : Array α) (n) : (shrink.loop n a).size = a.size - theorem size_shrink (a : Array α) (n) : (a.shrink n).size = min a.size n := by simp [shrink, size_shrink_loop] omega + +/-! ### set -/ + +theorem size_set! (a : Array α) (i v) : (a.set! i v).size = a.size := by + rw [set!_is_setD, size_setD] + +/-! ### 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 .. + +/-! ### mem -/ + +alias not_mem_empty := not_mem_nil + +theorem mem_singleton : a ∈ #[b] ↔ a = b := by simp + +/-! ### append -/ + +alias append_empty := append_nil + +alias empty_append := nil_append + +/-! ### insertAt -/ + +private theorem size_insertAt_loop (as : Array α) (i : Fin (as.size+1)) (j : Fin bs.size) : + (insertAt.loop as i bs j).size = bs.size := by + unfold insertAt.loop + split + · rw [size_insertAt_loop, size_swap] + · rfl + +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] + +private theorem get_insertAt_loop_lt (as : Array α) (i : Fin (as.size+1)) (j : Fin bs.size) + (k) (hk : k < (insertAt.loop as i bs j).size) (h : k < i) : + (insertAt.loop as i bs j)[k] = bs[k]'(size_insertAt_loop .. ▸ hk) := by + unfold insertAt.loop + 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] + exact h + · rfl + +private theorem get_insertAt_loop_gt (as : Array α) (i : Fin (as.size+1)) (j : Fin bs.size) + (k) (hk : k < (insertAt.loop as i bs j).size) (hgt : j < k) : + (insertAt.loop as i bs j)[k] = bs[k]'(size_insertAt_loop .. ▸ hk) := by + unfold insertAt.loop + 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] + exact Nat.lt_of_le_of_lt (Nat.pred_le _) hgt + · rfl + +private theorem get_insertAt_loop_eq (as : Array α) (i : Fin (as.size+1)) (j : Fin bs.size) + (k) (hk : k < (insertAt.loop as i bs j).size) (heq : i = k) (h : i.val ≤ j.val) : + (insertAt.loop as i bs j)[k] = bs[j] := by + 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 + exact heq + exact Nat.le_pred_of_lt h + · congr; omega + +private theorem get_insertAt_loop_gt_le (as : Array α) (i : Fin (as.size+1)) (j : Fin bs.size) + (k) (hk : k < (insertAt.loop as i bs j).size) (hgt : i < k) (hle : k ≤ j) : + (insertAt.loop as i bs j)[k] = bs[k-1] := by + unfold insertAt.loop + split + · next h => + 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 + 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 + 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 + · next h => + absurd h + exact Nat.lt_of_lt_of_le hgt hle + +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'] + 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'] + exact hgt + rw [size_insertAt] at hk + exact Nat.le_of_lt_succ hk + +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] + exact heq + exact Nat.le_of_lt_succ i.is_lt diff --git a/Batteries/Data/Array/Merge.lean b/Batteries/Data/Array/Merge.lean index 1486520565..aa83e0200b 100644 --- a/Batteries/Data/Array/Merge.lean +++ b/Batteries/Data/Array/Merge.lean @@ -27,7 +27,7 @@ where termination_by xs.size + ys.size - (i + j) set_option linter.unusedVariables false in -@[deprecated merge, inherit_doc merge] +@[deprecated merge (since := "2024-04-24"), inherit_doc merge] def mergeSortedPreservingDuplicates [ord : Ord α] (xs ys : Array α) : Array α := merge (compare · · |>.isLT) xs ys @@ -55,7 +55,7 @@ where | .eq => go (acc.push (merge x y)) (i + 1) (j + 1) termination_by xs.size + ys.size - (i + j) -@[deprecated] alias mergeSortedMergingDuplicates := mergeDedupWith +@[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 @@ -64,7 +64,7 @@ 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] alias mergeSortedDeduplicating := mergeDedup +@[deprecated (since := "2024-04-24")] alias mergeSortedDeduplicating := mergeDedup set_option linter.unusedVariables false in /-- @@ -83,7 +83,7 @@ where ys.foldl (init := xs) fun xs y => if xs.any (· == y) (stop := xsSize) then xs else xs.push y -@[deprecated] alias mergeUnsortedDeduplicating := mergeUnsortedDedup +@[deprecated (since := "2024-04-24")] alias mergeUnsortedDeduplicating := mergeUnsortedDedup /-- `O(|xs|)`. Replace each run `[x₁, ⋯, xₙ]` of equal elements in `xs` with @@ -101,7 +101,7 @@ where acc.push hd termination_by xs.size - i -@[deprecated] alias mergeAdjacentDuplicates := mergeAdjacentDups +@[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 @@ -110,13 +110,13 @@ where def dedupSorted [eq : BEq α] (xs : Array α) : Array α := xs.mergeAdjacentDups (eq := eq) fun x _ => x -@[deprecated] alias deduplicateSorted := dedupSorted +@[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] alias sortAndDeduplicate := sortDedup +@[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 a9821eb689..316813972a 100644 --- a/Batteries/Data/Array/Monadic.lean +++ b/Batteries/Data/Array/Monadic.lean @@ -102,7 +102,7 @@ theorem SatisfiesM_anyM_iff_exists [Monad m] [LawfulMonad m] · intro | true, h => simp only [true_iff]; exact h | false, h => - simp only [false_iff] + simp only [false_iff, reduceCtorEq] exact h.2.imp fun ⟨j, h₁, h₂, hq⟩ => ⟨j, h₁, Nat.lt_min.2 ⟨h₂, j.2⟩, hq⟩ | inr hstart => rw [anyM_stop_le_start (h := hstart)] diff --git a/Batteries/Data/Array/OfFn.lean b/Batteries/Data/Array/OfFn.lean new file mode 100644 index 0000000000..a5d3bc78bc --- /dev/null +++ b/Batteries/Data/Array/OfFn.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2024 Lean FRO. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Batteries.Data.List.OfFn + +open List + +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 + +end Array diff --git a/Batteries/Data/Array/Pairwise.lean b/Batteries/Data/Array/Pairwise.lean new file mode 100644 index 0000000000..84dff1f680 --- /dev/null +++ b/Batteries/Data/Array/Pairwise.lean @@ -0,0 +1,61 @@ +/- +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.Data.Array.Lemmas +import Batteries.Data.List.Pairwise + +namespace Array + +/-- +`Pairwise R as` means that all the elements of the array `as` are `R`-related to all elements with +larger indices. + +`Pairwise R #[1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3` + +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 + +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 + +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 + +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 + rw [pairwise_iff_getElem] + constructor + · intro h i j _ hj hlt; exact h ⟨j, hj⟩ ⟨i, hlt⟩ + · intro h ⟨j, hj⟩ ⟨i, hlt⟩; exact h i j (Nat.lt_trans hlt hj) hj hlt + decidable_of_iff _ this + +theorem pairwise_empty : #[].Pairwise R := by + unfold Pairwise; exact List.Pairwise.nil + +theorem pairwise_singleton (R : α → α → Prop) (a) : #[a].Pairwise R := by + unfold Pairwise; exact List.pairwise_singleton .. + +theorem pairwise_pair : #[a, b].Pairwise R ↔ R a b := by + unfold Pairwise; exact List.pairwise_pair + +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] + +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] + +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 ⊢ + intro _ _ _ _ hlt + apply h + exact Nat.add_lt_add_left hlt start diff --git a/Batteries/Data/BitVec.lean b/Batteries/Data/BitVec.lean deleted file mode 100644 index ff4358f07d..0000000000 --- a/Batteries/Data/BitVec.lean +++ /dev/null @@ -1 +0,0 @@ -import Batteries.Data.BitVec.Lemmas diff --git a/Batteries/Data/BitVec/Lemmas.lean b/Batteries/Data/BitVec/Lemmas.lean deleted file mode 100644 index e0e45b8cb0..0000000000 --- a/Batteries/Data/BitVec/Lemmas.lean +++ /dev/null @@ -1,19 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ -import Batteries.Tactic.Alias - -namespace BitVec - -/-- Replaced 2024-02-07. -/ -@[deprecated] alias zero_is_unique := eq_nil - -/-! ### sub/neg -/ - -/-- Replaced 2024-02-06. -/ -@[deprecated] alias sub_toNat := toNat_sub - -/-- Replaced 2024-02-06. -/ -@[deprecated] alias neg_toNat := toNat_neg diff --git a/Batteries/Data/Bool.lean b/Batteries/Data/Bool.lean deleted file mode 100644 index ab48cbc578..0000000000 --- a/Batteries/Data/Bool.lean +++ /dev/null @@ -1,19 +0,0 @@ -/- -Copyright (c) 2023 F. G. Dorais. No rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: F. G. Dorais --/ - -import Batteries.Tactic.Alias - -namespace Bool - -/-! ### injectivity lemmas -/ - -@[deprecated] alias not_inj' := not_inj_iff - -@[deprecated] alias and_or_inj_right' := and_or_inj_right_iff - -@[deprecated] alias and_or_inj_left' := and_or_inj_left_iff - -end Bool diff --git a/Batteries/Data/ByteArray.lean b/Batteries/Data/ByteArray.lean index f147eaf47b..ae4544fd21 100644 --- a/Batteries/Data/ByteArray.lean +++ b/Batteries/Data/ByteArray.lean @@ -3,7 +3,7 @@ Copyright (c) 2023 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.Data.Array.Lemmas +import Batteries.Tactic.Alias namespace ByteArray @@ -19,15 +19,18 @@ theorem getElem_eq_data_getElem (a : ByteArray) (h : i < a.size) : a[i] = a.data /-! ### empty -/ -@[simp] theorem mkEmpty_data (cap) : (mkEmpty cap).data = #[] := rfl +@[simp] theorem data_mkEmpty (cap) : (mkEmpty cap).data = #[] := rfl +@[deprecated (since := "2024-08-13")] alias mkEmpty_data := data_mkEmpty -@[simp] theorem empty_data : empty.data = #[] := rfl +@[simp] theorem data_empty : empty.data = #[] := rfl +@[deprecated (since := "2024-08-13")] alias empty_data := data_empty @[simp] theorem size_empty : empty.size = 0 := rfl /-! ### push -/ -@[simp] theorem push_data (a : ByteArray) (b : UInt8) : (a.push b).data = a.data.push b := rfl +@[simp] theorem data_push (a : ByteArray) (b : UInt8) : (a.push b).data = a.data.push b := rfl +@[deprecated (since := "2024-08-13")] alias push_data := data_push @[simp] theorem size_push (a : ByteArray) (b : UInt8) : (a.push b).size = a.size + 1 := Array.size_push .. @@ -41,8 +44,9 @@ theorem get_push_lt (a : ByteArray) (x : UInt8) (i : Nat) (h : i < a.size) : /-! ### set -/ -@[simp] theorem set_data (a : ByteArray) (i : Fin a.size) (v : UInt8) : +@[simp] theorem data_set (a : ByteArray) (i : Fin a.size) (v : UInt8) : (a.set i v).data = a.data.set i v := rfl +@[deprecated (since := "2024-08-13")] alias set_data := data_set @[simp] theorem size_set (a : ByteArray) (i : Fin a.size) (v : UInt8) : (a.set i v).size = a.size := @@ -61,20 +65,22 @@ theorem set_set (a : ByteArray) (i : Fin a.size) (v v' : UInt8) : /-! ### copySlice -/ -@[simp] theorem copySlice_data (a i b j len exact) : +@[simp] theorem data_copySlice (a i b j len exact) : (copySlice a i b j len exact).data = b.data.extract 0 j ++ a.data.extract i (i + len) ++ b.data.extract (j + min len (a.data.size - i)) b.data.size := rfl +@[deprecated (since := "2024-08-13")] alias copySlice_data := data_copySlice /-! ### append -/ @[simp] theorem append_eq (a b) : ByteArray.append a b = a ++ b := rfl -@[simp] theorem append_data (a b : ByteArray) : (a ++ b).data = a.data ++ b.data := by +@[simp] theorem data_append (a b : ByteArray) : (a ++ b).data = a.data ++ b.data := by rw [←append_eq]; simp [ByteArray.append, size] rw [Array.extract_empty_of_stop_le_start (h:=Nat.le_add_right ..), Array.append_nil] +@[deprecated (since := "2024-08-13")] alias append_data := data_append theorem size_append (a b : ByteArray) : (a ++ b).size = a.size + b.size := by - simp only [size, append_eq, append_data]; exact Array.size_append .. + simp only [size, append_eq, data_append]; exact Array.size_append .. 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 ..)) : @@ -88,12 +94,13 @@ theorem get_append_right {a b : ByteArray} (hle : a.size ≤ i) (h : i < (a ++ b /-! ### extract -/ -@[simp] theorem extract_data (a : ByteArray) (start stop) : +@[simp] theorem data_extract (a : ByteArray) (start stop) : (a.extract start stop).data = a.data.extract start stop := by simp [extract] match Nat.le_total start stop with | .inl h => simp [h, Nat.add_sub_cancel'] | .inr h => simp [h, Nat.sub_eq_zero_of_le, Array.extract_empty_of_stop_le_start] +@[deprecated (since := "2024-08-13")] alias extract_data := data_extract @[simp] theorem size_extract (a : ByteArray) (start stop) : (a.extract start stop).size = min stop a.size - start := by @@ -114,7 +121,8 @@ theorem get_extract_aux {a : ByteArray} {start stop} (h : i < (a.extract start s def ofFn (f : Fin n → UInt8) : ByteArray where data := .ofFn f -@[simp] theorem ofFn_data (f : Fin n → UInt8) : (ofFn f).data = .ofFn f := rfl +@[simp] theorem data_ofFn (f : Fin n → UInt8) : (ofFn f).data = .ofFn f := rfl +@[deprecated (since := "2024-08-13")] alias ofFn_data := data_ofFn @[simp] theorem size_ofFn (f : Fin n → UInt8) : (ofFn f).size = n := by simp [size] @@ -132,9 +140,44 @@ private def ofFnAux (f : Fin n → UInt8) : ByteArray := go 0 (mkEmpty n) where termination_by n - i @[csimp] private theorem ofFn_eq_ofFnAux : @ofFn = @ofFnAux := by - funext n f; ext; simp [ofFnAux, Array.ofFn, ofFnAux_data, mkEmpty] + funext n f; ext1; simp [ofFnAux, Array.ofFn, data_ofFnAux, mkEmpty] where - ofFnAux_data {n} (f : Fin n → UInt8) (i) {acc} : + data_ofFnAux {n} (f : Fin n → UInt8) (i) {acc} : (ofFnAux.go f i acc).data = Array.ofFn.go f i acc.data := by - rw [ofFnAux.go, Array.ofFn.go]; split; rw [ofFnAux_data f (i+1), push_data]; rfl + rw [ofFnAux.go, Array.ofFn.go]; split; rw [data_ofFnAux f (i+1), data_push]; rfl termination_by n - i + +/-! ### map/mapM -/ + +/-- +Unsafe optimized implementation of `mapM`. + +This function is unsafe because it relies on the implementation limit that the size of an array is +always less than `USize.size`. +-/ +@[inline] +unsafe def mapMUnsafe [Monad m] (a : ByteArray) (f : UInt8 → m UInt8) : m ByteArray := + loop a 0 a.usize +where + /-- Inner loop for `mapMUnsafe`. -/ + @[specialize] + loop (a : ByteArray) (k s : USize) := do + if k < a.usize then + let x := a.uget k lcProof + let y ← f x + let a := a.uset k y lcProof + loop a (k+1) s + else pure a + +/-- `mapM f a` applies the monadic function `f` to each element of the array. -/ +@[implemented_by mapMUnsafe] +def mapM [Monad m] (a : ByteArray) (f : UInt8 → m UInt8) : m ByteArray := do + let mut r := a + for i in [0:r.size] do + r := r.set! i (← f r[i]!) + return r + +/-- `map f a` applies the function `f` to each element of the array. -/ +@[inline] +def map (a : ByteArray) (f : UInt8 → UInt8) : ByteArray := + mapM (m:=Id) a f diff --git a/Batteries/Data/ByteSubarray.lean b/Batteries/Data/ByteSubarray.lean new file mode 100644 index 0000000000..3844d1b1bc --- /dev/null +++ b/Batteries/Data/ByteSubarray.lean @@ -0,0 +1,105 @@ + +/- +Copyright (c) 2021 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, François G. Dorais +-/ + +namespace Batteries + +/-- A subarray of a `ByteArray`. -/ +structure ByteSubarray where + /-- `O(1)`. Get data array of a `ByteSubarray`. -/ + array : ByteArray + /-- `O(1)`. Get start index of a `ByteSubarray`. -/ + start : Nat + /-- `O(1)`. Get stop index of a `ByteSubarray`. -/ + stop : Nat + /-- Start index is before stop index. -/ + start_le_stop : start ≤ stop + /-- Stop index is before end of data array. -/ + stop_le_array_size : stop ≤ array.size + +namespace ByteSubarray + +/-- `O(1)`. Get the size of a `ByteSubarray`. -/ +protected def size (self : ByteSubarray) := self.stop - self.start + +/-- `O(1)`. Test if a `ByteSubarray` is empty. -/ +protected def isEmpty (self : ByteSubarray) := self.start != self.stop + +theorem stop_eq_start_add_size (self : ByteSubarray) : self.stop = self.start + self.size := by + rw [ByteSubarray.size, Nat.add_sub_cancel' self.start_le_stop] + +/-- `O(n)`. Extract a `ByteSubarray` to a `ByteArray`. -/ +def toByteArray (self : ByteSubarray) : ByteArray := + self.array.extract self.start self.stop + +/-- `O(1)`. Get the element at index `i` from the start of a `ByteSubarray`. -/ +@[inline] def get (self : ByteSubarray) (i : Fin self.size) : UInt8 := + have : self.start + i.1 < self.array.size := by + apply Nat.lt_of_lt_of_le _ self.stop_le_array_size + rw [stop_eq_start_add_size] + apply Nat.add_lt_add_left i.is_lt self.start + self.array[self.start + i.1] + +instance : GetElem ByteSubarray Nat UInt8 fun self i => i < self.size where + getElem self i h := self.get ⟨i, h⟩ + +/-- `O(1)`. Pop the last element of a `ByteSubarray`. -/ +@[inline] def pop (self : ByteSubarray) : ByteSubarray := + if h : self.start = self.stop then self else + {self with + stop := self.stop - 1 + start_le_stop := Nat.le_pred_of_lt (Nat.lt_of_le_of_ne self.start_le_stop h) + stop_le_array_size := Nat.le_trans (Nat.pred_le _) self.stop_le_array_size + } + +/-- `O(1)`. Pop the first element of a `ByteSubarray`. -/ +@[inline] def popFront (self : ByteSubarray) : ByteSubarray := + if h : self.start = self.stop then self else + {self with + start := self.start + 1 + start_le_stop := Nat.succ_le_of_lt (Nat.lt_of_le_of_ne self.start_le_stop h) + } + +/-- Folds a monadic function over a `ByteSubarray` from left to right. -/ +@[inline] def foldlM [Monad m] (self : ByteSubarray) (f : β → UInt8 → m β) (init : β) : m β := + self.array.foldlM f init self.start self.stop + +/-- Folds a function over a `ByteSubarray` from left to right. -/ +@[inline] def foldl (self : ByteSubarray) (f : β → UInt8 → β) (init : β) : β := + self.foldlM (m:=Id) f init + +/-- Implementation of `forIn` for a `ByteSubarray`. -/ +@[specialize] +protected def forIn [Monad m] (self : ByteSubarray) (init : β) (f : UInt8 → β → m (ForInStep β)) : + m β := loop self.size (Nat.le_refl _) init +where + /-- Inner loop of the `forIn` implementation for `ByteSubarray`. -/ + loop (i : Nat) (h : i ≤ self.size) (b : β) : m β := do + match i, h with + | 0, _ => pure b + | i+1, h => + match (← f self[self.size - 1 - i] b) with + | ForInStep.done b => pure b + | ForInStep.yield b => loop i (Nat.le_of_succ_le h) b + +instance : ForIn m ByteSubarray UInt8 where + forIn := ByteSubarray.forIn + +instance : Stream ByteSubarray UInt8 where + next? s := s[0]? >>= fun x => (x, s.popFront) + +end Batteries.ByteSubarray + +/-- `O(1)`. Coerce a byte array into a byte slice. -/ +def ByteArray.toByteSubarray (array : ByteArray) : Batteries.ByteSubarray where + array := array + start := 0 + stop := array.size + start_le_stop := Nat.zero_le _ + stop_le_array_size := Nat.le_refl _ + +instance : Coe ByteArray Batteries.ByteSubarray where + coe := ByteArray.toByteSubarray diff --git a/Batteries/Data/Char.lean b/Batteries/Data/Char.lean index c94b35ac44..4f3c59ef0b 100644 --- a/Batteries/Data/Char.lean +++ b/Batteries/Data/Char.lean @@ -4,11 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Batteries.Data.UInt - -@[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b - | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl - -theorem Char.ext_iff {x y : Char} : x = y ↔ x.val = y.val := ⟨congrArg _, Char.ext⟩ +import Batteries.Tactic.Alias theorem Char.le_antisymm_iff {x y : Char} : x = y ↔ x ≤ y ∧ y ≤ x := Char.ext_iff.trans UInt32.le_antisymm_iff @@ -21,16 +17,7 @@ instance : Batteries.LawfulOrd Char := .compareOfLessAndEq namespace String -private theorem csize_eq (c) : - csize c = 1 ∨ csize c = 2 ∨ csize c = 3 ∨ - csize c = 4 := by - simp only [csize, Char.utf8Size] - repeat (first | split | (solve | simp (config := {decide := true}))) - -theorem csize_pos (c) : 0 < csize c := by - rcases csize_eq c with _|_|_|_ <;> simp_all (config := {decide := true}) - -theorem csize_le_4 (c) : csize c ≤ 4 := by - rcases csize_eq c with _|_|_|_ <;> simp_all (config := {decide := true}) +@[deprecated (since := "2024-06-11")] alias csize_pos := Char.utf8Size_pos +@[deprecated (since := "2024-06-11")] alias csize_le_4 := Char.utf8Size_le_four end String diff --git a/Batteries/Data/Fin/Lemmas.lean b/Batteries/Data/Fin/Lemmas.lean index a310aa6f93..5ddde152de 100644 --- a/Batteries/Data/Fin/Lemmas.lean +++ b/Batteries/Data/Fin/Lemmas.lean @@ -9,12 +9,6 @@ namespace Fin attribute [norm_cast] val_last -protected theorem le_antisymm_iff {x y : Fin n} : x = y ↔ x ≤ y ∧ y ≤ x := - Fin.ext_iff.trans Nat.le_antisymm_iff - -protected theorem le_antisymm {x y : Fin n} (h1 : x ≤ y) (h2 : y ≤ x) : x = y := - Fin.le_antisymm_iff.2 ⟨h1, h2⟩ - /-! ### clamp -/ @[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl @@ -30,8 +24,13 @@ protected theorem le_antisymm {x y : Fin n} (h1 : x ≤ y) (h2 : y ≤ x) : x = @[simp] theorem length_list (n) : (list n).length = n := by simp [list] -@[simp] theorem get_list (i : Fin (list n).length) : (list n).get i = i.cast (length_list n) := by - cases i; simp only [list]; rw [← Array.getElem_eq_data_get, getElem_enum, cast_mk] +@[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] + +@[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 + simp [getElem_list] @[simp] theorem list_zero : list 0 = [] := by simp [list] @@ -41,18 +40,18 @@ 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 => rfl + | zero => simp [last] | 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 => rfl + | zero => simp [last] | succ n ih => conv => lhs; rw [list_succ_last] conv => rhs; rw [list_succ] - simp [List.reverse_map, ih, Function.comp_def, rev_succ] + simp [← List.map_reverse, ih, Function.comp_def, rev_succ] /-! ### foldl -/ diff --git a/Batteries/Data/FloatArray.lean b/Batteries/Data/FloatArray.lean new file mode 100644 index 0000000000..a0ef34073c --- /dev/null +++ b/Batteries/Data/FloatArray.lean @@ -0,0 +1,40 @@ +/- +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 FloatArray + +/-- +Unsafe optimized implementation of `mapM`. + +This function is unsafe because it relies on the implementation limit that the size of an array is +always less than `USize.size`. +-/ +@[inline] +unsafe def mapMUnsafe [Monad m] (a : FloatArray) (f : Float → m Float) : m FloatArray := + loop a 0 a.usize +where + /-- Inner loop for `mapMUnsafe`. -/ + @[specialize] + loop (a : FloatArray) (k s : USize) := do + if k < s then + let x := a.uget k lcProof + let y ← f x + let a := a.uset k y lcProof + loop a (k+1) s + else pure a + +/-- `mapM f a` applies the monadic function `f` to each element of the array. -/ +@[implemented_by mapMUnsafe] +def mapM [Monad m] (a : FloatArray) (f : Float → m Float) : m FloatArray := do + let mut r := a + for i in [0:r.size] do + r := r.set! i (← f r[i]!) + return r + +/-- `map f a` applies the function `f` to each element of the array. -/ +@[inline] +def map (a : FloatArray) (f : Float → Float) : FloatArray := + mapM (m:=Id) a f diff --git a/Batteries/Data/HashMap/Basic.lean b/Batteries/Data/HashMap/Basic.lean index 106fea1e4d..3419ba35ab 100644 --- a/Batteries/Data/HashMap/Basic.lean +++ b/Batteries/Data/HashMap/Basic.lean @@ -6,7 +6,6 @@ Authors: Leonardo de Moura, Mario Carneiro import Batteries.Data.AssocList import Batteries.Data.Nat.Basic import Batteries.Data.Array.Monadic -import Batteries.Classes.BEq namespace Batteries.HashMap diff --git a/Batteries/Data/HashMap/Lemmas.lean b/Batteries/Data/HashMap/Lemmas.lean index 50efb40455..79107fc0bf 100644 --- a/Batteries/Data/HashMap/Lemmas.lean +++ b/Batteries/Data/HashMap/Lemmas.lean @@ -4,8 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Batteries.Data.HashMap.Basic -import Batteries.Data.Array.Lemmas -import Batteries.Util.ProofWanted + +/-! +# Lemmas for `Batteries.HashMap` + +Note that Lean core provides an alternative hash map implementation, `Std.HashMap`, which comes with +more lemmas. See the module `Std.Data.HashMap.Lemmas`. +-/ namespace Batteries.HashMap @@ -21,5 +26,7 @@ end Imp @[simp] theorem empty_find? [BEq α] [Hashable α] {a : α} : (∅ : HashMap α β).find? a = none := by simp [find?, Imp.find?] -proof_wanted insert_find? [BEq α] [Hashable α] (m : HashMap α β) (a a' : α) (b : β) : - (m.insert a b).find? a' = if a' == a then some b else m.find? a' +-- `Std.HashMap` has this lemma (as `getElem?_insert`) and many more, so working on this +-- `proof_wanted` is likely not a good use of your time. +-- proof_wanted insert_find? [BEq α] [Hashable α] (m : HashMap α β) (a a' : α) (b : β) : +-- (m.insert a b).find? a' = if a' == a then some b else m.find? a' diff --git a/Batteries/Data/HashMap/WF.lean b/Batteries/Data/HashMap/WF.lean index 57b121c83c..258723a89b 100644 --- a/Batteries/Data/HashMap/WF.lean +++ b/Batteries/Data/HashMap/WF.lean @@ -3,9 +3,10 @@ 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.Tactic.SeqFocus import Batteries.Data.HashMap.Basic -import Batteries.Data.Array.Lemmas import Batteries.Data.Nat.Lemmas +import Batteries.Data.List.Lemmas namespace Batteries.HashMap namespace Imp @@ -23,8 +24,8 @@ theorem update_data (self : Buckets α β) (i d h) : 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_get] - exact List.exists_of_set' h + simp only [Array.data_length, Array.ugetElem_eq_getElem, Array.getElem_eq_data_getElem] + 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 @@ -37,13 +38,13 @@ theorem size_eq (data : Buckets α β) : theorem mk_size (h) : (mk n h : Buckets α β).size = 0 := by simp only [mk, mkArray, size_eq]; clear h - induction n <;> simp [*] + induction n <;> simp_all [List.replicate_succ] theorem WF.mk' [BEq α] [Hashable α] (h) : (Buckets.mk n h : Buckets α β).WF := by 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_get, AssocList.All] + · simp [Buckets.mk, empty', mkArray, Array.getElem_eq_data_getElem, AssocList.All] theorem WF.update [BEq α] [Hashable α] {buckets : Buckets α β} {i d h} (H : buckets.WF) (h₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], @@ -57,7 +58,8 @@ theorem WF.update [BEq α] [Hashable α] {buckets : Buckets α β} {i d h} (H : | .inl hl => H.1 _ hl | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_data ..)) · revert hp - simp only [Array.getElem_eq_data_get, update_data, List.get_set, Array.data_length, update_size] + simp only [Array.getElem_eq_data_getElem, update_data, List.getElem_set, Array.data_length, + update_size] split <;> intro hp · next eq => exact eq ▸ h₂ (H.2 _ _) _ hp · simp only [update_size, Array.data_length] at hi @@ -87,23 +89,26 @@ 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.getD j .nil = .nil) : + go (i source) (target : Buckets α β) (hs : ∀ j < i, source.data[j]?.getD .nil = .nil) : (expand.go i source target).size = .sum (source.data.map (·.toList.length)) + target.size := by unfold expand.go; split · next H => - refine (go (i+1) _ _ fun j hj => ?a).trans ?b <;> simp + refine (go (i+1) _ _ fun j hj => ?a).trans ?b · case a => - simp only [List.getD_eq_get?, List.get?_set, Option.map_eq_map]; split - · cases List.get? .. <;> rfl + simp only [Array.data_length, Array.data_set] + simp [List.getD_eq_getElem?_getD, List.getElem?_set, Option.map_eq_map]; split + · cases source.data[j]? <;> rfl · next H => exact hs _ (Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) (Ne.symm H)) · case b => - refine have ⟨l₁, l₂, h₁, _, eq⟩ := List.exists_of_set' H; eq ▸ ?_ - simp only [Buckets.size_eq, h₁, List.map_append, List.map_cons, AssocList.toList, - List.length_nil, Nat.sum_append, Nat.sum_cons, Nat.zero_add, Array.data_length] + simp only [Array.data_length, Array.data_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] 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_get] + rw [← Array.getElem_eq_data_getElem] have := @reinsertAux_size α β _; simp [Buckets.size] at this induction source[i].toList generalizing target <;> simp [*, Nat.succ_add]; rfl · next H => @@ -111,10 +116,10 @@ where rw [← (_ : source.data.map (fun _ => .nil) = source.data)] · simp only [List.map_map] induction source.data <;> simp [*] - refine List.ext_get (by simp) fun j h₁ h₂ => ?_ - simp only [List.get_map, Array.data_length] + refine List.ext_getElem (by simp) fun j h₁ h₂ => ?_ + simp only [List.getElem_map, Array.data_length] have := (hs j (Nat.lt_of_lt_of_le h₂ (Nat.not_lt.1 H))).symm - rwa [List.getD_eq_get?, List.get?_eq_get, Option.getD_some] at this + rwa [List.getElem?_eq_getElem] at this termination_by source.size - i theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α × β)} {i : Nat} @@ -166,8 +171,8 @@ 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_get, Array.data_set, - List.get_set] + · simp only [Array.data_length, Array.size_set, Array.getElem_eq_data_getElem, Array.data_set, + List.getElem_set] split · nofun · exact hs₂ _ (by simp_all) @@ -222,7 +227,7 @@ private theorem pairwise_replaceF [BEq α] [PartialEquivBEq α] | cons a l ih => simp only [List.pairwise_cons, List.replaceF] at H ⊢ generalize e : cond .. = z; unfold cond at e; revert e - split <;> (intro h; subst h; simp) + split <;> (intro h; subst h; simp only [List.pairwise_cons]) · next e => exact ⟨(H.1 · · ∘ PartialEquivBEq.trans e), H.2⟩ · next e => refine ⟨fun a h => ?_, ih H.2⟩ @@ -313,7 +318,7 @@ theorem WF.mapVal {α β γ} {f : α → β → γ} [BEq α] [Hashable α] 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_iff] + · simp only [Array.map_data, 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, @@ -359,13 +364,13 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable simp only [Array.mapM_eq_mapM_data, bind, StateT.bind, 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_iff, List.toList_toAssocList] + · simp only [List.forall_mem_map, List.toList_toAssocList] refine fun l h => (List.pairwise_reverse.2 ?_).imp (mt PartialEquivBEq.symm) 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_get, - List.get_map] at h ⊢ + · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_getElem, + List.getElem_map] at h ⊢ have := H.out.2.2 _ h simp only [AssocList.All, List.toList_toAssocList, List.mem_reverse, List.mem_filterMap, Option.map_eq_some', forall_exists_index, and_imp, g₁] at this ⊢ diff --git a/Batteries/Data/Int.lean b/Batteries/Data/Int.lean deleted file mode 100644 index 29b6c2e4a9..0000000000 --- a/Batteries/Data/Int.lean +++ /dev/null @@ -1,3 +0,0 @@ -import Batteries.Data.Int.DivMod -import Batteries.Data.Int.Lemmas -import Batteries.Data.Int.Order diff --git a/Batteries/Data/Int/DivMod.lean b/Batteries/Data/Int/DivMod.lean deleted file mode 100644 index 7558c98a3d..0000000000 --- a/Batteries/Data/Int/DivMod.lean +++ /dev/null @@ -1,84 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Mario Carneiro --/ -import Batteries.Data.Int.Order - -/-! -# Lemmas about integer division --/ - - -open Nat - -namespace Int - -/-! -### The following lemmas have been commented out here for a while, and need restoration. --/ - -/- -theorem eq_mul_ediv_of_mul_eq_mul_of_dvd_left {a b c d : Int} - (hb : b ≠ 0) (hbc : b ∣ c) (h : b * a = c * d) : a = c / b * d := by - rcases hbc with ⟨k, hk⟩ - subst hk - rw [Int.mul_ediv_cancel_left _ hb] - rw [Int.mul_assoc] at h - apply mul_left_cancel₀ hb h - -/-- If an integer with larger absolute value divides an integer, it is -zero. -/ -theorem eq_zero_of_dvd_ofNatAbs_lt_natAbs {a b : Int} (w : a ∣ b) (h : natAbs b < natAbs a) : - b = 0 := by - rw [← natAbs_dvd, ← dvd_natAbs, ofNat_dvd] at w - rw [← natAbs_eq_zero] - exact eq_zero_of_dvd_of_lt w h - -theorem eq_zero_of_dvd_of_nonneg_of_lt {a b : Int} (w₁ : 0 ≤ a) (w₂ : a < b) (h : b ∣ a) : a = 0 := - eq_zero_of_dvd_ofNatAbs_lt_natAbs h (natAbs_lt_natAbs_of_nonneg_of_lt w₁ w₂) - -/-- If two integers are congruent to a sufficiently large modulus, -they are equal. -/ -theorem eq_of_mod_eq_ofNatAbs_sub_lt_natAbs {a b c : Int} - (h1 : a % b = c) (h2 : natAbs (a - c) < natAbs b) : a = c := - Int.eq_of_sub_eq_zero (eq_zero_of_dvd_ofNatAbs_lt_natAbs (dvd_sub_of_emod_eq h1) h2) - -theorem ofNat_add_negSucc_of_lt {m n : Nat} (h : m < n.succ) : ofNat m + -[n+1] = -[n+1 - m] := by - change subNatNat _ _ = _ - have h' : n.succ - m = (n - m).succ - apply succ_sub - apply le_of_lt_succ h - simp [*, subNatNat] - -theorem ofNat_add_negSucc_of_ge {m n : Nat} (h : n.succ ≤ m) : - ofNat m + -[n+1] = ofNat (m - n.succ) := by - change subNatNat _ _ = _ - have h' : n.succ - m = 0 - apply tsub_eq_zero_iff_le.mpr h - simp [*, subNatNat] - -@[simp] -theorem neg_add_neg (m n : Nat) : -[m+1] + -[n+1] = -[Nat+1.succ (m + n)] := - rfl - -theorem natAbs_le_of_dvd_ne_zero {s t : Int} (hst : s ∣ t) (ht : t ≠ 0) : natAbs s ≤ natAbs t := - not_lt.mp (mt (eq_zero_of_dvd_ofNatAbs_lt_natAbs hst) ht) - -theorem natAbs_eq_of_dvd_dvd {s t : Int} (hst : s ∣ t) (hts : t ∣ s) : natAbs s = natAbs t := - Nat.dvd_antisymm (natAbs_dvd_iff_dvd.mpr hst) (natAbs_dvd_iff_dvd.mpr hts) - -theorem div_dvd_of_dvd {s t : Int} (hst : s ∣ t) : t / s ∣ t := by - rcases eq_or_ne s 0 with (rfl | hs) - · simpa using hst - rcases hst with ⟨c, hc⟩ - simp [hc, Int.mul_div_cancel_left _ hs] - -theorem dvd_div_of_mul_dvd {a b c : Int} (h : a * b ∣ c) : b ∣ c / a := by - rcases eq_or_ne a 0 with (rfl | ha) - · simp only [Int.div_zero, dvd_zero] - - rcases h with ⟨d, rfl⟩ - refine' ⟨d, _⟩ - rw [mul_assoc, Int.mul_div_cancel_left _ ha] --/ diff --git a/Batteries/Data/Int/Lemmas.lean b/Batteries/Data/Int/Lemmas.lean deleted file mode 100644 index 3ce6c74c04..0000000000 --- a/Batteries/Data/Int/Lemmas.lean +++ /dev/null @@ -1,6 +0,0 @@ --- This is a backwards compatibility shim, --- after `Batteries.Data.Int.Lemmas` was split into smaller files. --- Hopefully it can later be removed. - -import Batteries.Data.Int.Order -import Batteries.Data.Int.DivMod diff --git a/Batteries/Data/Int/Order.lean b/Batteries/Data/Int/Order.lean deleted file mode 100644 index 3855f19885..0000000000 --- a/Batteries/Data/Int/Order.lean +++ /dev/null @@ -1,10 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro --/ -import Batteries.Tactic.Alias - -namespace Int - -@[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Batteries/Data/LazyList.lean b/Batteries/Data/LazyList.lean index 9deb41e77b..7a3074d1b6 100644 --- a/Batteries/Data/LazyList.lean +++ b/Batteries/Data/LazyList.lean @@ -1,12 +1,17 @@ /- Copyright (c) 2017 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura +Authors: Leonardo de Moura, Simon Hudon -/ /-! # Lazy lists +Deprecated. This module is deprecated and will be removed in the future. +Most use cases can use `MLList`. Without custom support from the kernel +(previously provided in Lean 3) this type is not very useful, +but was ported from Lean 3 anyway. + The type `LazyList α` is a lazy list with elements of type `α`. In the VM, these are potentially infinite lists where all elements after the first are computed on-demand. @@ -17,6 +22,7 @@ logically we can prove that `LazyList α` is isomorphic to `List α`.) /-- Lazy list. All elements (except the first) are computed lazily. -/ +@[deprecated "Consider using `MLList`." (since := "2024-07-15")] inductive LazyList (α : Type u) : Type u /-- The empty lazy list. -/ | nil : LazyList α @@ -24,6 +30,7 @@ inductive LazyList (α : Type u) : Type u | cons (hd : α) (tl : Thunk <| LazyList α) : LazyList α +set_option linter.deprecated false namespace LazyList @@ -117,4 +124,160 @@ partial def iterates (f : α → α) : α → LazyList α partial def iota (i : Nat) : LazyList Nat := iterates Nat.succ i + +instance decidableEq {α : Type u} [DecidableEq α] : DecidableEq (LazyList α) + | nil, nil => isTrue rfl + | cons x xs, cons y ys => + if h : x = y then + match decidableEq xs.get ys.get with + | isFalse h2 => by + apply isFalse; simp only [cons.injEq, not_and]; intro _ xs_ys; apply h2; rw [xs_ys] + | isTrue h2 => by apply isTrue; congr; ext; exact h2 + else by apply isFalse; simp only [cons.injEq, not_and]; intro; contradiction + | nil, cons _ _ => by apply isFalse; simp + | cons _ _, nil => by apply isFalse; simp + +/-- Traversal of lazy lists using an applicative effect. -/ +protected def traverse {m : Type u → Type u} [Applicative m] {α β : Type u} (f : α → m β) : + LazyList α → m (LazyList β) + | LazyList.nil => pure LazyList.nil + | LazyList.cons x xs => LazyList.cons <$> f x <*> Thunk.pure <$> xs.get.traverse f + +/-- `init xs`, if `xs` non-empty, drops the last element of the list. +Otherwise, return the empty list. -/ +def init {α} : LazyList α → LazyList α + | LazyList.nil => LazyList.nil + | LazyList.cons x xs => + let xs' := xs.get + match xs' with + | LazyList.nil => LazyList.nil + | LazyList.cons _ _ => LazyList.cons x (init xs') + +/-- Return the first object contained in the list that satisfies +predicate `p` -/ +def find {α} (p : α → Prop) [DecidablePred p] : LazyList α → Option α + | nil => none + | cons h t => if p h then some h else t.get.find p + +/-- `interleave xs ys` creates a list where elements of `xs` and `ys` alternate. -/ +def interleave {α} : LazyList α → LazyList α → LazyList α + | LazyList.nil, xs => xs + | a@(LazyList.cons _ _), LazyList.nil => a + | LazyList.cons x xs, LazyList.cons y ys => + LazyList.cons x (LazyList.cons y (interleave xs.get ys.get)) + +/-- `interleaveAll (xs::ys::zs::xss)` creates a list where elements of `xs`, `ys` +and `zs` and the rest alternate. Every other element of the resulting list is taken from +`xs`, every fourth is taken from `ys`, every eighth is taken from `zs` and so on. -/ +def interleaveAll {α} : List (LazyList α) → LazyList α + | [] => LazyList.nil + | x :: xs => interleave x (interleaveAll xs) + +/-- Monadic bind operation for `LazyList`. -/ +protected def bind {α β} : LazyList α → (α → LazyList β) → LazyList β + | LazyList.nil, _ => LazyList.nil + | LazyList.cons x xs, f => (f x).append (xs.get.bind f) + +/-- Reverse the order of a `LazyList`. +It is done by converting to a `List` first because reversal involves evaluating all +the list and if the list is all evaluated, `List` is a better representation for +it than a series of thunks. -/ +def reverse {α} (xs : LazyList α) : LazyList α := + ofList xs.toList.reverse + +instance : Monad LazyList where + pure := @LazyList.singleton + bind := @LazyList.bind + +-- Porting note: Added `Thunk.pure` to definition. +theorem append_nil {α} (xs : LazyList α) : xs.append (Thunk.pure LazyList.nil) = xs := by + induction xs using LazyList.rec with + | nil => simp only [Thunk.pure, append, Thunk.get] + | cons _ _ => simpa only [append, cons.injEq, true_and] + | mk _ ih => ext; apply ih + +theorem append_assoc {α} (xs ys zs : LazyList α) : + (xs.append ys).append zs = xs.append (ys.append zs) := by + induction xs using LazyList.rec with + | nil => simp only [append, Thunk.get] + | cons _ _ => simpa only [append, cons.injEq, true_and] + | mk _ ih => ext; apply ih + +-- Porting note: Rewrote proof of `append_bind`. +theorem append_bind {α β} (xs : LazyList α) (ys : Thunk (LazyList α)) (f : α → LazyList β) : + (xs.append ys).bind f = (xs.bind f).append (ys.get.bind f) := by + match xs with + | LazyList.nil => + simp only [append, Thunk.get, LazyList.bind] + | LazyList.cons x xs => + simp only [append, Thunk.get, LazyList.bind] + have := append_bind xs.get ys f + simp only [Thunk.get] at this + rw [this, append_assoc] + +-- TODO: upstream from mathlib +-- instance : LawfulMonad LazyList.{u} + +/-- Try applying function `f` to every element of a `LazyList` and +return the result of the first attempt that succeeds. -/ +def mfirst {m} [Alternative m] {α β} (f : α → m β) : LazyList α → m β + | nil => failure + | cons x xs => f x <|> xs.get.mfirst f + +/-- Membership in lazy lists -/ +protected def Mem {α} (x : α) : LazyList α → Prop + | nil => False + | cons y ys => x = y ∨ ys.get.Mem x + +instance {α} : Membership α (LazyList α) where + mem l a := LazyList.Mem a l + +instance Mem.decidable {α} [DecidableEq α] (x : α) : ∀ xs : LazyList α, Decidable (x ∈ xs) + | LazyList.nil => by + apply Decidable.isFalse + simp [Membership.mem, LazyList.Mem] + | LazyList.cons y ys => + if h : x = y then by + apply Decidable.isTrue + simp only [Membership.mem, LazyList.Mem] + exact Or.inl h + else by + have := Mem.decidable x ys.get + have : (x ∈ ys.get) ↔ (x ∈ cons y ys) := by simp [Membership.mem, LazyList.Mem, h] + exact decidable_of_decidable_of_iff this + +@[simp] +theorem mem_nil {α} (x : α) : x ∈ @LazyList.nil α ↔ False := by + simp [Membership.mem, LazyList.Mem] + +@[simp] +theorem mem_cons {α} (x y : α) (ys : Thunk (LazyList α)) : + x ∈ @LazyList.cons α y ys ↔ x = y ∨ x ∈ ys.get := by + simp [Membership.mem, LazyList.Mem] + +theorem forall_mem_cons {α} {p : α → Prop} {a : α} {l : Thunk (LazyList α)} : + (∀ x ∈ @LazyList.cons _ a l, p x) ↔ p a ∧ ∀ x ∈ l.get, p x := by + simp only [Membership.mem, LazyList.Mem, or_imp, forall_and, forall_eq] + +/-! ### map for partial functions -/ + + +/-- Partial map. If `f : ∀ a, p a → β` is a partial function defined on + `a : α` satisfying `p`, then `pmap f l h` is essentially the same as `map f l` + but is defined only when all members of `l` satisfy `p`, using the proof + to apply `f`. -/ +@[simp] +def pmap {α β} {p : α → Prop} (f : ∀ a, p a → β) : ∀ l : LazyList α, (∀ a ∈ l, p a) → LazyList β + | LazyList.nil, _ => LazyList.nil + | LazyList.cons x xs, H => + LazyList.cons (f x (forall_mem_cons.1 H).1) (xs.get.pmap f (forall_mem_cons.1 H).2) + +/-- "Attach" the proof that the elements of `l` are in `l` to produce a new `LazyList` + with the same elements but in the type `{x // x ∈ l}`. -/ +def attach {α} (l : LazyList α) : LazyList { x // x ∈ l } := + pmap Subtype.mk l fun _ => id + +instance {α} [Repr α] : Repr (LazyList α) := + ⟨fun xs _ => repr xs.toList⟩ + end LazyList diff --git a/Batteries/Data/List.lean b/Batteries/Data/List.lean index d060ba89c8..f93f90a6c2 100644 --- a/Batteries/Data/List.lean +++ b/Batteries/Data/List.lean @@ -1,8 +1,8 @@ import Batteries.Data.List.Basic import Batteries.Data.List.Count import Batteries.Data.List.EraseIdx -import Batteries.Data.List.Init.Attach import Batteries.Data.List.Init.Lemmas import Batteries.Data.List.Lemmas +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 aacd1c9f2c..c2d76ed0e6 100644 --- a/Batteries/Data/List/Basic.lean +++ b/Batteries/Data/List/Basic.lean @@ -10,16 +10,6 @@ namespace List /-! ## New definitions -/ -/-- -`l₁ ⊆ l₂` means that every element of `l₁` is also an element of `l₂`, ignoring multiplicity. --/ -protected def Subset (l₁ l₂ : List α) := ∀ ⦃a : α⦄, a ∈ l₁ → a ∈ l₂ - -instance : HasSubset (List α) := ⟨List.Subset⟩ - -instance [DecidableEq α] : DecidableRel (Subset : List α → List α → Prop) := - fun _ _ => decidableBAll _ _ - /-- Computes the "bag intersection" of `l₁` and `l₂`, that is, the collection of elements of `l₁` which are also in `l₂`. As each element @@ -37,15 +27,6 @@ protected def diff {α} [BEq α] : List α → List α → List α open Option Nat -/-- Get the tail of a nonempty list, or return `[]` for `[]`. -/ -def tail : List α → List α - | [] => [] - | _::as => as - --- FIXME: `@[simp]` on the definition simplifies even `tail l` -@[simp] theorem tail_nil : @tail α [] = [] := rfl -@[simp] theorem tail_cons : @tail α (a::as) = as := rfl - /-- Get the head and tail of a list, if it is nonempty. -/ @[inline] def next? : List α → Option (α × List α) | [] => none @@ -83,19 +64,9 @@ drop_while (· != 1) [0, 1, 2, 3] = [1, 2, 3] | [] => [] | x :: xs => bif p x then xs else after p xs -/-- Returns the index of the first element satisfying `p`, or the length of the list otherwise. -/ -@[inline] def findIdx (p : α → Bool) (l : List α) : Nat := go l 0 where - /-- Auxiliary for `findIdx`: `findIdx.go p l n = findIdx p l + n` -/ - @[specialize] go : List α → Nat → Nat - | [], n => n - | a :: l, n => bif p a then n else go l (n + 1) - -/-- Returns the index of the first element equal to `a`, or the length of the list otherwise. -/ -def indexOf [BEq α] (a : α) : List α → Nat := findIdx (· == a) - -@[deprecated] alias removeNth := eraseIdx -@[deprecated] alias removeNthTR := eraseIdxTR -@[deprecated] alias removeNth_eq_removeNthTR := eraseIdx_eq_eraseIdxTR +@[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 α @@ -139,40 +110,6 @@ Unlike `bagInter` this does not preserve multiplicity: `[1, 1].inter [1]` is `[1 instance [BEq α] : Inter (List α) := ⟨List.inter⟩ -/-- `l₁ <+ l₂`, or `Sublist l₁ l₂`, says that `l₁` is a (non-contiguous) subsequence of `l₂`. -/ -inductive Sublist {α} : List α → List α → Prop - /-- the base case: `[]` is a sublist of `[]` -/ - | slnil : Sublist [] [] - /-- If `l₁` is a subsequence of `l₂`, then it is also a subsequence of `a :: l₂`. -/ - | cons a : Sublist l₁ l₂ → Sublist l₁ (a :: l₂) - /-- If `l₁` is a subsequence of `l₂`, then `a :: l₁` is a subsequence of `a :: l₂`. -/ - | cons₂ a : Sublist l₁ l₂ → Sublist (a :: l₁) (a :: l₂) - -@[inherit_doc] scoped infixl:50 " <+ " => Sublist - -/-- True if the first list is a potentially non-contiguous sub-sequence of the second list. -/ -def isSublist [BEq α] : List α → List α → Bool - | [], _ => true - | _, [] => false - | l₁@(hd₁::tl₁), hd₂::tl₂ => - if hd₁ == hd₂ - then tl₁.isSublist tl₂ - else l₁.isSublist tl₂ - -/-- -Split a list at an index. -``` -splitAt 2 [a, b, c] = ([a, b], [c]) -``` --/ -def splitAt (n : Nat) (l : List α) : List α × List α := go l n #[] where - /-- Auxiliary for `splitAt`: `splitAt.go l n xs acc = (acc.toList ++ take n xs, drop n xs)` - if `n < length xs`, else `(l, [])`. -/ - go : List α → Nat → Array α → List α × List α - | [], _, _ => (l, []) - | x :: xs, n+1, acc => go xs n (acc.push x) - | xs, _, acc => (acc.toList, xs) - /-- Split a list at an index. Ensures the left list always has the specified length by right padding with the provided default element. @@ -181,13 +118,13 @@ splitAtD 2 [a, b, c] x = ([a, b], [c]) splitAtD 4 [a, b, c] x = ([a, b, c, x], []) ``` -/ -def splitAtD (n : Nat) (l : List α) (dflt : α) : List α × List α := go n l #[] where - /-- Auxiliary for `splitAtD`: `splitAtD.go dflt n l acc = (acc.toList ++ left, right)` +def splitAtD (n : Nat) (l : List α) (dflt : α) : List α × List α := go n l [] where + /-- Auxiliary for `splitAtD`: `splitAtD.go dflt n l acc = (acc.reverse ++ left, right)` if `splitAtD n l dflt = (left, right)`. -/ - go : Nat → List α → Array α → List α × List α - | n+1, x :: xs, acc => go n xs (acc.push x) - | 0, xs, acc => (acc.toList, xs) - | n, [], acc => (acc.toListAppend (replicate n dflt), []) + go : Nat → List α → List α → List α × List α + | n+1, x :: xs, acc => go n xs (x :: acc) + | 0, xs, acc => (acc.reverse, xs) + | n, [], acc => (acc.reverseAux (replicate n dflt), []) /-- Split a list at every element satisfying a predicate. The separators are not in the result. @@ -299,7 +236,7 @@ theorem insertNthTR_go_eq : ∀ n l, insertNthTR.go a n l acc = acc.data ++ inse @[csimp] theorem insertNth_eq_insertNthTR : @insertNth = @insertNthTR := by funext α f n l; simp [insertNthTR, insertNthTR_go_eq] -@[simp] theorem headD_eq_head? (l) (a : α) : headD l a = (head? l).getD a := by cases l <;> rfl +theorem headD_eq_head? (l) (a : α) : headD l a = (head? l).getD a := by cases l <;> rfl /-- Take `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l` @@ -313,7 +250,8 @@ def takeD : Nat → List α → α → List α @[simp] theorem takeD_succ (l) (a : α) : takeD (n+1) l a = l.head?.getD a :: takeD n l.tail a := by simp [takeD] -@[simp] theorem takeD_nil (n) (a : α) : takeD n [] a = replicate n a := by induction n <;> simp [*] +@[simp] theorem takeD_nil (n) (a : α) : takeD n [] a = replicate n a := by + induction n <;> simp [*, replicate_succ] /-- Tail-recursive version of `takeD`. -/ def takeDTR (n : Nat) (l : List α) (dflt : α) : List α := go n l #[] where @@ -325,25 +263,12 @@ def takeDTR (n : Nat) (l : List α) (dflt : α) : List α := go n l #[] where theorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.data ++ takeD n l dflt | 0, _ => by simp [takeDTR.go] - | _+1, [] => by simp [takeDTR.go] + | _+1, [] => by simp [takeDTR.go, replicate_succ] | _+1, _::l => by simp [takeDTR.go, takeDTR_go_eq _ l] @[csimp] theorem takeD_eq_takeDTR : @takeD = @takeDTR := by funext α f n l; simp [takeDTR, takeDTR_go_eq] -/-- -Pads `l : List α` with repeated occurrences of `a : α` until it is of length `n`. -If `l` is initially larger than `n`, just return `l`. --/ -def leftpad (n : Nat) (a : α) (l : List α) : List α := replicate (n - length l) a ++ l - -/-- Optimized version of `leftpad`. -/ -@[inline] def leftpadTR (n : Nat) (a : α) (l : List α) : List α := - replicateTR.loop a (n - length l) l - -@[csimp] theorem leftpad_eq_leftpadTR : @leftpad = @leftpadTR := by - funext α n a l; simp [leftpad, leftpadTR, replicateTR_loop_eq] - /-- Fold a function `f` over the list from the left, returning the list of partial results. ``` @@ -415,14 +340,6 @@ indexesOf a [a, b, a, a] = [0, 2, 3] -/ @[inline] def indexesOf [BEq α] (a : α) : List α → List Nat := findIdxs (· == a) -/-- Return the index of the first occurrence of an element satisfying `p`. -/ -def findIdx? (p : α → Bool) : List α → (start : Nat := 0) → Option Nat -| [], _ => none -| a :: l, i => if p a then some i else findIdx? p l (i + 1) - -/-- Return the index of the first occurrence of `a` in the list. -/ -@[inline] def indexOf? [BEq α] (a : α) : List α → Option Nat := findIdx? (· == a) - /-- `lookmap` is a combination of `lookup` and `filterMap`. `lookmap f l` will apply `f : α → Option α` to each element of the list, @@ -436,40 +353,6 @@ replacing `a → b` at the first value `a` in the list such that `f a = some b`. | some b => acc.toListAppend (b :: l) | none => go l (acc.push a) -/-- `countP p l` is the number of elements of `l` that satisfy `p`. -/ -@[inline] def countP (p : α → Bool) (l : List α) : Nat := go l 0 where - /-- Auxiliary for `countP`: `countP.go p l acc = countP p l + acc`. -/ - @[specialize] go : List α → Nat → Nat - | [], acc => acc - | x :: xs, acc => bif p x then go xs (acc + 1) else go xs acc - -/-- `count a l` is the number of occurrences of `a` in `l`. -/ -@[inline] def count [BEq α] (a : α) : List α → Nat := countP (· == a) - -/-- -`IsPrefix l₁ l₂`, or `l₁ <+: l₂`, means that `l₁` is a prefix of `l₂`, -that is, `l₂` has the form `l₁ ++ t` for some `t`. --/ -def IsPrefix (l₁ : List α) (l₂ : List α) : Prop := ∃ t, l₁ ++ t = l₂ - -/-- -`IsSuffix l₁ l₂`, or `l₁ <:+ l₂`, means that `l₁` is a suffix of `l₂`, -that is, `l₂` has the form `t ++ l₁` for some `t`. --/ -def IsSuffix (l₁ : List α) (l₂ : List α) : Prop := ∃ t, t ++ l₁ = l₂ - -/-- -`IsInfix l₁ l₂`, or `l₁ <:+: l₂`, means that `l₁` is a contiguous -substring of `l₂`, that is, `l₂` has the form `s ++ l₁ ++ t` for some `s, t`. --/ -def IsInfix (l₁ : List α) (l₂ : List α) : Prop := ∃ s t, s ++ l₁ ++ t = l₂ - -@[inherit_doc] infixl:50 " <+: " => IsPrefix - -@[inherit_doc] infixl:50 " <:+ " => IsSuffix - -@[inherit_doc] infixl:50 " <:+: " => IsInfix - /-- `inits l` is the list of initial segments of `l`. ``` @@ -485,7 +368,7 @@ def initsTR (l : List α) : List (List α) := l.foldr (fun a arrs => (arrs.map fun t => a :: t).push []) #[[]] |>.toListRev @[csimp] theorem inits_eq_initsTR : @inits = @initsTR := by - funext α l; simp [initsTR]; induction l <;> simp [*, reverse_map] + funext α l; simp [initsTR]; induction l <;> simp [*, map_reverse] /-- `tails l` is the list of terminal segments of `l`. @@ -647,7 +530,7 @@ theorem sections_eq_nil_of_isEmpty : ∀ {L}, L.any isEmpty → @sections α L = | l :: L, h => by simp only [any, foldr, Bool.or_eq_true] at h match l, h with - | [], .inl rfl => simp; induction sections L <;> simp [*] + | [], .inl rfl => simp | l, .inr h => simp [sections, sections_eq_nil_of_isEmpty h] @[csimp] theorem sections_eq_sectionsTR : @sections = @sectionsTR := by @@ -658,29 +541,6 @@ theorem sections_eq_nil_of_isEmpty : ∀ {L}, L.any isEmpty → @sections α L = rw [Array.foldl_eq_foldl_data, Array.foldl_data_eq_bind]; rfl intros; apply Array.foldl_data_eq_map -/-- `eraseP p l` removes the first element of `l` satisfying the predicate `p`. -/ -def eraseP (p : α → Bool) : List α → List α - | [] => [] - | a :: l => bif p a then l else a :: eraseP p l - -/-- Tail-recursive version of `eraseP`. -/ -@[inline] def erasePTR (p : α → Bool) (l : List α) : List α := go l #[] where - /-- Auxiliary for `erasePTR`: `erasePTR.go p l xs acc = acc.toList ++ eraseP p xs`, - unless `xs` does not contain any elements satisfying `p`, where it returns `l`. -/ - @[specialize] go : List α → Array α → List α - | [], _ => l - | a :: l, acc => bif p a then acc.toListAppend l else go l (acc.push a) - -@[csimp] theorem eraseP_eq_erasePTR : @eraseP = @erasePTR := by - funext α p l; simp [erasePTR] - let rec go (acc) : ∀ xs, l = acc.data ++ xs → - erasePTR.go p l xs acc = acc.data ++ xs.eraseP p - | [] => fun h => by simp [erasePTR.go, eraseP, h] - | x::xs => by - simp [erasePTR.go, eraseP]; cases p x <;> simp - · intro h; rw [go _ xs]; {simp}; simp [h] - exact (go #[] _ rfl).symm - /-- `extractP p l` returns a pair of an element `a` of `l` satisfying the predicate `p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`. @@ -741,28 +601,7 @@ def sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : ofFn f = [f 0, f 1, ... , f (n - 1)] ``` -/ -def ofFn {n} (f : Fin n → α) : List α := go n 0 rfl where - /-- Auxiliary for `List.ofFn`. `ofFn.go f i j _ = [f j, ..., f (n - 1)]`. -/ - -- This used to be defined via `Array.ofFn` but mathlib relies on reducing it, - -- so we use a structurally recursive definition here. - go : (i j : Nat) → (h : i + j = n) → List α - | 0, _, _ => [] - | i+1, j, h => f ⟨j, by omega⟩ :: go i (j+1) (Nat.add_right_comm .. ▸ h :) - -/-- Tail-recursive version of `ofFn`. -/ -@[inline] def ofFnTR {n} (f : Fin n → α) : List α := go n (Nat.le_refl _) [] where - /-- Auxiliary for `List.ofFnTR`. `ofFnTR.go f i _ acc = f 0 :: ... :: f (i - 1) :: acc`. -/ - go : (i : Nat) → (h : i ≤ n) → List α → List α - | 0, _, acc => acc - | i+1, h, acc => go i (Nat.le_of_lt h) (f ⟨i, h⟩ :: acc) - -@[csimp] theorem ofFn_eq_ofFnTR : @ofFn = @ofFnTR := by - funext α n f; simp [ofFnTR] - let rec go (i j h h') : ofFnTR.go f j h' (ofFn.go f i j h) = ofFn f := by - unfold ofFnTR.go; split - · subst h; rfl - · next l j h' => exact go (i+1) j ((Nat.succ_add ..).trans h) (Nat.le_of_lt h') - exact (go 0 n (Nat.zero_add _) (Nat.le_refl _)).symm +def ofFn {n} (f : Fin n → α) : List α := Fin.foldr n (f · :: ·) [] /-- `ofFnNthVal f i` returns `some (f i)` if `i < n` and `none` otherwise. -/ def ofFnNthVal {n} (f : Fin n → α) (i : Nat) : Option α := @@ -805,46 +644,6 @@ where rename_i a as b bs; unfold cond; cases R a b <;> simp [go as bs] exact (go as bs [] []).symm -section Pairwise - -variable (R : α → α → Prop) - -/-- -`Pairwise R l` means that all the elements with earlier indexes are -`R`-related to all the elements with later indexes. -``` -Pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3 -``` -For example if `R = (·≠·)` then it asserts `l` has no duplicates, -and if `R = (·<·)` then it asserts that `l` is (strictly) sorted. --/ -inductive Pairwise : List α → Prop - /-- All elements of the empty list are vacuously pairwise related. -/ - | nil : Pairwise [] - /-- `a :: l` is `Pairwise R` if `a` `R`-relates to every element of `l`, - and `l` is `Pairwise R`. -/ - | cons : ∀ {a : α} {l : List α}, (∀ a' ∈ l, R a a') → Pairwise l → Pairwise (a :: l) - -attribute [simp] Pairwise.nil - -variable {R} - -@[simp] theorem pairwise_cons : Pairwise R (a::l) ↔ (∀ a' ∈ l, R a a') ∧ Pairwise R l := - ⟨fun | .cons h₁ h₂ => ⟨h₁, h₂⟩, fun ⟨h₁, h₂⟩ => h₂.cons h₁⟩ - -instance instDecidablePairwise [DecidableRel R] : - (l : List α) → Decidable (Pairwise R l) - | [] => isTrue .nil - | hd :: tl => - match instDecidablePairwise tl with - | isTrue ht => - match decidableBAll (R hd) tl with - | isFalse hf => isFalse fun hf' => hf (pairwise_cons.1 hf').1 - | isTrue ht' => isTrue <| pairwise_cons.mpr (And.intro ht' ht) - | isFalse hf => isFalse fun | .cons _ ih => hf ih - -end Pairwise - /-- `pwFilter R l` is a maximal sublist of `l` which is `Pairwise R`. `pwFilter (·≠·)` is the erase duplicates function (cf. `eraseDup`), and `pwFilter (·<·)` finds @@ -880,64 +679,12 @@ def Chain' : List α → Prop end Chain -/-- `Nodup l` means that `l` has no duplicates, that is, any element appears at most - once in the List. It is defined as `Pairwise (≠)`. -/ -def Nodup : List α → Prop := Pairwise (· ≠ ·) - -instance nodupDecidable [DecidableEq α] : ∀ l : List α, Decidable (Nodup l) := - instDecidablePairwise - /-- `eraseDup l` removes duplicates from `l` (taking only the first occurrence). Defined as `pwFilter (≠)`. eraseDup [1, 0, 2, 2, 1] = [0, 2, 1] -/ @[inline] def eraseDup [BEq α] : List α → List α := pwFilter (· != ·) -/-- `range' start len step` is the list of numbers `[start, start+step, ..., start+(len-1)*step]`. - It is intended mainly for proving properties of `range` and `iota`. -/ -def range' : (start len : Nat) → (step : Nat := 1) → List Nat - | _, 0, _ => [] - | s, n+1, step => s :: range' (s+step) n step - -/-- Optimized version of `range'`. -/ -@[inline] def range'TR (s n : Nat) (step : Nat := 1) : List Nat := go n (s + step * n) [] where - /-- Auxiliary for `range'TR`: `range'TR.go n e = [e-n, ..., e-1] ++ acc`. -/ - go : Nat → Nat → List Nat → List Nat - | 0, _, acc => acc - | n+1, e, acc => go n (e-step) ((e-step) :: acc) - -@[csimp] theorem range'_eq_range'TR : @range' = @range'TR := by - funext s n step - let rec go (s) : ∀ n m, - range'TR.go step n (s + step * n) (range' (s + step * n) m step) = range' s (n + m) step - | 0, m => by simp [range'TR.go] - | n+1, m => by - simp [range'TR.go] - rw [Nat.mul_succ, ← Nat.add_assoc, Nat.add_sub_cancel, Nat.add_right_comm n] - exact go s n (m + 1) - exact (go s n 0).symm - -/-- Drop `none`s from a list, and replace each remaining `some a` with `a`. -/ -@[inline] def reduceOption {α} : List (Option α) → List α := - List.filterMap id - -/-- -`ilast' x xs` returns the last element of `xs` if `xs` is non-empty; it returns `x` otherwise. -Use `List.getLastD` instead. --/ -@[simp, deprecated getLastD] def ilast' {α} : α → List α → α - | a, [] => a - | _, b :: l => ilast' b l - -/-- -`last' xs` returns the last element of `xs` if `xs` is non-empty; it returns `none` otherwise. -Use `List.getLast?` instead --/ -@[simp, deprecated getLast?] def last' {α} : List α → Option α - | [] => none - | [a] => some a - | _ :: l => last' l - /-- `rotate l n` rotates the elements of `l` to the left by `n` ``` @@ -1342,30 +1089,6 @@ protected def traverse [Applicative F] (f : α → F β) : List α → F (List | [] => pure [] | x :: xs => List.cons <$> f x <*> List.traverse f xs -/-- -`Perm l₁ l₂` or `l₁ ~ l₂` asserts that `l₁` and `l₂` are permutations -of each other. This is defined by induction using pairwise swaps. --/ -inductive Perm : List α → List α → Prop - /-- `[] ~ []` -/ - | nil : Perm [] [] - /-- `l₁ ~ l₂ → x::l₁ ~ x::l₂` -/ - | cons (x : α) {l₁ l₂ : List α} : Perm l₁ l₂ → Perm (x :: l₁) (x :: l₂) - /-- `x::y::l ~ y::x::l` -/ - | swap (x y : α) (l : List α) : Perm (y :: x :: l) (x :: y :: l) - /-- `Perm` is transitive. -/ - | trans {l₁ l₂ l₃ : List α} : Perm l₁ l₂ → Perm l₂ l₃ → Perm l₁ l₃ - -@[inherit_doc] scoped infixl:50 " ~ " => Perm - -/-- -`O(|l₁| * |l₂|)`. Computes whether `l₁` is a permutation of `l₂`. See `isPerm_iff` for a -characterization in terms of `List.Perm`. --/ -def isPerm [BEq α] : List α → List α → Bool - | [], l₂ => l₂.isEmpty - | a :: l₁, l₂ => l₂.contains a && l₁.isPerm (l₂.erase a) - /-- `Subperm l₁ l₂`, denoted `l₁ <+~ l₂`, means that `l₁` is a sublist of a permutation of `l₂`. This is an analogue of `l₁ ⊆ l₂` which respects @@ -1382,13 +1105,13 @@ See `isSubperm_iff` for a characterization in terms of `List.Subperm`. def isSubperm [BEq α] (l₁ l₂ : List α) : Bool := ∀ x ∈ l₁, count x l₁ ≤ count x l₂ /-- -`O(|l| + |r|)`. Merge two lists using `s` as a switch. +`O(|l|)`. Inserts `a` in `l` right before the first element such that `p` is true, or at the end of +the list if `p` always false on `l`. -/ -def merge (s : α → α → Bool) (l r : List α) : List α := - loop l r [] +def insertP (p : α → Bool) (a : α) (l : List α) : List α := + loop l [] where - /-- Inner loop for `List.merge`. Tail recursive. -/ - loop : List α → List α → List α → List α - | [], r, t => reverseAux t r - | l, [], t => reverseAux t l - | a::l, b::r, t => bif s a b then loop l (b::r) (a::t) else loop (a::l) r (b::t) + /-- Inner loop for `insertP`. Tail recursive. -/ + loop : List α → List α → List α + | [], r => reverseAux (a :: r) [] -- Note: `reverseAux` is tail recursive. + | b :: l, r => bif p b then reverseAux (a :: r) (b :: l) else loop l (b :: r) diff --git a/Batteries/Data/List/Count.lean b/Batteries/Data/List/Count.lean index 81548ff437..151169f74b 100644 --- a/Batteries/Data/List/Count.lean +++ b/Batteries/Data/List/Count.lean @@ -19,111 +19,6 @@ open Nat namespace List -section countP - -variable (p q : α → Bool) - -@[simp] theorem countP_nil : countP p [] = 0 := rfl - -protected theorem countP_go_eq_add (l) : countP.go p l n = n + countP.go p l 0 := by - induction l generalizing n with - | nil => rfl - | cons head tail ih => - unfold countP.go - rw [ih (n := n + 1), ih (n := n), ih (n := 1)] - if h : p head then simp [h, Nat.add_assoc] else simp [h] - -@[simp] theorem countP_cons_of_pos (l) (pa : p a) : countP p (a :: l) = countP p l + 1 := by - have : countP.go p (a :: l) 0 = countP.go p l 1 := show cond .. = _ by rw [pa]; rfl - unfold countP - rw [this, Nat.add_comm, List.countP_go_eq_add] - -@[simp] theorem countP_cons_of_neg (l) (pa : ¬p a) : countP p (a :: l) = countP p l := by - simp [countP, countP.go, pa] - -theorem countP_cons (a : α) (l) : countP p (a :: l) = countP p l + if p a then 1 else 0 := by - by_cases h : p a <;> simp [h] - -theorem length_eq_countP_add_countP (l) : length l = countP p l + countP (fun a => ¬p a) l := by - induction l with - | nil => rfl - | cons x h ih => - if h : p x then - rw [countP_cons_of_pos _ _ h, countP_cons_of_neg _ _ _, length, ih] - · rw [Nat.add_assoc, Nat.add_comm _ 1, Nat.add_assoc] - · simp only [h, not_true_eq_false, decide_False, not_false_eq_true] - else - rw [countP_cons_of_pos (fun a => ¬p a) _ _, countP_cons_of_neg _ _ h, length, ih] - · rfl - · simp only [h, not_false_eq_true, decide_True] - -theorem countP_eq_length_filter (l) : countP p l = length (filter p l) := by - induction l with - | nil => rfl - | cons x l ih => - if h : p x - then rw [countP_cons_of_pos p l h, ih, filter_cons_of_pos l h, length] - else rw [countP_cons_of_neg p l h, ih, filter_cons_of_neg l h] - -theorem countP_le_length : countP p l ≤ l.length := by - simp only [countP_eq_length_filter] - apply length_filter_le - -@[simp] theorem countP_append (l₁ l₂) : countP p (l₁ ++ l₂) = countP p l₁ + countP p l₂ := by - simp only [countP_eq_length_filter, filter_append, length_append] - -theorem countP_pos : 0 < countP p l ↔ ∃ a ∈ l, p a := by - simp only [countP_eq_length_filter, length_pos_iff_exists_mem, mem_filter, exists_prop] - -theorem countP_eq_zero : countP p l = 0 ↔ ∀ a ∈ l, ¬p a := by - simp only [countP_eq_length_filter, length_eq_zero, filter_eq_nil] - -theorem countP_eq_length : countP p l = l.length ↔ ∀ a ∈ l, p a := by - rw [countP_eq_length_filter, filter_length_eq_length] - -theorem Sublist.countP_le (s : l₁ <+ l₂) : countP p l₁ ≤ countP p l₂ := by - simp only [countP_eq_length_filter] - apply s.filter _ |>.length_le - -theorem countP_filter (l : List α) : - countP p (filter q l) = countP (fun a => p a ∧ q a) l := by - simp only [countP_eq_length_filter, filter_filter] - -@[simp] theorem countP_true {l : List α} : (l.countP fun _ => true) = l.length := by - rw [countP_eq_length] - simp - -@[simp] theorem countP_false {l : List α} : (l.countP fun _ => false) = 0 := by - rw [countP_eq_zero] - simp - -@[simp] theorem countP_map (p : β → Bool) (f : α → β) : - ∀ l, countP p (map f l) = countP (p ∘ f) l - | [] => rfl - | a :: l => by rw [map_cons, countP_cons, countP_cons, countP_map p f l]; rfl - -variable {p q} - -theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP q l := by - induction l with - | nil => apply Nat.le_refl - | cons a l ihl => - rw [forall_mem_cons] at h - have ⟨ha, hl⟩ := h - simp [countP_cons] - cases h : p a - . simp - apply Nat.le_trans ?_ (Nat.le_add_right _ _) - apply ihl hl - . simp [ha h] - apply ihl hl - -theorem countP_congr (h : ∀ x ∈ l, p x ↔ q x) : countP p l = countP q l := - Nat.le_antisymm - (countP_mono_left fun x hx => (h x hx).1) - (countP_mono_left fun x hx => (h x hx).2) - -end countP /-! ### count -/ @@ -131,118 +26,6 @@ section count variable [DecidableEq α] -@[simp] theorem count_nil (a : α) : count a [] = 0 := rfl - -theorem count_cons (a b : α) (l : List α) : - count a (b :: l) = count a l + if a = b then 1 else 0 := by - simp [count, countP_cons, eq_comm (a := a)] - -@[simp] theorem count_cons_self (a : α) (l : List α) : count a (a :: l) = count a l + 1 := by - simp [count_cons] - -@[simp] theorem count_cons_of_ne (h : a ≠ b) (l : List α) : count a (b :: l) = count a l := by - simp [count_cons, h] - -theorem count_tail : ∀ (l : List α) (a : α) (h : l ≠ []), - l.tail.count a = l.count a - if a = l.head h then 1 else 0 - | head :: tail, a, h => by simp [count_cons] - -theorem count_le_length (a : α) (l : List α) : count a l ≤ l.length := countP_le_length _ - -theorem Sublist.count_le (h : l₁ <+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.countP_le _ - -theorem count_le_count_cons (a b : α) (l : List α) : count a l ≤ count a (b :: l) := - (sublist_cons _ _).count_le _ - -theorem count_singleton (a : α) : count a [a] = 1 := by simp - -theorem count_singleton' (a b : α) : count a [b] = if a = b then 1 else 0 := by simp [count_cons] - -@[simp] theorem count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ := - countP_append _ +theorem count_singleton' (a b : α) : count a [b] = if b = a then 1 else 0 := by simp [count_cons] theorem count_concat (a : α) (l : List α) : count a (concat l a) = succ (count a l) := by simp - -@[simp] -theorem count_pos_iff_mem {a : α} {l : List α} : 0 < count a l ↔ a ∈ l := by - simp only [count, countP_pos, beq_iff_eq, exists_eq_right] - -@[simp 900] theorem count_eq_zero_of_not_mem {a : α} {l : List α} (h : a ∉ l) : count a l = 0 := - Decidable.byContradiction fun h' => h <| count_pos_iff_mem.1 (Nat.pos_of_ne_zero h') - -theorem not_mem_of_count_eq_zero {a : α} {l : List α} (h : count a l = 0) : a ∉ l := - fun h' => Nat.ne_of_lt (count_pos_iff_mem.2 h') h.symm - -theorem count_eq_zero {l : List α} : count a l = 0 ↔ a ∉ l := - ⟨not_mem_of_count_eq_zero, count_eq_zero_of_not_mem⟩ - -theorem count_eq_length {l : List α} : count a l = l.length ↔ ∀ b ∈ l, a = b := by - rw [count, countP_eq_length] - refine ⟨fun h b hb => Eq.symm ?_, fun h b hb => ?_⟩ - · simpa using h b hb - · rw [h b hb, beq_self_eq_true] - -@[simp] theorem count_replicate_self (a : α) (n : Nat) : count a (replicate n a) = n := - (count_eq_length.2 <| fun _ h => (eq_of_mem_replicate h).symm).trans (length_replicate ..) - -theorem count_replicate (a b : α) (n : Nat) : count a (replicate n b) = if a = b then n else 0 := by - split - exacts [‹a = b› ▸ count_replicate_self .., count_eq_zero.2 <| mt eq_of_mem_replicate ‹a ≠ b›] - -theorem filter_beq (l : List α) (a : α) : l.filter (· == a) = replicate (count a l) a := by - simp only [count, countP_eq_length_filter, eq_replicate, mem_filter, beq_iff_eq] - exact ⟨trivial, fun _ h => h.2⟩ - -theorem filter_eq (l : List α) (a : α) : l.filter (· = a) = replicate (count a l) a := - filter_beq l a - -@[deprecated filter_eq] -theorem filter_eq' (l : List α) (a : α) : l.filter (a = ·) = replicate (count a l) a := by - simpa only [eq_comm] using filter_eq l a - -@[deprecated filter_beq] -theorem filter_beq' (l : List α) (a : α) : l.filter (a == ·) = replicate (count a l) a := by - simpa only [eq_comm (b := a)] using filter_eq l a - -theorem le_count_iff_replicate_sublist {l : List α} : n ≤ count a l ↔ replicate n a <+ l := by - refine ⟨fun h => ?_, fun h => ?_⟩ - · exact ((replicate_sublist_replicate a).2 h).trans <| filter_eq l a ▸ filter_sublist _ - · simpa only [count_replicate_self] using h.count_le a - -theorem replicate_count_eq_of_count_eq_length {l : List α} (h : count a l = length l) : - replicate (count a l) a = l := - (le_count_iff_replicate_sublist.mp (Nat.le_refl _)).eq_of_length <| - (length_replicate (count a l) a).trans h - -@[simp] theorem count_filter {l : List α} (h : p a) : count a (filter p l) = count a l := by - rw [count, countP_filter]; congr; funext b - rw [(by rfl : (b == a) = decide (b = a)), decide_eq_decide] - simp; rintro rfl; exact h - -theorem count_le_count_map [DecidableEq β] (l : List α) (f : α → β) (x : α) : - count x l ≤ count (f x) (map f l) := by - rw [count, count, countP_map] - apply countP_mono_left; simp (config := { contextual := true }) - -theorem count_erase (a b : α) : - ∀ l : List α, count a (l.erase b) = count a l - if a = b then 1 else 0 - | [] => by simp - | c :: l => by - rw [erase_cons] - if hc : c = b then - have hc_beq := (beq_iff_eq _ _).mpr hc - rw [if_pos hc_beq, hc, count_cons, Nat.add_sub_cancel] - else - have hc_beq := beq_false_of_ne hc - simp only [hc_beq, if_false, count_cons, count_cons, count_erase a b l] - if ha : a = b then - rw [← ha, eq_comm] at hc - rw [if_pos ha, if_neg hc, Nat.add_zero, Nat.add_zero] - else - rw [if_neg ha, Nat.sub_zero, Nat.sub_zero] - -@[simp] theorem count_erase_self (a : α) (l : List α) : - count a (List.erase l a) = count a l - 1 := by rw [count_erase, if_pos rfl] - -@[simp] theorem count_erase_of_ne (ab : a ≠ b) (l : List α) : count a (l.erase b) = count a l := by - rw [count_erase, if_neg ab, Nat.sub_zero] diff --git a/Batteries/Data/List/EraseIdx.lean b/Batteries/Data/List/EraseIdx.lean index 31a595be57..42b4bfacd1 100644 --- a/Batteries/Data/List/EraseIdx.lean +++ b/Batteries/Data/List/EraseIdx.lean @@ -17,66 +17,18 @@ namespace List universe u v variable {α : Type u} {β : Type v} -@[simp] theorem eraseIdx_zero (l : List α) : eraseIdx l 0 = tail l := by cases l <;> rfl - -theorem eraseIdx_eq_take_drop_succ : - ∀ (l : List α) (i : Nat), l.eraseIdx i = l.take i ++ l.drop (i + 1) - | nil, _ => by simp - | a::l, 0 => by simp - | a::l, i + 1 => by simp [eraseIdx_eq_take_drop_succ l i] - -theorem eraseIdx_sublist : ∀ (l : List α) (k : Nat), eraseIdx l k <+ l - | [], _ => by simp - | a::l, 0 => by simp - | a::l, k + 1 => by simp [eraseIdx_sublist l k] - -theorem eraseIdx_subset (l : List α) (k : Nat) : eraseIdx l k ⊆ l := (eraseIdx_sublist l k).subset - -@[simp] -theorem eraseIdx_eq_self : ∀ {l : List α} {k : Nat}, eraseIdx l k = l ↔ length l ≤ k - | [], _ => by simp - | a::l, 0 => by simp [(cons_ne_self _ _).symm] - | a::l, k + 1 => by simp [eraseIdx_eq_self] - -alias ⟨_, eraseIdx_of_length_le⟩ := eraseIdx_eq_self - -theorem eraseIdx_append_of_lt_length {l : List α} {k : Nat} (hk : k < length l) (l' : List α) : - eraseIdx (l ++ l') k = eraseIdx l k ++ l' := by - rw [eraseIdx_eq_take_drop_succ, take_append_of_le_length, drop_append_of_le_length, - eraseIdx_eq_take_drop_succ, append_assoc] - all_goals omega - -theorem eraseIdx_append_of_length_le {l : List α} {k : Nat} (hk : length l ≤ k) (l' : List α) : - eraseIdx (l ++ l') k = l ++ eraseIdx l' (k - length l) := by - rw [eraseIdx_eq_take_drop_succ, eraseIdx_eq_take_drop_succ, - take_append_eq_append_take, drop_append_eq_append_drop, - take_all_of_le hk, drop_eq_nil_of_le (by omega), nil_append, append_assoc] - congr - omega - -protected theorem IsPrefix.eraseIdx {l l' : List α} (h : l <+: l') (k : Nat) : - eraseIdx l k <+: eraseIdx l' k := by - rcases h with ⟨t, rfl⟩ - if hkl : k < length l then - simp [eraseIdx_append_of_lt_length hkl] - else - rw [Nat.not_lt] at hkl - simp [eraseIdx_append_of_length_le hkl, eraseIdx_of_length_le hkl] - -theorem mem_eraseIdx_iff_get {x : α} : - ∀ {l} {k}, x ∈ eraseIdx l k ↔ ∃ i : Fin l.length, ↑i ≠ k ∧ l.get i = x - | [], _ => by - simp only [eraseIdx, Fin.exists_iff, not_mem_nil, false_iff] - rintro ⟨i, h, -⟩ - exact Nat.not_lt_zero _ h - | a::l, 0 => by simp [Fin.exists_fin_succ, mem_iff_get] - | a::l, k+1 => by - simp [Fin.exists_fin_succ, mem_eraseIdx_iff_get, @eq_comm _ a, k.succ_ne_zero.symm] - +@[deprecated mem_eraseIdx_iff_getElem (since := "2024-06-12")] +theorem mem_eraseIdx_iff_get {x : α} {l} {k} : + x ∈ eraseIdx l k ↔ ∃ i : Fin l.length, ↑i ≠ k ∧ l.get i = x := by + simp only [mem_eraseIdx_iff_getElem, ne_eq, exists_and_left, get_eq_getElem] + constructor + · rintro ⟨i, h, w, rfl⟩ + exact ⟨⟨i, w⟩, h, rfl⟩ + · rintro ⟨i, h, rfl⟩ + exact ⟨i.1, h, i.2, rfl⟩ + +@[deprecated mem_eraseIdx_iff_getElem? (since := "2024-06-12")] theorem mem_eraseIdx_iff_get? {x : α} {l} {k} : x ∈ eraseIdx l k ↔ ∃ i ≠ k, l.get? i = x := by - simp only [mem_eraseIdx_iff_get, Fin.exists_iff, exists_and_left, get_eq_iff, exists_prop] - refine exists_congr fun i => and_congr_right' <| and_iff_right_of_imp fun h => ?_ - obtain ⟨h, -⟩ := get?_eq_some.1 h - exact h + simp [mem_eraseIdx_iff_getElem?] end List diff --git a/Batteries/Data/List/Init/Attach.lean b/Batteries/Data/List/Init/Attach.lean deleted file mode 100644 index d2b2bf0990..0000000000 --- a/Batteries/Data/List/Init/Attach.lean +++ /dev/null @@ -1,44 +0,0 @@ -/- -Copyright (c) 2023 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ - -namespace List - -/-- `O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on - `a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l` - but is defined only when all members of `l` satisfy `P`, using the proof - to apply `f`. -/ -@[simp] def pmap {P : α → Prop} (f : ∀ a, P a → β) : ∀ l : List α, (H : ∀ a ∈ l, P a) → List β - | [], _ => [] - | a :: l, H => f a (forall_mem_cons.1 H).1 :: pmap f l (forall_mem_cons.1 H).2 - -/-- -Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of -`List {x // P x}` is the same as the input `List α`. -(Someday, the compiler might do this optimization automatically, but until then...) --/ -@[inline] private unsafe def attachWithImpl - (l : List α) (P : α → Prop) (_ : ∀ x ∈ l, P x) : List {x // P x} := unsafeCast l - -/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `l` to produce a new list - with the same elements but in the type `{x // P x}`. -/ -@[implemented_by attachWithImpl] def attachWith - (l : List α) (P : α → Prop) (H : ∀ x ∈ l, P x) : List {x // P x} := pmap Subtype.mk l H - -/-- `O(1)`. "Attach" the proof that the elements of `l` are in `l` to produce a new list - with the same elements but in the type `{x // x ∈ l}`. -/ -@[inline] def attach (l : List α) : List {x // x ∈ l} := attachWith l _ fun _ => id - -/-- Implementation of `pmap` using the zero-copy version of `attach`. -/ -@[inline] private def pmapImpl {P : α → Prop} (f : ∀ a, P a → β) (l : List α) (H : ∀ a ∈ l, P a) : - List β := (l.attachWith _ H).map fun ⟨x, h'⟩ => f x h' - -@[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by - funext α β p f L h' - let rec go : ∀ L' (hL' : ∀ ⦃x⦄, x ∈ L' → p x), - pmap f L' hL' = map (fun ⟨x, hx⟩ => f x hx) (pmap Subtype.mk L' hL') - | nil, hL' => rfl - | cons _ L', hL' => congrArg _ <| go L' fun _ hx => hL' (.tail _ hx) - exact go L h' diff --git a/Batteries/Data/List/Lemmas.lean b/Batteries/Data/List/Lemmas.lean index cd010a8150..d211cb04f8 100644 --- a/Batteries/Data/List/Lemmas.lean +++ b/Batteries/Data/List/Lemmas.lean @@ -17,260 +17,56 @@ open Nat @[simp] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by simp [Array.mem_def] -/-! ### drop -/ - -@[simp] -theorem drop_one : ∀ l : List α, drop 1 l = tail l - | [] | _ :: _ => rfl - -/-! ### zipWith -/ - -theorem zipWith_distrib_tail : (zipWith f l l').tail = zipWith f l.tail l'.tail := by - rw [← drop_one]; simp [zipWith_distrib_drop] - -/-! ### List subset -/ - -theorem subset_def {l₁ l₂ : List α} : l₁ ⊆ l₂ ↔ ∀ {a : α}, a ∈ l₁ → a ∈ l₂ := .rfl - -@[simp] theorem nil_subset (l : List α) : [] ⊆ l := nofun - -@[simp] theorem Subset.refl (l : List α) : l ⊆ l := fun _ i => i - -theorem Subset.trans {l₁ l₂ l₃ : List α} (h₁ : l₁ ⊆ l₂) (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ := - fun _ i => h₂ (h₁ i) - -instance : Trans (Membership.mem : α → List α → Prop) Subset Membership.mem := - ⟨fun h₁ h₂ => h₂ h₁⟩ - -instance : Trans (Subset : List α → List α → Prop) Subset Subset := - ⟨Subset.trans⟩ - -@[simp] theorem subset_cons (a : α) (l : List α) : l ⊆ a :: l := fun _ => Mem.tail _ - -theorem subset_of_cons_subset {a : α} {l₁ l₂ : List α} : a :: l₁ ⊆ l₂ → l₁ ⊆ l₂ := - fun s _ i => s (mem_cons_of_mem _ i) - -theorem subset_cons_of_subset (a : α) {l₁ l₂ : List α} : l₁ ⊆ l₂ → l₁ ⊆ a :: l₂ := - fun s _ i => .tail _ (s i) - -theorem cons_subset_cons {l₁ l₂ : List α} (a : α) (s : l₁ ⊆ l₂) : a :: l₁ ⊆ a :: l₂ := - fun _ => by simp only [mem_cons]; exact Or.imp_right (@s _) - -@[simp] theorem subset_append_left (l₁ l₂ : List α) : l₁ ⊆ l₁ ++ l₂ := fun _ => mem_append_left _ - -@[simp] theorem subset_append_right (l₁ l₂ : List α) : l₂ ⊆ l₁ ++ l₂ := fun _ => mem_append_right _ - -theorem subset_append_of_subset_left (l₂ : List α) : l ⊆ l₁ → l ⊆ l₁ ++ l₂ := -fun s => Subset.trans s <| subset_append_left _ _ - -theorem subset_append_of_subset_right (l₁ : List α) : l ⊆ l₂ → l ⊆ l₁ ++ l₂ := -fun s => Subset.trans s <| subset_append_right _ _ - -@[simp] theorem cons_subset : a :: l ⊆ m ↔ a ∈ m ∧ l ⊆ m := by - simp only [subset_def, mem_cons, or_imp, forall_and, forall_eq] - -@[simp] theorem append_subset {l₁ l₂ l : List α} : - l₁ ++ l₂ ⊆ l ↔ l₁ ⊆ l ∧ l₂ ⊆ l := by simp [subset_def, or_imp, forall_and] - -theorem subset_nil {l : List α} : l ⊆ [] ↔ l = [] := - ⟨fun h => match l with | [] => rfl | _::_ => (nomatch h (.head ..)), fun | rfl => Subset.refl _⟩ - -theorem map_subset {l₁ l₂ : List α} (f : α → β) (H : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ := - fun x => by simp only [mem_map]; exact .imp fun a => .imp_left (@H _) - -/-! ### sublists -/ - -@[simp] theorem nil_sublist : ∀ l : List α, [] <+ l - | [] => .slnil - | a :: l => (nil_sublist l).cons a - -@[simp] theorem Sublist.refl : ∀ l : List α, l <+ l - | [] => .slnil - | a :: l => (Sublist.refl l).cons₂ a - -theorem Sublist.trans {l₁ l₂ l₃ : List α} (h₁ : l₁ <+ l₂) (h₂ : l₂ <+ l₃) : l₁ <+ l₃ := by - induction h₂ generalizing l₁ with - | slnil => exact h₁ - | cons _ _ IH => exact (IH h₁).cons _ - | @cons₂ l₂ _ a _ IH => - generalize e : a :: l₂ = l₂' - match e ▸ h₁ with - | .slnil => apply nil_sublist - | .cons a' h₁' => cases e; apply (IH h₁').cons - | .cons₂ a' h₁' => cases e; apply (IH h₁').cons₂ - -instance : Trans (@Sublist α) Sublist Sublist := ⟨Sublist.trans⟩ - -@[simp] theorem sublist_cons (a : α) (l : List α) : l <+ a :: l := (Sublist.refl l).cons _ - -theorem sublist_of_cons_sublist : a :: l₁ <+ l₂ → l₁ <+ l₂ := - (sublist_cons a l₁).trans - -@[simp] theorem sublist_append_left : ∀ l₁ l₂ : List α, l₁ <+ l₁ ++ l₂ - | [], _ => nil_sublist _ - | _ :: l₁, l₂ => (sublist_append_left l₁ l₂).cons₂ _ +/-! ### toArray-/ -@[simp] theorem sublist_append_right : ∀ l₁ l₂ : List α, l₂ <+ l₁ ++ l₂ - | [], _ => Sublist.refl _ - | _ :: l₁, l₂ => (sublist_append_right l₁ l₂).cons _ - -theorem sublist_append_of_sublist_left (s : l <+ l₁) : l <+ l₁ ++ l₂ := - s.trans <| sublist_append_left .. - -theorem sublist_append_of_sublist_right (s : l <+ l₂) : l <+ l₁ ++ l₂ := - s.trans <| sublist_append_right .. - -@[simp] -theorem cons_sublist_cons : a :: l₁ <+ a :: l₂ ↔ l₁ <+ l₂ := - ⟨fun | .cons _ s => sublist_of_cons_sublist s | .cons₂ _ s => s, .cons₂ _⟩ - -@[simp] theorem append_sublist_append_left : ∀ l, l ++ l₁ <+ l ++ l₂ ↔ l₁ <+ l₂ - | [] => Iff.rfl - | _ :: l => cons_sublist_cons.trans (append_sublist_append_left l) - -theorem Sublist.append_left : l₁ <+ l₂ → ∀ l, l ++ l₁ <+ l ++ l₂ := - fun h l => (append_sublist_append_left l).mpr h - -theorem Sublist.append_right : l₁ <+ l₂ → ∀ l, l₁ ++ l <+ l₂ ++ l - | .slnil, _ => Sublist.refl _ - | .cons _ h, _ => (h.append_right _).cons _ - | .cons₂ _ h, _ => (h.append_right _).cons₂ _ - -theorem sublist_or_mem_of_sublist (h : l <+ l₁ ++ a :: l₂) : l <+ l₁ ++ l₂ ∨ a ∈ l := by - induction l₁ generalizing l with - | nil => match h with - | .cons _ h => exact .inl h - | .cons₂ _ h => exact .inr (.head ..) - | cons b l₁ IH => - match h with - | .cons _ h => exact (IH h).imp_left (Sublist.cons _) - | .cons₂ _ h => exact (IH h).imp (Sublist.cons₂ _) (.tail _) - -theorem Sublist.reverse : l₁ <+ l₂ → l₁.reverse <+ l₂.reverse - | .slnil => Sublist.refl _ - | .cons _ h => by rw [reverse_cons]; exact sublist_append_of_sublist_left h.reverse - | .cons₂ _ h => by rw [reverse_cons, reverse_cons]; exact h.reverse.append_right _ - -@[simp] theorem reverse_sublist : l₁.reverse <+ l₂.reverse ↔ l₁ <+ l₂ := - ⟨fun h => l₁.reverse_reverse ▸ l₂.reverse_reverse ▸ h.reverse, Sublist.reverse⟩ - -@[simp] theorem append_sublist_append_right (l) : l₁ ++ l <+ l₂ ++ l ↔ l₁ <+ l₂ := - ⟨fun h => by - have := h.reverse - simp only [reverse_append, append_sublist_append_left, reverse_sublist] at this - exact this, - fun h => h.append_right l⟩ - -theorem Sublist.append (hl : l₁ <+ l₂) (hr : r₁ <+ r₂) : l₁ ++ r₁ <+ l₂ ++ r₂ := - (hl.append_right _).trans ((append_sublist_append_left _).2 hr) - -theorem Sublist.subset : l₁ <+ l₂ → l₁ ⊆ l₂ - | .slnil, _, h => h - | .cons _ s, _, h => .tail _ (s.subset h) - | .cons₂ .., _, .head .. => .head .. - | .cons₂ _ s, _, .tail _ h => .tail _ (s.subset h) - -instance : Trans (@Sublist α) Subset Subset := - ⟨fun h₁ h₂ => trans h₁.subset h₂⟩ - -instance : Trans Subset (@Sublist α) Subset := - ⟨fun h₁ h₂ => trans h₁ h₂.subset⟩ - -instance : Trans (Membership.mem : α → List α → Prop) Sublist Membership.mem := - ⟨fun h₁ h₂ => h₂.subset h₁⟩ - -theorem Sublist.length_le : l₁ <+ l₂ → length l₁ ≤ length l₂ - | .slnil => Nat.le_refl 0 - | .cons _l s => le_succ_of_le (length_le s) - | .cons₂ _ s => succ_le_succ (length_le s) - -@[simp] theorem sublist_nil {l : List α} : l <+ [] ↔ l = [] := - ⟨fun s => subset_nil.1 s.subset, fun H => H ▸ Sublist.refl _⟩ - -theorem Sublist.eq_of_length : l₁ <+ l₂ → length l₁ = length l₂ → l₁ = l₂ - | .slnil, _ => rfl - | .cons a s, h => nomatch Nat.not_lt.2 s.length_le (h ▸ lt_succ_self _) - | .cons₂ a s, h => by rw [s.eq_of_length (succ.inj h)] - -theorem Sublist.eq_of_length_le (s : l₁ <+ l₂) (h : length l₂ ≤ length l₁) : l₁ = l₂ := - s.eq_of_length <| Nat.le_antisymm s.length_le h - -@[simp] theorem singleton_sublist {a : α} {l} : [a] <+ l ↔ a ∈ l := by - refine ⟨fun h => h.subset (mem_singleton_self _), fun h => ?_⟩ - obtain ⟨_, _, rfl⟩ := append_of_mem h - exact ((nil_sublist _).cons₂ _).trans (sublist_append_right ..) - -@[simp] theorem replicate_sublist_replicate {m n} (a : α) : - replicate m a <+ replicate n a ↔ m ≤ n := by - refine ⟨fun h => ?_, fun h => ?_⟩ - · have := h.length_le; simp only [length_replicate] at this ⊢; exact this - · induction h with - | refl => apply Sublist.refl - | step => simp [*, replicate, Sublist.cons] - -theorem isSublist_iff_sublist [BEq α] [LawfulBEq α] {l₁ l₂ : List α} : - l₁.isSublist l₂ ↔ l₁ <+ l₂ := by - cases l₁ <;> cases l₂ <;> simp [isSublist] - case cons.cons hd₁ tl₁ hd₂ tl₂ => - if h_eq : hd₁ = hd₂ then - simp [h_eq, cons_sublist_cons, isSublist_iff_sublist] - else - simp only [beq_iff_eq, h_eq] - constructor - · intro h_sub - apply Sublist.cons - exact isSublist_iff_sublist.mp h_sub - · intro h_sub - cases h_sub - case cons h_sub => - exact isSublist_iff_sublist.mpr h_sub - case cons₂ => - contradiction - -instance [DecidableEq α] (l₁ l₂ : List α) : Decidable (l₁ <+ l₂) := - decidable_of_iff (l₁.isSublist l₂) isSublist_iff_sublist - -/-! ### tail -/ +@[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 -theorem tail_eq_tailD (l) : @tail α l = tailD l [] := by cases l <;> rfl +@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : + (Array.mk xs)[i] = xs[i] := rfl -theorem tail_eq_tail? (l) : @tail α l = (tail? l).getD [] := by simp [tail_eq_tailD] +@[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 @[simp] theorem next?_cons (a l) : @next? α (a :: l) = some (a, l) := rfl +/-! ### dropLast -/ + +theorem dropLast_eq_eraseIdx {xs : List α} {i : Nat} (last_idx : i + 1 = xs.length) : + xs.dropLast = List.eraseIdx xs i := by + induction i generalizing xs with + | zero => + let [x] := xs + rfl + | succ n ih => + let x::xs := xs + simp at last_idx + rw [dropLast, eraseIdx] + congr + exact ih last_idx + exact fun _ => nomatch xs + /-! ### get? -/ -theorem get_eq_iff : List.get l n = x ↔ l.get? n.1 = some x := by simp [get?_eq_some] +@[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 - induction xs generalizing i j with - | nil => cases h₀ - | cons x xs ih => - match i, j with - | 0, 0 => rfl - | i+1, j+1 => simp; cases h₁ with - | cons ha h₁ => exact ih (Nat.lt_of_succ_lt_succ h₀) h₁ h₂ - | i+1, 0 => ?_ | 0, j+1 => ?_ - all_goals - simp at h₂ - cases h₁; rename_i h' h - have := h x ?_ rfl; cases this - rw [mem_iff_get?] - exact ⟨_, h₂⟩; exact ⟨_ , h₂.symm⟩ - -/-! ### drop -/ - -theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) := by - induction l generalizing n with - | nil => simp - | cons hd tl hl => - cases n - · simp - · simp [hl] + apply getElem?_inj h₀ h₁ + simp_all /-! ### modifyNth -/ @@ -292,23 +88,31 @@ theorem eraseIdx_eq_modifyNthTail : ∀ n (l : List α), eraseIdx l n = modifyNt | n+1, [] => rfl | n+1, a :: l => congrArg (cons _) (eraseIdx_eq_modifyNthTail _ _) -@[deprecated] alias removeNth_eq_nth_tail := eraseIdx_eq_modifyNthTail +@[deprecated (since := "2024-05-06")] alias removeNth_eq_nth_tail := eraseIdx_eq_modifyNthTail -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 - | n, l, 0 => by cases l <;> cases n <;> rfl +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.get? m <;> simp [h, modifyNth, m.succ_ne_zero.symm] - | n+1, a :: l, m+1 => - (get?_modifyNth f n l m).trans <| by - cases h' : l.get? m <;> by_cases h : n = m <;> - simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h'] - -theorem modifyNthTail_length (f : List α → List α) (H : ∀ l, length (f l) = length l) : + | 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) (modifyNthTail_length _ H _ _) + | _+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 @@ -320,16 +124,28 @@ theorem exists_of_modifyNthTail (f : List α → List α) {n} {l : List α} (h : ⟨_, _, (take_append_drop n l).symm, length_take_of_le h⟩ ⟨_, _, eq, hl, hl ▸ eq ▸ modifyNthTail_add (n := 0) ..⟩ -@[simp] theorem modify_get?_length (f : α → α) : ∀ n l, length (modifyNth f n l) = length l := - modifyNthTail_length _ fun l => by cases l <;> rfl +@[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] -@[simp] theorem get?_modifyNth_eq (f : α → α) (n) (l : List α) : - (modifyNth f n l).get? n = f <$> l.get? n := by - simp only [get?_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 get?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : +@[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 only [get?_modifyNth, if_neg h, id_map'] + 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₂ := @@ -347,9 +163,9 @@ 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) : - modifyNth f n l = take n l ++ f (get l ⟨n, h⟩) :: drop (n + 1) l := by - rw [modifyNth_eq_take_drop, drop_eq_get_cons h]; 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 -/ @@ -367,160 +183,53 @@ theorem modifyNth_eq_set_get? (f : α → α) : | 0, l => by cases l <;> rfl | n+1, [] => rfl | n+1, b :: l => - (congrArg (cons _) (modifyNth_eq_set_get? ..)).trans <| by cases h : l.get? n <;> simp [h] + (congrArg (cons _) (modifyNth_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 -theorem exists_of_set {l : List α} (h : n < l.length) : +-- 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 -theorem exists_of_set' {l : List α} (h : n < l.length) : - ∃ l₁ l₂, l = l₁ ++ l.get ⟨n, h⟩ :: l₂ ∧ l₁.length = n ∧ l.set n a' = l₁ ++ a' :: l₂ := - have ⟨_, _, _, h₁, h₂, h₃⟩ := exists_of_set h; ⟨_, _, get_of_append h₁ h₂ ▸ h₁, h₂, h₃⟩ - -@[simp] +@[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 [set_eq_modifyNth, get?_modifyNth_eq] + simp only [get?_eq_getElem?, getElem?_set_eq', Option.map_eq_map] + 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?_set_eq, get?_eq_get h]; rfl + (set l n a).get? n = some a := by + rw [get?_eq_getElem?, getElem?_set_eq', getElem?_eq_getElem h]; rfl -@[simp] +@[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 only [set_eq_modifyNth, get?_modifyNth_ne _ _ h] + 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 - by_cases m = n <;> simp [*, get?_set_eq, get?_set_ne] + simp [getElem?_set'] 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 - simp [get?_set, get?_eq_get h] + simp [getElem?_set', getElem?_eq_getElem h] 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 [get?_set]; split <;> subst_vars <;> simp [*, get?_eq_get h] - -theorem drop_set_of_lt (a : α) {n m : Nat} (l : List α) (h : n < m) : - (l.set n a).drop m = l.drop m := - List.ext fun i => by rw [get?_drop, get?_drop, get?_set_ne _ _ (by omega)] - -theorem take_set_of_lt (a : α) {n m : Nat} (l : List α) (h : m < n) : - (l.set n a).take m = l.take m := - List.ext fun i => by - rw [get?_take_eq_if, get?_take_eq_if] - split - · next h' => rw [get?_set_ne _ _ (by omega)] - · rfl - -/-! ### removeNth -/ - -theorem length_eraseIdx : ∀ {l i}, i < length l → length (@eraseIdx α l i) = length l - 1 - | [], _, _ => rfl - | _::_, 0, _ => by simp [eraseIdx] - | x::xs, i+1, h => by - have : i < length xs := Nat.lt_of_succ_lt_succ h - simp [eraseIdx, ← Nat.add_one] - rw [length_eraseIdx this, Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) this)] + simp [getElem?_set]; split <;> subst_vars <;> simp [*, getElem?_eq_getElem h] -@[deprecated] alias length_removeNth := length_eraseIdx - -/-! ### tail -/ - -@[simp] theorem length_tail (l : List α) : length (tail l) = length l - 1 := by cases l <;> rfl +@[deprecated (since := "2024-05-06")] alias length_removeNth := length_eraseIdx /-! ### eraseP -/ -@[simp] theorem eraseP_nil : [].eraseP p = [] := rfl - -theorem eraseP_cons (a : α) (l : List α) : - (a :: l).eraseP p = bif p a then l else a :: l.eraseP p := rfl - -@[simp] theorem eraseP_cons_of_pos {l : List α} (p) (h : p a) : (a :: l).eraseP p = l := by - simp [eraseP_cons, h] - -@[simp] theorem eraseP_cons_of_neg {l : List α} (p) (h : ¬p a) : - (a :: l).eraseP p = a :: l.eraseP p := by simp [eraseP_cons, h] - -theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.eraseP p = l := by - induction l with - | nil => rfl - | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2] - -theorem exists_of_eraseP : ∀ {l : List α} {a} (al : a ∈ l) (pa : p a), - ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.eraseP p = l₁ ++ l₂ - | b :: l, a, al, pa => - if pb : p b then - ⟨b, [], l, forall_mem_nil _, pb, by simp [pb]⟩ - else - match al with - | .head .. => nomatch pb pa - | .tail _ al => - let ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩ := exists_of_eraseP al pa - ⟨c, b::l₁, l₂, (forall_mem_cons ..).2 ⟨pb, h₁⟩, - h₂, by rw [h₃, cons_append], by simp [pb, h₄]⟩ - -theorem exists_or_eq_self_of_eraseP (p) (l : List α) : - l.eraseP p = l ∨ - ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.eraseP p = l₁ ++ l₂ := - if h : ∃ a ∈ l, p a then - let ⟨_, ha, pa⟩ := h - .inr (exists_of_eraseP ha pa) - else - .inl (eraseP_of_forall_not (h ⟨·, ·, ·⟩)) - -@[simp] theorem length_eraseP_of_mem (al : a ∈ l) (pa : p a) : - length (l.eraseP p) = Nat.pred (length l) := by - let ⟨_, l₁, l₂, _, _, e₁, e₂⟩ := exists_of_eraseP al pa - rw [e₂]; simp [length_append, e₁]; rfl - -theorem eraseP_append_left {a : α} (pa : p a) : - ∀ {l₁ : List α} l₂, a ∈ l₁ → (l₁++l₂).eraseP p = l₁.eraseP p ++ l₂ - | x :: xs, l₂, h => by - by_cases h' : p x <;> simp [h'] - rw [eraseP_append_left pa l₂ ((mem_cons.1 h).resolve_left (mt _ h'))] - intro | rfl => exact pa - -theorem eraseP_append_right : - ∀ {l₁ : List α} l₂, (∀ b ∈ l₁, ¬p b) → eraseP p (l₁++l₂) = l₁ ++ l₂.eraseP p - | [], l₂, _ => rfl - | x :: xs, l₂, h => by - simp [(forall_mem_cons.1 h).1, eraseP_append_right _ (forall_mem_cons.1 h).2] - -theorem eraseP_sublist (l : List α) : l.eraseP p <+ l := by - match exists_or_eq_self_of_eraseP p l with - | .inl h => rw [h]; apply Sublist.refl - | .inr ⟨c, l₁, l₂, _, _, h₃, h₄⟩ => rw [h₄, h₃]; simp - -theorem eraseP_subset (l : List α) : l.eraseP p ⊆ l := (eraseP_sublist l).subset - -protected theorem Sublist.eraseP : l₁ <+ l₂ → l₁.eraseP p <+ l₂.eraseP p - | .slnil => Sublist.refl _ - | .cons a s => by - by_cases h : p a <;> simp [h] - exacts [s.eraseP.trans (eraseP_sublist _), s.eraseP.cons _] - | .cons₂ a s => by - by_cases h : p a <;> simp [h] - exacts [s, s.eraseP] - -theorem mem_of_mem_eraseP {l : List α} : a ∈ l.eraseP p → a ∈ l := (eraseP_subset _ ·) - -@[simp] theorem mem_eraseP_of_neg {l : List α} (pa : ¬p a) : a ∈ l.eraseP p ↔ a ∈ l := by - refine ⟨mem_of_mem_eraseP, fun al => ?_⟩ - match exists_or_eq_self_of_eraseP p l with - | .inl h => rw [h]; assumption - | .inr ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩ => - rw [h₄]; rw [h₃] at al - have : a ≠ c := fun h => (h ▸ pa).elim h₂ - simp [this] at al; simp [al] - -theorem eraseP_map (f : β → α) : ∀ (l : List β), (map f l).eraseP p = map f (l.eraseP (p ∘ f)) - | [] => rfl - | b::l => by by_cases h : p (f b) <;> simp [h, eraseP_map f l, eraseP_cons_of_pos] - @[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 → @@ -533,234 +242,26 @@ theorem eraseP_map (f : β → α) : ∀ (l : List β), (map f l).eraseP p = map /-! ### erase -/ -section erase -variable [BEq α] - -theorem erase_eq_eraseP' (a : α) (l : List α) : l.erase a = l.eraseP (· == a) := by - induction l - · simp - · next b t ih => - rw [erase_cons, eraseP_cons, ih] - if h : b == a then simp [h] else simp [h] - -theorem erase_eq_eraseP [LawfulBEq α] (a : α) : ∀ l : List α, l.erase a = l.eraseP (a == ·) - | [] => rfl - | b :: l => by - if h : a = b then simp [h] else simp [h, Ne.symm h, erase_eq_eraseP a l] - -theorem exists_erase_eq [LawfulBEq α] {a : α} {l : List α} (h : a ∈ l) : - ∃ l₁ l₂, a ∉ l₁ ∧ l = l₁ ++ a :: l₂ ∧ l.erase a = l₁ ++ l₂ := by - let ⟨_, l₁, l₂, h₁, e, h₂, h₃⟩ := exists_of_eraseP h (beq_self_eq_true _) - rw [erase_eq_eraseP]; exact ⟨l₁, l₂, fun h => h₁ _ h (beq_self_eq_true _), eq_of_beq e ▸ h₂, h₃⟩ - -@[simp] theorem length_erase_of_mem [LawfulBEq α] {a : α} {l : List α} (h : a ∈ l) : - length (l.erase a) = Nat.pred (length l) := by - rw [erase_eq_eraseP]; exact length_eraseP_of_mem h (beq_self_eq_true a) - -theorem erase_append_left [LawfulBEq α] {l₁ : List α} (l₂) (h : a ∈ l₁) : - (l₁ ++ l₂).erase a = l₁.erase a ++ l₂ := by - simp [erase_eq_eraseP]; exact eraseP_append_left (beq_self_eq_true a) l₂ h - -theorem erase_append_right [LawfulBEq α] {a : α} {l₁ : List α} (l₂ : List α) (h : a ∉ l₁) : - (l₁ ++ l₂).erase a = (l₁ ++ l₂.erase a) := by - rw [erase_eq_eraseP, erase_eq_eraseP, eraseP_append_right] - intros b h' h''; rw [eq_of_beq h''] at h; exact h h' - -theorem erase_sublist (a : α) (l : List α) : l.erase a <+ l := - erase_eq_eraseP' a l ▸ eraseP_sublist l - -theorem erase_subset (a : α) (l : List α) : l.erase a ⊆ l := (erase_sublist a l).subset - -theorem Sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a := by - simp only [erase_eq_eraseP']; exact h.eraseP -@[deprecated] alias sublist.erase := Sublist.erase - -theorem mem_of_mem_erase {a b : α} {l : List α} (h : a ∈ l.erase b) : a ∈ l := erase_subset _ _ h - -@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : List α} (ab : a ≠ b) : - a ∈ l.erase b ↔ a ∈ l := - erase_eq_eraseP b l ▸ mem_eraseP_of_neg (mt eq_of_beq ab.symm) - -theorem erase_comm [LawfulBEq α] (a b : α) (l : List α) : - (l.erase a).erase b = (l.erase b).erase a := by - if ab : a == b then rw [eq_of_beq ab] else ?_ - if ha : a ∈ l then ?_ else - simp only [erase_of_not_mem ha, erase_of_not_mem (mt mem_of_mem_erase ha)] - if hb : b ∈ l then ?_ else - simp only [erase_of_not_mem hb, erase_of_not_mem (mt mem_of_mem_erase hb)] - match l, l.erase a, exists_erase_eq ha with - | _, _, ⟨l₁, l₂, ha', rfl, rfl⟩ => - if h₁ : b ∈ l₁ then - rw [erase_append_left _ h₁, erase_append_left _ h₁, - erase_append_right _ (mt mem_of_mem_erase ha'), erase_cons_head] - else - rw [erase_append_right _ h₁, erase_append_right _ h₁, erase_append_right _ ha', - erase_cons_tail _ ab, erase_cons_head] - -end erase - -/-! ### filter and partition -/ - -@[simp] theorem filter_sublist {p : α → Bool} : ∀ (l : List α), filter p l <+ l - | [] => .slnil - | a :: l => by rw [filter]; split <;> simp [Sublist.cons, Sublist.cons₂, filter_sublist l] +@[deprecated (since := "2024-04-22")] alias sublist.erase := Sublist.erase -/-! ### filterMap -/ +theorem erase_of_forall_bne [BEq α] (a : α) (xs : List α) (h : ∀ (x : α), x ∈ xs → ¬x == a) : + xs.erase a = xs := by + rw [erase_eq_eraseP', eraseP_of_forall_not h] -theorem length_filter_le (p : α → Bool) (l : List α) : - (l.filter p).length ≤ l.length := (filter_sublist _).length_le +-- TODO a version of the above theorem with LawfulBEq and ∉ -theorem length_filterMap_le (f : α → Option β) (l : List α) : - (filterMap f l).length ≤ l.length := by - rw [← length_map _ some, map_filterMap_some_eq_filter_map_is_some, ← length_map _ f] - apply length_filter_le +/-! ### findIdx? -/ -protected theorem Sublist.filterMap (f : α → Option β) (s : l₁ <+ l₂) : - filterMap f l₁ <+ filterMap f l₂ := by - induction s <;> simp <;> split <;> simp [*, cons, cons₂] - -theorem Sublist.filter (p : α → Bool) {l₁ l₂} (s : l₁ <+ l₂) : filter p l₁ <+ filter p l₂ := by - rw [← filterMap_eq_filter]; apply s.filterMap - -@[simp] -theorem filter_eq_self {l} : filter p l = l ↔ ∀ a ∈ l, p a := by - induction l with simp - | cons a l ih => - cases h : p a <;> simp [*] - intro h; exact Nat.lt_irrefl _ (h ▸ length_filter_le p l) - -@[simp] -theorem filter_length_eq_length {l} : (filter p l).length = l.length ↔ ∀ a ∈ l, p a := - Iff.trans ⟨l.filter_sublist.eq_of_length, congrArg length⟩ filter_eq_self - -/-! ### findIdx -/ - -@[simp] theorem findIdx_nil {α : Type _} (p : α → Bool) : [].findIdx p = 0 := rfl - -theorem findIdx_cons (p : α → Bool) (b : α) (l : List α) : - (b :: l).findIdx p = bif p b then 0 else (l.findIdx p) + 1 := by - cases H : p b with - | true => simp [H, findIdx, findIdx.go] - | false => simp [H, findIdx, findIdx.go, findIdx_go_succ] -where - findIdx_go_succ (p : α → Bool) (l : List α) (n : Nat) : - List.findIdx.go p l (n + 1) = (findIdx.go p l n) + 1 := by - cases l with - | nil => unfold findIdx.go; exact Nat.succ_eq_add_one n - | cons head tail => - unfold findIdx.go - cases p head <;> simp only [cond_false, cond_true] - exact findIdx_go_succ p tail (n + 1) - -theorem findIdx_of_get?_eq_some {xs : List α} (w : xs.get? (xs.findIdx p) = some y) : p y := by - induction xs with - | nil => simp_all - | cons x xs ih => by_cases h : p x <;> simp_all [findIdx_cons] - -theorem findIdx_get {xs : List α} {w : xs.findIdx p < xs.length} : - p (xs.get ⟨xs.findIdx p, w⟩) := - xs.findIdx_of_get?_eq_some (get?_eq_get w) - -theorem findIdx_lt_length_of_exists {xs : List α} (h : ∃ x ∈ xs, p x) : - xs.findIdx p < xs.length := by - induction xs with - | nil => simp_all - | cons x xs ih => - by_cases p x - · simp_all only [forall_exists_index, and_imp, mem_cons, exists_eq_or_imp, true_or, - findIdx_cons, cond_true, length_cons] - apply Nat.succ_pos - · simp_all [findIdx_cons] - refine Nat.succ_lt_succ ?_ - obtain ⟨x', m', h'⟩ := h - exact ih x' m' h' - -theorem findIdx_get?_eq_get_of_exists {xs : List α} (h : ∃ x ∈ xs, p x) : - xs.get? (xs.findIdx p) = some (xs.get ⟨xs.findIdx p, xs.findIdx_lt_length_of_exists h⟩) := - get?_eq_get (findIdx_lt_length_of_exists h) - - /-! ### findIdx? -/ - -@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl - -@[simp] theorem findIdx?_cons : - (x :: xs).findIdx? p i = if p x then some i else findIdx? p xs (i + 1) := rfl - -@[simp] theorem findIdx?_succ : - (xs : List α).findIdx? p (i+1) = (xs.findIdx? p i).map fun i => i + 1 := by - induction xs generalizing i with simp - | cons _ _ _ => split <;> simp_all - -theorem findIdx?_eq_some_iff (xs : List α) (p : α → Bool) : - xs.findIdx? p = some i ↔ (xs.take (i + 1)).map p = replicate i false ++ [true] := by - induction xs generalizing i with - | nil => simp - | cons x xs ih => - simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ, take_succ_cons, map_cons] - split <;> cases i <;> simp_all - -theorem findIdx?_of_eq_some {xs : List α} {p : α → Bool} (w : xs.findIdx? p = some i) : - match xs.get? i with | some a => p a | none => false := by - induction xs generalizing i with - | nil => simp_all - | cons x xs ih => - simp_all only [findIdx?_cons, Nat.zero_add, findIdx?_succ] - split at w <;> cases i <;> simp_all - -theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p = none) : - ∀ i, match xs.get? i with | some a => ¬ p a | none => true := by - intro i - induction xs generalizing i with - | nil => simp_all +theorem findIdx_eq_findIdx? (p : α → Bool) (l : List α) : + l.findIdx p = (match l.findIdx? p with | some i => i | none => l.length) := by + induction l with + | nil => rfl | cons x xs ih => - simp_all only [Bool.not_eq_true, findIdx?_cons, Nat.zero_add, findIdx?_succ] - cases i with - | zero => - split at w <;> simp_all - | succ i => - simp only [get?_cons_succ] - apply ih - split at w <;> simp_all - -@[simp] theorem findIdx?_append : - (xs ++ ys : List α).findIdx? p = - (xs.findIdx? p <|> (ys.findIdx? p).map fun i => i + xs.length) := by - induction xs with simp - | cons _ _ _ => split <;> simp_all [Option.map_orElse, Option.map_map]; rfl - -@[simp] theorem findIdx?_replicate : - (replicate n a).findIdx? p = if 0 < n ∧ p a then some 0 else none := by - induction n with - | zero => simp - | succ n ih => - simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, Nat.zero_lt_succ, true_and] - split <;> simp_all - -/-! ### pairwise -/ - -theorem Pairwise.sublist : l₁ <+ l₂ → l₂.Pairwise R → l₁.Pairwise R - | .slnil, h => h - | .cons _ s, .cons _ h₂ => h₂.sublist s - | .cons₂ _ s, .cons h₁ h₂ => (h₂.sublist s).cons fun _ h => h₁ _ (s.subset h) - -theorem pairwise_map {l : List α} : - (l.map f).Pairwise R ↔ l.Pairwise fun a b => R (f a) (f b) := by - induction l - · simp - · simp only [map, pairwise_cons, forall_mem_map_iff, *] - -theorem pairwise_append {l₁ l₂ : List α} : - (l₁ ++ l₂).Pairwise R ↔ l₁.Pairwise R ∧ l₂.Pairwise R ∧ ∀ a ∈ l₁, ∀ b ∈ l₂, R a b := by - induction l₁ <;> simp [*, or_imp, forall_and, and_assoc, and_left_comm] - -theorem pairwise_reverse {l : List α} : - l.reverse.Pairwise R ↔ l.Pairwise (fun a b => R b a) := by - induction l <;> simp [*, pairwise_append, and_comm] - -theorem Pairwise.imp {α R S} (H : ∀ {a b}, R a b → S a b) : - ∀ {l : List α}, l.Pairwise R → l.Pairwise S - | _, .nil => .nil - | _, .cons h₁ h₂ => .cons (H ∘ h₁ ·) (h₂.imp H) + rw [findIdx_cons, findIdx?_cons] + if h : p x then + simp [h] + else + cases h' : findIdx? p xs <;> simp [h, h', ih] /-! ### replaceF -/ @@ -830,10 +331,10 @@ theorem disjoint_of_subset_right (ss : l₂ ⊆ l) (d : Disjoint l₁ l) : Disjo fun _ m m₁ => d m (ss m₁) theorem disjoint_of_disjoint_cons_left {l₁ l₂} : Disjoint (a :: l₁) l₂ → Disjoint l₁ l₂ := -disjoint_of_subset_left (subset_cons _ _) + disjoint_of_subset_left (subset_cons_self _ _) theorem disjoint_of_disjoint_cons_right {l₁ l₂} : Disjoint l₁ (a :: l₂) → Disjoint l₁ l₂ := -disjoint_of_subset_right (subset_cons _ _) + disjoint_of_subset_right (subset_cons_self _ _) @[simp] theorem disjoint_nil_left (l : List α) : Disjoint [] l := fun a => (not_mem_nil a).elim @@ -869,23 +370,13 @@ theorem disjoint_of_disjoint_append_right_left (d : Disjoint l (l₁ ++ l₂)) : theorem disjoint_of_disjoint_append_right_right (d : Disjoint l (l₁ ++ l₂)) : Disjoint l l₂ := (disjoint_append_right.1 d).2 -/-! ### foldl / foldr -/ - -theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁) - (H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by - induction l generalizing init <;> simp [*, H] - -theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : α → β₂ → β₂) (l : List α) (init : β₁) - (H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by - induction l <;> simp [*, H] - /-! ### union -/ section union variable [BEq α] -theorem union_def [BEq α] (l₁ l₂ : List α) : l₁ ∪ l₂ = foldr .insert l₂ l₁ := rfl +theorem union_def (l₁ l₂ : List α) : l₁ ∪ l₂ = foldr .insert l₂ l₁ := rfl @[simp] theorem nil_union (l : List α) : nil ∪ l = l := by simp [List.union_def, foldr] @@ -914,46 +405,23 @@ theorem pair_mem_product {xs : List α} {ys : List β} {x : α} {y : β} : simp only [product, and_imp, mem_map, Prod.mk.injEq, exists_eq_right_right, mem_bind, iff_self] -/-! ### leftpad -/ - -/-- The length of the List returned by `List.leftpad n a l` is equal - to the larger of `n` and `l.length` -/ -@[simp] -theorem leftpad_length (n : Nat) (a : α) (l : List α) : - (leftpad n a l).length = max n l.length := by - simp only [leftpad, length_append, length_replicate, Nat.sub_add_eq_max] - -theorem leftpad_prefix (n : Nat) (a : α) (l : List α) : - replicate (n - length l) a <+: leftpad n a l := by - simp only [IsPrefix, leftpad] - exact Exists.intro l rfl - -theorem leftpad_suffix (n : Nat) (a : α) (l : List α) : l <:+ (leftpad n a l) := by - simp only [IsSuffix, leftpad] - exact Exists.intro (replicate (n - length l) a) rfl - /-! ### monadic operations -/ --- we use ForIn.forIn as the simp normal form -@[simp] theorem forIn_eq_forIn [Monad m] : @List.forIn α β m _ = forIn := rfl - 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] congr; ext (b | b) <;> simp -@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ l₂ : List α) (f : α → m PUnit) : - (l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by induction l₁ <;> simp [*] - /-! ### diff -/ section Diff variable [BEq α] -variable [LawfulBEq α] @[simp] theorem diff_nil (l : List α) : l.diff [] = l := rfl +variable [LawfulBEq α] + @[simp] theorem diff_cons (l₁ l₂ : List α) (a : α) : l₁.diff (a :: l₂) = (l₁.erase a).diff l₂ := by simp_all [List.diff, erase_of_not_mem] @@ -1022,205 +490,8 @@ theorem Sublist.erase_diff_erase_sublist {a : α} : end Diff -/-! ### prefix, suffix, infix -/ - -@[simp] theorem prefix_append (l₁ l₂ : List α) : l₁ <+: l₁ ++ l₂ := ⟨l₂, rfl⟩ - -@[simp] theorem suffix_append (l₁ l₂ : List α) : l₂ <:+ l₁ ++ l₂ := ⟨l₁, rfl⟩ - -theorem infix_append (l₁ l₂ l₃ : List α) : l₂ <:+: l₁ ++ l₂ ++ l₃ := ⟨l₁, l₃, rfl⟩ - -@[simp] theorem infix_append' (l₁ l₂ l₃ : List α) : l₂ <:+: l₁ ++ (l₂ ++ l₃) := by - rw [← List.append_assoc]; apply infix_append - -theorem IsPrefix.isInfix : l₁ <+: l₂ → l₁ <:+: l₂ := fun ⟨t, h⟩ => ⟨[], t, h⟩ - -theorem IsSuffix.isInfix : l₁ <:+ l₂ → l₁ <:+: l₂ := fun ⟨t, h⟩ => ⟨t, [], by rw [h, append_nil]⟩ - -theorem nil_prefix (l : List α) : [] <+: l := ⟨l, rfl⟩ - -theorem nil_suffix (l : List α) : [] <:+ l := ⟨l, append_nil _⟩ - -theorem nil_infix (l : List α) : [] <:+: l := (nil_prefix _).isInfix - -theorem prefix_refl (l : List α) : l <+: l := ⟨[], append_nil _⟩ - -theorem suffix_refl (l : List α) : l <:+ l := ⟨[], rfl⟩ - -theorem infix_refl (l : List α) : l <:+: l := (prefix_refl l).isInfix - -@[simp] theorem suffix_cons (a : α) : ∀ l, l <:+ a :: l := suffix_append [a] - -theorem infix_cons : l₁ <:+: l₂ → l₁ <:+: a :: l₂ := fun ⟨L₁, L₂, h⟩ => ⟨a :: L₁, L₂, h ▸ rfl⟩ - -theorem infix_concat : l₁ <:+: l₂ → l₁ <:+: concat l₂ a := fun ⟨L₁, L₂, h⟩ => - ⟨L₁, concat L₂ a, by simp [← h, concat_eq_append, append_assoc]⟩ - -theorem IsPrefix.trans : ∀ {l₁ l₂ l₃ : List α}, l₁ <+: l₂ → l₂ <+: l₃ → l₁ <+: l₃ - | _, _, _, ⟨r₁, rfl⟩, ⟨r₂, rfl⟩ => ⟨r₁ ++ r₂, (append_assoc _ _ _).symm⟩ - -theorem IsSuffix.trans : ∀ {l₁ l₂ l₃ : List α}, l₁ <:+ l₂ → l₂ <:+ l₃ → l₁ <:+ l₃ - | _, _, _, ⟨l₁, rfl⟩, ⟨l₂, rfl⟩ => ⟨l₂ ++ l₁, append_assoc _ _ _⟩ - -theorem IsInfix.trans : ∀ {l₁ l₂ l₃ : List α}, l₁ <:+: l₂ → l₂ <:+: l₃ → l₁ <:+: l₃ - | l, _, _, ⟨l₁, r₁, rfl⟩, ⟨l₂, r₂, rfl⟩ => ⟨l₂ ++ l₁, r₁ ++ r₂, by simp only [append_assoc]⟩ - -protected theorem IsInfix.sublist : l₁ <:+: l₂ → l₁ <+ l₂ - | ⟨_, _, h⟩ => h ▸ (sublist_append_right ..).trans (sublist_append_left ..) - -protected theorem IsInfix.subset (hl : l₁ <:+: l₂) : l₁ ⊆ l₂ := - hl.sublist.subset - -protected theorem IsPrefix.sublist (h : l₁ <+: l₂) : l₁ <+ l₂ := - h.isInfix.sublist - -protected theorem IsPrefix.subset (hl : l₁ <+: l₂) : l₁ ⊆ l₂ := - hl.sublist.subset - -protected theorem IsSuffix.sublist (h : l₁ <:+ l₂) : l₁ <+ l₂ := - h.isInfix.sublist - -protected theorem IsSuffix.subset (hl : l₁ <:+ l₂) : l₁ ⊆ l₂ := - hl.sublist.subset - -@[simp] theorem reverse_suffix : reverse l₁ <:+ reverse l₂ ↔ l₁ <+: l₂ := - ⟨fun ⟨r, e⟩ => ⟨reverse r, by rw [← reverse_reverse l₁, ← reverse_append, e, reverse_reverse]⟩, - fun ⟨r, e⟩ => ⟨reverse r, by rw [← reverse_append, e]⟩⟩ - -@[simp] theorem reverse_prefix : reverse l₁ <+: reverse l₂ ↔ l₁ <:+ l₂ := by - rw [← reverse_suffix]; simp only [reverse_reverse] - -@[simp] theorem reverse_infix : reverse l₁ <:+: reverse l₂ ↔ l₁ <:+: l₂ := by - refine ⟨fun ⟨s, t, e⟩ => ⟨reverse t, reverse s, ?_⟩, fun ⟨s, t, e⟩ => ⟨reverse t, reverse s, ?_⟩⟩ - · rw [← reverse_reverse l₁, append_assoc, ← reverse_append, ← reverse_append, e, - reverse_reverse] - · rw [append_assoc, ← reverse_append, ← reverse_append, e] - -theorem IsInfix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length := - h.sublist.length_le - -theorem IsPrefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length := - h.sublist.length_le - -theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length := - h.sublist.length_le - -@[simp] theorem infix_nil : l <:+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ infix_refl _)⟩ - -@[simp] theorem prefix_nil : l <+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ prefix_refl _)⟩ - -@[simp] theorem suffix_nil : l <:+ [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ suffix_refl _)⟩ - -theorem infix_iff_prefix_suffix (l₁ l₂ : List α) : l₁ <:+: l₂ ↔ ∃ t, l₁ <+: t ∧ t <:+ l₂ := - ⟨fun ⟨_, t, e⟩ => ⟨l₁ ++ t, ⟨_, rfl⟩, e ▸ append_assoc .. ▸ ⟨_, rfl⟩⟩, - fun ⟨_, ⟨t, rfl⟩, s, e⟩ => ⟨s, t, append_assoc .. ▸ e⟩⟩ - -theorem IsInfix.eq_of_length (h : l₁ <:+: l₂) : l₁.length = l₂.length → l₁ = l₂ := - h.sublist.eq_of_length - -theorem IsPrefix.eq_of_length (h : l₁ <+: l₂) : l₁.length = l₂.length → l₁ = l₂ := - h.sublist.eq_of_length - -theorem IsSuffix.eq_of_length (h : l₁ <:+ l₂) : l₁.length = l₂.length → l₁ = l₂ := - h.sublist.eq_of_length - -theorem prefix_of_prefix_length_le : - ∀ {l₁ l₂ l₃ : List α}, l₁ <+: l₃ → l₂ <+: l₃ → length l₁ ≤ length l₂ → l₁ <+: l₂ - | [], l₂, _, _, _, _ => nil_prefix _ - | a :: l₁, b :: l₂, _, ⟨r₁, rfl⟩, ⟨r₂, e⟩, ll => by - injection e with _ e'; subst b - rcases prefix_of_prefix_length_le ⟨_, rfl⟩ ⟨_, e'⟩ (le_of_succ_le_succ ll) with ⟨r₃, rfl⟩ - exact ⟨r₃, rfl⟩ - -theorem prefix_or_prefix_of_prefix (h₁ : l₁ <+: l₃) (h₂ : l₂ <+: l₃) : l₁ <+: l₂ ∨ l₂ <+: l₁ := - (Nat.le_total (length l₁) (length l₂)).imp (prefix_of_prefix_length_le h₁ h₂) - (prefix_of_prefix_length_le h₂ h₁) - -theorem suffix_of_suffix_length_le - (h₁ : l₁ <:+ l₃) (h₂ : l₂ <:+ l₃) (ll : length l₁ ≤ length l₂) : l₁ <:+ l₂ := - reverse_prefix.1 <| - prefix_of_prefix_length_le (reverse_prefix.2 h₁) (reverse_prefix.2 h₂) (by simp [ll]) - -theorem suffix_or_suffix_of_suffix (h₁ : l₁ <:+ l₃) (h₂ : l₂ <:+ l₃) : l₁ <:+ l₂ ∨ l₂ <:+ l₁ := - (prefix_or_prefix_of_prefix (reverse_prefix.2 h₁) (reverse_prefix.2 h₂)).imp reverse_prefix.1 - reverse_prefix.1 - -theorem suffix_cons_iff : l₁ <:+ a :: l₂ ↔ l₁ = a :: l₂ ∨ l₁ <:+ l₂ := by - constructor - · rintro ⟨⟨hd, tl⟩, hl₃⟩ - · exact Or.inl hl₃ - · simp only [cons_append] at hl₃ - injection hl₃ with _ hl₄ - exact Or.inr ⟨_, hl₄⟩ - · rintro (rfl | hl₁) - · exact (a :: l₂).suffix_refl - · exact hl₁.trans (l₂.suffix_cons _) - -theorem infix_cons_iff : l₁ <:+: a :: l₂ ↔ l₁ <+: a :: l₂ ∨ l₁ <:+: l₂ := by - constructor - · rintro ⟨⟨hd, tl⟩, t, hl₃⟩ - · exact Or.inl ⟨t, hl₃⟩ - · simp only [cons_append] at hl₃ - injection hl₃ with _ hl₄ - exact Or.inr ⟨_, t, hl₄⟩ - · rintro (h | hl₁) - · exact h.isInfix - · exact infix_cons hl₁ - -theorem infix_of_mem_join : ∀ {L : List (List α)}, l ∈ L → l <:+: join L - | l' :: _, h => - match h with - | List.Mem.head .. => infix_append [] _ _ - | List.Mem.tail _ hlMemL => - IsInfix.trans (infix_of_mem_join hlMemL) <| (suffix_append _ _).isInfix - -theorem prefix_append_right_inj (l) : l ++ l₁ <+: l ++ l₂ ↔ l₁ <+: l₂ := - exists_congr fun r => by rw [append_assoc, append_right_inj] - -@[simp] -theorem prefix_cons_inj (a) : a :: l₁ <+: a :: l₂ ↔ l₁ <+: l₂ := - prefix_append_right_inj [a] - -theorem take_prefix (n) (l : List α) : take n l <+: l := - ⟨_, take_append_drop _ _⟩ - -theorem drop_suffix (n) (l : List α) : drop n l <:+ l := - ⟨_, take_append_drop _ _⟩ - -theorem take_sublist (n) (l : List α) : take n l <+ l := - (take_prefix n l).sublist - -theorem drop_sublist (n) (l : List α) : drop n l <+ l := - (drop_suffix n l).sublist - -theorem take_subset (n) (l : List α) : take n l ⊆ l := - (take_sublist n l).subset - -theorem drop_subset (n) (l : List α) : drop n l ⊆ l := - (drop_sublist n l).subset - -theorem mem_of_mem_take {l : List α} (h : a ∈ l.take n) : a ∈ l := - take_subset n l h - -theorem IsPrefix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) : - l₁.filter p <+: l₂.filter p := by - obtain ⟨xs, rfl⟩ := h - rw [filter_append]; apply prefix_append - -theorem IsSuffix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) : - l₁.filter p <:+ l₂.filter p := by - obtain ⟨xs, rfl⟩ := h - rw [filter_append]; apply suffix_append - -theorem IsInfix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) : - l₁.filter p <:+: l₂.filter p := by - obtain ⟨xs, ys, rfl⟩ := h - rw [filter_append, filter_append]; apply infix_append _ - /-! ### drop -/ -theorem mem_of_mem_drop {n} {l : List α} (h : a ∈ l.drop n) : a ∈ l := drop_subset _ _ h - theorem disjoint_take_drop : ∀ {l : List α}, l.Nodup → m ≤ n → Disjoint (l.take m) (l.drop n) | [], _, _ => by simp | x :: xs, hl, h => by @@ -1269,36 +540,6 @@ protected theorem Pairwise.chain (p : Pairwise R (a :: l)) : Chain R a l := by /-! ### range', range -/ -@[simp] theorem length_range' (s step) : ∀ n : Nat, length (range' s n step) = n - | 0 => rfl - | _ + 1 => congrArg succ (length_range' _ _ _) - -@[simp] theorem range'_eq_nil : range' s n step = [] ↔ n = 0 := by - rw [← length_eq_zero, length_range'] - -theorem mem_range' : ∀{n}, m ∈ range' s n step ↔ ∃ i < n, m = s + step * i - | 0 => by simp [range', Nat.not_lt_zero] - | n + 1 => by - have h (i) : i ≤ n ↔ i = 0 ∨ ∃ j, i = succ j ∧ j < n := by cases i <;> simp [Nat.succ_le] - simp [range', mem_range', Nat.lt_succ, h]; simp only [← exists_and_right, and_assoc] - rw [exists_comm]; simp [Nat.mul_succ, Nat.add_assoc, Nat.add_comm] - -@[simp] theorem mem_range'_1 : m ∈ range' s n ↔ s ≤ m ∧ m < s + n := by - simp [mem_range']; exact ⟨ - fun ⟨i, h, e⟩ => e ▸ ⟨Nat.le_add_right .., Nat.add_lt_add_left h _⟩, - fun ⟨h₁, h₂⟩ => ⟨m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm⟩⟩ - -@[simp] -theorem map_add_range' (a) : ∀ s n step, map (a + ·) (range' s n step) = range' (a + s) n step - | _, 0, _ => rfl - | s, n + 1, step => by simp [range', map_add_range' _ (s + step) n step, Nat.add_assoc] - -theorem map_sub_range' (a s n : Nat) (h : a ≤ s) : - map (· - a) (range' s n step) = range' (s - a) n step := by - conv => lhs; rw [← Nat.add_sub_cancel' h] - rw [← map_add_range', map_map, (?_ : _∘_ = _), map_id] - funext x; apply Nat.add_sub_cancel_left - theorem chain_succ_range' : ∀ s n step : Nat, Chain (fun a b => b = a + step) s (range' (s + step) n step) | _, 0, _ => Chain.nil @@ -1308,132 +549,23 @@ theorem chain_lt_range' (s n : Nat) {step} (h : 0 < step) : Chain (· < ·) s (range' (s + step) n step) := (chain_succ_range' s n step).imp fun _ _ e => e.symm ▸ Nat.lt_add_of_pos_right h -theorem range'_append : ∀ s m n step : Nat, - range' s m step ++ range' (s + step * m) n step = range' s (n + m) step - | s, 0, n, step => rfl - | s, m + 1, n, step => by - simpa [range', Nat.mul_succ, Nat.add_assoc, Nat.add_comm] - using range'_append (s + step) m n step - -@[simp] theorem range'_append_1 (s m n : Nat) : - range' s m ++ range' (s + m) n = range' s (n + m) := by simpa using range'_append s m n 1 - -theorem range'_sublist_right {s m n : Nat} : range' s m step <+ range' s n step ↔ m ≤ n := - ⟨fun h => by simpa only [length_range'] using h.length_le, - fun h => by rw [← Nat.sub_add_cancel h, ← range'_append]; apply sublist_append_left⟩ - -theorem range'_subset_right {s m n : Nat} (step0 : 0 < step) : - range' s m step ⊆ range' s n step ↔ m ≤ n := by - refine ⟨fun h => Nat.le_of_not_lt fun hn => ?_, fun h => (range'_sublist_right.2 h).subset⟩ - have ⟨i, h', e⟩ := mem_range'.1 <| h <| mem_range'.2 ⟨_, hn, rfl⟩ - exact Nat.ne_of_gt h' (Nat.eq_of_mul_eq_mul_left step0 (Nat.add_left_cancel e)) - -theorem range'_subset_right_1 {s m n : Nat} : range' s m ⊆ range' s n ↔ m ≤ n := - range'_subset_right (by decide) - -theorem get?_range' (s step) : ∀ {m n : Nat}, m < n → get? (range' s n step) m = some (s + step * m) - | 0, n + 1, _ => rfl - | m + 1, n + 1, h => - (get?_range' (s + step) step (Nat.lt_of_add_lt_add_right h)).trans <| by - simp [Nat.mul_succ, Nat.add_assoc, Nat.add_comm] - -@[simp] theorem get_range' {n m step} (i) (H : i < (range' n m step).length) : - get (range' n m step) ⟨i, H⟩ = n + step * i := - (get?_eq_some.1 <| get?_range' n step (by simpa using H)).2 - -theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ [s + step * n] := by - rw [Nat.add_comm n 1]; exact (range'_append s n 1 step).symm - -theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ [s + n] := by - simp [range'_concat] - -theorem range_loop_range' : ∀ s n : Nat, range.loop s (range' s n) = range' 0 (n + s) - | 0, n => rfl - | s + 1, n => by rw [← Nat.add_assoc, Nat.add_right_comm n s 1]; exact range_loop_range' s (n + 1) - -theorem range_eq_range' (n : Nat) : range n = range' 0 n := - (range_loop_range' n 0).trans <| by rw [Nat.zero_add] - -theorem range_succ_eq_map (n : Nat) : range (n + 1) = 0 :: map succ (range n) := by - rw [range_eq_range', range_eq_range', range', Nat.add_comm, ← map_add_range'] - congr; exact funext one_add +@[deprecated getElem?_range' (since := "2024-06-12")] +theorem get?_range' (s step) {m n : Nat} (h : m < n) : + get? (range' s n step) m = some (s + step * m) := by + simp [h] -theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) := by - rw [range_eq_range', map_add_range']; rfl - -@[simp] theorem length_range (n : Nat) : length (range n) = n := by - simp only [range_eq_range', length_range'] - -@[simp] theorem range_eq_nil {n : Nat} : range n = [] ↔ n = 0 := by - rw [← length_eq_zero, length_range] - -@[simp] -theorem range_sublist {m n : Nat} : range m <+ range n ↔ m ≤ n := by - simp only [range_eq_range', range'_sublist_right] - -@[simp] -theorem range_subset {m n : Nat} : range m ⊆ range n ↔ m ≤ n := by - simp only [range_eq_range', range'_subset_right, lt_succ_self] - -@[simp] -theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by - simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add] - -theorem not_mem_range_self {n : Nat} : n ∉ range n := by simp - -theorem self_mem_range_succ (n : Nat) : n ∈ range (n + 1) := by simp +@[deprecated getElem_range' (since := "2024-06-12")] +theorem get_range' {n m step} (i) (H : i < (range' n m step).length) : + get (range' n m step) ⟨i, H⟩ = n + step * i := by + simp +@[deprecated getElem?_range (since := "2024-06-12")] theorem get?_range {m n : Nat} (h : m < n) : get? (range n) m = some m := by - simp [range_eq_range', get?_range' _ _ h] - -theorem range_succ (n : Nat) : range (succ n) = range n ++ [n] := by - simp only [range_eq_range', range'_1_concat, Nat.zero_add] - -@[simp] theorem range_zero : range 0 = [] := rfl + simp [getElem?_range, h] -theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·) := by - rw [← range'_eq_map_range] - simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm - -theorem iota_eq_reverse_range' : ∀ n : Nat, iota n = reverse (range' 1 n) - | 0 => rfl - | n + 1 => by simp [iota, range'_concat, iota_eq_reverse_range' n, reverse_append, Nat.add_comm] - -@[simp] theorem length_iota (n : Nat) : length (iota n) = n := by simp [iota_eq_reverse_range'] - -@[simp] -theorem mem_iota {m n : Nat} : m ∈ iota n ↔ 1 ≤ m ∧ m ≤ n := by - simp [iota_eq_reverse_range', Nat.add_comm, Nat.lt_succ] - -theorem reverse_range' : ∀ s n : Nat, reverse (range' s n) = map (s + n - 1 - ·) (range n) - | s, 0 => rfl - | s, n + 1 => by - rw [range'_1_concat, reverse_append, range_succ_eq_map, - show s + (n + 1) - 1 = s + n from rfl, map, map_map] - simp [reverse_range', Nat.sub_right_comm]; rfl - -@[simp] theorem get_range {n} (i) (H : i < (range n).length) : get (range n) ⟨i, H⟩ = i := - Option.some.inj <| by rw [← get?_eq_get _, get?_range (by simpa using H)] - -/-! ### enum, enumFrom -/ - -@[simp] theorem enumFrom_map_fst (n) : - ∀ (l : List α), map Prod.fst (enumFrom n l) = range' n l.length - | [] => rfl - | _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _) - -@[simp] theorem enum_map_fst (l : List α) : map Prod.fst (enum l) = range l.length := by - simp only [enum, enumFrom_map_fst, range_eq_range'] - -/-! ### maximum? -/ - --- A specialization of `maximum?_eq_some_iff` to Nat. -theorem maximum?_eq_some_iff' {xs : List Nat} : - xs.maximum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, b ≤ a) := - maximum?_eq_some_iff - (le_refl := Nat.le_refl) - (max_eq_or := fun _ _ => Nat.max_def .. ▸ by split <;> simp) - (max_le_iff := fun _ _ _ => Nat.max_le) +@[deprecated getElem_range (since := "2024-06-12")] +theorem get_range {n} (i) (H : i < (range n).length) : get (range n) ⟨i, H⟩ = i := by + simp /-! ### indexOf and indexesOf -/ @@ -1474,12 +606,13 @@ theorem indexesOf_cons [BEq α] : (x :: xs : List α).indexesOf y = bif x == y then 0 :: (xs.indexesOf y).map (· + 1) else (xs.indexesOf y).map (· + 1) := by simp [indexesOf, findIdxs_cons] -@[simp] theorem indexOf_nil [BEq α] : ([] : List α).indexOf x = 0 := rfl - -theorem indexOf_cons [BEq α] : - (x :: xs : List α).indexOf y = bif x == y then 0 else xs.indexOf y + 1 := by - dsimp [indexOf] - simp [findIdx_cons] +@[simp] theorem eraseIdx_indexOf_eq_erase [BEq α] (a : α) (l : List α) : + l.eraseIdx (l.indexOf a) = l.erase a := by + induction l with + | nil => rfl + | cons x xs ih => + rw [List.erase, indexOf_cons] + cases x == a <;> simp [ih] theorem indexOf_mem_indexesOf [BEq α] [LawfulBEq α] {xs : List α} (m : x ∈ xs) : xs.indexOf x ∈ xs.indexesOf x := by @@ -1495,45 +628,49 @@ theorem indexOf_mem_indexesOf [BEq α] [LawfulBEq α] {xs : List α} (m : x ∈ specialize ih m simpa -theorem merge_loop_nil_left (s : α → α → Bool) (r t) : - merge.loop s [] r t = reverseAux t r := by - rw [merge.loop] +@[simp] theorem indexOf?_nil [BEq α] : ([] : List α).indexOf? x = none := rfl +theorem indexOf?_cons [BEq α] : + (x :: xs : List α).indexOf? y = if x == y then some 0 else (xs.indexOf? y).map Nat.succ := by + simp [indexOf?] -theorem merge_loop_nil_right (s : α → α → Bool) (l t) : - merge.loop s l [] t = reverseAux t l := by - cases l <;> rw [merge.loop]; intro; contradiction +theorem indexOf?_eq_none_iff [BEq α] {a : α} {l : List α} : + l.indexOf? a = none ↔ ∀ x ∈ l, ¬x == a := by + simp [indexOf?, findIdx?_eq_none_iff] -theorem merge_loop (s : α → α → Bool) (l r t) : - merge.loop s l r t = reverseAux t (merge s l r) := by - rw [merge]; generalize hn : l.length + r.length = n - induction n using Nat.recAux generalizing l r t with - | zero => - rw [eq_nil_of_length_eq_zero (Nat.eq_zero_of_add_eq_zero_left hn)] - rw [eq_nil_of_length_eq_zero (Nat.eq_zero_of_add_eq_zero_right hn)] - simp only [merge.loop, reverseAux] - | succ n ih => - match l, r with - | [], r => simp only [merge_loop_nil_left]; rfl - | l, [] => simp only [merge_loop_nil_right]; rfl - | a::l, b::r => - simp only [merge.loop, cond] - split - · have hn : l.length + (b :: r).length = n := by - apply Nat.add_right_cancel (m:=1) - rw [←hn]; simp only [length_cons, Nat.add_succ, Nat.succ_add] - rw [ih _ _ (a::t) hn, ih _ _ [] hn, ih _ _ [a] hn]; rfl - · have hn : (a::l).length + r.length = n := by - apply Nat.add_right_cancel (m:=1) - rw [←hn]; simp only [length_cons, Nat.add_succ, Nat.succ_add] - rw [ih _ _ (b::t) hn, ih _ _ [] hn, ih _ _ [b] hn]; rfl - -@[simp] theorem merge_nil (s : α → α → Bool) (l) : merge s l [] = l := merge_loop_nil_right .. - -@[simp] theorem nil_merge (s : α → α → Bool) (r) : merge s [] r = r := merge_loop_nil_left .. +theorem indexOf_eq_indexOf? [BEq α] (a : α) (l : List α) : + l.indexOf a = (match l.indexOf? a with | some i => i | none => l.length) := by + simp [indexOf, indexOf?, findIdx_eq_findIdx?] + +/-! ### insertP -/ + +theorem insertP_loop (a : α) (l r : List α) : + insertP.loop p a l r = reverseAux r (insertP p a l) := by + induction l generalizing r with simp [insertP, insertP.loop, cond] + | cons b l ih => rw [ih (b :: r), ih [b]]; split <;> simp + +@[simp] theorem insertP_nil (p : α → Bool) (a) : insertP p a [] = [a] := rfl + +@[simp] theorem insertP_cons_pos (p : α → Bool) (a b l) (h : p b) : + insertP p a (b :: l) = a :: b :: l := by + simp only [insertP, insertP.loop, cond, h]; rfl + +@[simp] theorem insertP_cons_neg (p : α → Bool) (a b l) (h : ¬ p b) : + insertP p a (b :: l) = b :: insertP p a l := by + simp only [insertP, insertP.loop, cond, h]; exact insertP_loop .. + +@[simp] theorem length_insertP (p : α → Bool) (a l) : (insertP p a l).length = l.length + 1 := by + induction l with simp [insertP, insertP.loop, cond] + | cons _ _ ih => split <;> simp [insertP_loop, ih] + +@[simp] theorem mem_insertP (p : α → Bool) (a l) : a ∈ insertP p a l := by + 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, merge.loop, cond]; split <;> (next hs => rw [hs, merge_loop]; rfl) + 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 @@ -1554,19 +691,18 @@ theorem cons_merge_cons (s : α → α → Bool) (a b l r) : · simp_arith [length_merge s l (b::r)] · simp_arith [length_merge s (a::l) r] -@[simp] -theorem mem_merge {s : α → α → Bool} : x ∈ merge s l r ↔ x ∈ l ∨ x ∈ r := by - match l, r with - | l, [] => simp - | [], l => simp - | a::l, b::r => - rw [cons_merge_cons] - split - · simp [mem_merge (l := l) (r := b::r), or_assoc] - · simp [mem_merge (l := a::l) (r := r), or_assoc, or_left_comm] - 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 [*] diff --git a/Batteries/Data/List/OfFn.lean b/Batteries/Data/List/OfFn.lean new file mode 100644 index 0000000000..93214cc99b --- /dev/null +++ b/Batteries/Data/List/OfFn.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2024 Lean FRO. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Batteries.Data.List.Lemmas +import Batteries.Data.Fin.Lemmas + +/-! +# Theorems about `List.ofFn` +-/ + +namespace List + +@[simp] +theorem length_ofFn (f : Fin n → α) : (ofFn f).length = n := by + simp only [ofFn] + induction n with + | zero => simp + | succ n ih => simp [Fin.foldr_succ, ih] + +@[simp] +protected theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h : i < (ofFn f).length) : + (ofFn f)[i] = f ⟨i, by simp_all⟩ := by + simp only [ofFn] + induction n generalizing i with + | zero => simp at h + | succ n ih => + match i with + | 0 => simp [Fin.foldr_succ] + | i+1 => + simp only [Fin.foldr_succ] + apply ih + simp_all + +@[simp] +protected theorem getElem?_ofFn (f : Fin n → α) (i) : (ofFn f)[i]? = ofFnNthVal f i := + if h : i < (ofFn f).length + then by + rw [getElem?_eq_getElem h, List.getElem_ofFn] + · simp only [length_ofFn] at h; simp [ofFnNthVal, h] + else by + rw [ofFnNthVal, dif_neg] <;> + simpa using h + +@[simp] theorem toArray_ofFn (f : Fin n → α) : (ofFn f).toArray = Array.ofFn f := by + ext <;> simp + +end List diff --git a/Batteries/Data/List/Pairwise.lean b/Batteries/Data/List/Pairwise.lean index 392f261bf2..de13a5e292 100644 --- a/Batteries/Data/List/Pairwise.lean +++ b/Batteries/Data/List/Pairwise.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, James Gallicchio -/ import Batteries.Data.List.Count -import Batteries.Data.Fin.Lemmas /-! # Pairwise relations on a list @@ -30,227 +29,13 @@ namespace List /-! ### Pairwise -/ -theorem rel_of_pairwise_cons (p : (a :: l).Pairwise R) : ∀ {a'}, a' ∈ l → R a a' := - (pairwise_cons.1 p).1 _ - -theorem Pairwise.of_cons (p : (a :: l).Pairwise R) : Pairwise R l := - (pairwise_cons.1 p).2 - -theorem Pairwise.tail : ∀ {l : List α} (_p : Pairwise R l), Pairwise R l.tail - | [], h => h - | _ :: _, h => h.of_cons - -theorem Pairwise.drop : ∀ {l : List α} {n : Nat}, List.Pairwise R l → List.Pairwise R (l.drop n) - | _, 0, h => h - | [], _ + 1, _ => List.Pairwise.nil - | _ :: _, n + 1, h => Pairwise.drop (n := n) (pairwise_cons.mp h).right - -theorem Pairwise.imp_of_mem {S : α → α → Prop} - (H : ∀ {a b}, a ∈ l → b ∈ l → R a b → S a b) (p : Pairwise R l) : Pairwise S l := by - induction p with - | nil => constructor - | @cons a l r _ ih => - constructor - · exact fun x h => H (mem_cons_self ..) (mem_cons_of_mem _ h) <| r x h - · exact ih fun m m' => H (mem_cons_of_mem _ m) (mem_cons_of_mem _ m') - -theorem Pairwise.and (hR : Pairwise R l) (hS : Pairwise S l) : - l.Pairwise fun a b => R a b ∧ S a b := by - induction hR with - | nil => simp only [Pairwise.nil] - | cons R1 _ IH => - simp only [Pairwise.nil, pairwise_cons] at hS ⊢ - exact ⟨fun b bl => ⟨R1 b bl, hS.1 b bl⟩, IH hS.2⟩ - -theorem pairwise_and_iff : l.Pairwise (fun a b => R a b ∧ S a b) ↔ Pairwise R l ∧ Pairwise S l := - ⟨fun h => ⟨h.imp fun h => h.1, h.imp fun h => h.2⟩, fun ⟨hR, hS⟩ => hR.and hS⟩ - -theorem Pairwise.imp₂ (H : ∀ a b, R a b → S a b → T a b) - (hR : Pairwise R l) (hS : l.Pairwise S) : l.Pairwise T := - (hR.and hS).imp fun ⟨h₁, h₂⟩ => H _ _ h₁ h₂ - -theorem Pairwise.iff_of_mem {S : α → α → Prop} {l : List α} - (H : ∀ {a b}, a ∈ l → b ∈ l → (R a b ↔ S a b)) : Pairwise R l ↔ Pairwise S l := - ⟨Pairwise.imp_of_mem fun m m' => (H m m').1, Pairwise.imp_of_mem fun m m' => (H m m').2⟩ - -theorem Pairwise.iff {S : α → α → Prop} (H : ∀ a b, R a b ↔ S a b) {l : List α} : - Pairwise R l ↔ Pairwise S l := - Pairwise.iff_of_mem fun _ _ => H .. - -theorem pairwise_of_forall {l : List α} (H : ∀ x y, R x y) : Pairwise R l := by - induction l <;> simp [*] - -theorem Pairwise.and_mem {l : List α} : - Pairwise R l ↔ Pairwise (fun x y => x ∈ l ∧ y ∈ l ∧ R x y) l := - Pairwise.iff_of_mem <| by simp (config := { contextual := true }) - -theorem Pairwise.imp_mem {l : List α} : - Pairwise R l ↔ Pairwise (fun x y => x ∈ l → y ∈ l → R x y) l := - Pairwise.iff_of_mem <| by simp (config := { contextual := true }) - -theorem Pairwise.forall_of_forall_of_flip (h₁ : ∀ x ∈ l, R x x) (h₂ : Pairwise R l) - (h₃ : l.Pairwise (flip R)) : ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y := by - induction l with - | nil => exact forall_mem_nil _ - | cons a l ih => - rw [pairwise_cons] at h₂ h₃ - simp only [mem_cons] - rintro x (rfl | hx) y (rfl | hy) - · exact h₁ _ (l.mem_cons_self _) - · exact h₂.1 _ hy - · exact h₃.1 _ hx - · exact ih (fun x hx => h₁ _ <| mem_cons_of_mem _ hx) h₂.2 h₃.2 hx hy - -theorem pairwise_singleton (R) (a : α) : Pairwise R [a] := by simp - -theorem pairwise_pair {a b : α} : Pairwise R [a, b] ↔ R a b := by simp - -theorem pairwise_append_comm {R : α → α → Prop} (s : ∀ {x y}, R x y → R y x) {l₁ l₂ : List α} : - Pairwise R (l₁ ++ l₂) ↔ Pairwise R (l₂ ++ l₁) := by - have (l₁ l₂ : List α) (H : ∀ x : α, x ∈ l₁ → ∀ y : α, y ∈ l₂ → R x y) - (x : α) (xm : x ∈ l₂) (y : α) (ym : y ∈ l₁) : R x y := s (H y ym x xm) - simp only [pairwise_append, and_left_comm]; rw [Iff.intro (this l₁ l₂) (this l₂ l₁)] - -theorem pairwise_middle {R : α → α → Prop} (s : ∀ {x y}, R x y → R y x) {a : α} {l₁ l₂ : List α} : - Pairwise R (l₁ ++ a :: l₂) ↔ Pairwise R (a :: (l₁ ++ l₂)) := by - show Pairwise R (l₁ ++ ([a] ++ l₂)) ↔ Pairwise R ([a] ++ l₁ ++ l₂) - rw [← append_assoc, pairwise_append, @pairwise_append _ _ ([a] ++ l₁), pairwise_append_comm s] - simp only [mem_append, or_comm] - -theorem Pairwise.of_map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, S (f a) (f b) → R a b) - (p : Pairwise S (map f l)) : Pairwise R l := - (pairwise_map.1 p).imp (H _ _) - -theorem Pairwise.map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, R a b → S (f a) (f b)) - (p : Pairwise R l) : Pairwise S (map f l) := - pairwise_map.2 <| p.imp (H _ _) - -theorem pairwise_filterMap (f : β → Option α) {l : List β} : - Pairwise R (filterMap f l) ↔ Pairwise (fun a a' : β => ∀ b ∈ f a, ∀ b' ∈ f a', R b b') l := by - let _S (a a' : β) := ∀ b ∈ f a, ∀ b' ∈ f a', R b b' - simp only [Option.mem_def] - induction l with - | nil => simp only [filterMap, Pairwise.nil] - | cons a l IH => ?_ - match e : f a with - | none => - rw [filterMap_cons_none _ _ e, pairwise_cons] - simp only [e, false_implies, implies_true, true_and, IH] - | some b => - rw [filterMap_cons_some _ _ _ e] - simpa [IH, e] using fun _ => - ⟨fun h a ha b hab => h _ _ ha hab, fun h a b ha hab => h _ ha _ hab⟩ - -theorem Pairwise.filter_map {S : β → β → Prop} (f : α → Option β) - (H : ∀ a a' : α, R a a' → ∀ b ∈ f a, ∀ b' ∈ f a', S b b') {l : List α} (p : Pairwise R l) : - Pairwise S (filterMap f l) := - (pairwise_filterMap _).2 <| p.imp (H _ _) - -theorem pairwise_filter (p : α → Prop) [DecidablePred p] {l : List α} : - Pairwise R (filter p l) ↔ Pairwise (fun x y => p x → p y → R x y) l := by - rw [← filterMap_eq_filter, pairwise_filterMap] - simp - -theorem Pairwise.filter (p : α → Bool) : Pairwise R l → Pairwise R (filter p l) := - Pairwise.sublist (filter_sublist _) - -theorem pairwise_join {L : List (List α)} : - Pairwise R (join L) ↔ - (∀ l ∈ L, Pairwise R l) ∧ Pairwise (fun l₁ l₂ => ∀ x ∈ l₁, ∀ y ∈ l₂, R x y) L := by - induction L with - | nil => simp - | cons l L IH => - simp only [join, pairwise_append, IH, mem_join, exists_imp, and_imp, forall_mem_cons, - pairwise_cons, and_assoc, and_congr_right_iff] - rw [and_comm, and_congr_left_iff] - intros; exact ⟨fun h a b c d e => h c d e a b, fun h c d e a b => h a b c d e⟩ - -theorem pairwise_bind {R : β → β → Prop} {l : List α} {f : α → List β} : - List.Pairwise R (l.bind f) ↔ - (∀ a ∈ l, Pairwise R (f a)) ∧ Pairwise (fun a₁ a₂ => ∀ x ∈ f a₁, ∀ y ∈ f a₂, R x y) l := by - simp [List.bind, pairwise_join, pairwise_map] - -theorem pairwise_iff_forall_sublist : l.Pairwise R ↔ (∀ {a b}, [a,b] <+ l → R a b) := by - induction l with - | nil => simp - | cons hd tl IH => - rw [List.pairwise_cons] - constructor <;> intro h - · intro - | a, b, .cons _ hab => exact IH.mp h.2 hab - | _, b, .cons₂ _ hab => refine h.1 _ (hab.subset ?_); simp - · constructor - · intro x hx - apply h - rw [List.cons_sublist_cons, List.singleton_sublist] - exact hx - · apply IH.mpr - intro a b hab - apply h; exact hab.cons _ - -@[deprecated pairwise_iff_forall_sublist] -theorem pairwise_of_reflexive_on_dupl_of_forall_ne [DecidableEq α] {l : List α} {r : α → α → Prop} - (hr : ∀ a, 1 < count a l → r a a) (h : ∀ a ∈ l, ∀ b ∈ l, a ≠ b → r a b) : l.Pairwise r := by - apply pairwise_iff_forall_sublist.mpr - intro a b hab - if heq : a = b then - cases heq; apply hr - rwa [show [a,a] = replicate 2 a from rfl, ← le_count_iff_replicate_sublist] at hab - else - apply h <;> try (apply hab.subset; simp) - exact heq - -/-- given a list `is` of monotonically increasing indices into `l`, getting each index - produces a sublist of `l`. -/ -theorem map_get_sublist {l : List α} {is : List (Fin l.length)} (h : is.Pairwise (·.val < ·.val)) : - is.map (get l) <+ l := by - suffices ∀ n l', l' = l.drop n → (∀ i ∈ is, n ≤ i) → map (get l) is <+ l' - from this 0 l (by simp) (by simp) - intro n l' hl' his - induction is generalizing n l' with - | nil => simp - | cons hd tl IH => - simp; cases hl' - have := IH h.of_cons (hd+1) _ rfl (pairwise_cons.mp h).1 - specialize his hd (.head _) - have := (drop_eq_get_cons ..).symm ▸ this.cons₂ (get l hd) - have := Sublist.append (nil_sublist (take hd l |>.drop n)) this - rwa [nil_append, ← (drop_append_of_le_length ?_), take_append_drop] at this - simp [Nat.min_eq_left (Nat.le_of_lt hd.isLt), his] - -/-- given a sublist `l' <+ l`, there exists a list of indices `is` such that - `l' = map (get l) is`. -/ -theorem sublist_eq_map_get (h : l' <+ l) : ∃ is : List (Fin l.length), - l' = map (get l) is ∧ is.Pairwise (· < ·) := by - induction h with - | slnil => exact ⟨[], by simp⟩ - | cons _ _ IH => - let ⟨is, IH⟩ := IH - refine ⟨is.map (·.succ), ?_⟩ - simp [comp, pairwise_map] - exact IH - | cons₂ _ _ IH => - rcases IH with ⟨is,IH⟩ - refine ⟨⟨0, by simp [Nat.zero_lt_succ]⟩ :: is.map (·.succ), ?_⟩ - simp [comp_def, pairwise_map, IH] - theorem pairwise_iff_get : Pairwise R l ↔ ∀ (i j) (_hij : i < j), R (get l i) (get l j) := by - rw [pairwise_iff_forall_sublist] + rw [pairwise_iff_getElem] constructor <;> intro h · intros i j h' - apply h - apply map_get_sublist (is := [i, j]) - rw [Fin.lt_def] at h'; simp [h'] - · intros a b h' - have ⟨is, h', hij⟩ := sublist_eq_map_get h' - rcases is with ⟨⟩ | ⟨a', ⟨⟩ | ⟨b', ⟨⟩⟩⟩ <;> simp at h' - rcases h' with ⟨rfl, rfl⟩ - apply h; simpa using hij - -theorem pairwise_replicate {α : Type _} {r : α → α → Prop} {x : α} (hx : r x x) : - ∀ n : Nat, Pairwise r (List.replicate n x) - | 0 => by simp - | n + 1 => by simp [mem_replicate, hx, pairwise_replicate hx n] + exact h _ _ _ _ h' + · intros i j hi hj h' + exact h ⟨i, hi⟩ ⟨j, hj⟩ h' /-! ### Pairwise filtering -/ diff --git a/Batteries/Data/List/Perm.lean b/Batteries/Data/List/Perm.lean index 49299089a5..42c4bbc9c2 100644 --- a/Batteries/Data/List/Perm.lean +++ b/Batteries/Data/List/Perm.lean @@ -4,10 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Batteries.Tactic.Alias -import Batteries.Data.List.Init.Attach import Batteries.Data.List.Pairwise --- Adaptation note: nightly-2024-03-18. We should be able to remove this after nightly-2024-03-19. -import Lean.Elab.Tactic.Rfl /-! # List Permutations @@ -26,189 +23,6 @@ namespace List open Perm (swap) -@[simp, refl] protected theorem Perm.refl : ∀ l : List α, l ~ l - | [] => .nil - | x :: xs => (Perm.refl xs).cons x - -protected theorem Perm.rfl {l : List α} : l ~ l := .refl _ - -theorem Perm.of_eq (h : l₁ = l₂) : l₁ ~ l₂ := h ▸ .rfl - -protected theorem Perm.symm {l₁ l₂ : List α} (h : l₁ ~ l₂) : l₂ ~ l₁ := by - induction h with - | nil => exact nil - | cons _ _ ih => exact cons _ ih - | swap => exact swap .. - | trans _ _ ih₁ ih₂ => exact trans ih₂ ih₁ - -theorem perm_comm {l₁ l₂ : List α} : l₁ ~ l₂ ↔ l₂ ~ l₁ := ⟨Perm.symm, Perm.symm⟩ - -theorem Perm.swap' (x y : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : y :: x :: l₁ ~ x :: y :: l₂ := - (swap ..).trans <| p.cons _ |>.cons _ - -/-- -Similar to `Perm.recOn`, but the `swap` case is generalized to `Perm.swap'`, -where the tail of the lists are not necessarily the same. --/ -@[elab_as_elim] theorem Perm.recOnSwap' - {motive : (l₁ : List α) → (l₂ : List α) → l₁ ~ l₂ → Prop} {l₁ l₂ : List α} (p : l₁ ~ l₂) - (nil : motive [] [] .nil) - (cons : ∀ x {l₁ l₂}, (h : l₁ ~ l₂) → motive l₁ l₂ h → motive (x :: l₁) (x :: l₂) (.cons x h)) - (swap' : ∀ x y {l₁ l₂}, (h : l₁ ~ l₂) → motive l₁ l₂ h → - motive (y :: x :: l₁) (x :: y :: l₂) (.swap' _ _ h)) - (trans : ∀ {l₁ l₂ l₃}, (h₁ : l₁ ~ l₂) → (h₂ : l₂ ~ l₃) → motive l₁ l₂ h₁ → motive l₂ l₃ h₂ → - motive l₁ l₃ (.trans h₁ h₂)) : motive l₁ l₂ p := - have motive_refl l : motive l l (.refl l) := - List.recOn l nil fun x xs ih => cons x (.refl xs) ih - Perm.recOn p nil cons (fun x y l => swap' x y (.refl l) (motive_refl l)) trans - -theorem Perm.eqv (α) : Equivalence (@Perm α) := ⟨.refl, .symm, .trans⟩ - -instance isSetoid (α) : Setoid (List α) := .mk Perm (Perm.eqv α) - -theorem Perm.mem_iff {a : α} {l₁ l₂ : List α} (p : l₁ ~ l₂) : a ∈ l₁ ↔ a ∈ l₂ := by - induction p with - | nil => rfl - | cons _ _ ih => simp only [mem_cons, ih] - | swap => simp only [mem_cons, or_left_comm] - | trans _ _ ih₁ ih₂ => simp only [ih₁, ih₂] - -theorem Perm.subset {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁ ⊆ l₂ := fun _ => p.mem_iff.mp - -theorem Perm.append_right {l₁ l₂ : List α} (t₁ : List α) (p : l₁ ~ l₂) : l₁ ++ t₁ ~ l₂ ++ t₁ := by - induction p with - | nil => rfl - | cons _ _ ih => exact cons _ ih - | swap => exact swap .. - | trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂ - -theorem Perm.append_left {t₁ t₂ : List α} : ∀ l : List α, t₁ ~ t₂ → l ++ t₁ ~ l ++ t₂ - | [], p => p - | x :: xs, p => (p.append_left xs).cons x - -theorem Perm.append {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ++ t₁ ~ l₂ ++ t₂ := - (p₁.append_right t₁).trans (p₂.append_left l₂) - -theorem Perm.append_cons (a : α) {h₁ h₂ t₁ t₂ : List α} (p₁ : h₁ ~ h₂) (p₂ : t₁ ~ t₂) : - h₁ ++ a :: t₁ ~ h₂ ++ a :: t₂ := p₁.append (p₂.cons a) - -@[simp] theorem perm_middle {a : α} : ∀ {l₁ l₂ : List α}, l₁ ++ a :: l₂ ~ a :: (l₁ ++ l₂) - | [], _ => .refl _ - | b :: _, _ => (Perm.cons _ perm_middle).trans (swap a b _) - -@[simp] theorem perm_append_singleton (a : α) (l : List α) : l ++ [a] ~ a :: l := - perm_middle.trans <| by rw [append_nil] - -theorem perm_append_comm : ∀ {l₁ l₂ : List α}, l₁ ++ l₂ ~ l₂ ++ l₁ - | [], l₂ => by simp - | a :: t, l₂ => (perm_append_comm.cons _).trans perm_middle.symm - -theorem concat_perm (l : List α) (a : α) : concat l a ~ a :: l := by simp - -theorem Perm.length_eq {l₁ l₂ : List α} (p : l₁ ~ l₂) : length l₁ = length l₂ := by - induction p with - | nil => rfl - | cons _ _ ih => simp only [length_cons, ih] - | swap => rfl - | trans _ _ ih₁ ih₂ => simp only [ih₁, ih₂] - -theorem Perm.eq_nil {l : List α} (p : l ~ []) : l = [] := eq_nil_of_length_eq_zero p.length_eq - -theorem Perm.nil_eq {l : List α} (p : [] ~ l) : [] = l := p.symm.eq_nil.symm - -@[simp] theorem perm_nil {l₁ : List α} : l₁ ~ [] ↔ l₁ = [] := - ⟨fun p => p.eq_nil, fun e => e ▸ .rfl⟩ - -@[simp] theorem nil_perm {l₁ : List α} : [] ~ l₁ ↔ l₁ = [] := perm_comm.trans perm_nil - -theorem not_perm_nil_cons (x : α) (l : List α) : ¬[] ~ x :: l := (nomatch ·.symm.eq_nil) - -@[simp] theorem reverse_perm : ∀ l : List α, reverse l ~ l - | [] => .nil - | a :: l => reverse_cons .. ▸ (perm_append_singleton _ _).trans ((reverse_perm l).cons a) - -theorem perm_cons_append_cons {l l₁ l₂ : List α} (a : α) (p : l ~ l₁ ++ l₂) : - a :: l ~ l₁ ++ a :: l₂ := (p.cons a).trans perm_middle.symm - -@[simp] theorem perm_replicate {n : Nat} {a : α} {l : List α} : - l ~ replicate n a ↔ l = replicate n a := by - refine ⟨fun p => eq_replicate.2 ?_, fun h => h ▸ .rfl⟩ - exact ⟨p.length_eq.trans <| length_replicate .., fun _b m => eq_of_mem_replicate <| p.subset m⟩ - -@[simp] theorem replicate_perm {n : Nat} {a : α} {l : List α} : - replicate n a ~ l ↔ replicate n a = l := (perm_comm.trans perm_replicate).trans eq_comm - -@[simp] theorem perm_singleton {a : α} {l : List α} : l ~ [a] ↔ l = [a] := perm_replicate (n := 1) - -@[simp] theorem singleton_perm {a : α} {l : List α} : [a] ~ l ↔ [a] = l := replicate_perm (n := 1) - -alias ⟨Perm.eq_singleton,_⟩ := perm_singleton -alias ⟨Perm.singleton_eq,_⟩ := singleton_perm - -theorem singleton_perm_singleton {a b : α} : [a] ~ [b] ↔ a = b := by simp - -theorem perm_cons_erase [DecidableEq α] {a : α} {l : List α} (h : a ∈ l) : l ~ a :: l.erase a := - let ⟨_l₁, _l₂, _, e₁, e₂⟩ := exists_erase_eq h - e₂ ▸ e₁ ▸ perm_middle - -theorem Perm.filterMap (f : α → Option β) {l₁ l₂ : List α} (p : l₁ ~ l₂) : - filterMap f l₁ ~ filterMap f l₂ := by - induction p with - | nil => simp - | cons x _p IH => cases h : f x <;> simp [h, filterMap, IH, Perm.cons] - | swap x y l₂ => cases hx : f x <;> cases hy : f y <;> simp [hx, hy, filterMap, swap] - | trans _p₁ _p₂ IH₁ IH₂ => exact IH₁.trans IH₂ - -theorem Perm.map (f : α → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) : map f l₁ ~ map f l₂ := - filterMap_eq_map f ▸ p.filterMap _ - -theorem Perm.pmap {p : α → Prop} (f : ∀ a, p a → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) {H₁ H₂} : - pmap f l₁ H₁ ~ pmap f l₂ H₂ := by - induction p with - | nil => simp - | cons x _p IH => simp [IH, Perm.cons] - | swap x y => simp [swap] - | trans _p₁ p₂ IH₁ IH₂ => exact IH₁.trans (IH₂ (H₁ := fun a m => H₂ a (p₂.subset m))) - -theorem Perm.filter (p : α → Bool) {l₁ l₂ : List α} (s : l₁ ~ l₂) : - filter p l₁ ~ filter p l₂ := by rw [← filterMap_eq_filter]; apply s.filterMap - -theorem filter_append_perm (p : α → Bool) (l : List α) : - filter p l ++ filter (fun x => !p x) l ~ l := by - induction l with - | nil => rfl - | cons x l ih => - by_cases h : p x <;> simp [h] - · exact ih.cons x - · exact Perm.trans (perm_append_comm.trans (perm_append_comm.cons _)) (ih.cons x) - -theorem exists_perm_sublist {l₁ l₂ l₂' : List α} (s : l₁ <+ l₂) (p : l₂ ~ l₂') : - ∃ l₁', l₁' ~ l₁ ∧ l₁' <+ l₂' := by - induction p generalizing l₁ with - | nil => exact ⟨[], sublist_nil.mp s ▸ .rfl, nil_sublist _⟩ - | cons x _ IH => - match s with - | .cons _ s => let ⟨l₁', p', s'⟩ := IH s; exact ⟨l₁', p', s'.cons _⟩ - | .cons₂ _ s => let ⟨l₁', p', s'⟩ := IH s; exact ⟨x :: l₁', p'.cons x, s'.cons₂ _⟩ - | swap x y l' => - match s with - | .cons _ (.cons _ s) => exact ⟨_, .rfl, (s.cons _).cons _⟩ - | .cons _ (.cons₂ _ s) => exact ⟨x :: _, .rfl, (s.cons _).cons₂ _⟩ - | .cons₂ _ (.cons _ s) => exact ⟨y :: _, .rfl, (s.cons₂ _).cons _⟩ - | .cons₂ _ (.cons₂ _ s) => exact ⟨x :: y :: _, .swap .., (s.cons₂ _).cons₂ _⟩ - | trans _ _ IH₁ IH₂ => - let ⟨m₁, pm, sm⟩ := IH₁ s - let ⟨r₁, pr, sr⟩ := IH₂ sm - exact ⟨r₁, pr.trans pm, sr⟩ - -theorem Perm.sizeOf_eq_sizeOf [SizeOf α] {l₁ l₂ : List α} (h : l₁ ~ l₂) : - sizeOf l₁ = sizeOf l₂ := by - induction h with - | nil => rfl - | cons _ _ h_sz₁₂ => simp [h_sz₁₂] - | swap => simp [Nat.add_left_comm] - | trans _ _ h_sz₁₂ h_sz₂₃ => simp [h_sz₁₂, h_sz₂₃] - section Subperm theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩ @@ -234,7 +48,7 @@ theorem Subperm.trans {l₁ l₂ l₃ : List α} (s₁₂ : l₁ <+~ l₂) (s₂ ⟨l₁', p₁, s₁.trans s₂⟩ theorem Subperm.cons_right {α : Type _} {l l' : List α} (x : α) (h : l <+~ l') : l <+~ x :: l' := - h.trans (sublist_cons x l').subperm + h.trans (sublist_cons_self x l').subperm theorem Subperm.length_le {l₁ l₂ : List α} : l₁ <+~ l₂ → length l₁ ≤ length l₂ | ⟨_l, p, s⟩ => p.length_eq ▸ s.length_le @@ -259,119 +73,16 @@ theorem Subperm.filter (p : α → Bool) ⦃l l' : List α⦄ (h : l <+~ l') : end Subperm -theorem Sublist.exists_perm_append {l₁ l₂ : List α} : l₁ <+ l₂ → ∃ l, l₂ ~ l₁ ++ l - | Sublist.slnil => ⟨nil, .rfl⟩ - | Sublist.cons a s => - let ⟨l, p⟩ := Sublist.exists_perm_append s - ⟨a :: l, (p.cons a).trans perm_middle.symm⟩ - | Sublist.cons₂ a s => - let ⟨l, p⟩ := Sublist.exists_perm_append s - ⟨l, p.cons a⟩ - -theorem Perm.countP_eq (p : α → Bool) {l₁ l₂ : List α} (s : l₁ ~ l₂) : - countP p l₁ = countP p l₂ := by - simp only [countP_eq_length_filter] - exact (s.filter _).length_eq - theorem Subperm.countP_le (p : α → Bool) {l₁ l₂ : List α} : l₁ <+~ l₂ → countP p l₁ ≤ countP p l₂ | ⟨_l, p', s⟩ => p'.countP_eq p ▸ s.countP_le p -theorem Perm.countP_congr {l₁ l₂ : List α} (s : l₁ ~ l₂) {p p' : α → Bool} - (hp : ∀ x ∈ l₁, p x = p' x) : l₁.countP p = l₂.countP p' := by - rw [← s.countP_eq p'] - clear s - induction l₁ with - | nil => rfl - | cons y s hs => - simp only [mem_cons, forall_eq_or_imp] at hp - simp only [countP_cons, hs hp.2, hp.1] - -theorem countP_eq_countP_filter_add (l : List α) (p q : α → Bool) : - l.countP p = (l.filter q).countP p + (l.filter fun a => !q a).countP p := - countP_append .. ▸ Perm.countP_eq _ (filter_append_perm _ _).symm - -theorem Perm.count_eq [DecidableEq α] {l₁ l₂ : List α} (p : l₁ ~ l₂) (a) : - count a l₁ = count a l₂ := p.countP_eq _ - theorem Subperm.count_le [DecidableEq α] {l₁ l₂ : List α} (s : l₁ <+~ l₂) (a) : count a l₁ ≤ count a l₂ := s.countP_le _ -theorem Perm.foldl_eq' {f : β → α → β} {l₁ l₂ : List α} (p : l₁ ~ l₂) - (comm : ∀ x ∈ l₁, ∀ y ∈ l₁, ∀ (z), f (f z x) y = f (f z y) x) - (init) : foldl f init l₁ = foldl f init l₂ := by - induction p using recOnSwap' generalizing init with - | nil => simp - | cons x _p IH => - simp only [foldl] - apply IH; intros; apply comm <;> exact .tail _ ‹_› - | swap' x y _p IH => - simp only [foldl] - rw [comm x (.tail _ <| .head _) y (.head _)] - apply IH; intros; apply comm <;> exact .tail _ (.tail _ ‹_›) - | trans p₁ _p₂ IH₁ IH₂ => - refine (IH₁ comm init).trans (IH₂ ?_ _) - intros; apply comm <;> apply p₁.symm.subset <;> assumption - -theorem Perm.rec_heq {β : List α → Sort _} {f : ∀ a l, β l → β (a :: l)} {b : β []} {l l' : List α} - (hl : l ~ l') (f_congr : ∀ {a l l' b b'}, l ~ l' → HEq b b' → HEq (f a l b) (f a l' b')) - (f_swap : ∀ {a a' l b}, HEq (f a (a' :: l) (f a' l b)) (f a' (a :: l) (f a l b))) : - HEq (@List.rec α β b f l) (@List.rec α β b f l') := by - induction hl with - | nil => rfl - | cons a h ih => exact f_congr h ih - | swap a a' l => exact f_swap - | trans _h₁ _h₂ ih₁ ih₂ => exact ih₁.trans ih₂ - -/-- Lemma used to destruct perms element by element. -/ -theorem perm_inv_core {a : α} {l₁ l₂ r₁ r₂ : List α} : - l₁ ++ a :: r₁ ~ l₂ ++ a :: r₂ → l₁ ++ r₁ ~ l₂ ++ r₂ := by - -- Necessary generalization for `induction` - suffices ∀ s₁ s₂ (_ : s₁ ~ s₂) {l₁ l₂ r₁ r₂}, - l₁ ++ a :: r₁ = s₁ → l₂ ++ a :: r₂ = s₂ → l₁ ++ r₁ ~ l₂ ++ r₂ from (this _ _ · rfl rfl) - intro s₁ s₂ p - induction p using Perm.recOnSwap' with intro l₁ l₂ r₁ r₂ e₁ e₂ - | nil => - simp at e₁ - | cons x p IH => - cases l₁ <;> cases l₂ <;> - dsimp at e₁ e₂ <;> injections <;> subst_vars - · exact p - · exact p.trans perm_middle - · exact perm_middle.symm.trans p - · exact (IH rfl rfl).cons _ - | swap' x y p IH => - obtain _ | ⟨y, _ | ⟨z, l₁⟩⟩ := l₁ - <;> obtain _ | ⟨u, _ | ⟨v, l₂⟩⟩ := l₂ - <;> dsimp at e₁ e₂ <;> injections <;> subst_vars - <;> try exact p.cons _ - · exact (p.trans perm_middle).cons u - · exact ((p.trans perm_middle).cons _).trans (swap _ _ _) - · exact (perm_middle.symm.trans p).cons y - · exact (swap _ _ _).trans ((perm_middle.symm.trans p).cons u) - · exact (IH rfl rfl).swap' _ _ - | trans p₁ p₂ IH₁ IH₂ => - subst e₁ e₂ - obtain ⟨l₂, r₂, rfl⟩ := append_of_mem (a := a) (p₁.subset (by simp)) - exact (IH₁ rfl rfl).trans (IH₂ rfl rfl) - -theorem Perm.cons_inv {a : α} {l₁ l₂ : List α} : a :: l₁ ~ a :: l₂ → l₁ ~ l₂ := - perm_inv_core (l₁ := []) (l₂ := []) - -@[simp] theorem perm_cons (a : α) {l₁ l₂ : List α} : a :: l₁ ~ a :: l₂ ↔ l₁ ~ l₂ := - ⟨.cons_inv, .cons a⟩ - -theorem perm_append_left_iff {l₁ l₂ : List α} : ∀ l, l ++ l₁ ~ l ++ l₂ ↔ l₁ ~ l₂ - | [] => .rfl - | a :: l => (perm_cons a).trans (perm_append_left_iff l) - -theorem perm_append_right_iff {l₁ l₂ : List α} (l) : l₁ ++ l ~ l₂ ++ l ↔ l₁ ~ l₂ := by - refine ⟨fun p => ?_, .append_right _⟩ - exact (perm_append_left_iff _).1 <| perm_append_comm.trans <| p.trans perm_append_comm - theorem subperm_cons (a : α) {l₁ l₂ : List α} : a :: l₁ <+~ a :: l₂ ↔ l₁ <+~ l₂ := by refine ⟨fun ⟨l, p, s⟩ => ?_, fun ⟨l, p, s⟩ => ⟨a :: l, p.cons a, s.cons₂ _⟩⟩ match s with - | .cons _ s' => exact (p.subperm_left.2 <| (sublist_cons _ _).subperm).trans s'.subperm + | .cons _ s' => exact (p.subperm_left.2 <| (sublist_cons_self _ _).subperm).trans s'.subperm | .cons₂ _ s' => exact ⟨_, p.cons_inv, s'⟩ /-- Weaker version of `Subperm.cons_left` -/ @@ -412,7 +123,7 @@ theorem Subperm.exists_of_length_lt {l₁ l₂ : List α} (s : l₁ <+~ l₂) (h | slnil => cases h | cons a s IH => match Nat.lt_or_eq_of_le (Nat.le_of_lt_succ h) with - | .inl h => exact (IH h).imp fun a s => s.trans (sublist_cons _ _).subperm + | .inl h => exact (IH h).imp fun a s => s.trans (sublist_cons_self _ _).subperm | .inr h => exact ⟨a, s.eq_of_length h ▸ .refl _⟩ | cons₂ b _ IH => exact (IH <| Nat.lt_of_succ_lt_succ h).imp fun a s => @@ -433,38 +144,30 @@ theorem perm_ext_iff_of_nodup {l₁ l₂ : List α} (d₁ : Nodup l₁) (d₂ : theorem Nodup.perm_iff_eq_of_sublist {l₁ l₂ l : List α} (d : Nodup l) (s₁ : l₁ <+ l) (s₂ : l₂ <+ l) : l₁ ~ l₂ ↔ l₁ = l₂ := by refine ⟨fun h => ?_, fun h => by rw [h]⟩ - induction s₂ generalizing l₁ with simp [Nodup] at d + induction s₂ generalizing l₁ with simp [Nodup, List.forall_mem_ne] at d | slnil => exact h.eq_nil | cons a s₂ IH => match s₁ with | .cons _ s₁ => exact IH d.2 s₁ h | .cons₂ _ s₁ => have := Subperm.subset ⟨_, h.symm, s₂⟩ (.head _) - exact (d.1 _ this rfl).elim + exact (d.1 this).elim | cons₂ a _ IH => match s₁ with | .cons _ s₁ => have := Subperm.subset ⟨_, h, s₁⟩ (.head _) - exact (d.1 _ this rfl).elim + exact (d.1 this).elim | .cons₂ _ s₁ => rw [IH d.2 s₁ h.cons_inv] section DecidableEq variable [DecidableEq α] -theorem Perm.erase (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁.erase a ~ l₂.erase a := - if h₁ : a ∈ l₁ then - have h₂ : a ∈ l₂ := p.subset h₁ - .cons_inv <| (perm_cons_erase h₁).symm.trans <| p.trans (perm_cons_erase h₂) - else by - have h₂ : a ∉ l₂ := mt p.mem_iff.2 h₁ - rw [erase_of_not_mem h₁, erase_of_not_mem h₂]; exact p - theorem subperm_cons_erase (a : α) (l : List α) : l <+~ a :: l.erase a := if h : a ∈ l then (perm_cons_erase h).subperm else - (erase_of_not_mem h).symm ▸ (sublist_cons _ _).subperm + (erase_of_not_mem h).symm ▸ (sublist_cons_self _ _).subperm theorem erase_subperm (a : α) (l : List α) : l.erase a <+~ l := (erase_sublist _ _).subperm @@ -512,8 +215,8 @@ theorem erase_cons_subperm_cons_erase (a b : α) (l : List α) : if h : a = b then rw [h, erase_cons_head]; apply subperm_cons_erase else - have : ¬(a == b) = true := by simp only [beq_false_of_ne h, not_false_eq_true] - rw [erase_cons_tail _ this] + have : ¬(a == b) = true := by simp only [beq_false_of_ne h, not_false_eq_true, reduceCtorEq] + rw [erase_cons_tail this] theorem subperm_cons_diff {a : α} {l₁ l₂ : List α} : (a :: l₁).diff l₂ <+~ a :: l₁.diff l₂ := by induction l₂ with @@ -525,28 +228,6 @@ theorem subperm_cons_diff {a : α} {l₁ l₂ : List α} : (a :: l₁).diff l₂ theorem subset_cons_diff {a : α} {l₁ l₂ : List α} : (a :: l₁).diff l₂ ⊆ a :: l₁.diff l₂ := subperm_cons_diff.subset -theorem cons_perm_iff_perm_erase {a : α} {l₁ l₂ : List α} : - a :: l₁ ~ l₂ ↔ a ∈ l₂ ∧ l₁ ~ l₂.erase a := by - refine ⟨fun h => ?_, fun ⟨m, h⟩ => (h.cons a).trans (perm_cons_erase m).symm⟩ - have : a ∈ l₂ := h.subset (mem_cons_self a l₁) - exact ⟨this, (h.trans <| perm_cons_erase this).cons_inv⟩ - -theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l₁ = count a l₂ := by - refine ⟨Perm.count_eq, fun H => ?_⟩ - induction l₁ generalizing l₂ with - | nil => - match l₂ with - | nil => rfl - | cons b l₂ => - specialize H b - simp at H - | cons a l₁ IH => - have : a ∈ l₂ := count_pos_iff_mem.mp (by rw [← H]; simp) - refine ((IH fun b => ?_).cons a).trans (perm_cons_erase this).symm - specialize H b - rw [(perm_cons_erase this).count_eq] at H - by_cases h : b = a <;> simpa [h] using H - /-- The list version of `add_tsub_cancel_of_le` for multisets. -/ theorem subperm_append_diff_self_of_count_le {l₁ l₂ : List α} (h : ∀ x ∈ l₁, count x l₁ ≤ count x l₂) : l₁ ++ l₂.diff l₁ ~ l₂ := by @@ -589,28 +270,6 @@ theorem Subperm.cons_left {l₁ l₂ : List α} (h : l₁ <+~ l₂) (x : α) (hx refine h y ?_ simpa [hy'] using hy -theorem isPerm_iff : ∀ {l₁ l₂ : List α}, l₁.isPerm l₂ ↔ l₁ ~ l₂ - | [], [] => by simp [isPerm, isEmpty] - | [], _ :: _ => by simp [isPerm, isEmpty, Perm.nil_eq] - | a :: l₁, l₂ => by simp [isPerm, isPerm_iff, cons_perm_iff_perm_erase] - -instance decidablePerm (l₁ l₂ : List α) : Decidable (l₁ ~ l₂) := decidable_of_iff _ isPerm_iff - -protected theorem Perm.insert (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : - l₁.insert a ~ l₂.insert a := by - if h : a ∈ l₁ then - simp [h, p.subset h, p] - else - have := p.cons a - simpa [h, mt p.mem_iff.2 h] using this - -theorem perm_insert_swap (x y : α) (l : List α) : - List.insert x (List.insert y l) ~ List.insert y (List.insert x l) := by - by_cases xl : x ∈ l <;> by_cases yl : y ∈ l <;> simp [xl, yl] - if xy : x = y then simp [xy] else - simp [List.insert, xl, yl, xy, Ne.symm xy] - constructor - theorem perm_insertNth {α} (x : α) (l : List α) {n} (h : n ≤ l.length) : insertNth n x l ~ x :: l := by induction l generalizing n with @@ -643,65 +302,28 @@ theorem Perm.union {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : theorem Perm.inter_right {l₁ l₂ : List α} (t₁ : List α) : l₁ ~ l₂ → l₁ ∩ t₁ ~ l₂ ∩ t₁ := .filter _ theorem Perm.inter_left (l : List α) {t₁ t₂ : List α} (p : t₁ ~ t₂) : l ∩ t₁ = l ∩ t₂ := - filter_congr' fun a _ => by simpa using p.mem_iff (a := a) + filter_congr fun a _ => by simpa using p.mem_iff (a := a) theorem Perm.inter {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ∩ t₁ ~ l₂ ∩ t₂ := p₂.inter_left l₂ ▸ p₁.inter_right t₁ end DecidableEq -theorem Perm.pairwise_iff {R : α → α → Prop} (S : ∀ {x y}, R x y → R y x) : - ∀ {l₁ l₂ : List α} (_p : l₁ ~ l₂), Pairwise R l₁ ↔ Pairwise R l₂ := - suffices ∀ {l₁ l₂}, l₁ ~ l₂ → Pairwise R l₁ → Pairwise R l₂ - from fun p => ⟨this p, this p.symm⟩ - fun {l₁ l₂} p d => by - induction d generalizing l₂ with - | nil => rw [← p.nil_eq]; constructor - | cons h _ IH => - have : _ ∈ l₂ := p.subset (mem_cons_self _ _) - obtain ⟨s₂, t₂, rfl⟩ := append_of_mem this - have p' := (p.trans perm_middle).cons_inv - refine (pairwise_middle S).2 (pairwise_cons.2 ⟨fun b m => ?_, IH p'⟩) - exact h _ (p'.symm.subset m) - -theorem Pairwise.perm {R : α → α → Prop} {l l' : List α} (hR : l.Pairwise R) (hl : l ~ l') - (hsymm : ∀ {x y}, R x y → R y x) : l'.Pairwise R := (hl.pairwise_iff hsymm).mp hR - -theorem Perm.pairwise {R : α → α → Prop} {l l' : List α} (hl : l ~ l') (hR : l.Pairwise R) - (hsymm : ∀ {x y}, R x y → R y x) : l'.Pairwise R := hR.perm hl hsymm - -theorem Perm.nodup_iff {l₁ l₂ : List α} : l₁ ~ l₂ → (Nodup l₁ ↔ Nodup l₂) := - Perm.pairwise_iff <| @Ne.symm α - -theorem Perm.join {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.join ~ l₂.join := by - induction h with - | nil => rfl - | cons _ _ ih => simp only [join_cons, perm_append_left_iff, ih] - | swap => simp only [join_cons, ← append_assoc, perm_append_right_iff]; exact perm_append_comm .. - | trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂ - -theorem Perm.bind_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f := - (p.map _).join - theorem Perm.join_congr : ∀ {l₁ l₂ : List (List α)} (_ : List.Forall₂ (· ~ ·) l₁ l₂), l₁.join ~ l₂.join | _, _, .nil => .rfl | _ :: _, _ :: _, .cons h₁ h₂ => h₁.append (Perm.join_congr h₂) -theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α} - (H : Pairwise (fun a b => f a → f b → False) l₁) (p : l₁ ~ l₂) : eraseP f l₁ ~ eraseP f l₂ := by - induction p with - | nil => simp - | cons a p IH => - if h : f a then simp [h, p] - else simp [h]; exact IH (pairwise_cons.1 H).2 - | swap a b l => - by_cases h₁ : f a <;> by_cases h₂ : f b <;> simp [h₁, h₂] - · cases (pairwise_cons.1 H).1 _ (mem_cons.2 (Or.inl rfl)) h₂ h₁ - · apply swap - | trans p₁ _ IH₁ IH₂ => - refine (IH₁ H).trans (IH₂ ((p₁.pairwise_iff ?_).1 H)) - exact fun h h₁ h₂ => h h₂ h₁ +theorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by + induction l with simp [insertP, insertP.loop, cond] + | cons _ _ ih => + split + · exact Perm.refl .. + · rw [insertP_loop, reverseAux, reverseAux] + exact Perm.trans (Perm.cons _ ih) (Perm.swap ..) + +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 match l, r with diff --git a/Batteries/Data/Nat/Basic.lean b/Batteries/Data/Nat/Basic.lean index a6e55a6ea2..21b4a4dd43 100644 --- a/Batteries/Data/Nat/Basic.lean +++ b/Batteries/Data/Nat/Basic.lean @@ -21,13 +21,6 @@ protected def recAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0) protected def strongRec {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → motive m) → motive n) (t : Nat) : motive t := ind t fun m _ => Nat.strongRec ind m -/-- - Strong recursor for `Nat` --/ -@[elab_as_elim] -protected def strongRecOn (t : Nat) {motive : Nat → Sort _} - (ind : ∀ n, (∀ m, m < n → motive m) → motive n) : motive t := Nat.strongRec ind t - /-- Strong recursor via a `Nat`-valued measure -/ @@ -94,9 +87,6 @@ protected def casesDiagOn {motive : Nat → Nat → Sort _} (m n : Nat) Nat.recDiag zero_zero (fun _ _ => zero_succ _) (fun _ _ => succ_zero _) (fun _ _ _ => succ_succ _ _) m n -/-- Sum of a list of natural numbers. -/ -protected def sum (l : List Nat) : Nat := l.foldr (·+·) 0 - /-- Integer square root function. Implemented via Newton's method. -/ diff --git a/Batteries/Data/Nat/Lemmas.lean b/Batteries/Data/Nat/Lemmas.lean index 951f330e51..7fa93705f7 100644 --- a/Batteries/Data/Nat/Lemmas.lean +++ b/Batteries/Data/Nat/Lemmas.lean @@ -47,7 +47,7 @@ theorem strongRec_eq {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → m theorem strongRecOn_eq {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → motive m) → motive n) (t : Nat) : Nat.strongRecOn t ind = ind t fun m _ => Nat.strongRecOn m ind := - Nat.strongRec_eq .. + WellFounded.fix_eq WellFoundedRelation.wf ind t @[simp] theorem recDiagAux_zero_left {motive : Nat → Nat → Sort _} (zero_left : ∀ n, motive 0 n) (zero_right : ∀ m, motive m 0) @@ -149,22 +149,6 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := | .eq => .inr (.inl (Nat.compare_eq_eq.1 h)) | .gt => .inr (.inr (Nat.compare_eq_gt.1 h)) -/-! ## add -/ - -@[deprecated] alias succ_add_eq_succ_add := Nat.succ_add_eq_add_succ - -/-! ## sub -/ - -@[deprecated] protected alias le_of_le_of_sub_le_sub_right := Nat.le_of_sub_le_sub_right - -@[deprecated] protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left - -/-! ### mul -/ - -@[deprecated] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' - -@[deprecated] protected alias mul_lt_mul' := Nat.mul_lt_mul_of_le_of_lt - /-! ### div/mod -/ -- TODO mod_core_congr, mod_def @@ -175,12 +159,5 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := /-! ### sum -/ -@[simp] theorem sum_nil : Nat.sum [] = 0 := rfl - -@[simp] theorem sum_cons : Nat.sum (a :: l) = a + Nat.sum l := rfl - @[simp] theorem sum_append : Nat.sum (l₁ ++ l₂) = Nat.sum l₁ + Nat.sum l₂ := by induction l₁ <;> simp [*, Nat.add_assoc] - -@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne -@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Batteries/Data/Option.lean b/Batteries/Data/Option.lean deleted file mode 100644 index e99c38ee11..0000000000 --- a/Batteries/Data/Option.lean +++ /dev/null @@ -1 +0,0 @@ -import Batteries.Data.Option.Lemmas diff --git a/Batteries/Data/Option/Lemmas.lean b/Batteries/Data/Option/Lemmas.lean deleted file mode 100644 index a768a776ce..0000000000 --- a/Batteries/Data/Option/Lemmas.lean +++ /dev/null @@ -1,13 +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 --/ -import Batteries.Tactic.Alias - -namespace Option - -@[deprecated] alias to_list_some := toList_some -@[deprecated] alias to_list_none := toList_none - -end Option diff --git a/Batteries/Data/RBMap/Basic.lean b/Batteries/Data/RBMap/Basic.lean index a9ba215ad9..8eb202591c 100644 --- a/Batteries/Data/RBMap/Basic.lean +++ b/Batteries/Data/RBMap/Basic.lean @@ -67,8 +67,8 @@ protected def max? : RBNode α → Option α | node _ _ v nil => some v | node _ _ _ r => r.max? -@[deprecated] protected alias min := RBNode.min? -@[deprecated] protected alias max := RBNode.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 @@ -194,7 +194,8 @@ instance {t : RBNode α} [DecidablePred p] : Decidable (t.Any p) := /-- True if `x` is an element of `t` "exactly", i.e. up to equality, not the `cmp` relation. -/ def EMem (x : α) (t : RBNode α) : Prop := t.Any (x = ·) -instance : Membership α (RBNode α) := ⟨EMem⟩ +instance : Membership α (RBNode α) where + mem t x := EMem x t /-- True if the specified `cut` matches at least one element of of `t`. -/ def MemP (cut : α → Ordering) (t : RBNode α) : Prop := t.Any (cut · = .eq) @@ -669,8 +670,8 @@ 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] protected alias min := RBSet.min? -@[deprecated] protected alias max := RBSet.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 @@ -768,7 +769,8 @@ def MemP (cut : α → Ordering) (t : RBSet α cmp) : Prop := t.1.MemP cut /-- True if `x` is equivalent to an element of `t`. -/ def Mem (x : α) (t : RBSet α cmp) : Prop := MemP (cmp x) t -instance : Membership α (RBSet α cmp) := ⟨Mem⟩ +instance : Membership α (RBSet α cmp) where + mem t x := Mem x t -- These instances are put in a special namespace because they are usually not what users want -- when deciding membership in a RBSet, since this does a naive linear search through the tree. @@ -1053,8 +1055,8 @@ 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] protected alias min := RBMap.min? -@[deprecated] protected alias max := RBMap.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/Lemmas.lean b/Batteries/Data/RBMap/Lemmas.lean index 37f24ebea9..df9ec1d585 100644 --- a/Batteries/Data/RBMap/Lemmas.lean +++ b/Batteries/Data/RBMap/Lemmas.lean @@ -25,9 +25,9 @@ attribute [simp] fold foldl foldr Any forM foldlM Ordered @[simp] theorem max?_reverse (t : RBNode α) : t.reverse.max? = t.min? := by rw [← min?_reverse, reverse_reverse] -@[simp] theorem mem_nil {x} : ¬x ∈ (.nil : RBNode α) := by simp [(·∈·), EMem] +@[simp] theorem mem_nil {x} : ¬x ∈ (.nil : RBNode α) := by simp [Membership.mem, EMem] @[simp] theorem mem_node {y c a x b} : - y ∈ (.node c a x b : RBNode α) ↔ y = x ∨ y ∈ a ∨ y ∈ b := by simp [(·∈·), EMem] + y ∈ (.node c a x b : RBNode α) ↔ y = x ∨ y ∈ a ∨ y ∈ b := by simp [Membership.mem, EMem] theorem All_def {t : RBNode α} : t.All p ↔ ∀ x ∈ t, p x := by induction t <;> simp [or_imp, forall_and, *] @@ -152,7 +152,6 @@ theorem min?_eq_toList_head? {t : RBNode α} : t.min? = t.toList.head? := by | nil => rfl | node _ l _ _ ih => cases l <;> simp [RBNode.min?, ih] - next ll _ _ => cases toList ll <;> rfl theorem max?_eq_toList_getLast? {t : RBNode α} : t.max? = t.toList.getLast? := by rw [← min?_reverse, min?_eq_toList_head?]; simp @@ -1104,3 +1103,128 @@ theorem lowerBound?_lt {t : RBSet α cmp} [TransCmp cmp] lowerBoundP?_lt H hz end RBSet + +namespace RBMap + +-- @[simp] -- FIXME: RBSet.val_toList already triggers here, seems bad? +theorem val_toList {t : RBMap α β cmp} : t.1.toList = t.toList := rfl + +@[simp] theorem mkRBSet_eq : mkRBMap α β cmp = ∅ := rfl +@[simp] theorem empty_eq : @RBMap.empty α β cmp = ∅ := rfl +@[simp] theorem default_eq : (default : RBMap α β cmp) = ∅ := rfl +@[simp] theorem empty_toList : toList (∅ : RBMap α β cmp) = [] := rfl +@[simp] theorem single_toList : toList (single a b : RBMap α β cmp) = [(a, b)] := rfl + +theorem mem_toList {t : RBMap α β cmp} : x ∈ toList t ↔ x ∈ t.1 := RBNode.mem_toList + +theorem foldl_eq_foldl_toList {t : RBMap α β cmp} : + t.foldl f init = t.toList.foldl (fun r p => f r p.1 p.2) init := + RBNode.foldl_eq_foldl_toList + +theorem foldr_eq_foldr_toList {t : RBMap α β cmp} : + t.foldr f init = t.toList.foldr (fun p r => f p.1 p.2 r) init := + RBNode.foldr_eq_foldr_toList + +theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} : + t.foldlM (m := m) f init = t.toList.foldlM (fun r p => f r p.1 p.2) init := + RBNode.foldlM_eq_foldlM_toList + +theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} : + t.forM (m := m) f = t.toList.forM (fun p => f p.1 p.2) := + RBNode.forM_eq_forM_toList + +theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} : + forIn (m := m) t init f = forIn t.toList init f := RBNode.forIn_eq_forIn_toList + +theorem toStream_eq {t : RBMap α β cmp} : toStream t = t.1.toStream .nil := rfl + +@[simp] theorem toStream_toList {t : RBMap α β cmp} : (toStream t).toList = t.toList := + RBSet.toStream_toList + +theorem toList_sorted {t : RBMap α β cmp} : t.toList.Pairwise (RBNode.cmpLT (cmp ·.1 ·.1)) := + RBSet.toList_sorted + +theorem findEntry?_some_eq_eq {t : RBMap α β cmp} : t.findEntry? x = some (y, v) → cmp x y = .eq := + RBSet.findP?_some_eq_eq + +theorem findEntry?_some_mem_toList {t : RBMap α β cmp} (h : t.findEntry? x = some y) : + y ∈ toList t := RBSet.findP?_some_mem_toList h + +theorem find?_some_mem_toList {t : RBMap α β cmp} (h : t.find? x = some v) : + ∃ y, (y, v) ∈ toList t ∧ cmp x y = .eq := by + obtain ⟨⟨y, v⟩, h', rfl⟩ := Option.map_eq_some'.1 h + exact ⟨_, findEntry?_some_mem_toList h', findEntry?_some_eq_eq h'⟩ + +theorem mem_toList_unique [@TransCmp α cmp] {t : RBMap α β cmp} + (hx : x ∈ toList t) (hy : y ∈ toList t) (e : cmp x.1 y.1 = .eq) : x = y := + RBSet.mem_toList_unique hx hy e + +/-- A "representable cut" is one generated by `cmp a` for some `a`. This is always a valid cut. -/ +instance (cmp) (a : α) : IsStrictCut cmp (cmp a) where + le_lt_trans h₁ h₂ := TransCmp.lt_le_trans h₂ h₁ + le_gt_trans h₁ := Decidable.not_imp_not.1 (TransCmp.le_trans · h₁) + exact h := (TransCmp.cmp_congr_left h).symm + +instance (f : α → β) (cmp) [@TransCmp β cmp] (x : β) : + IsStrictCut (Ordering.byKey f cmp) (fun y => cmp x (f y)) where + le_lt_trans h₁ h₂ := TransCmp.lt_le_trans h₂ h₁ + le_gt_trans h₁ := Decidable.not_imp_not.1 (TransCmp.le_trans · h₁) + exact h := (TransCmp.cmp_congr_left h).symm + +theorem findEntry?_some [@TransCmp α cmp] {t : RBMap α β cmp} : + t.findEntry? x = some y ↔ y ∈ toList t ∧ cmp x y.1 = .eq := RBSet.findP?_some + +theorem find?_some [@TransCmp α cmp] {t : RBMap α β cmp} : + t.find? x = some v ↔ ∃ y, (y, v) ∈ toList t ∧ cmp x y = .eq := by + simp only [find?, findEntry?_some, Option.map_eq_some']; constructor + · rintro ⟨_, h, rfl⟩; exact ⟨_, h⟩ + · rintro ⟨b, h⟩; exact ⟨_, h, rfl⟩ + +theorem contains_iff_findEntry? {t : RBMap α β cmp} : + t.contains x ↔ ∃ v, t.findEntry? x = some v := Option.isSome_iff_exists + +theorem contains_iff_find? {t : RBMap α β cmp} : + t.contains x ↔ ∃ v, t.find? x = some v := by + simp only [contains_iff_findEntry?, Prod.exists, find?, Option.map_eq_some', and_comm, + exists_eq_left] + rw [exists_comm] + +theorem size_eq (t : RBMap α β cmp) : t.size = t.toList.length := RBNode.size_eq + +theorem mem_toList_insert_self (v) (t : RBMap α β cmp) : (k, v) ∈ toList (t.insert k v) := + RBSet.mem_toList_insert_self .. + +theorem mem_toList_insert_of_mem (v) {t : RBMap α β cmp} (h : y ∈ toList t) : + y ∈ toList (t.insert k v) ∨ cmp k y.1 = .eq := RBSet.mem_toList_insert_of_mem _ h + +theorem mem_toList_insert [@TransCmp α cmp] {t : RBMap α β cmp} : + y ∈ toList (t.insert k v) ↔ (y ∈ toList t ∧ t.findEntry? k ≠ some y) ∨ y = (k, v) := + RBSet.mem_toList_insert + +theorem findEntry?_congr [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k₁ k₂ = .eq) : + t.findEntry? k₁ = t.findEntry? k₂ := by simp [findEntry?, TransCmp.cmp_congr_left' h] + +theorem find?_congr [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k₁ k₂ = .eq) : + t.find? k₁ = t.find? k₂ := by simp [find?, findEntry?_congr _ h] + +theorem findEntry?_insert_of_eq [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k' k = .eq) : + (t.insert k v).findEntry? k' = some (k, v) := RBSet.findP?_insert_of_eq _ h + +theorem find?_insert_of_eq [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k' k = .eq) : + (t.insert k v).find? k' = some v := by rw [find?, findEntry?_insert_of_eq _ h]; rfl + +theorem findEntry?_insert_of_ne [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k' k ≠ .eq) : + (t.insert k v).findEntry? k' = t.findEntry? k' := RBSet.findP?_insert_of_ne _ h + +theorem find?_insert_of_ne [@TransCmp α cmp] (t : RBMap α β cmp) (h : cmp k' k ≠ .eq) : + (t.insert k v).find? k' = t.find? k' := by simp [find?, findEntry?_insert_of_ne _ h] + +theorem findEntry?_insert [@TransCmp α cmp] (t : RBMap α β cmp) (k v k') : + (t.insert k v).findEntry? k' = if cmp k' k = .eq then some (k, v) else t.findEntry? k' := + RBSet.findP?_insert .. + +theorem find?_insert [@TransCmp α cmp] (t : RBMap α β cmp) (k v k') : + (t.insert k v).find? k' = if cmp k' k = .eq then some v else t.find? k' := by + split <;> [exact find?_insert_of_eq t ‹_›; exact find?_insert_of_ne t ‹_›] + +end RBMap diff --git a/Batteries/Data/Range/Lemmas.lean b/Batteries/Data/Range/Lemmas.lean index 586f32a7e8..d71082848f 100644 --- a/Batteries/Data/Range/Lemmas.lean +++ b/Batteries/Data/Range/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Batteries.Tactic.SeqFocus import Batteries.Data.List.Lemmas -import Batteries.Data.List.Init.Attach namespace Std.Range diff --git a/Batteries/Data/Rat/Basic.lean b/Batteries/Data/Rat/Basic.lean index 600e67981f..f96651d34c 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.Data.Int.DivMod import Batteries.Lean.Float /-! # Basics for the Rational Numbers -/ diff --git a/Batteries/Data/Rat/Lemmas.lean b/Batteries/Data/Rat/Lemmas.lean index e70914f6e0..77b911ec94 100644 --- a/Batteries/Data/Rat/Lemmas.lean +++ b/Batteries/Data/Rat/Lemmas.lean @@ -63,10 +63,10 @@ theorem normalize_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) : normalize n₁ d₁ z₁ = normalize n₂ d₂ z₂ ↔ n₁ * d₂ = n₂ * d₁ := by constructor <;> intro h · simp only [normalize_eq, mk'.injEq] at h - have' hn₁ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₁.natAbs d₁ - have' hn₂ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₂.natAbs d₂ - have' hd₁ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₁.natAbs d₁ - have' hd₂ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₂.natAbs d₂ + have hn₁ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₁.natAbs d₁ + have hn₂ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₂.natAbs d₂ + have hd₁ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₁.natAbs d₁ + have hd₂ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₂.natAbs d₂ rw [← Int.ediv_mul_cancel (Int.dvd_trans hd₂ (Int.dvd_mul_left ..)), Int.mul_ediv_assoc _ hd₂, ← Int.ofNat_ediv, ← h.2, Int.ofNat_ediv, ← Int.mul_ediv_assoc _ hd₁, Int.mul_ediv_assoc' _ hn₁, diff --git a/Batteries/Data/String/Basic.lean b/Batteries/Data/String/Basic.lean index d06df6eefa..6ff6ac98bf 100644 --- a/Batteries/Data/String/Basic.lean +++ b/Batteries/Data/String/Basic.lean @@ -104,3 +104,26 @@ def stripSuffix (s : String) (suff : Substring) : String := /-- 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 + +/-- +Convert a string of assumed-ASCII characters into a byte array. +(If any characters are non-ASCII they will be reduced modulo 256.) + +Note: if you just need the underlying `ByteArray` of a non-ASCII string, +use `String.toUTF8`. +-/ +def toAsciiByteArray (s : String) : ByteArray := + let rec + /-- + Internal implementation of `toAsciiByteArray`. + `loop p out = out ++ toAsciiByteArray ({ s with startPos := p } : Substring)` + -/ + loop (p : Pos) (out : ByteArray) : ByteArray := + if h : s.atEnd p then out else + let c := s.get p + have : utf8ByteSize s - (next s p).byteIdx < utf8ByteSize s - p.byteIdx := + Nat.sub_lt_sub_left (Nat.lt_of_not_le <| mt decide_eq_true h) + (Nat.lt_add_of_pos_right (Char.utf8Size_pos _)) + loop (s.next p) (out.push c.toUInt8) + termination_by utf8ByteSize s - p.byteIdx + loop 0 ByteArray.empty diff --git a/Batteries/Data/String/Lemmas.lean b/Batteries/Data/String/Lemmas.lean index 8a9376fe05..ddd43d32a4 100644 --- a/Batteries/Data/String/Lemmas.lean +++ b/Batteries/Data/String/Lemmas.lean @@ -11,7 +11,8 @@ import Batteries.Tactic.SeqFocus namespace String -attribute [ext] ext +-- TODO(kmill): add `@[ext]` attribute to `String.ext` in core. +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 @@ -33,14 +34,14 @@ instance : Batteries.BEqOrd String := .compareOfLessAndEq String.lt_irrefl attribute [simp] toList -- prefer `String.data` over `String.toList` in lemmas -private theorem add_csize_pos : 0 < i + csize c := - Nat.add_pos_right _ (csize_pos c) +private theorem add_utf8Size_pos : 0 < i + Char.utf8Size c := + Nat.add_pos_right _ (Char.utf8Size_pos c) -private theorem ne_add_csize_add_self : i ≠ n + csize c + i := - Nat.ne_of_lt (Nat.lt_add_of_pos_left add_csize_pos) +private theorem ne_add_utf8Size_add_self : i ≠ n + Char.utf8Size c + i := + Nat.ne_of_lt (Nat.lt_add_of_pos_left add_utf8Size_pos) -private theorem ne_self_add_add_csize : i ≠ i + (n + csize c) := - Nat.ne_of_lt (Nat.lt_add_of_pos_right add_csize_pos) +private theorem ne_self_add_add_utf8Size : i ≠ i + (n + Char.utf8Size c) := + Nat.ne_of_lt (Nat.lt_add_of_pos_right add_utf8Size_pos) /-- The UTF-8 byte length of a list of characters. (This is intended for specification purposes.) -/ @[inline] def utf8Len : List Char → Nat := utf8ByteSize.go @@ -51,19 +52,19 @@ private theorem ne_self_add_add_csize : i ≠ i + (n + csize c) := @[simp] theorem utf8Len_nil : utf8Len [] = 0 := rfl -@[simp] theorem utf8Len_cons (c cs) : utf8Len (c :: cs) = utf8Len cs + csize c := rfl +@[simp] theorem utf8Len_cons (c cs) : utf8Len (c :: cs) = utf8Len cs + c.utf8Size := rfl @[simp] theorem utf8Len_append (cs₁ cs₂) : utf8Len (cs₁ ++ cs₂) = utf8Len cs₁ + utf8Len cs₂ := by induction cs₁ <;> simp [*, Nat.add_right_comm] -@[simp] theorem utf8Len_reverseAux (cs₁ cs₂) : +theorem utf8Len_reverseAux (cs₁ cs₂) : utf8Len (cs₁.reverseAux cs₂) = utf8Len cs₁ + utf8Len cs₂ := by - induction cs₁ generalizing cs₂ <;> simp [*, ← Nat.add_assoc, Nat.add_right_comm] + induction cs₁ generalizing cs₂ <;> simp_all [← Nat.add_assoc, Nat.add_right_comm] @[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_csize_pos] + cases l <;> simp [Nat.ne_of_gt add_utf8Size_pos] section open List @@ -86,12 +87,13 @@ end namespace Pos -attribute [ext] ext +-- TODO(kmill): add `@[ext]` attribute to `String.Pos.ext` in core. +attribute [ext (iff := false)] ext -theorem lt_addChar (p : Pos) (c : Char) : p < p + c := Nat.lt_add_of_pos_right (csize_pos _) +theorem lt_addChar (p : Pos) (c : Char) : p < p + c := Nat.lt_add_of_pos_right (Char.utf8Size_pos _) private theorem zero_ne_addChar {i : Pos} {c : Char} : 0 ≠ i + c := - ne_of_lt add_csize_pos + ne_of_lt add_utf8Size_pos /-- A string position is valid if it is equal to the UTF-8 length of an initial substring of `s`. -/ def Valid (s : String) (p : Pos) : Prop := @@ -135,10 +137,10 @@ theorem utf8GetAux_add_right_cancel (s : List Char) (i p n : Nat) : utf8GetAux s ⟨i + n⟩ ⟨p + n⟩ = utf8GetAux s ⟨i⟩ ⟨p⟩ := by apply utf8InductionOn s ⟨i⟩ ⟨p⟩ (motive := fun s i => utf8GetAux s ⟨i.byteIdx + n⟩ ⟨p + n⟩ = utf8GetAux s i ⟨p⟩) <;> - simp [utf8GetAux] + simp only [utf8GetAux, Char.reduceDefault, implies_true, ↓reduceIte, ne_eq, pos_add_char] intro c cs ⟨i⟩ h ih - simp [Pos.ext_iff, Pos.addChar_eq] at h ⊢ - simp [Nat.add_right_cancel_iff, h] + simp only [Pos.ext_iff, Pos.addChar_eq] at h ⊢ + simp only [Nat.add_right_cancel_iff, h, ↓reduceIte] rw [Nat.add_right_comm] exact ih @@ -151,8 +153,9 @@ theorem utf8GetAux_of_valid (cs cs' : List Char) {i p : Nat} (hp : i + utf8Len c | [], [] => rfl | [], c::cs' => simp [← hp, utf8GetAux] | c::cs, cs' => - simp [utf8GetAux, -List.headD_eq_head?]; rw [if_neg] - case hnc => simp [← hp, Pos.ext_iff]; exact ne_self_add_add_csize + simp only [utf8GetAux, List.append_eq, Char.reduceDefault, ↓Char.isValue] + rw [if_neg] + case hnc => simp only [← hp, utf8Len_cons, Pos.ext_iff]; exact ne_self_add_add_utf8Size refine utf8GetAux_of_valid cs cs' ?_ simpa [Nat.add_assoc, Nat.add_comm] using hp @@ -169,8 +172,9 @@ theorem utf8GetAux?_of_valid (cs cs' : List Char) {i p : Nat} (hp : i + utf8Len | [], [] => rfl | [], c::cs' => simp [← hp, utf8GetAux?] | c::cs, cs' => - simp [utf8GetAux?]; rw [if_neg] - case hnc => simp [← hp, Pos.ext_iff]; exact ne_self_add_add_csize + simp only [utf8GetAux?, List.append_eq] + rw [if_neg] + case hnc => simp only [← hp, Pos.ext_iff]; exact ne_self_add_add_utf8Size refine utf8GetAux?_of_valid cs cs' ?_ simpa [Nat.add_assoc, Nat.add_comm] using hp @@ -183,8 +187,9 @@ theorem utf8SetAux_of_valid (c' : Char) (cs cs' : List Char) {i p : Nat} (hp : i | [], [] => rfl | [], c::cs' => simp [← hp, utf8SetAux] | c::cs, cs' => - simp [utf8SetAux]; rw [if_neg] - case hnc => simp [← hp, Pos.ext_iff]; exact ne_self_add_add_csize + simp only [utf8SetAux, List.append_eq, List.cons_append] + rw [if_neg] + case hnc => simp only [← hp, Pos.ext_iff]; exact ne_self_add_add_utf8Size refine congrArg (c::·) (utf8SetAux_of_valid c' cs cs' ?_) simpa [Nat.add_assoc, Nat.add_comm] using hp @@ -197,11 +202,11 @@ theorem modify_of_valid (cs cs' : List Char) : rw [modify, set_of_valid, get_of_valid]; cases cs' <;> rfl theorem next_of_valid' (cs cs' : List Char) : - next ⟨cs ++ cs'⟩ ⟨utf8Len cs⟩ = ⟨utf8Len cs + csize (cs'.headD default)⟩ := by + next ⟨cs ++ cs'⟩ ⟨utf8Len cs⟩ = ⟨utf8Len cs + (cs'.headD default).utf8Size⟩ := by simp only [next, get_of_valid]; rfl theorem next_of_valid (cs : List Char) (c : Char) (cs' : List Char) : - next ⟨cs ++ c :: cs'⟩ ⟨utf8Len cs⟩ = ⟨utf8Len cs + csize c⟩ := next_of_valid' .. + 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 _ @@ -214,20 +219,24 @@ theorem valid_next {p : Pos} (h : p.Valid s) (h₂ : p < s.endPos) : (next s p). simpa using Pos.Valid.mk (cs ++ [c]) cs' theorem utf8PrevAux_of_valid {cs cs' : List Char} {c : Char} {i p : Nat} - (hp : i + (utf8Len cs + csize c) = p) : + (hp : i + (utf8Len cs + c.utf8Size) = p) : utf8PrevAux (cs ++ c :: cs') ⟨i⟩ ⟨p⟩ = ⟨i + utf8Len cs⟩ := by match cs with | [] => simp [utf8PrevAux, ← hp, Pos.addChar_eq] | c'::cs => - simp [utf8PrevAux, Pos.addChar_eq, ← hp]; rw [if_neg] + simp only [utf8PrevAux, Pos.addChar_eq, ← hp, utf8Len_cons, List.append_eq] + rw [if_neg] case hnc => - simp [Pos.ext_iff]; rw [Nat.add_right_comm, Nat.add_left_comm]; apply ne_add_csize_add_self + simp only [Pos.ext_iff] + rw [Nat.add_right_comm, Nat.add_left_comm] + apply ne_add_utf8Size_add_self refine (utf8PrevAux_of_valid (by simp [Nat.add_assoc, Nat.add_left_comm])).trans ?_ simp [Nat.add_assoc, Nat.add_comm] theorem prev_of_valid (cs : List Char) (c : Char) (cs' : List Char) : - prev ⟨cs ++ c :: cs'⟩ ⟨utf8Len cs + csize c⟩ = ⟨utf8Len cs⟩ := by - simp [prev]; refine (if_neg (Pos.ne_of_gt add_csize_pos)).trans ?_ + prev ⟨cs ++ c :: cs'⟩ ⟨utf8Len cs + c.utf8Size⟩ = ⟨utf8Len cs⟩ := by + simp only [prev] + refine (if_neg (Pos.ne_of_gt add_utf8Size_pos)).trans ?_ rw [utf8PrevAux_of_valid] <;> simp theorem prev_of_valid' (cs cs' : List Char) : @@ -247,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_csize_pos] + cases cs' <;> simp [Nat.lt_add_of_pos_right add_utf8Size_pos] unseal posOfAux findAux in theorem posOfAux_eq (s c) : posOfAux s c = findAux s (· == c) := rfl @@ -268,13 +277,18 @@ theorem findAux_of_valid (p) : ∀ l m r, | l, [], r => by unfold findAux List.takeWhile; simp | l, c::m, r => by unfold findAux List.takeWhile - rw [dif_pos (by exact Nat.lt_add_of_pos_right add_csize_pos)] + rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)] have h1 := get_of_valid l (c::m++r); have h2 := next_of_valid l c (m++r) - simp at h1 h2; simp [h1, h2] - cases p c <;> simp - have foo := findAux_of_valid p (l++[c]) m r; simp at foo - rw [Nat.add_right_comm, Nat.add_assoc] at foo - rw [foo, Nat.add_right_comm, Nat.add_assoc] + simp only [List.cons_append, Char.reduceDefault, List.headD_cons] at h1 h2 + simp only [List.append_assoc, List.cons_append, h1, utf8Len_cons, h2] + cases p c + · simp only [Bool.false_eq_true, ↓reduceIte, Bool.not_false, utf8Len_cons] + have foo := findAux_of_valid p (l++[c]) m r + simp only [List.append_assoc, List.singleton_append, List.cons_append, utf8Len_append, + utf8Len_cons, utf8Len_nil, Nat.zero_add, List.nil_append] at foo + rw [Nat.add_right_comm, Nat.add_assoc] at foo + rw [foo, Nat.add_right_comm, Nat.add_assoc] + · simp theorem find_of_valid (p s) : find s p = ⟨utf8Len (s.1.takeWhile (!p ·))⟩ := by simpa using findAux_of_valid p [] s.1 [] @@ -285,10 +299,12 @@ theorem revFindAux_of_valid (p) : ∀ l r, | [], r => by unfold revFindAux List.dropWhile; simp | c::l, r => by unfold revFindAux List.dropWhile - rw [dif_neg (by exact Pos.ne_of_gt add_csize_pos)] + rw [dif_neg (by exact Pos.ne_of_gt add_utf8Size_pos)] have h1 := get_of_valid l.reverse (c::r); have h2 := prev_of_valid l.reverse c r - simp at h1 h2; simp [h1, h2] - cases p c <;> simp + simp only [utf8Len_reverse, Char.reduceDefault, List.headD_cons] at h1 h2 + simp only [List.reverse_cons, List.append_assoc, List.singleton_append, utf8Len_cons, h2, h1] + cases p c <;> simp only [Bool.false_eq_true, ↓reduceIte, Bool.not_false, Bool.not_true, + List.tail?_cons, Option.map_some'] exact revFindAux_of_valid p l (c::r) theorem revFind_of_valid (p s) : @@ -305,19 +321,22 @@ theorem firstDiffPos_loop_eq (l₁ l₂ r₁ r₂ stop p) rw [ dif_pos <| by rw [hstop, ← hl₁, ← hl₂] - refine Nat.lt_min.2 ⟨?_, ?_⟩ <;> exact Nat.lt_add_of_pos_right add_csize_pos, + refine Nat.lt_min.2 ⟨?_, ?_⟩ <;> exact Nat.lt_add_of_pos_right add_utf8Size_pos, show get ⟨l₁ ++ a :: r₁⟩ ⟨p⟩ = a by simp [hl₁, get_of_valid], show get ⟨l₂ ++ b :: r₂⟩ ⟨p⟩ = b by simp [hl₂, get_of_valid]] - simp; split <;> simp - subst b - rw [show next ⟨l₁ ++ a :: r₁⟩ ⟨p⟩ = ⟨utf8Len l₁ + csize a⟩ by simp [hl₁, next_of_valid]] - simpa [← hl₁, ← Nat.add_assoc, Nat.add_right_comm] using - firstDiffPos_loop_eq (l₁ ++ [a]) (l₂ ++ [a]) r₁ r₂ stop (p + csize a) - (by simp [hl₁]) (by simp [hl₂]) (by simp [hstop, ← Nat.add_assoc, Nat.add_right_comm]) + simp only [bne_iff_ne, ne_eq, ite_not, decide_eq_true_eq] + split + · simp only [utf8Len_cons] + subst b + rw [show next ⟨l₁ ++ a :: r₁⟩ ⟨p⟩ = ⟨utf8Len l₁ + a.utf8Size⟩ by simp [hl₁, next_of_valid]] + simpa [← hl₁, ← Nat.add_assoc, Nat.add_right_comm] using + firstDiffPos_loop_eq (l₁ ++ [a]) (l₂ ++ [a]) r₁ r₂ stop (p + a.utf8Size) + (by simp [hl₁]) (by simp [hl₂]) (by simp [hstop, ← Nat.add_assoc, Nat.add_right_comm]) + · simp · next h => rw [dif_neg] <;> simp [hstop, ← hl₁, ← hl₂, -Nat.not_lt, Nat.lt_min] intro h₁ h₂ - have : ∀ {cs}, p < p + utf8Len cs → cs ≠ [] := by rintro _ h rfl; simp at h + have : ∀ {cs}, 0 < utf8Len cs → cs ≠ [] := by rintro _ h rfl; simp at h obtain ⟨a, as, e₁⟩ := List.exists_cons_of_ne_nil (this h₁) obtain ⟨b, bs, e₂⟩ := List.exists_cons_of_ne_nil (this h₂) exact h _ _ _ _ e₁ e₂ @@ -330,10 +349,11 @@ theorem firstDiffPos_eq (a b : String) : theorem extract.go₂_add_right_cancel (s : List Char) (i e n : Nat) : go₂ s ⟨i + n⟩ ⟨e + n⟩ = go₂ s ⟨i⟩ ⟨e⟩ := by apply utf8InductionOn s ⟨i⟩ ⟨e⟩ (motive := fun s i => - go₂ s ⟨i.byteIdx + n⟩ ⟨e + n⟩ = go₂ s i ⟨e⟩) <;> simp [go₂] + go₂ s ⟨i.byteIdx + n⟩ ⟨e + n⟩ = go₂ s i ⟨e⟩) + <;> simp only [ne_eq, go₂, pos_add_char, implies_true, ↓reduceIte] intro c cs ⟨i⟩ h ih - simp [Pos.ext_iff, Pos.addChar_eq] at h ⊢ - simp [Nat.add_right_cancel_iff, h] + simp only [Pos.ext_iff, Pos.addChar_eq] at h ⊢ + simp only [Nat.add_right_cancel_iff, h, ↓reduceIte, List.cons.injEq, true_and] rw [Nat.add_right_comm] exact ih @@ -341,32 +361,35 @@ theorem extract.go₂_append_left : ∀ (s t : List Char) (i e : Nat), e = utf8Len s + i → go₂ (s ++ t) ⟨i⟩ ⟨e⟩ = s | [], t, i, _, rfl => by cases t <;> simp [go₂] | c :: cs, t, i, _, rfl => by - simp [go₂, Pos.ext_iff, ne_add_csize_add_self, Pos.addChar_eq] + simp only [go₂, utf8Len_cons, Pos.ext_iff, ne_add_utf8Size_add_self, ↓reduceIte, List.append_eq, + Pos.addChar_eq, List.cons.injEq, true_and] apply go₂_append_left; rw [Nat.add_right_comm, Nat.add_assoc] theorem extract.go₁_add_right_cancel (s : List Char) (i b e n : Nat) : go₁ s ⟨i + n⟩ ⟨b + n⟩ ⟨e + n⟩ = go₁ s ⟨i⟩ ⟨b⟩ ⟨e⟩ := by apply utf8InductionOn s ⟨i⟩ ⟨b⟩ (motive := fun s i => - go₁ s ⟨i.byteIdx + n⟩ ⟨b + n⟩ ⟨e + n⟩ = go₁ s i ⟨b⟩ ⟨e⟩) <;> - simp [go₁] + go₁ s ⟨i.byteIdx + n⟩ ⟨b + n⟩ ⟨e + n⟩ = go₁ s i ⟨b⟩ ⟨e⟩) + <;> simp only [ne_eq, go₁, pos_add_char, implies_true, ↓reduceIte] · intro c cs apply go₂_add_right_cancel · intro c cs ⟨i⟩ h ih - simp [Pos.ext_iff, Pos.addChar_eq] at h ih ⊢ - simp [Nat.add_right_cancel_iff, h] + simp only [Pos.ext_iff, Pos.addChar_eq] at h ih ⊢ + simp only [Nat.add_right_cancel_iff, h, ↓reduceIte] rw [Nat.add_right_comm] exact ih theorem extract.go₁_cons_addChar (c : Char) (cs : List Char) (b e : Pos) : go₁ (c :: cs) 0 (b + c) (e + c) = go₁ cs 0 b e := by - simp [go₁, Pos.ext_iff, Nat.ne_of_lt add_csize_pos] + simp only [go₁, Pos.ext_iff, Pos.byteIdx_zero, pos_add_char, Nat.ne_of_lt add_utf8Size_pos, + ↓reduceIte] apply go₁_add_right_cancel theorem extract.go₁_append_right : ∀ (s t : List Char) (i b : Nat) (e : Pos), b = utf8Len s + i → go₁ (s ++ t) ⟨i⟩ ⟨b⟩ e = go₂ t ⟨b⟩ e | [], t, i, _, e, rfl => by cases t <;> simp [go₁, go₂] | c :: cs, t, i, _, e, rfl => by - simp [go₁, Pos.ext_iff, ne_add_csize_add_self, Pos.addChar_eq] + simp only [go₁, utf8Len_cons, Pos.ext_iff, ne_add_utf8Size_add_self, ↓reduceIte, List.append_eq, + Pos.addChar_eq] apply go₁_append_right; rw [Nat.add_right_comm, Nat.add_assoc] theorem extract.go₁_zero_utf8Len (s : List Char) : go₁ s 0 0 ⟨utf8Len s⟩ = s := @@ -375,13 +398,15 @@ theorem extract.go₁_zero_utf8Len (s : List Char) : go₁ s 0 0 ⟨utf8Len s⟩ theorem extract_cons_addChar (c : Char) (cs : List Char) (b e : Pos) : extract ⟨c :: cs⟩ (b + c) (e + c) = extract ⟨cs⟩ b e := by - simp [extract, Nat.add_le_add_iff_right] + simp only [extract, pos_add_char, ge_iff_le, Nat.add_le_add_iff_right] split <;> [rfl; rw [extract.go₁_cons_addChar]] theorem extract_zero_endPos : ∀ (s : String), s.extract 0 (endPos s) = s | ⟨[]⟩ => rfl | ⟨c :: cs⟩ => by - simp [extract, Nat.ne_of_gt add_csize_pos]; congr + simp only [extract, Pos.byteIdx_zero, endPos_eq, utf8Len_cons, ge_iff_le, Nat.le_zero_eq, + Nat.ne_of_gt add_utf8Size_pos, ↓reduceIte] + congr apply extract.go₁_zero_utf8Len theorem extract_of_valid (l m r : List Char) : @@ -396,11 +421,18 @@ theorem splitAux_of_valid (p l m r acc) : splitAux ⟨l ++ m ++ r⟩ p ⟨utf8Len l⟩ ⟨utf8Len l + utf8Len m⟩ acc = acc.reverse ++ (List.splitOnP.go p r m.reverse).map mk := by unfold splitAux - simp [by simpa using atEnd_of_valid (l ++ m) r]; split + simp only [List.append_assoc, atEnd_iff, endPos_eq, utf8Len_append, Pos.mk_le_mk, + Nat.add_le_add_iff_left, by simpa using atEnd_of_valid (l ++ m) r, List.reverse_cons, + dite_eq_ite] + split · subst r; simpa [List.splitOnP.go] using extract_of_valid l m [] · obtain ⟨c, r, rfl⟩ := r.exists_cons_of_ne_nil ‹_› - simp [by simpa using (⟨get_of_valid (l++m) (c::r), next_of_valid (l++m) c r, - extract_of_valid l m (c::r)⟩ : _∧_∧_), List.splitOnP.go] + simp only [by + simpa using + (⟨get_of_valid (l ++ m) (c :: r), next_of_valid (l ++ m) c r, + extract_of_valid l m (c :: r)⟩ : + _ ∧ _ ∧ _), + List.splitOnP.go, List.reverse_reverse] split · simpa [Nat.add_assoc] using splitAux_of_valid p (l++m++[c]) [] r (⟨m⟩::acc) · simpa [Nat.add_assoc] using splitAux_of_valid p l (m++[c]) r acc @@ -478,7 +510,7 @@ theorem pos_eq_zero {l r it} (h : ValidFor l r it) : it.2 = 0 ↔ l = [] := by simp [h.pos, Pos.ext_iff] theorem pos_eq_endPos {l r it} (h : ValidFor l r it) : it.2 = it.1.endPos ↔ r = [] := by - simp [h.pos, h.toString, Pos.ext_iff] + simp only [h.pos, h.toString, endPos_eq, utf8Len_reverseAux, Pos.ext_iff] exact (Nat.add_left_cancel_iff (m := 0)).trans <| eq_comm.trans utf8Len_eq_zero theorem curr : ∀ {it}, ValidFor l r it → it.curr = r.headD default @@ -494,15 +526,21 @@ theorem prev : ∀ {it}, ValidFor (c :: l) r it → ValidFor l (c :: r) it.prev | it, h => by cases h.out' have := prev_of_valid l.reverse c r - simp at this; simp [Iterator.prev, this] + simp only [utf8Len_reverse] at this + simp only [Iterator.prev, List.reverse_cons, List.append_assoc, List.singleton_append, + utf8Len_append, utf8Len_reverse, utf8Len_cons, utf8Len_nil, Nat.zero_add, this] exact .of_eq _ (by simp [List.reverseAux_eq]) (by simp) theorem prev_nil : ∀ {it}, ValidFor [] r it → ValidFor [] r it.prev - | it, h => by simp [Iterator.prev, h.toString, h.pos]; constructor + | it, h => by + simp only [Iterator.prev, h.toString, List.reverseAux_nil, h.pos, utf8Len_nil, + Pos.mk_zero, prev_zero] + constructor theorem atEnd : ∀ {it}, ValidFor l r it → (it.atEnd ↔ r = []) | it, h => by - simp [Iterator.atEnd, h.pos, h.toString] + simp only [Iterator.atEnd, h.pos, h.toString, endPos_eq, utf8Len_reverseAux, ge_iff_le, + decide_eq_true_eq] exact Nat.add_le_add_iff_left.trans <| Nat.le_zero.trans utf8Len_eq_zero theorem hasNext : ∀ {it}, ValidFor l r it → (it.hasNext ↔ r ≠ []) @@ -515,26 +553,29 @@ theorem setCurr' : ∀ {it}, ValidFor l r it → ValidFor l (r.modifyHead fun _ => c) (it.setCurr c) | it, h => by cases h.out' - simp [Iterator.setCurr] + simp only [setCurr, utf8Len_reverse] refine .of_eq _ ?_ (by simp) have := set_of_valid l.reverse r c - simp at this; simp [List.reverseAux_eq, this] + simp only [utf8Len_reverse] at this; simp [List.reverseAux_eq, this] theorem setCurr (h : ValidFor l (c :: r) it) : ValidFor l (c :: r) (it.setCurr c) := h.setCurr' theorem toEnd (h : ValidFor l r it) : ValidFor (r.reverse ++ l) [] it.toEnd := by - simp [Iterator.toEnd, h.toString] + simp only [Iterator.toEnd, h.toString, endPos_eq, utf8Len_reverseAux] exact .of_eq _ (by simp [List.reverseAux_eq]) (by simp [Nat.add_comm]) theorem toEnd' (it : Iterator) : ValidFor it.s.1.reverse [] it.toEnd := by - simp [Iterator.toEnd] + simp only [Iterator.toEnd] exact .of_eq _ (by simp [List.reverseAux_eq]) (by simp [endPos, utf8ByteSize]) theorem extract (h₁ : ValidFor l (m ++ r) it₁) (h₂ : ValidFor (m.reverse ++ l) r it₂) : it₁.extract it₂ = ⟨m⟩ := by cases h₁.out; cases h₂.out - simp [Iterator.extract, List.reverseAux_eq, Nat.not_lt.2 (Nat.le_add_left ..)] + simp only [Iterator.extract, List.reverseAux_eq, List.reverse_append, List.reverse_reverse, + List.append_assoc, ne_eq, not_true_eq_false, decide_False, utf8Len_append, utf8Len_reverse, + gt_iff_lt, pos_lt_eq, Nat.not_lt.2 (Nat.le_add_left ..), Bool.or_self, Bool.false_eq_true, + ↓reduceIte] simpa [Nat.add_comm] using extract_of_valid l.reverse m r theorem remainingToString {it} (h : ValidFor l r it) : it.remainingToString = ⟨r⟩ := by @@ -545,7 +586,7 @@ theorem nextn : ∀ {it}, ValidFor l r it → ∀ n, n ≤ r.length → ValidFor ((r.take n).reverse ++ l) (r.drop n) (it.nextn n) | it, h, 0, _ => by simp [h, Iterator.nextn] | it, h, n+1, hn => by - simp [h, Iterator.nextn] + simp only [Iterator.nextn] have a::r := r simpa using h.next.nextn _ (Nat.le_of_succ_le_succ hn) @@ -553,7 +594,7 @@ theorem prevn : ∀ {it}, ValidFor l r it → ∀ n, n ≤ l.length → ValidFor (l.drop n) ((l.take n).reverse ++ r) (it.prevn n) | it, h, 0, _ => by simp [h, Iterator.prevn] | it, h, n+1, hn => by - simp [h, Iterator.prevn] + simp only [Iterator.prevn] have a::l := l simpa using h.prev.prevn _ (Nat.le_of_succ_le_succ hn) @@ -606,10 +647,10 @@ theorem offsetOfPosAux_of_valid : ∀ l m r n, | l, [], r, n => by unfold offsetOfPosAux; simp | l, c::m, r, n => by unfold offsetOfPosAux - rw [if_neg (by exact Nat.not_le.2 (Nat.lt_add_of_pos_right add_csize_pos))] + rw [if_neg (by exact Nat.not_le.2 (Nat.lt_add_of_pos_right add_utf8Size_pos))] simp only [List.append_assoc, atEnd_of_valid l (c::m++r)] - simp [next_of_valid l c (m++r)] - simpa [← Nat.add_assoc, Nat.add_right_comm, Nat.succ_eq_add_one] using + simp only [List.cons_append, utf8Len_cons, next_of_valid l c (m ++ r)] + simpa [← Nat.add_assoc, Nat.add_right_comm] using offsetOfPosAux_of_valid (l++[c]) m r (n + 1) theorem offsetOfPos_of_valid (l r) : offsetOfPos ⟨l ++ r⟩ ⟨utf8Len l⟩ = l.length := by @@ -621,8 +662,9 @@ theorem foldlAux_of_valid (f : α → Char → α) : ∀ l m r a, | l, [], r, a => by unfold foldlAux; simp | l, c::m, r, a => by unfold foldlAux - rw [dif_pos (by exact Nat.lt_add_of_pos_right add_csize_pos)] - simp [get_of_valid l (c::(m++r)), next_of_valid l c (m++r)] + rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)] + simp only [List.append_assoc, List.cons_append, utf8Len_cons, next_of_valid l c (m ++ r), + get_of_valid l (c :: (m ++ r)), Char.reduceDefault, List.headD_cons, List.foldl_cons] simpa [← Nat.add_assoc, Nat.add_right_comm] using foldlAux_of_valid f (l++[c]) m r (f a c) theorem foldl_eq (f : α → Char → α) (s a) : foldl f a s = s.1.foldl f a := by @@ -634,9 +676,9 @@ theorem foldrAux_of_valid (f : Char → α → α) (l m r a) : rw [← m.reverse_reverse] induction m.reverse generalizing r a with (unfold foldrAux; simp) | cons c m IH => - rw [if_pos (by exact Nat.lt_add_of_pos_right add_csize_pos)] - simp [← Nat.add_assoc, by simpa using prev_of_valid (l++m.reverse) c r] - simp [by simpa using get_of_valid (l++m.reverse) (c::r)] + rw [if_pos add_utf8Size_pos] + simp only [← Nat.add_assoc, by simpa using prev_of_valid (l ++ m.reverse) c r] + simp only [by simpa using get_of_valid (l ++ m.reverse) (c :: r)] simpa using IH (c::r) (f c a) theorem foldr_eq (f : Char → α → α) (s a) : foldr f a s = s.1.foldr f a := by @@ -648,8 +690,10 @@ theorem anyAux_of_valid (p : Char → Bool) : ∀ l m r, | l, [], r => by unfold anyAux; simp | l, c::m, r => by unfold anyAux - rw [dif_pos (by exact Nat.lt_add_of_pos_right add_csize_pos)] - simp [get_of_valid l (c::(m++r)), next_of_valid l c (m++r)] + rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)] + simp only [List.append_assoc, List.cons_append, get_of_valid l (c :: (m ++ r)), + Char.reduceDefault, List.headD_cons, utf8Len_cons, next_of_valid l c (m ++ r), + Bool.if_true_left, Bool.decide_eq_true, List.any_cons] cases p c <;> simp simpa [← Nat.add_assoc, Nat.add_right_comm] using anyAux_of_valid p (l++[c]) m r @@ -672,7 +716,8 @@ theorem mapAux_of_valid (f : Char → Char) : ∀ l r, mapAux f ⟨utf8Len l⟩ | l, c::r => by unfold mapAux rw [dif_neg (by rw [atEnd_of_valid]; simp)] - simp [set_of_valid l (c::r), get_of_valid l (c::r), next_of_valid l (f c) r] + simp only [get_of_valid l (c :: r), Char.reduceDefault, List.headD_cons, + set_of_valid l (c :: r), List.modifyHead_cons, next_of_valid l (f c) r, List.map_cons] simpa using mapAux_of_valid f (l++[f c]) r theorem map_eq (f : Char → Char) (s) : map f s = ⟨s.1.map f⟩ := by @@ -689,8 +734,9 @@ theorem takeWhileAux_of_valid (p : Char → Bool) : ∀ l m r, | l, [], r => by unfold Substring.takeWhileAux List.takeWhile; simp | l, c::m, r => by unfold Substring.takeWhileAux List.takeWhile - rw [dif_pos (by exact Nat.lt_add_of_pos_right add_csize_pos)] - simp [get_of_valid l (c::(m++r)), next_of_valid l c (m++r)] + rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)] + simp only [List.append_assoc, List.cons_append, get_of_valid l (c :: (m ++ r)), + Char.reduceDefault, List.headD_cons, utf8Len_cons, next_of_valid l c (m ++ r)] cases p c <;> simp simpa [← Nat.add_assoc, Nat.add_right_comm] using takeWhileAux_of_valid p (l++[c]) m r @@ -752,33 +798,35 @@ theorem toString : ∀ {s}, ValidFor l m r s → s.toString = ⟨m⟩ theorem toIterator : ∀ {s}, ValidFor l m r s → s.toIterator.ValidFor l.reverse (m ++ r) | _, h => by - simp [Substring.toIterator] + simp only [Substring.toIterator] exact .of_eq _ (by simp [h.str, List.reverseAux_eq]) (by simp [h.startPos]) theorem get : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → s.get ⟨utf8Len m₁⟩ = c | _, ⟨⟩ => by simpa using get_of_valid (l ++ m₁) (c :: m₂ ++ r) -theorem next : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + csize c⟩ +theorem next : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → + s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + c.utf8Size⟩ | _, ⟨⟩ => by - simp [Substring.next] + simp only [Substring.next, utf8Len_append, utf8Len_cons, List.append_assoc, List.cons_append] rw [if_neg (mt Pos.ext_iff.1 ?a)] case a => simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using - @ne_add_csize_add_self (utf8Len l + utf8Len m₁) (utf8Len m₂) c + @ne_add_utf8Size_add_self (utf8Len l + utf8Len m₁) (utf8Len m₂) c have := next_of_valid (l ++ m₁) c (m₂ ++ r) - simp [Pos.add_eq] at this ⊢; rw [this] + simp only [List.append_assoc, utf8Len_append, Pos.add_eq] at this ⊢; rw [this] simp [Nat.add_assoc, Nat.add_sub_cancel_left] theorem next_stop : ∀ {s}, ValidFor l m r s → s.next ⟨utf8Len m⟩ = ⟨utf8Len m⟩ | _, ⟨⟩ => by simp [Substring.next, Pos.add_eq] -theorem prev : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → s.prev ⟨utf8Len m₁ + csize c⟩ = ⟨utf8Len m₁⟩ +theorem prev : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → + s.prev ⟨utf8Len m₁ + c.utf8Size⟩ = ⟨utf8Len m₁⟩ | _, ⟨⟩ => by - simp [Substring.prev] + simp only [Substring.prev, List.append_assoc, List.cons_append] rw [if_neg (mt Pos.ext_iff.1 <| Ne.symm ?a)] - case a => simpa [Nat.add_comm] using @ne_add_csize_add_self (utf8Len l) (utf8Len m₁) c + case a => simpa [Nat.add_comm] using @ne_add_utf8Size_add_self (utf8Len l) (utf8Len m₁) c have := prev_of_valid (l ++ m₁) c (m₂ ++ r) - simp [Pos.add_eq, Nat.add_assoc] at this ⊢; rw [this] + simp only [List.append_assoc, utf8Len_append, Nat.add_assoc, Pos.add_eq] at this ⊢; rw [this] simp [Nat.add_sub_cancel_left] theorem nextn_stop : ∀ {s}, ValidFor l m r s → ∀ n, s.nextn n ⟨utf8Len m⟩ = ⟨utf8Len m⟩ @@ -789,7 +837,7 @@ theorem nextn : ∀ {s}, ValidFor l (m₁ ++ m₂) r s → ∀ n, s.nextn n ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + utf8Len (m₂.take n)⟩ | _, _, 0 => by simp [Substring.nextn] | s, h, n+1 => by - simp [Substring.nextn] + simp only [Substring.nextn] match m₂ with | [] => simp at h; simp [h.next_stop, h.nextn_stop] | c::m₂ => @@ -801,7 +849,7 @@ theorem prevn : ∀ {s}, ValidFor l (m₁.reverse ++ m₂) r s → ∀ n, s.prevn n ⟨utf8Len m₁⟩ = ⟨utf8Len (m₁.drop n)⟩ | _, _, 0 => by simp [Substring.prevn] | s, h, n+1 => by - simp [Substring.prevn] + simp only [Substring.prevn] match m₁ with | [] => simp | c::m₁ => @@ -814,8 +862,9 @@ theorem front : ∀ {s}, ValidFor l (c :: m) r s → s.front = c theorem drop : ∀ {s}, ValidFor l m r s → ∀ n, ValidFor (l ++ m.take n) (m.drop n) r (s.drop n) | s, h, n => by have : Substring.nextn {..} .. = _ := h.nextn (m₁ := []) n - simp at this; simp [Substring.drop, this] - simp [h.str, h.startPos, h.stopPos] + simp only [utf8Len_nil, Pos.mk_zero, Nat.zero_add] at this + simp only [Substring.drop, this] + simp only [h.str, List.append_assoc, h.startPos, h.stopPos] rw [← List.take_append_drop n m] at h refine .of_eq _ (by simp) (by simp) ?_ conv => lhs; rw [← List.take_append_drop n m] @@ -824,8 +873,9 @@ theorem drop : ∀ {s}, ValidFor l m r s → ∀ n, ValidFor (l ++ m.take n) (m. theorem take : ∀ {s}, ValidFor l m r s → ∀ n, ValidFor l (m.take n) (m.drop n ++ r) (s.take n) | s, h, n => by have : Substring.nextn {..} .. = _ := h.nextn (m₁ := []) n - simp at this; simp [Substring.take, this] - simp [h.str, h.startPos, h.stopPos] + simp at this + simp only [Substring.take, this] + simp only [h.str, List.append_assoc, h.startPos] rw [← List.take_append_drop n m] at h refine .of_eq _ ?_ (by simp) (by simp) conv => lhs; rw [← List.take_append_drop n m] @@ -839,14 +889,16 @@ theorem atEnd : ∀ {s}, ValidFor l m r s → (s.atEnd ⟨p⟩ ↔ p = utf8Len m theorem extract : ∀ {s}, ValidFor l m r s → ValidFor ml mm mr ⟨⟨m⟩, b, e⟩ → ∃ l' r', ValidFor l' mm r' (s.extract b e) | _, ⟨⟩, ⟨⟩ => by - simp [Substring.extract]; split + simp only [Substring.extract, ge_iff_le, Pos.mk_le_mk, List.append_assoc, utf8Len_append] + split · next h => rw [utf8Len_eq_zero.1 <| Nat.le_zero.1 <| Nat.add_le_add_iff_left.1 h] exact ⟨[], [], ⟨⟩⟩ · next h => refine ⟨l ++ ml, mr ++ r, .of_eq _ (by simp) ?_ ?_⟩ <;> - simp [Nat.min_eq_min] <;> rw [Nat.min_eq_right] <;> - try simp [Nat.add_le_add_iff_left, Nat.le_add_right] + simp only [Pos.add_byteIdx, Nat.min_eq_min, utf8Len_append] + <;> rw [Nat.min_eq_right] + <;> try simp [Nat.add_le_add_iff_left, Nat.le_add_right] rw [Nat.add_assoc] -- TODO: splitOn @@ -870,14 +922,14 @@ theorem takeWhile (p : Char → Bool) : ∀ {s}, ValidFor l m r s → ValidFor l (m.takeWhile p) (m.dropWhile p ++ r) (s.takeWhile p) | _, ⟨⟩ => by simp only [Substring.takeWhile, takeWhileAux_of_valid] - refine' .of_eq .. <;> simp + apply ValidFor.of_eq <;> simp rw [← List.append_assoc, List.takeWhile_append_dropWhile] theorem dropWhile (p : Char → Bool) : ∀ {s}, ValidFor l m r s → ValidFor (l ++ m.takeWhile p) (m.dropWhile p) r (s.dropWhile p) | _, ⟨⟩ => by simp only [Substring.dropWhile, takeWhileAux_of_valid] - refine' .of_eq .. <;> simp + apply ValidFor.of_eq <;> simp rw [Nat.add_assoc, ← utf8Len_append (m.takeWhile p), List.takeWhile_append_dropWhile] -- TODO: takeRightWhile @@ -888,11 +940,11 @@ namespace Valid theorem validFor : ∀ {s}, Valid s → ∃ l m r, ValidFor l m r s | ⟨⟨_⟩, ⟨_⟩, ⟨_⟩⟩, ⟨⟨l, mr, rfl, rfl⟩, ⟨lm, r, e, rfl⟩, h⟩ => by - simp at * + simp only [utf8ByteSize.go_eq, Pos.mk_le_mk] at * have := (or_iff_right_iff_imp.2 fun h => ?x).1 (List.append_eq_append_iff.1 e) case x => match l, r, h with | _, _, ⟨m, rfl, rfl⟩ => ?_ - simp at h + simp only [utf8Len_append] at h cases utf8Len_eq_zero.1 <| Nat.le_zero.1 (Nat.le_of_add_le_add_left (c := 0) h) exact ⟨[], by simp⟩ match lm, mr, this with @@ -913,22 +965,22 @@ theorem isEmpty : ∀ {s}, Valid s → (s.isEmpty ↔ s.toString = "") theorem get : ∀ {s}, Valid s → s.toString.1 = m₁ ++ c :: m₂ → s.get ⟨utf8Len m₁⟩ = c | _, h, e => by let ⟨l, m, r, h⟩ := h.validFor - simp [h.toString] at e; subst e; simp [h.get] + simp only [h.toString] at e; subst e; simp [h.get] theorem next : ∀ {s}, Valid s → s.toString.1 = m₁ ++ c :: m₂ → - s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + csize c⟩ + s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + c.utf8Size⟩ | _, h, e => by let ⟨l, m, r, h⟩ := h.validFor - simp [h.toString] at e; subst e; simp [h.next] + simp only [h.toString] at e; subst e; simp [h.next] theorem next_stop : ∀ {s}, Valid s → s.next ⟨s.bsize⟩ = ⟨s.bsize⟩ | _, h => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.bsize, h.next_stop] theorem prev : ∀ {s}, Valid s → s.toString.1 = m₁ ++ c :: m₂ → - s.prev ⟨utf8Len m₁ + csize c⟩ = ⟨utf8Len m₁⟩ + s.prev ⟨utf8Len m₁ + c.utf8Size⟩ = ⟨utf8Len m₁⟩ | _, h, e => by let ⟨l, m, r, h⟩ := h.validFor - simp [h.toString] at e; subst e; simp [h.prev] + simp only [h.toString] at e; subst e; simp [h.prev] theorem nextn_stop : ∀ {s}, Valid s → ∀ n, s.nextn n ⟨s.bsize⟩ = ⟨s.bsize⟩ | _, h, n => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.bsize, h.nextn_stop] @@ -937,13 +989,13 @@ theorem nextn : ∀ {s}, Valid s → s.toString.1 = m₁ ++ m₂ → ∀ n, s.nextn n ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + utf8Len (m₂.take n)⟩ | _, h, e => by let ⟨l, m, r, h⟩ := h.validFor - simp [h.toString] at e; subst e; simp [h.nextn] + simp only [h.toString] at e; subst e; simp [h.nextn] theorem prevn : ∀ {s}, Valid s → s.toString.1 = m₁.reverse ++ m₂ → ∀ n, s.prevn n ⟨utf8Len m₁⟩ = ⟨utf8Len (m₁.drop n)⟩ | _, h, e => by let ⟨l, m, r, h⟩ := h.validFor - simp [h.toString] at e; subst e; simp [h.prevn] + simp only [h.toString] at e; subst e; simp [h.prevn] theorem front : ∀ {s}, Valid s → s.toString.1 = c :: m → s.front = c | _, h => h.get (m₁ := []) diff --git a/Batteries/Data/Sum/Lemmas.lean b/Batteries/Data/Sum/Lemmas.lean index 9d55bd1919..ffc24dcd76 100644 --- a/Batteries/Data/Sum/Lemmas.lean +++ b/Batteries/Data/Sum/Lemmas.lean @@ -45,10 +45,10 @@ section get | 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] + 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] + 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 @@ -63,10 +63,10 @@ theorem eq_right_getRight_of_isRight : ∀ {x : α ⊕ β} (h : x.isRight), x = 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] + 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] + cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq, reduceCtorEq] @[simp] theorem bnot_isLeft (x : α ⊕ β) : !x.isLeft = x.isRight := by cases x <;> rfl diff --git a/Batteries/Data/Thunk.lean b/Batteries/Data/Thunk.lean deleted file mode 100644 index 88c92c3784..0000000000 --- a/Batteries/Data/Thunk.lean +++ /dev/null @@ -1,10 +0,0 @@ -/- -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, et al. --/ - -namespace Thunk - -@[ext] protected theorem ext : {a b : Thunk α} → a.get = b.get → a = b - | {..}, {..}, heq => congrArg _ <| funext fun _ => heq diff --git a/Batteries/Data/UInt.lean b/Batteries/Data/UInt.lean index 2c2b18bcad..c8916c2a28 100644 --- a/Batteries/Data/UInt.lean +++ b/Batteries/Data/UInt.lean @@ -10,8 +10,6 @@ import Batteries.Classes.Order @[ext] theorem UInt8.ext : {x y : UInt8} → x.toNat = y.toNat → x = y | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl -theorem UInt8.ext_iff {x y : UInt8} : x = y ↔ x.toNat = y.toNat := ⟨congrArg _, UInt8.ext⟩ - @[simp] theorem UInt8.val_val_eq_toNat (x : UInt8) : x.val.val = x.toNat := rfl @[simp] theorem UInt8.val_ofNat (n) : @@ -28,21 +26,13 @@ theorem UInt8.toNat_lt (x : UInt8) : x.toNat < 2 ^ 8 := x.val.isLt @[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := rfl -theorem UInt8.toNat_zero : (0 : UInt8).toNat = 0 := rfl - theorem UInt8.toNat_add (x y : UInt8) : (x + y).toNat = (x.toNat + y.toNat) % UInt8.size := rfl theorem UInt8.toNat_sub (x y : UInt8) : - (x - y).toNat = (x.toNat + (UInt8.size - y.toNat)) % UInt8.size := rfl + (x - y).toNat = (UInt8.size - y.toNat + x.toNat) % UInt8.size := rfl theorem UInt8.toNat_mul (x y : UInt8) : (x * y).toNat = (x.toNat * y.toNat) % UInt8.size := rfl -theorem UInt8.toNat_div (x y : UInt8) : (x / y).toNat = x.toNat / y.toNat := rfl - -theorem UInt8.toNat_mod (x y : UInt8) : (x % y).toNat = x.toNat % y.toNat := rfl - -theorem UInt8.toNat_modn (x : UInt8) (n) : (x.modn n).toNat = x.toNat % n := rfl - /-- Maximum `UInt8` value. -/ def UInt8.last : UInt8 := ⟨UInt8.size.pred, Nat.pred_lt (by decide)⟩ @@ -67,7 +57,7 @@ theorem UInt8.lt_iff_toNat_lt_toNat {x y : UInt8} : x < y ↔ x.toNat < y.toNat theorem UInt8.compare_eq_toNat_compare_toNat (x y : UInt8) : compare x y = compare x.toNat y.toNat := by - simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, ext_iff] + simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt8.ext_iff] theorem UInt8.max_def (x y : UInt8) : max x y = if x ≤ y then y else x := rfl @@ -98,8 +88,6 @@ theorem UInt8.toNat_min (x y : UInt8) : (min x y).toNat = min x.toNat y.toNat := @[ext] theorem UInt16.ext : {x y : UInt16} → x.toNat = y.toNat → x = y | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl -theorem UInt16.ext_iff {x y : UInt16} : x = y ↔ x.toNat = y.toNat := ⟨congrArg _, UInt16.ext⟩ - @[simp] theorem UInt16.val_val_eq_toNat (x : UInt16) : x.val.val = x.toNat := rfl @[simp] theorem UInt16.val_ofNat (n) : @@ -116,21 +104,13 @@ theorem UInt16.toNat_lt (x : UInt16) : x.toNat < 2 ^ 16 := x.val.isLt @[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := rfl -theorem UInt16.toNat_zero : (0 : UInt16).toNat = 0 := rfl - theorem UInt16.toNat_add (x y : UInt16) : (x + y).toNat = (x.toNat + y.toNat) % UInt16.size := rfl theorem UInt16.toNat_sub (x y : UInt16) : - (x - y).toNat = (x.toNat + (UInt16.size - y.toNat)) % UInt16.size := rfl + (x - y).toNat = (UInt16.size - y.toNat + x.toNat) % UInt16.size := rfl theorem UInt16.toNat_mul (x y : UInt16) : (x * y).toNat = (x.toNat * y.toNat) % UInt16.size := rfl -theorem UInt16.toNat_div (x y : UInt16) : (x / y).toNat = x.toNat / y.toNat := rfl - -theorem UInt16.toNat_mod (x y : UInt16) : (x % y).toNat = x.toNat % y.toNat := rfl - -theorem UInt16.toNat_modn (x : UInt16) (n) : (x.modn n).toNat = x.toNat % n := rfl - /-- Maximum `UInt16` value. -/ def UInt16.last : UInt16 := ⟨UInt16.size.pred, Nat.pred_lt (by decide)⟩ @@ -155,7 +135,7 @@ theorem UInt16.lt_iff_toNat_lt_toNat {x y : UInt16} : x < y ↔ x.toNat < y.toNa theorem UInt16.compare_eq_toNat_compare_toNat (x y : UInt16) : compare x y = compare x.toNat y.toNat := by - simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, ext_iff] + simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt16.ext_iff] theorem UInt16.max_def (x y : UInt16) : max x y = if x ≤ y then y else x := rfl @@ -186,8 +166,6 @@ theorem UInt16.toNat_min (x y : UInt16) : (min x y).toNat = min x.toNat y.toNat @[ext] theorem UInt32.ext : {x y : UInt32} → x.toNat = y.toNat → x = y | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl -theorem UInt32.ext_iff {x y : UInt32} : x = y ↔ x.toNat = y.toNat := ⟨congrArg _, UInt32.ext⟩ - @[simp] theorem UInt32.val_val_eq_toNat (x : UInt32) : x.val.val = x.toNat := rfl @[simp] theorem UInt32.val_ofNat (n) : @@ -204,21 +182,13 @@ theorem UInt32.toNat_lt (x : UInt32) : x.toNat < 2 ^ 32 := x.val.isLt @[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := rfl -theorem UInt32.toNat_zero : (0 : UInt32).toNat = 0 := rfl - theorem UInt32.toNat_add (x y : UInt32) : (x + y).toNat = (x.toNat + y.toNat) % UInt32.size := rfl theorem UInt32.toNat_sub (x y : UInt32) : - (x - y).toNat = (x.toNat + (UInt32.size - y.toNat)) % UInt32.size := rfl + (x - y).toNat = (UInt32.size - y.toNat + x.toNat) % UInt32.size := rfl theorem UInt32.toNat_mul (x y : UInt32) : (x * y).toNat = (x.toNat * y.toNat) % UInt32.size := rfl -theorem UInt32.toNat_div (x y : UInt32) : (x / y).toNat = x.toNat / y.toNat := rfl - -theorem UInt32.toNat_mod (x y : UInt32) : (x % y).toNat = x.toNat % y.toNat := rfl - -theorem UInt32.toNat_modn (x : UInt32) (n) : (x.modn n).toNat = x.toNat % n := rfl - /-- Maximum `UInt32` value. -/ def UInt32.last : UInt32 := ⟨UInt32.size.pred, Nat.pred_lt (by decide)⟩ @@ -243,7 +213,7 @@ theorem UInt32.lt_iff_toNat_lt_toNat {x y : UInt32} : x < y ↔ x.toNat < y.toNa theorem UInt32.compare_eq_toNat_compare_toNat (x y : UInt32) : compare x y = compare x.toNat y.toNat := by - simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, ext_iff] + simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt32.ext_iff] theorem UInt32.max_def (x y : UInt32) : max x y = if x ≤ y then y else x := rfl @@ -274,8 +244,6 @@ theorem UInt32.toNat_min (x y : UInt32) : (min x y).toNat = min x.toNat y.toNat @[ext] theorem UInt64.ext : {x y : UInt64} → x.toNat = y.toNat → x = y | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl -theorem UInt64.ext_iff {x y : UInt64} : x = y ↔ x.toNat = y.toNat := ⟨congrArg _, UInt64.ext⟩ - @[simp] theorem UInt64.val_val_eq_toNat (x : UInt64) : x.val.val = x.toNat := rfl @[simp] theorem UInt64.val_ofNat (n) : @@ -292,21 +260,13 @@ theorem UInt64.toNat_lt (x : UInt64) : x.toNat < 2 ^ 64 := x.val.isLt @[simp] theorem UInt64.toUInt32_toNat (x : UInt64) : x.toUInt32.toNat = x.toNat % 2 ^ 32 := rfl -theorem UInt64.toNat_zero : (0 : UInt64).toNat = 0 := rfl - theorem UInt64.toNat_add (x y : UInt64) : (x + y).toNat = (x.toNat + y.toNat) % UInt64.size := rfl theorem UInt64.toNat_sub (x y : UInt64) : - (x - y).toNat = (x.toNat + (UInt64.size - y.toNat)) % UInt64.size := rfl + (x - y).toNat = (UInt64.size - y.toNat + x.toNat) % UInt64.size := rfl theorem UInt64.toNat_mul (x y : UInt64) : (x * y).toNat = (x.toNat * y.toNat) % UInt64.size := rfl -theorem UInt64.toNat_div (x y : UInt64) : (x / y).toNat = x.toNat / y.toNat := rfl - -theorem UInt64.toNat_mod (x y : UInt64) : (x % y).toNat = x.toNat % y.toNat := rfl - -theorem UInt64.toNat_modn (x : UInt64) (n) : (x.modn n).toNat = x.toNat % n := rfl - /-- Maximum `UInt64` value. -/ def UInt64.last : UInt64 := ⟨UInt64.size.pred, Nat.pred_lt (by decide)⟩ @@ -332,7 +292,7 @@ theorem UInt64.lt_iff_toNat_lt_toNat {x y : UInt64} : x < y ↔ x.toNat < y.toNa theorem UInt64.compare_eq_toNat_compare_toNat (x y : UInt64) : compare x y = compare x.toNat y.toNat := by - simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, ext_iff] + simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt64.ext_iff] theorem UInt64.max_def (x y : UInt64) : max x y = if x ≤ y then y else x := rfl @@ -363,8 +323,6 @@ theorem UInt64.toNat_min (x y : UInt64) : (min x y).toNat = min x.toNat y.toNat @[ext] theorem USize.ext : {x y : USize} → x.toNat = y.toNat → x = y | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl -theorem USize.ext_iff {x y : USize} : x = y ↔ x.toNat = y.toNat := ⟨congrArg _, USize.ext⟩ - @[simp] theorem USize.val_val_eq_toNat (x : USize) : x.val.val = x.toNat := rfl @[simp] theorem USize.val_ofNat (n) : @@ -394,21 +352,13 @@ theorem USize.toNat_lt (x : USize) : x.toNat < USize.size := x.val.isLt @[simp] theorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := rfl -theorem USize.toNat_zero : (0 : USize).toNat = 0 := rfl - theorem USize.toNat_add (x y : USize) : (x + y).toNat = (x.toNat + y.toNat) % USize.size := rfl theorem USize.toNat_sub (x y : USize) : - (x - y).toNat = (x.toNat + (USize.size - y.toNat)) % USize.size := rfl + (x - y).toNat = (USize.size - y.toNat + x.toNat) % USize.size := rfl theorem USize.toNat_mul (x y : USize) : (x * y).toNat = (x.toNat * y.toNat) % USize.size := rfl -theorem USize.toNat_div (x y : USize) : (x / y).toNat = x.toNat / y.toNat := rfl - -theorem USize.toNat_mod (x y : USize) : (x % y).toNat = x.toNat % y.toNat := rfl - -theorem USize.toNat_modn (x : USize) (n) : (x.modn n).toNat = x.toNat % n := rfl - /-- Maximum `USize` value. -/ def USize.last : USize := ⟨USize.size.pred, Nat.pred_lt (by decide)⟩ @@ -433,7 +383,7 @@ theorem USize.lt_iff_toNat_lt_toNat {x y : USize} : x < y ↔ x.toNat < y.toNat theorem USize.compare_eq_toNat_compare_toNat (x y : USize) : compare x y = compare x.toNat y.toNat := by - simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, ext_iff] + simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, USize.ext_iff] theorem USize.max_def (x y : USize) : max x y = if x ≤ y then y else x := rfl diff --git a/Batteries/Data/UnionFind/Basic.lean b/Batteries/Data/UnionFind/Basic.lean index 24966452c2..549c9e1cde 100644 --- a/Batteries/Data/UnionFind/Basic.lean +++ b/Batteries/Data/UnionFind/Basic.lean @@ -3,8 +3,9 @@ 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.Data.Array.Lemmas import Batteries.Tactic.Lint.Misc +import Batteries.Tactic.SeqFocus +import Batteries.Data.Array.Lemmas namespace Batteries @@ -46,13 +47,17 @@ theorem lt_of_parentD : parentD arr i ≠ i → i < arr.size := theorem parentD_set {arr : Array UFNode} {x v i} : parentD (arr.set x v) i = if x.1 = i then v.parent else parentD arr i := by - rw [parentD]; simp [Array.get_eq_getElem, parentD] - split <;> [split <;> simp [Array.get_set, *]; split <;> [(subst i; cases ‹¬_› x.2); rfl]] + rw [parentD]; simp only [Array.size_set, Array.get_eq_getElem, parentD] + split + · split <;> simp_all + · split <;> [(subst i; cases ‹¬_› x.2); rfl] theorem rankD_set {arr : Array UFNode} {x v i} : rankD (arr.set x v) i = if x.1 = i then v.rank else rankD arr i := by - rw [rankD]; simp [Array.get_eq_getElem, rankD] - split <;> [split <;> simp [Array.get_set, *]; split <;> [(subst i; cases ‹¬_› x.2); rfl]] + rw [rankD]; simp only [Array.size_set, Array.get_eq_getElem, rankD] + split + · split <;> simp_all + · split <;> [(subst i; cases ‹¬_› x.2); rfl] end UnionFind @@ -146,7 +151,7 @@ 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 [rankMax, Array.foldr_eq_foldr_data] + 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) theorem rankD_lt_rankMax (self : UnionFind) (i : Nat) : @@ -156,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 [rankD, Array.get_eq_getElem, Array.get_push] + simp only [rankD, Array.size_push, Array.get_eq_getElem, Array.get_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 [parentD, Array.get_eq_getElem, Array.get_push] + simp only [parentD, Array.size_push, Array.get_eq_getElem, Array.get_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 ‹_›) @@ -169,9 +174,9 @@ theorem push_parentD (arr : Array UFNode) : parentD (arr.push ⟨arr.size, 0⟩) def push (self : UnionFind) : UnionFind where arr := self.arr.push ⟨self.arr.size, 0⟩ parentD_lt {i} := by - simp [push_parentD]; simp [parentD] + simp only [Array.size_push, push_parentD]; simp only [parentD, Array.get_eq_getElem] split <;> [exact fun _ => Nat.lt_succ_of_lt (self.parent'_lt _); exact id] - rankD_lt := by simp [push_parentD, push_rankD]; exact self.rank_lt + rankD_lt := by simp only [push_parentD, ne_eq, push_rankD]; exact self.rank_lt /-- Root of a union-find node. -/ def root (self : UnionFind) (x : Fin self.size) : Fin self.size := @@ -205,18 +210,23 @@ termination_by self.rankMax - self.rank x theorem parent_rootD (self : UnionFind) (x : Nat) : self.parent (self.rootD x) = self.rootD x := by - rw [rootD]; split <;> - [simp [parentD, parent_root, -Array.get_eq_getElem]; simp [parentD_of_not_lt, *]] + rw [rootD] + split + · simp [parentD, parent_root, -Array.get_eq_getElem] + · simp [parentD_of_not_lt, *] @[nolint unusedHavesSuffices] theorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = self.rootD x := by - simp [rootD, parent_lt]; split <;> simp [parentD, parentD_of_not_lt, *, -Array.get_eq_getElem] - (conv => rhs; rw [root]); split - · rw [root, dif_pos] <;> simp [*, -Array.get_eq_getElem] - · simp + simp only [rootD, Array.data_length, parent_lt] + split + · simp only [parentD, ↓reduceDIte, *] + (conv => rhs; rw [root]); split + · rw [root, dif_pos] <;> simp_all + · simp + · 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 [rootD]; split <;> simp [*] + simp only [rootD, Array.data_length]; split <;> simp [*] @[nolint unusedHavesSuffices] theorem rootD_eq_self {self : UnionFind} {x : Nat} : self.rootD x = x ↔ self.parent x = x := by @@ -273,7 +283,9 @@ termination_by self.rankMax - self.rank x @[nolint unusedHavesSuffices] theorem findAux_root {self : UnionFind} {x : Fin self.size} : (findAux self x).root = self.root x := by - rw [findAux, root]; simp; split <;> simp + rw [findAux, root] + simp only [Array.data_length, 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 termination_by self.rankMax - self.rank x @@ -286,22 +298,26 @@ 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 [findAux_root, rootD] + simp only [rootD, Array.get_eq_getElem, Array.data_length, findAux_root] apply dif_pos exact parent'_lt .. +set_option linter.deprecated false in theorem rankD_findAux {self : UnionFind} {x : Fin self.size} : rankD (findAux self x).s i = self.rank i := by if h : i < self.size then 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]), Array.get_modify (by rwa [FindAux.size_eq])] + rw [rankD_eq' (by simp [FindAux.size_eq, h])] + rw [Array.get_modify (by rwa [FindAux.size_eq])] split <;> simp [← rankD_eq, rankD_findAux (x := ⟨_, self.parent'_lt x⟩), -Array.get_eq_getElem] else - simp [rank, rankD]; rw [dif_neg (by rwa [FindAux.size_eq]), dif_neg h] + simp only [rankD, Array.data_length, Array.get_eq_getElem, rank] + rw [dif_neg (by rwa [FindAux.size_eq]), dif_neg h] termination_by self.rankMax - self.rank x +set_option linter.deprecated false in theorem parentD_findAux {self : UnionFind} {x : Fin self.size} : parentD (findAux self x).s i = if i = x then self.rootD x else parentD (self.findAux ⟨_, self.parent'_lt x⟩).s i := by @@ -311,7 +327,7 @@ theorem parentD_findAux {self : UnionFind} {x : Fin self.size} : · next h => rw [parentD]; split <;> rename_i h' · rw [Array.get_modify (by simpa using h')] - simp [@eq_comm _ i, -Array.get_eq_getElem] + simp only [Array.data_length, @eq_comm _ i] split <;> simp [← parentD_eq, -Array.get_eq_getElem] · rw [if_neg (mt (by rintro rfl; simp [FindAux.size_eq]) h')] rw [parentD, dif_neg]; simpa using h' @@ -330,9 +346,11 @@ theorem parentD_findAux_lt {self : UnionFind} {x : Fin self.size} (h : i < self. if h' : (self.arr.get x).parent = x then rw [findAux_s, if_pos h']; apply self.parentD_lt h else - rw [parentD_findAux]; split <;> [simp [rootD_lt]; skip] - have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) - apply parentD_findAux_lt h + rw [parentD_findAux] + split + · simp [rootD_lt] + · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) + apply parentD_findAux_lt h termination_by self.rankMax - self.rank x theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : @@ -341,10 +359,12 @@ theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : if h' : (self.arr.get x).parent = x then rw [findAux_s, if_pos h']; exact .inr rfl else - rw [parentD_findAux]; split <;> [simp [*]; skip] - 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] + rw [parentD_findAux] + split + · 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] termination_by self.rankMax - self.rank x theorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} : @@ -365,7 +385,9 @@ def find (self : UnionFind) (x : Fin self.size) : let r := self.findAux x { 1.arr := r.s 2.1.val := r.root - 1.parentD_lt := fun h => by simp [FindAux.size_eq] at *; exact parentD_findAux_lt h + 1.parentD_lt := fun h => by + simp only [Array.data_length, 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 2.2 := by simp [size, r.size_eq] } @@ -398,7 +420,8 @@ 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 [find, parent]; rw [parentD_findAux, if_pos rfl] + simp only [parent, Array.data_length, find] + rw [parentD_findAux, if_pos rfl] theorem find_parent_or (self : UnionFind) (x : Fin self.size) (i) : (self.find x).1.parent i = self.rootD i ∧ self.rootD i = self.rootD x ∨ @@ -449,7 +472,8 @@ theorem setParentBump_rankD_lt {arr : Array UFNode} {x y : Fin arr.size} simp [hP, hR, -Array.get_eq_getElem] at *; split <;> rename_i h₁ <;> [simp [← h₁]; skip] <;> split <;> rename_i h₂ <;> intro h · simp [h₂] at h - · simp [rankD_eq]; split <;> rename_i h₃ + · simp only [rankD_eq, Array.get_eq_getElem] + split <;> rename_i h₃ · rw [← h₃]; apply Nat.lt_succ_self · exact Nat.lt_of_le_of_ne H h₃ · cases h₂.1 @@ -469,13 +493,16 @@ theorem setParent_rankD_lt {arr : Array UFNode} {x y : Fin arr.size} (by simp [rankD_set, Nat.ne_of_lt h, rankD_eq, -Array.get_eq_getElem]) @[simp] theorem linkAux_size : (linkAux self x y).size = self.size := by - simp [linkAux]; split <;> [rfl; split] <;> [skip; split] <;> simp + simp only [linkAux, Array.get_eq_getElem] + split <;> [rfl; split] <;> [skip; split] <;> simp /-- Link a union-find node to a root node. -/ 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 at *; simp [linkAux]; split <;> [skip; split <;> [skip; split]] + simp only [Array.data_length, linkAux_size] at * + simp only [linkAux, Array.get_eq_getElem] + split <;> [skip; split <;> [skip; split]] · exact self.parentD_lt h · rw [parentD_set]; split <;> [exact x.2; exact self.parentD_lt h] · rw [parentD_set]; split @@ -484,12 +511,21 @@ def link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : · rw [parentD_set]; split <;> [exact y.2; exact self.parentD_lt h] rankD_lt := by rw [parent, parentD_eq] at yroot - simp [linkAux]; split <;> [skip; split <;> [skip; split]] + simp only [linkAux, Array.get_eq_getElem, ne_eq] + split <;> [skip; split <;> [skip; split]] · exact self.rankD_lt · exact setParent_rankD_lt ‹_› self.rankD_lt - · refine setParentBump_rankD_lt (.inr yroot) (Nat.le_of_eq ‹_›) self.rankD_lt - (by simp [parentD_set]; rintro rfl; simp [*, parentD_eq]) fun {i} => ?_ - simp [rankD_set]; split <;> simp [*]; rintro rfl; simp [rankD_eq, *] + · refine setParentBump_rankD_lt (.inr yroot) (Nat.le_of_eq ‹_›) self.rankD_lt (by + simp only [parentD_set, ite_eq_right_iff] + rintro rfl + simp [*, parentD_eq]) fun {i} => ?_ + 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, + and_true, ite_false, ite_eq_right_iff] + rintro rfl + simp [rankD_eq, *] · exact setParent_rankD_lt (Nat.lt_of_le_of_ne (Nat.not_lt.1 ‹_›) ‹_›) self.rankD_lt @[inherit_doc link] diff --git a/Batteries/Data/Vector.lean b/Batteries/Data/Vector.lean new file mode 100644 index 0000000000..f543f121ef --- /dev/null +++ b/Batteries/Data/Vector.lean @@ -0,0 +1,2 @@ +import Batteries.Data.Vector.Basic +import Batteries.Data.Vector.Lemmas diff --git a/Batteries/Data/Vector/Basic.lean b/Batteries/Data/Vector/Basic.lean new file mode 100644 index 0000000000..d8b11a5e75 --- /dev/null +++ b/Batteries/Data/Vector/Basic.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2024 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, François G. Dorais +-/ + +import Batteries.Data.Array +import Batteries.Data.List.Basic +import Batteries.Data.List.Lemmas +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. +-/ + +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 +deriving Repr, DecidableEq + +namespace Vector + +/-- Syntax for `Vector α n` -/ +syntax "#v[" withoutPosition(sepBy(term, ", ")) "]" : term + +open Lean in +macro_rules + | `(#v[ $elems,* ]) => `(Vector.mk (n := $(quote elems.getElems.size)) #[$elems,*] rfl) + +/-- 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 + +/-- 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 + +/-- `Vector.empty` produces an empty vector -/ +def empty : Vector α 0 := ⟨Array.empty, rfl⟩ + +/-- Make an empty vector with pre-allocated capacity-/ +def mkEmpty (capacity : Nat) : Vector α 0 := ⟨Array.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 ..⟩ + +/-- Returns a vector of size `1` with a single element `v` -/ +def singleton (v : α) : Vector α 1 := mkVector 1 v + +/-- +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 + +/-- 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) + +/-- `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⟩ + +/-- +`getD v i v₀` gets the `iᵗʰ` element of v if valid. +Otherwise it returns `v₀` by default +-/ +def getD (v : Vector α n) (i : Nat) (v₀ : α) : α := Array.getD v.toArray i v₀ + +/-- +`v.back! v` gets the last element of the vector. +panics if `v` is empty. +-/ +abbrev back! [Inhabited α] (v : Vector α n) : α := v[n - 1]! + +/-- +`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]? + +/-- `Vector.head` produces the head of a vector -/ +abbrev head (v : Vector α (n+1)) := v[0] + +/-- `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]⟩ + +/-- `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]⟩ + +/-- +Sets 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. +-/ +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]⟩ + +/-- +`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. + +This will perform the update destructively provided that a has a reference count of 1 when called. +-/ +def setN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : Vector α n := + v.set ⟨i, h⟩ x + +/-- +Sets an element in a vector, or do nothing if the index is out of bounds. + +This will perform the update destructively provided that a has a reference count of 1 when called. +-/ +def setD (v : Vector α n) (i : Nat) (x : α) : Vector α n := + ⟨v.toArray.setD i x, by simp [v.size_eq]⟩ + +/-- +Sets an element in an array, or panic if the index is out of bounds. + +This will perform the update destructively provided that a has a reference count of 1 when called. +-/ +def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n := + ⟨v.toArray.set! i x, by simp [v.size_eq]⟩ + +/-- Appends a vector to another. -/ +def append : Vector α n → Vector α m → Vector α (n + m) + | ⟨a₁, _⟩, ⟨a₂, _⟩ => ⟨a₁ ++ a₂, by simp [Array.size_append, *]⟩ + +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⟩ + +/-- +`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. +-/ +def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) := + ⟨Array.extract v.toArray start stop, by simp [v.size_eq]⟩ + +/-- Maps a vector under a function. -/ +def map (f : α → β) (v : Vector α n) : Vector β n := + ⟨v.toArray.map f, by simp [v.size_eq]⟩ + +/-- 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₂]⟩ + +/-- 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 ..⟩ + +/-- +Swaps two entries in a Vector. + +This will perform the update destructively provided that `v` has a reference count of 1 when called. +-/ +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]⟩ + +/-- +`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. + +This will perform the update destructively provided that `v` has a reference count of 1 when called. +-/ +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⟩ + +/-- +Swaps two entries in a `Vector α n`, or 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. +-/ +def swap! (v : Vector α n) (i j : Nat) : Vector α n := + ⟨Array.swap! v.toArray i j, by simp [v.size_eq]⟩ + +/-- +Swaps the entry with index `i : Fin n` in the vector for a new entry. +The old entry is returned with the modified vector. +-/ +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]⟩) + +/-- +Swaps the entry with index `i : Nat` in the vector for a new entry `x`. +The old entry is returned alongwith the modified vector. + +Automatically generates a proof of `i < n` with `get_elem_tactic` where feasible. +-/ +def swapAtN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : α × Vector α n := + swapAt v ⟨i, h⟩ x + +/-- +`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. +-/ +@[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" + +/-- `range n` returns the vector `#v[0,1,2,...,n-1]`. -/ +def range (n : Nat) : Vector Nat n := ⟨Array.range n, Array.size_range ..⟩ + +/-- +`shrink v m` shrinks the vector to the first `m` elements if `m < n`. +Returns `v` unchanged if `m ≥ n`. +-/ +def shrink (v : Vector α n) (m : Nat) : Vector α (min n m) := + ⟨v.toArray.shrink m, by simp [Array.size_shrink, v.size_eq]⟩ + +/-- +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) + +/-- +Takes the first (up to) `i` elements from a vector of length `n`. + +-/ +alias take := shrink + +/-- +`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`. +-/ +@[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 + +instance [BEq α] : BEq (Vector α n) := + ⟨fun a b => isEqv a b BEq.beq⟩ + +proof_wanted lawfulBEq [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]⟩ + +/-- `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]⟩ + +/-- `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`. +-/ +@[inline] def eraseIdx! (v : Vector α n) (i : Nat) : Vector α (n-1) := + if h : i < n then + feraseIdx v ⟨i,h⟩ + else + have : Inhabited (Vector α (n-1)) := ⟨v.tail⟩ + panic! s!"Index {i} is 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. + +This function takes worst case O(n) time because it has to backshift all elements at positions +greater than i. +-/ +abbrev eraseIdxN (v : Vector α n) (i : Nat) (h : i < n := by get_elem_tactic) : Vector α (n - 1) := + v.feraseIdx ⟨i, h⟩ + +/-- +If `x` is an element of vector `v` at index `j`, then `indexOf? v x` returns `some j`. +Otherwise it returns `none`. +-/ +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) + | 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 + +/-- `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 diff --git a/Batteries/Data/Vector/Lemmas.lean b/Batteries/Data/Vector/Lemmas.lean new file mode 100644 index 0000000000..572ec9a79d --- /dev/null +++ b/Batteries/Data/Vector/Lemmas.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2024 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Francois Dorais +-/ + +import Batteries.Data.Vector.Basic +import Batteries.Data.List.Basic +import Batteries.Data.List.Lemmas +import Batteries.Data.Array.Lemmas +import Batteries.Tactic.Lint.Simp + +/-! +## Vectors +Lemmas about `Vector α n` +-/ + +namespace Batteries + +namespace Vector + + +/-- An `empty` vector maps to a `empty` vector. -/ +@[simp] +theorem map_empty (f : α → β) : map f empty = empty := by + rw [map, empty, mk.injEq] + exact Array.map_empty f + +theorem toArray_injective : ∀ {v w : Vector α n}, v.toArray = w.toArray → v = w + | {..}, {..}, rfl => rfl + +/-- A vector of length `0` is an `empty` vector. -/ +protected theorem eq_empty (v : Vector α 0) : v = empty := by + apply Vector.toArray_injective + apply Array.eq_empty_of_size_eq_zero v.2 + +/-- +`Vector.ext` is an extensionality theorem. +Vectors `a` and `b` are equal to each other if their elements are equal for each valid index. +-/ +@[ext] +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] + · intro i hi _ + rw [a.size_eq] 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 + +@[simp] theorem pop_mk {data : Array α} {size : data.size = n} : + (Vector.mk data size).pop = Vector.mk data.pop (by simp [size]) := rfl + +@[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by + rcases v with ⟨data, rfl⟩ + simp + +-- The `simpNF` linter incorrectly claims that this lemma can not be applied by `simp`. +@[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] theorem getElem_pop {v : Vector α n} {i : Nat} (h : i < n - 1) : (v.pop)[i] = v[i] := by + rcases v with ⟨data, rfl⟩ + simp diff --git a/Batteries/Lean/AttributeExtra.lean b/Batteries/Lean/AttributeExtra.lean index 7b8c92af3f..99eb7da612 100644 --- a/Batteries/Lean/AttributeExtra.lean +++ b/Batteries/Lean/AttributeExtra.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Batteries.Lean.TagAttribute +import Std.Data.HashMap.Basic + open Lean namespace Lean +open Std + /-- `TagAttributeExtra` works around a limitation of `TagAttribute`, which is that definitions must be tagged in the same file that declares the definition. @@ -73,7 +77,7 @@ structure ParametricAttributeExtra (α : Type) where /-- The underlying `ParametricAttribute`. -/ attr : ParametricAttribute α /-- A list of pre-tagged declarations with their values. -/ - base : HashMap Name α + base : Std.HashMap Name α deriving Inhabited /-- @@ -81,7 +85,7 @@ Registers a new parametric attribute. The `extra` field is a list of definitions which will be "pre-tagged" and are not subject to the usual restriction on tagging in the same file as the declaration. -/ -def registerParametricAttributeExtra [Inhabited α] (impl : ParametricAttributeImpl α) +def registerParametricAttributeExtra (impl : ParametricAttributeImpl α) (extra : List (Name × α)) : IO (ParametricAttributeExtra α) := do let attr ← registerParametricAttribute impl pure { attr, base := extra.foldl (fun s (a, b) => s.insert a b) {} } @@ -94,7 +98,7 @@ or `none` if `decl` is not tagged. -/ def getParam? [Inhabited α] (attr : ParametricAttributeExtra α) (env : Environment) (decl : Name) : Option α := - attr.attr.getParam? env decl <|> attr.base.find? decl + attr.attr.getParam? env decl <|> attr.base[decl]? /-- Applies attribute `attr` to declaration `decl`, given a value for the parameter. -/ def setParam (attr : ParametricAttributeExtra α) diff --git a/Batteries/Lean/Delaborator.lean b/Batteries/Lean/Delaborator.lean index d722eef9d8..e09f2198de 100644 --- a/Batteries/Lean/Delaborator.lean +++ b/Batteries/Lean/Delaborator.lean @@ -8,6 +8,6 @@ import Lean.PrettyPrinter open Lean PrettyPrinter Delaborator SubExpr /-- Abbreviation for `Lean.MessageData.ofConst`. -/ -@[deprecated 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/HashMap.lean b/Batteries/Lean/HashMap.lean index a8e963cf94..0cb3b0f87d 100644 --- a/Batteries/Lean/HashMap.lean +++ b/Batteries/Lean/HashMap.lean @@ -4,22 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Lean.Data.HashMap - -namespace Lean.HashMap +import Std.Data.HashMap.Basic +namespace Std.HashMap variable [BEq α] [Hashable α] -instance : ForIn m (HashMap α β) (α × β) where - forIn m init f := do - let mut acc := init - for buckets in m.val.buckets.val do - for d in buckets do - match ← f d acc with - | .done b => return b - | .yield b => acc := b - return acc - /-- `O(|other|)` amortized. Merge two `HashMap`s. The values of keys which appear in both maps are combined using the monadic function `f`. @@ -28,7 +17,7 @@ The values of keys which appear in both maps are combined using the monadic func def mergeWithM {m α β} [BEq α] [Hashable α] [Monad m] (f : α → β → β → m β) (self other : HashMap α β) : m (HashMap α β) := other.foldM (init := self) fun map k v₂ => - match map.find? k with + match map[k]? with | none => return map.insert k v₂ | some v₁ => return map.insert k (← f k v₁ v₂) @@ -41,6 +30,6 @@ def mergeWith (f : α → β → β → β) (self other : HashMap α β) : HashM -- Implementing this function directly, rather than via `mergeWithM`, gives -- us less constrained universes. other.fold (init := self) fun map k v₂ => - match map.find? k with + match map[k]? with | none => map.insert k v₂ | some v₁ => map.insert k <| f k v₁ v₂ diff --git a/Batteries/Lean/HashSet.lean b/Batteries/Lean/HashSet.lean index 0dedb7cd4f..4b6df398b3 100644 --- a/Batteries/Lean/HashSet.lean +++ b/Batteries/Lean/HashSet.lean @@ -4,9 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Lean.Data.HashSet +import Std.Data.HashSet -namespace Lean.HashSet +namespace Std.HashSet variable [BEq α] [Hashable α] @@ -54,7 +54,7 @@ instance : BEq (HashSet α) where `O(1)` amortized. Similar to `insert`, but also returns a Boolean flag indicating whether an existing entry has been replaced with `a => b`. -/ -@[inline] +@[inline, deprecated containsThenInsert (since := "2024-09-17")] def insert' (s : HashSet α) (a : α) : HashSet α × Bool := let oldSize := s.size let s := s.insert a @@ -66,10 +66,3 @@ def insert' (s : HashSet α) (a : α) : HashSet α × Bool := @[inline] protected def ofArray [BEq α] [Hashable α] (as : Array α) : HashSet α := HashSet.empty.insertMany as - -/-- -`O(n)`. Obtain a `HashSet` from a list. --/ -@[inline] -protected def ofList [BEq α] [Hashable α] (as : List α) : HashSet α := - HashSet.empty.insertMany as diff --git a/Batteries/Lean/Meta/AssertHypotheses.lean b/Batteries/Lean/Meta/AssertHypotheses.lean index a0905c6718..6275032063 100644 --- a/Batteries/Lean/Meta/AssertHypotheses.lean +++ b/Batteries/Lean/Meta/AssertHypotheses.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Batteries.Lean.Meta.Basic +import Lean.Meta.Tactic.Assert open Lean Lean.Meta diff --git a/Batteries/Lean/Meta/Basic.lean b/Batteries/Lean/Meta/Basic.lean index 3e72809893..d2c55af7ea 100644 --- a/Batteries/Lean/Meta/Basic.lean +++ b/Batteries/Lean/Meta/Basic.lean @@ -3,9 +3,7 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Jannis Limperg -/ -import Lean.Elab.Term -import Lean.Meta.Tactic.Apply -import Lean.Meta.Tactic.Replace +import Lean.Meta.Tactic.Intro open Lean Lean.Meta diff --git a/Batteries/Lean/Meta/Clear.lean b/Batteries/Lean/Meta/Clear.lean index 47caaaa4d3..66f38b7798 100644 --- a/Batteries/Lean/Meta/Clear.lean +++ b/Batteries/Lean/Meta/Clear.lean @@ -5,6 +5,7 @@ Authors: Jannis Limperg -/ import Batteries.Lean.Meta.Basic +import Lean.Meta.Tactic.Clear open Lean Lean.Meta diff --git a/Batteries/Lean/Meta/Inaccessible.lean b/Batteries/Lean/Meta/Inaccessible.lean index e308364616..55f203b252 100644 --- a/Batteries/Lean/Meta/Inaccessible.lean +++ b/Batteries/Lean/Meta/Inaccessible.lean @@ -3,9 +3,9 @@ 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.InferType +import Lean.Meta.Basic -open Lean Lean.Meta +open Lean Lean.Meta Std /-- Obtain the inaccessible fvars from the given local context. An fvar is @@ -15,7 +15,7 @@ later fvar with the same user name. def Lean.LocalContext.inaccessibleFVars (lctx : LocalContext) : Array LocalDecl := let (result, _) := - lctx.foldr (β := Array LocalDecl × HashSet Name) + lctx.foldr (β := Array LocalDecl × Std.HashSet Name) (init := (Array.mkEmpty lctx.numIndices, {})) fun ldecl (result, seen) => if ldecl.isImplementationDetail then diff --git a/Batteries/Lean/Name.lean b/Batteries/Lean/Name.lean deleted file mode 100644 index b5530e49d1..0000000000 --- a/Batteries/Lean/Name.lean +++ /dev/null @@ -1,28 +0,0 @@ -/- -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.Data.Name - -namespace Lean.Name - -/-- -Returns true if this a part of name that is internal or dynamically -generated so that it may easily be changed. - -Generally, user code should not explicitly use internal names. --/ -def isInternalDetail : Name → Bool - | .str p s => - s.startsWith "_" - || matchPrefix s "eq_" - || matchPrefix s "match_" - || matchPrefix s "proof_" - || p.isInternalOrNum - | .num _ _ => true - | p => p.isInternalOrNum -where - /-- Check that a string begins with the given prefix, and then is only digit characters. -/ - matchPrefix (s : String) (pre : String) := - s.startsWith pre && (s |>.drop pre.length |>.all Char.isDigit) diff --git a/Batteries/Lean/PersistentHashMap.lean b/Batteries/Lean/PersistentHashMap.lean index 5054e15758..b297f2fa52 100644 --- a/Batteries/Lean/PersistentHashMap.lean +++ b/Batteries/Lean/PersistentHashMap.lean @@ -10,15 +10,6 @@ namespace Lean.PersistentHashMap variable [BEq α] [Hashable α] -/-- -Similar to `insert`, but also returns a Boolean flag indicating whether an -existing entry has been replaced with `a => b`. --/ -def insert' (m : PersistentHashMap α β) (a : α) (b : β) : PersistentHashMap α β × Bool := - let oldSize := m.size - let m := m.insert a b - (m, m.size == oldSize) - /-- Builds a `PersistentHashMap` from a list of key-value pairs. Values of duplicated keys are replaced by their respective last occurrences. diff --git a/Batteries/Lean/PersistentHashSet.lean b/Batteries/Lean/PersistentHashSet.lean index 51e33e8487..0a8231d723 100644 --- a/Batteries/Lean/PersistentHashSet.lean +++ b/Batteries/Lean/PersistentHashSet.lean @@ -56,16 +56,6 @@ def all (s : PersistentHashSet α) (f : α → Bool) : Bool := instance : BEq (PersistentHashSet α) where beq s t := s.all (t.contains ·) && t.all (s.contains ·) -/-- -Similar to `insert`, but also returns a Boolean flag indicating whether an -existing entry has been replaced with `a => b`. --/ -@[inline] -def insert' (s : PersistentHashSet α) (a : α) : PersistentHashSet α × Bool := - let oldSize := s.size - let s := s.insert a - (s, s.size == oldSize) - /-- Insert all elements from a collection into a `PersistentHashSet`. -/ diff --git a/Batteries/Lean/Position.lean b/Batteries/Lean/Position.lean index f2bc155886..49fdad203e 100644 --- a/Batteries/Lean/Position.lean +++ b/Batteries/Lean/Position.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Syntax -import Lean.Meta.Tactic.TryThis import Lean.Data.Lsp.Utf16 /-- Gets the LSP range of syntax `stx`. -/ diff --git a/Batteries/Lean/SMap.lean b/Batteries/Lean/SMap.lean deleted file mode 100644 index 44a660e2e0..0000000000 --- a/Batteries/Lean/SMap.lean +++ /dev/null @@ -1,17 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.Data.SMap - -/-! -# Extra functions on Lean.SMap --/ - -set_option autoImplicit true - -/-- Monadic fold over a staged map. -/ -def Lean.SMap.foldM {m : Type w → Type w} [Monad m] [BEq α] [Hashable α] - (f : σ → α → β → m σ) (init : σ) (map : SMap α β) : m σ := do - map.map₂.foldlM f (← map.map₁.foldM f init) diff --git a/Batteries/Lean/System/IO.lean b/Batteries/Lean/System/IO.lean index c4d6b6ce84..40dcda5365 100644 --- a/Batteries/Lean/System/IO.lean +++ b/Batteries/Lean/System/IO.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Batteries.Data.List.Lemmas /-! # Functions for manipulating a list of tasks diff --git a/Batteries/Lean/Util/EnvSearch.lean b/Batteries/Lean/Util/EnvSearch.lean index 9143c89511..d9419b8cbf 100644 --- a/Batteries/Lean/Util/EnvSearch.lean +++ b/Batteries/Lean/Util/EnvSearch.lean @@ -24,8 +24,7 @@ where /-- Check constant should be returned -/ @[nolint unusedArguments] check matches_ (_name : Name) cinfo := do - let include ← p cinfo - if include then + if ← p cinfo then pure $ matches_.push cinfo else pure matches_ diff --git a/Batteries/Lean/Util/Path.lean b/Batteries/Lean/Util/Path.lean deleted file mode 100644 index d9488c0dc8..0000000000 --- a/Batteries/Lean/Util/Path.lean +++ /dev/null @@ -1,34 +0,0 @@ -/- -Copyright (c) 2022 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.Term - -/-! -# `compile_time_search_path%` term elaborator. - -Use this as `searchPathRef.set compile_time_search_path%`. --/ - -open Lean System - --- Ideally this instance would be constructed simply by `deriving instance ToExpr for FilePath` --- but for now we have decided not to upstream the `ToExpr` derive handler from `Mathlib`. --- https://leanprover.zulipchat.com/#narrow/stream/348111-std4/topic/ToExpr.20derive.20handler/near/386476438 -instance : ToExpr FilePath where - toTypeExpr := mkConst ``FilePath - toExpr path := mkApp (mkConst ``FilePath.mk) (toExpr path.1) - -/-- -Term elaborator that retrieves the current `SearchPath`. - -Typical usage is `searchPathRef.set compile_time_search_path%`. - -This must not be used in files that are potentially compiled on another machine and then -imported. -(That is, if used in an imported file it will embed the search path from whichever machine -compiled the `.olean`.) --/ -elab "compile_time_search_path%" : term => - return toExpr (← searchPathRef.get) diff --git a/Batteries/Linter/UnnecessarySeqFocus.lean b/Batteries/Linter/UnnecessarySeqFocus.lean index 3ebe54dcb4..dca3aac1d7 100644 --- a/Batteries/Linter/UnnecessarySeqFocus.lean +++ b/Batteries/Linter/UnnecessarySeqFocus.lean @@ -7,8 +7,8 @@ import Lean.Elab.Command import Lean.Linter.Util import Batteries.Lean.AttributeExtra -namespace Std.Linter -open Lean Elab Command Linter +namespace Batteries.Linter +open Lean Elab Command Linter Std /-- Enables the 'unnecessary `<;>`' linter. This will warn whenever the `<;>` tactic combinator @@ -83,7 +83,7 @@ structure Entry where used : Bool /-- The monad for collecting used tactic syntaxes. -/ -abbrev M (ω) := StateRefT (HashMap String.Range Entry) (ST ω) +abbrev M (ω) := StateRefT (Std.HashMap String.Range Entry) (ST ω) /-- True if this is a `<;>` node in either `tactic` or `conv` classes. -/ @[inline] def isSeqFocus (k : SyntaxNodeKind) : Bool := @@ -120,7 +120,7 @@ partial def markUsedTactics : InfoTree → M ω Unit | .node i c => do if let .ofTacticInfo i := i then if let some r := i.stx.getRange? true then - if let some entry := (← get).find? r then + if let some entry := (← get)[r]? then if i.stx.getKind == ``Parser.Tactic.«tactic_<;>_» then let isBad := do unless i.goalsBefore.length == 1 || !multigoalAttr.hasTag env i.stx[0].getKind do @@ -147,7 +147,7 @@ partial def markUsedTactics : InfoTree → M ω Unit end -/-- The main entry point to the unused tactic linter. -/ +@[inherit_doc Batteries.Linter.linter.unnecessarySeqFocus] def unnecessarySeqFocusLinter : Linter where run := withSetOptionIn fun stx => do unless getLinterUnnecessarySeqFocus (← getOptions) && (← getInfoState).enabled do return diff --git a/Batteries/Linter/UnreachableTactic.lean b/Batteries/Linter/UnreachableTactic.lean index c4ea4dd10c..1e55702674 100644 --- a/Batteries/Linter/UnreachableTactic.lean +++ b/Batteries/Linter/UnreachableTactic.lean @@ -7,8 +7,8 @@ import Lean.Elab.Command import Lean.Linter.Util import Batteries.Tactic.Unreachable -namespace Std.Linter -open Lean Elab Command Linter +namespace Batteries.Linter +open Lean Elab Command Linter Std /-- Enables the 'unreachable tactic' linter. This will warn on any tactics that are never executed. @@ -29,14 +29,14 @@ namespace UnreachableTactic def getLinterUnreachableTactic (o : Options) : Bool := getLinterValue linter.unreachableTactic o /-- The monad for collecting used tactic syntaxes. -/ -abbrev M := StateRefT (HashMap String.Range Syntax) IO +abbrev M := StateRefT (Std.HashMap String.Range Syntax) IO /-- A list of blacklisted syntax kinds, which are expected to have subterms that contain unevaluated tactics. -/ initialize ignoreTacticKindsRef : IO.Ref NameHashSet ← - IO.mkRef <| HashSet.empty + IO.mkRef <| Std.HashSet.empty |>.insert ``Parser.Term.binderTactic |>.insert ``Lean.Parser.Term.dynamicQuot |>.insert ``Lean.Parser.Tactic.quotSeq @@ -86,7 +86,7 @@ partial def eraseUsedTactics : InfoTree → M Unit end -/-- The main entry point to the unreachable tactic linter. -/ +@[inherit_doc Batteries.Linter.linter.unreachableTactic] def unreachableTacticLinter : Linter where run := withSetOptionIn fun stx => do unless getLinterUnreachableTactic (← getOptions) && (← getInfoState).enabled do return diff --git a/Batteries/Logic.lean b/Batteries/Logic.lean index 10b5bd2fcb..03c82eb5ac 100644 --- a/Batteries/Logic.lean +++ b/Batteries/Logic.lean @@ -3,23 +3,17 @@ Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro -/ -import Batteries.Tactic.Init import Batteries.Tactic.Alias -import Batteries.Tactic.Lint.Misc instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) -@[deprecated] alias proofIrrel := proof_irrel +@[deprecated (since := "2024-03-15")] alias proofIrrel := proof_irrel /-! ## id -/ theorem Function.id_def : @id α = fun x => x := rfl -/-! ## exists and forall -/ - -alias ⟨forall_not_of_not_exists, not_exists_of_forall_not⟩ := not_exists - /-! ## decidable -/ protected alias ⟨Decidable.exists_not_of_not_forall, _⟩ := Decidable.not_forall @@ -60,8 +54,7 @@ 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 _ -theorem Function.funext_iff {β : α → Sort u} {f₁ f₂ : ∀ x : α, β x} : f₁ = f₂ ↔ ∀ a, f₁ a = f₂ a := - ⟨congrFun, funext⟩ +protected alias Function.funext_iff := funext_iff theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} : f x ≠ f y → x ≠ y := mt <| congrArg _ @@ -128,9 +121,7 @@ end Mem -- instance (priority := 10) {α} [Subsingleton α] : DecidableEq α -- | a, b => isTrue (Subsingleton.elim a b) --- @[simp] -- TODO(Mario): profile -theorem eq_iff_true_of_subsingleton [Subsingleton α] (x y : α) : x = y ↔ True := - iff_true_intro (Subsingleton.elim ..) +-- TODO(Mario): profile adding `@[simp]` to `eq_iff_true_of_subsingleton` /-- If all points are equal to a given point `x`, then `α` is a subsingleton. -/ theorem subsingleton_of_forall_eq (x : α) (h : ∀ y, y = x) : Subsingleton α := diff --git a/Batteries/StdDeprecations.lean b/Batteries/StdDeprecations.lean index 49357a0573..cb49a3bdbf 100644 --- a/Batteries/StdDeprecations.lean +++ b/Batteries/StdDeprecations.lean @@ -4,12 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kim Morrison -/ import Batteries.Tactic.Alias -import Batteries.Data.HashMap import Batteries.Data.DList import Batteries.Data.PairingHeap -import Batteries.Data.RBMap -import Batteries.Data.BinomialHeap -import Batteries.Data.UnionFind +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. @@ -21,35 +21,35 @@ 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] alias Std.AssocList := Batteries.AssocList -@[deprecated] alias Std.HashMap := Batteries.HashMap -@[deprecated] alias Std.mkHashMap := Batteries.mkHashMap -@[deprecated] alias Std.DList := Batteries.DList -@[deprecated] alias Std.PairingHeapImp.Heap := Batteries.PairingHeapImp.Heap -@[deprecated] alias Std.TotalBLE := Batteries.TotalBLE -@[deprecated] alias Std.OrientedCmp := Batteries.OrientedCmp -@[deprecated] alias Std.TransCmp := Batteries.TransCmp -@[deprecated] alias Std.BEqCmp := Batteries.BEqCmp -@[deprecated] alias Std.LTCmp := Batteries.LTCmp -@[deprecated] alias Std.LECmp := Batteries.LECmp -@[deprecated] alias Std.LawfulCmp := Batteries.LawfulCmp -@[deprecated] alias Std.OrientedOrd := Batteries.OrientedOrd -@[deprecated] alias Std.TransOrd := Batteries.TransOrd -@[deprecated] alias Std.BEqOrd := Batteries.BEqOrd -@[deprecated] alias Std.LTOrd := Batteries.LTOrd -@[deprecated] alias Std.LEOrd := Batteries.LEOrd -@[deprecated] alias Std.LawfulOrd := Batteries.LawfulOrd -@[deprecated] alias Std.compareOfLessAndEq_eq_lt := Batteries.compareOfLessAndEq_eq_lt -@[deprecated] alias Std.RBColor := Batteries.RBColor -@[deprecated] alias Std.RBNode := Batteries.RBNode -@[deprecated] alias Std.RBSet := Batteries.RBSet -@[deprecated] alias Std.mkRBSet := Batteries.mkRBSet -@[deprecated] alias Std.RBMap := Batteries.RBMap -@[deprecated] alias Std.mkRBMap := Batteries.mkRBMap -@[deprecated] alias Std.BinomialHeap := Batteries.BinomialHeap -@[deprecated] alias Std.mkBinomialHeap := Batteries.mkBinomialHeap -@[deprecated] alias Std.UFNode := Batteries.UFNode -@[deprecated] alias Std.UnionFind := Batteries.UnionFind +@[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. diff --git a/Batteries/Tactic/Alias.lean b/Batteries/Tactic/Alias.lean index b7eaeaf713..471dfd883a 100644 --- a/Batteries/Tactic/Alias.lean +++ b/Batteries/Tactic/Alias.lean @@ -6,6 +6,7 @@ Authors: Mario Carneiro, David Renshaw, François G. Dorais import Lean.Elab.Command import Lean.Elab.DeclarationRange import Lean.Compiler.NoncomputableAttr +import Lean.DocString import Batteries.CodeAction.Deprecated /-! @@ -18,7 +19,7 @@ an iff theorem. namespace Batteries.Tactic.Alias -open Lean Elab Parser.Command Std +open Lean Elab Parser.Command /-- An alias can be in one of three forms -/ inductive AliasInfo where diff --git a/Batteries/Tactic/Case.lean b/Batteries/Tactic/Case.lean index 60bd585244..375d351b05 100644 --- a/Batteries/Tactic/Case.lean +++ b/Batteries/Tactic/Case.lean @@ -3,7 +3,7 @@ Copyright (c) 2023 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ -import Lean.Elab.Tactic.Conv.Pattern +import Lean.Elab.Tactic.BuiltinTactic /-! # Extensions to the `case` tactic diff --git a/Batteries/Tactic/Classical.lean b/Batteries/Tactic/Classical.lean index 7d3e6eb3c0..a3bc78b0a4 100644 --- a/Batteries/Tactic/Classical.lean +++ b/Batteries/Tactic/Classical.lean @@ -3,7 +3,7 @@ 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.ElabRules +import Lean.Elab.Tactic.Basic /-! # `classical` tactic -/ diff --git a/Batteries/Tactic/Init.lean b/Batteries/Tactic/Init.lean index fed3c1ad99..db7894f633 100644 --- a/Batteries/Tactic/Init.lean +++ b/Batteries/Tactic/Init.lean @@ -3,16 +3,14 @@ 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.Lean.Meta.Basic -import Lean.Elab.Command -import Lean.Elab.Tactic.BuiltinTactic +import Lean.Elab.Tactic.ElabTerm /-! # Simple tactics that are used throughout Batteries. -/ namespace Batteries.Tactic -open Lean Parser.Tactic Elab Command Elab.Tactic Meta +open Lean Parser.Tactic Elab Elab.Tactic Meta /-- `_` in tactic position acts like the `done` tactic: it fails and gives the list diff --git a/Batteries/Tactic/Lemma.lean b/Batteries/Tactic/Lemma.lean new file mode 100644 index 0000000000..10fdec7a0e --- /dev/null +++ b/Batteries/Tactic/Lemma.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2024 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin, Damiano Testa +-/ +import Lean.Meta.Tactic.TryThis + +/-! +# Control for `lemma` command + +The `lemma` command exists in `Mathlib`, but not in `Std`. + +This file enforces the convention by introducing a code-action +to replace `lemma` by `theorem`. +-/ + +namespace Batteries.Tactic.Lemma + +open Lean Elab.Command Meta.Tactic + +/-- Enables the use of `lemma` as a synonym for `theorem` -/ +register_option lang.lemmaCmd : Bool := { + defValue := false + descr := "enable the use of the `lemma` command as a synonym for `theorem`" +} + +/-- Check whether `lang.lemmaCmd` option is enabled -/ +def checkLangLemmaCmd (o : Options) : Bool := o.get `lang.lemmaCmd lang.lemmaCmd.defValue + +/-- `lemma` is not supported, please use `theorem` instead -/ +syntax (name := lemmaCmd) declModifiers + group("lemma " declId ppIndent(declSig) declVal) : command + +/-- Elaborator for the `lemma` command, if the option `lang.lemmaCmd` is false the command +emits a warning and code action instructing the user to use `theorem` instead.-/ +@[command_elab «lemmaCmd»] def elabLemma : CommandElab := fun stx => do + unless checkLangLemmaCmd (← getOptions) do + let lemmaStx := stx[1][0] + Elab.Command.liftTermElabM <| + TryThis.addSuggestion lemmaStx { suggestion := "theorem" } + logErrorAt lemmaStx + "`lemma` is not supported by default, please use `theorem` instead.\n\ + Use `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file.\n\ + Use the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally." + let out ← Elab.liftMacroM <| do + let stx := stx.modifyArg 1 fun stx => + let stx := stx.modifyArg 0 (mkAtomFrom · "theorem" (canonical := true)) + stx.setKind ``Parser.Command.theorem + pure <| stx.setKind ``Parser.Command.declaration + Elab.Command.elabCommand out diff --git a/Batteries/Tactic/Lint/Basic.lean b/Batteries/Tactic/Lint/Basic.lean index 87cc925a06..a0fceb7fa2 100644 --- a/Batteries/Tactic/Lint/Basic.lean +++ b/Batteries/Tactic/Lint/Basic.lean @@ -9,7 +9,7 @@ import Lean.Elab.Exception open Lean Meta -namespace Std.Tactic.Lint +namespace Batteries.Tactic.Lint /-! # Basic linter types and attributes @@ -42,6 +42,8 @@ def isAutoDecl (decl : Name) : CoreM Bool := do if env.isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then return true if let ConstantInfo.inductInfo _ := (← getEnv).find? n then + if s.startsWith "brecOn_" || s.startsWith "below_" || s.startsWith "binductionOn_" + || s.startsWith "ibelow_" then return true if [casesOnSuffix, recOnSuffix, brecOnSuffix, binductionOnSuffix, belowSuffix, "ibelow", "ndrec", "ndrecOn", "noConfusionType", "noConfusion", "ofNat", "toCtorIdx" ].any (· == s) then diff --git a/Batteries/Tactic/Lint/Frontend.lean b/Batteries/Tactic/Lint/Frontend.lean index 072e23743f..cb0369db5f 100644 --- a/Batteries/Tactic/Lint/Frontend.lean +++ b/Batteries/Tactic/Lint/Frontend.lean @@ -39,7 +39,7 @@ You can append `only name1 name2 ...` to any command to run a subset of linters, You can add custom linters by defining a term of type `Linter` with the `@[env_linter]` attribute. -A linter defined with the name `Std.Tactic.Lint.myNewCheck` can be run with `#lint myNewCheck` +A linter defined with the name `Batteries.Tactic.Lint.myNewCheck` can be run with `#lint myNewCheck` or `#lint only myNewCheck`. If you add the attribute `@[env_linter disabled]` to `linter.myNewCheck` it will be registered, but not run by default. @@ -52,8 +52,8 @@ omits it from only the specified linter checks. sanity check, lint, cleanup, command, tactic -/ -namespace Std.Tactic.Lint -open Lean Std +namespace Batteries.Tactic.Lint +open Lean /-- Verbosity for the linter output. -/ inductive LintVerbosity @@ -65,20 +65,28 @@ inductive LintVerbosity | high deriving Inhabited, DecidableEq, Repr -/-- `getChecks slow extra use_only` produces a list of linters. -`extras` is a list of names that should resolve to declarations with type `linter`. -If `useOnly` is true, it only uses the linters in `extra`. -Otherwise, it uses all linters in the environment tagged with `@[env_linter]`. +/-- `getChecks slow runOnly runAlways` produces a list of linters. +`runOnly` is an optional list of names that should resolve to declarations with type `NamedLinter`. +If populated, only these linters are run (regardless of the default configuration). +`runAlways` is an optional list of names that should resolve to declarations with type +`NamedLinter`. If populated, these linters are always run (regardless of their configuration). +Specifying a linter in `runAlways` but not `runOnly` is an error. +Otherwise, it uses all enabled linters in the environment tagged with `@[env_linter]`. If `slow` is false, it only uses the fast default tests. -/ -def getChecks (slow : Bool) (useOnly : Bool) : CoreM (Array NamedLinter) := do +def getChecks (slow : Bool) (runOnly : Option (List Name)) (runAlways : Option (List Name)) : + CoreM (Array NamedLinter) := do let mut result := #[] - unless useOnly do - for (name, declName, dflt) in batteriesLinterExt.getState (← getEnv) do - if dflt then - let linter ← getLinter name declName - if slow || linter.isFast then - let _ := Inhabited.mk linter - result := result.binInsert (·.name.lt ·.name) linter + for (name, declName, default) in batteriesLinterExt.getState (← getEnv) do + let shouldRun := match (runOnly, runAlways) with + | (some only, some always) => only.contains name && (always.contains name || default) + | (some only, none) => only.contains name + | (none, some always) => default || always.contains name + | _ => default + if shouldRun then + let linter ← getLinter name declName + if slow || linter.isFast then + let _ := Inhabited.mk linter + result := result.binInsert (·.name.lt ·.name) linter pure result -- Note: we have to use the same context as `runTermElabM` here so that the `simpNF` @@ -89,7 +97,7 @@ Runs all the specified linters on all the specified declarations in parallel, producing a list of results. -/ def lintCore (decls : Array Name) (linters : Array NamedLinter) : - CoreM (Array (NamedLinter × HashMap Name MessageData)) := do + CoreM (Array (NamedLinter × Std.HashMap Name MessageData)) := do let env ← getEnv let options ← getOptions -- TODO: sanitize options? @@ -106,19 +114,19 @@ def lintCore (decls : Array Name) (linters : Array NamedLinter) : | Except.error err => pure m!"LINTER FAILED:\n{err.toMessageData}" tasks.mapM fun (linter, decls) => do - let mut msgs : HashMap Name MessageData := {} + let mut msgs : Std.HashMap Name MessageData := {} for (declName, msg?) in decls do if let some msg := msg?.get then msgs := msgs.insert declName msg pure (linter, msgs) /-- Sorts a map with declaration keys as names by line number. -/ -def sortResults (results : HashMap Name α) : CoreM <| Array (Name × α) := do - let mut key : HashMap Name Nat := {} +def sortResults (results : Std.HashMap Name α) : CoreM <| Array (Name × α) := do + let mut key : Std.HashMap Name Nat := {} for (n, _) in results.toArray do if let some range ← findDeclarationRanges? n then key := key.insert n <| range.range.pos.line - pure $ results.toArray.qsort fun (a, _) (b, _) => key.findD a 0 < key.findD b 0 + pure $ results.toArray.qsort fun (a, _) (b, _) => key.getD a 0 < key.getD b 0 /-- Formats a linter warning as `#check` command with comment. -/ def printWarning (declName : Name) (warning : MessageData) (useErrorFormat : Bool := false) @@ -132,7 +140,7 @@ def printWarning (declName : Name) (warning : MessageData) (useErrorFormat : Boo addMessageContextPartial m!"#check {← mkConstWithLevelParams declName} /- {warning} -/" /-- Formats a map of linter warnings using `print_warning`, sorted by line number. -/ -def printWarnings (results : HashMap Name MessageData) (filePath : System.FilePath := default) +def printWarnings (results : Std.HashMap Name MessageData) (filePath : System.FilePath := default) (useErrorFormat : Bool := false) : CoreM MessageData := do (MessageData.joinSep ·.toList Format.line) <$> (← sortResults results).mapM fun (declName, warning) => @@ -142,15 +150,15 @@ def printWarnings (results : HashMap Name MessageData) (filePath : System.FilePa Formats a map of linter warnings grouped by filename with `-- filename` comments. The first `drop_fn_chars` characters are stripped from the filename. -/ -def groupedByFilename (results : HashMap Name MessageData) (useErrorFormat : Bool := false) : +def groupedByFilename (results : Std.HashMap Name MessageData) (useErrorFormat : Bool := false) : CoreM MessageData := do let sp ← if useErrorFormat then initSrcSearchPath ["."] else pure {} - let grouped : HashMap Name (System.FilePath × HashMap Name MessageData) ← + let grouped : Std.HashMap Name (System.FilePath × Std.HashMap Name MessageData) ← results.foldM (init := {}) fun grouped declName msg => do let mod ← findModuleOf? declName let mod := mod.getD (← getEnv).mainModule grouped.insert mod <$> - match grouped.find? mod with + match grouped[mod]? with | some (fp, msgs) => pure (fp, msgs.insert declName msg) | none => do let fp ← if useErrorFormat then @@ -166,7 +174,7 @@ def groupedByFilename (results : HashMap Name MessageData) (useErrorFormat : Boo Formats the linter results as Lean code with comments and `#check` commands. -/ def formatLinterResults - (results : Array (NamedLinter × HashMap Name MessageData)) + (results : Array (NamedLinter × Std.HashMap Name MessageData)) (decls : Array Name) (groupByFilename : Bool) (whereDesc : String) (runSlowLinters : Bool) @@ -209,7 +217,7 @@ def getDeclsInPackage (pkg : Name) : CoreM (Array Name) := do let mut decls ← getDeclsInCurrModule let modules := env.header.moduleNames.map (pkg.isPrefixOf ·) return env.constants.map₁.fold (init := decls) fun decls declName _ => - if modules[env.const2ModIdx[declName].get! (α := Nat)]! then + if modules[env.const2ModIdx[declName]?.get! (α := Nat)]! then decls.push declName else decls @@ -238,9 +246,11 @@ elab tk:"#lint" verbosity:("+" <|> "-")? fast:"*"? only:(&" only")? | some ⟨.node _ `token.«-» _⟩ => pure .low | _ => throwUnsupportedSyntax let fast := fast.isSome - let only := only.isSome + let onlyNames : Option (List Name) := match only.isSome with + | true => some (linters.map fun l => l.getId).toList + | false => none let linters ← liftCoreM do - let mut result ← getChecks (slow := !fast) only + let mut result ← getChecks (slow := !fast) (runOnly := onlyNames) none let linterState := batteriesLinterExt.getState (← getEnv) for id in linters do let name := id.getId.eraseMacroScopes diff --git a/Batteries/Tactic/Lint/Misc.lean b/Batteries/Tactic/Lint/Misc.lean index 4bb3f2125b..075c139aea 100644 --- a/Batteries/Tactic/Lint/Misc.lean +++ b/Batteries/Tactic/Lint/Misc.lean @@ -12,9 +12,9 @@ import Lean.Util.Recognizers import Lean.DocString import Batteries.Tactic.Lint.Basic -open Lean Meta +open Lean Meta Std -namespace Std.Tactic.Lint +namespace Batteries.Tactic.Lint /-! # Various linters @@ -143,7 +143,7 @@ In pseudo-mathematical form, this returns `{{p : parameter | p ∈ u} | (u : lev FIXME: We use `Array Name` instead of `HashSet Name`, since `HashSet` does not have an equality instance. It will ignore `nm₀.proof_i` declarations. -/ -private def univParamsGrouped (e : Expr) (nm₀ : Name) : Lean.HashSet (Array Name) := +private def univParamsGrouped (e : Expr) (nm₀ : Name) : Std.HashSet (Array Name) := runST fun σ => do let res ← ST.mkRef (σ := σ) {} e.forEach fun @@ -239,9 +239,7 @@ def findUnusedHaves (e : Expr) : MetaM (Array MessageData) := do | _ => return res.get -/-- A linter for checking that declarations don't have unused term mode have statements. We do not -tag this as `@[env_linter]` so that it is not in the default linter set as it is slow and an -uncommon problem. -/ +/-- A linter for checking that declarations don't have unused term mode have statements. -/ @[env_linter] def unusedHavesSuffices : Linter where noErrorsFound := "No declarations have unused term mode have statements." errorsFound := "THE FOLLOWING DECLARATIONS HAVE INEFFECTUAL TERM MODE HAVE/SUFFICES BLOCKS. \ diff --git a/Batteries/Tactic/Lint/Simp.lean b/Batteries/Tactic/Lint/Simp.lean index 3dc801fe0a..c6c0ad8828 100644 --- a/Batteries/Tactic/Lint/Simp.lean +++ b/Batteries/Tactic/Lint/Simp.lean @@ -9,7 +9,7 @@ import Batteries.Tactic.OpenPrivate import Batteries.Util.LibraryNote open Lean Meta -namespace Std.Tactic.Lint +namespace Batteries.Tactic.Lint /-! # Linter for simplification lemmas @@ -86,8 +86,6 @@ where | Trie.node vs children => children.foldl (init := arr ++ vs) fun arr (_, child) => trieElements arr child -open Std - /-- Add message `msg` to any errors thrown inside `k`. -/ def decorateError (msg : MessageData) (k : MetaM α) : MetaM α := do try k catch e => throw (.error e.getRef m!"{msg}\n{e.toMessageData}") @@ -96,7 +94,7 @@ def decorateError (msg : MessageData) (k : MetaM α) : MetaM α := do def formatLemmas (usedSimps : Simp.UsedSimps) (simpName : String) : MetaM MessageData := do let mut args := #[] let env ← getEnv - for (thm, _) in usedSimps.toArray.qsort (·.2 < ·.2) do + for (thm, _) in usedSimps.map.toArray.qsort (·.2 < ·.2) do if let .decl declName := thm then if env.contains declName && declName != ``eq_self then args := args.push (← mkConstWithFreshMVarLevels declName) @@ -120,7 +118,7 @@ https://leanprover-community.github.io/mathlib_docs/notes.html#simp-normal%20for else do let (e, s) ← dsimp lhs ctx return (Simp.Result.mk e .none .true, s) - if prf1Stats.usedTheorems.contains (.decl declName) then return none + if prf1Stats.usedTheorems.map.contains (.decl declName) then return none let ({ expr := rhs', .. }, stats) ← decorateError "simplify fails on right-hand side:" <| if !isRfl then diff --git a/Batteries/Tactic/Lint/TypeClass.lean b/Batteries/Tactic/Lint/TypeClass.lean index e6cf632f87..a025777d18 100644 --- a/Batteries/Tactic/Lint/TypeClass.lean +++ b/Batteries/Tactic/Lint/TypeClass.lean @@ -6,7 +6,7 @@ Authors: Gabriel Ebner import Lean.Meta.Instances import Batteries.Tactic.Lint.Basic -namespace Std.Tactic.Lint +namespace Batteries.Tactic.Lint open Lean Meta /-- diff --git a/Batteries/Tactic/NoMatch.lean b/Batteries/Tactic/NoMatch.lean index 9dc517b33f..ee6acefaf0 100644 --- a/Batteries/Tactic/NoMatch.lean +++ b/Batteries/Tactic/NoMatch.lean @@ -3,7 +3,8 @@ 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.ElabRules +import Lean.DocString +import Lean.Elab.Tactic.Basic /-! Deprecation warnings for `match ⋯ with.`, `fun.`, `λ.`, and `intro.`. diff --git a/Batteries/Tactic/PrintDependents.lean b/Batteries/Tactic/PrintDependents.lean index 9c55a04ecd..e927713886 100644 --- a/Batteries/Tactic/PrintDependents.lean +++ b/Batteries/Tactic/PrintDependents.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Elab.Command import Lean.Util.FoldConsts -import Batteries.Lean.Delaborator /-! # `#print dependents` command diff --git a/Batteries/Tactic/PrintPrefix.lean b/Batteries/Tactic/PrintPrefix.lean index 0046f0a4d7..b83e7b0ad8 100644 --- a/Batteries/Tactic/PrintPrefix.lean +++ b/Batteries/Tactic/PrintPrefix.lean @@ -3,9 +3,7 @@ Copyright (c) 2021 Shing Tak Lam. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Shing Tak Lam, Daniel Selsam, Mario Carneiro -/ -import Batteries.Lean.Name import Batteries.Lean.Util.EnvSearch -import Batteries.Lean.Delaborator import Lean.Elab.Tactic.Config namespace Batteries.Tactic diff --git a/Batteries/Tactic/SeqFocus.lean b/Batteries/Tactic/SeqFocus.lean index 8972f77891..cbbe70a44a 100644 --- a/Batteries/Tactic/SeqFocus.lean +++ b/Batteries/Tactic/SeqFocus.lean @@ -3,7 +3,7 @@ Copyright (c) 2022 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad -/ -import Lean.Elab.ElabRules +import Lean.Elab.Tactic.Basic open Lean Elab Meta Tactic diff --git a/Batteries/Tactic/ShowUnused.lean b/Batteries/Tactic/ShowUnused.lean index 25989a3da9..3797801cd8 100644 --- a/Batteries/Tactic/ShowUnused.lean +++ b/Batteries/Tactic/ShowUnused.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Util.FoldConsts import Lean.Linter.UnusedVariables -import Batteries.Lean.Delaborator /-! # The `#show_unused` command diff --git a/Batteries/Tactic/SqueezeScope.lean b/Batteries/Tactic/SqueezeScope.lean index 78a1d2a540..df289dc982 100644 --- a/Batteries/Tactic/SqueezeScope.lean +++ b/Batteries/Tactic/SqueezeScope.lean @@ -85,7 +85,8 @@ elab_rules : tactic throw e if let some new := new then for (_, stx, usedSimps) in new do - let usedSimps := usedSimps.foldl (fun s usedSimps => usedSimps.foldl .insert s) {} + let usedSimps := usedSimps.reverse.foldl + (fun s usedSimps => usedSimps.toArray.foldl .insert s) {} let stx' ← mkSimpCallStx stx usedSimps TryThis.addSuggestion stx[0] stx' (origSpan? := stx) diff --git a/Batteries/Tactic/Unreachable.lean b/Batteries/Tactic/Unreachable.lean index 76571dc850..4d6e6cf0a1 100644 --- a/Batteries/Tactic/Unreachable.lean +++ b/Batteries/Tactic/Unreachable.lean @@ -3,7 +3,7 @@ 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.ElabRules +import Lean.Elab.Tactic.Basic namespace Batteries.Tactic diff --git a/Batteries/Tactic/Where.lean b/Batteries/Tactic/Where.lean index 7a07d2ba6b..3ef51a46c9 100644 --- a/Batteries/Tactic/Where.lean +++ b/Batteries/Tactic/Where.lean @@ -40,10 +40,14 @@ private def describeOpenDecls (ds : List OpenDecl) : MessageData := Id.run do private def describeOptions (opts : Options) : CommandElabM (Option MessageData) := do let mut lines := #[] + let decls ← getOptionDecls for (name, val) in opts do - let dval ← getOptionDefaultValue name - if val != dval then - lines := lines.push m!"set_option {name} {val}" + match decls.find? name with + | some decl => + if val != decl.defValue then + lines := lines.push m!"set_option {name} {val}" + | none => + lines := lines.push m!"-- set_option {name} {val} -- unknown" if lines.isEmpty then return none else diff --git a/Batteries/Util/Cache.lean b/Batteries/Util/Cache.lean index edfac4fe97..866325df5a 100644 --- a/Batteries/Util/Cache.lean +++ b/Batteries/Util/Cache.lean @@ -3,7 +3,7 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ -import Batteries.Lean.Meta.DiscrTree +import Lean.Meta.DiscrTree /-! # Once-per-file cache for tactics diff --git a/Batteries/Util/CheckTactic.lean b/Batteries/Util/CheckTactic.lean deleted file mode 100644 index bc97e681cc..0000000000 --- a/Batteries/Util/CheckTactic.lean +++ /dev/null @@ -1,124 +0,0 @@ -/- -Copyright (c) 2024 Lean FRO. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ -import Lean.Elab.Tactic.ElabTerm -import Lean.Elab.Term - -/- -This file is the home for commands to tactics behave as expected. - -It currently includes two tactics: - -#check_tactic t ~> res - - -only a #check_simp command that applies simp -IT --/ - -namespace Batteries.Tactic - -open Lean Elab Tactic -open Meta - -/-- -Type used to lift an arbitrary value into a type parameter so it can -appear in a proof goal. - -It is used by the #check_tactic command. --/ -private inductive CheckGoalType {α : Sort u} : (val : α) → Prop where -| intro : (val : α) → CheckGoalType val - -private def matchCheckGoalType (stx : Syntax) (goalType : Expr) : MetaM (Expr × Expr × Level) := do - let u ← mkFreshLevelMVar - let type ← mkFreshExprMVar (some (.sort u)) - let val ← mkFreshExprMVar (some type) - let extType := mkAppN (.const ``CheckGoalType [u]) #[type, val] - if !(← isDefEq goalType extType) then - throwErrorAt stx "Goal{indentExpr goalType}\nis expected to match {indentExpr extType}" - pure (val, type, u) - -/-- -`check_tactic_goal t` verifies that the goal has is equal to -`CheckGoalType t` with reducible transparency. It closes the goal if so -and otherwise reports an error. - -It is used by #check_tactic. --/ -local syntax (name := check_tactic_goal) "check_tactic_goal " term : tactic - -/-- -Implementation of `check_tactic_goal` --/ -@[tactic check_tactic_goal] private def evalCheckTacticGoal : Tactic := fun stx => - match stx with - | `(tactic| check_tactic_goal $exp) => - closeMainGoalUsing (checkUnassigned := false) fun goalType => do - let (val, type, u) ← matchCheckGoalType stx goalType - let expTerm ← elabTermEnsuringType exp type - if !(← Meta.withReducible <| isDefEq val expTerm) then - throwErrorAt stx - m!"Term reduces to{indentExpr val}\nbut is expected to reduce to {indentExpr expTerm}" - return mkAppN (.const ``CheckGoalType.intro [u]) #[type, val] - | _ => throwErrorAt stx "check_goal syntax error" - -/-- -`check_tactic_goal t` verifies that the goal has is equal to -`CheckGoalType t` with reducible transparency. It closes the goal if so -and otherwise reports an error. - -It is used by #check_tactic. --/ -local syntax (name := check_tactic_fails) "check_tactic_fails " tactic : tactic - -@[tactic check_tactic_fails] private def evalCheckTacticFails : Tactic := fun stx => do - let `(tactic| check_tactic_fails $tactic) := stx - | throwUnsupportedSyntax - closeMainGoalUsing (checkUnassigned := false) fun goalType => do - let (val, type, u) ← matchCheckGoalType stx goalType - Term.withoutErrToSorry <| withoutRecover do - match (← try (some <$> evalTactic tactic) catch _ => pure none) with - | none => - return mkAppN (.const ``CheckGoalType.intro [u]) #[type, val] - | some () => - let gls ← getGoals - let ppGoal (g : MVarId) := do - let (val, _type, _u) ← matchCheckGoalType stx (← g.getType) - pure m!"{indentExpr val}" - let msg ← - match gls with - | [] => pure m!"{tactic} expected to fail on {val}, but closed goal." - | [g] => - pure <| m!"{tactic} expected to fail on {val}, but returned: {←ppGoal g}" - | gls => - let app m g := do pure <| m ++ (←ppGoal g) - let init := m!"{tactic} expected to fail on {val}, but returned goals:" - gls.foldlM (init := init) app - throwErrorAt stx msg - -/-- -`#check_tactic t ~> r by commands` runs the tactic sequence `commands` -on a goal with t in the type and sees if the resulting expression has -reduced it to `r`. --/ -macro "#check_tactic " t:term "~>" result:term "by" tac:tactic : command => - `(command|example : CheckGoalType $t := by $tac; check_tactic_goal $result) - -/-- -`#check_simp t ~> r` checks `simp` reduces `t` to `r`. --/ -macro "#check_simp " t:term "~>" exp:term : command => - `(command|#check_tactic $t ~> $exp by simp) - -example (x : Nat) : CheckGoalType ((x + z) = x) := by - fail_if_success simp [] - exact (CheckGoalType.intro ((x + z) = x)) - -/-- -`#check_simp t !~>` checks `simp` fails to reduce `t`. --/ -macro "#check_simp " t:term "!~>" : command => - `(command|example : CheckGoalType $t := by check_tactic_fails simp) diff --git a/Batteries/Util/ExtendedBinder.lean b/Batteries/Util/ExtendedBinder.lean index d577e1d785..c489c0a432 100644 --- a/Batteries/Util/ExtendedBinder.lean +++ b/Batteries/Util/ExtendedBinder.lean @@ -3,8 +3,6 @@ Copyright (c) 2021 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ -import Lean.Elab.MacroArgUtil -import Lean.Linter.MissingDocs /-! Defines an extended binder syntax supporting `∀ ε > 0, ...` etc. diff --git a/Batteries/Util/LibraryNote.lean b/Batteries/Util/LibraryNote.lean index eb08bf0b27..8c1d45f786 100644 --- a/Batteries/Util/LibraryNote.lean +++ b/Batteries/Util/LibraryNote.lean @@ -3,7 +3,7 @@ Copyright (c) 2022 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ -import Lean.Elab.ElabRules +import Lean.Elab.Command /-! # Define the `library_note` command. diff --git a/GNUmakefile b/GNUmakefile deleted file mode 100644 index 123c8af1a1..0000000000 --- a/GNUmakefile +++ /dev/null @@ -1,12 +0,0 @@ -.PHONY: all build test lint - -all: build test - -build: - lake build - -test: - lake test - -lint: - lake exe runLinter diff --git a/README.md b/README.md index f5f241fe22..ab8606d854 100644 --- a/README.md +++ b/README.md @@ -23,7 +23,9 @@ Additionally, please make sure that you're using the version of Lean that the cu 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 `make`. +* 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. diff --git a/lakefile.lean b/lakefile.lean index a59342f68c..e55e8b2639 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -13,14 +13,11 @@ package batteries where @[default_target] lean_lib Batteries -@[default_target] +@[default_target, lint_driver] lean_exe runLinter where srcDir := "scripts" supportInterpreter := true -meta if get_config? doc |>.isSome then -require «doc-gen4» from git "https://github.com/leanprover/doc-gen4" @ "main" - @[test_driver] lean_exe test where srcDir := "scripts" diff --git a/lean-toolchain b/lean-toolchain index 29c0cea43e..98556ba065 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.9.0-rc2 +leanprover/lean4:v4.12.0-rc1 diff --git a/scripts/check_imports.lean b/scripts/check_imports.lean index 94e778369f..bc651dcc12 100644 --- a/scripts/check_imports.lean +++ b/scripts/check_imports.lean @@ -34,7 +34,7 @@ def warn (fixable : Bool) (msg : String) : LogIO Unit := do -- | Predicate indicates if warnings are present and if they fixable. def getWarningInfo : LogIO (Bool × Bool) := get -def createModuleHashmap (env : Environment) : HashMap Name ModuleData := Id.run do +def createModuleHashmap (env : Environment) : Std.HashMap Name ModuleData := Id.run do let mut nameMap := {} for i in [0:env.header.moduleNames.size] do let nm := env.header.moduleNames[i]! @@ -70,7 +70,7 @@ def writeImportModule (path : FilePath) (imports : Array Name) : IO Unit := do /-- Check for imports and return true if warnings issued. -/ def checkMissingImports (modName : Name) (modData : ModuleData) (reqImports : Array Name) : LogIO Bool := do - let names : HashSet Name := HashSet.ofArray (modData.imports.map (·.module)) + let names : Std.HashSet Name := Std.HashSet.ofArray (modData.imports.map (·.module)) let mut warned := false for req in reqImports do if !names.contains req then @@ -80,11 +80,11 @@ def checkMissingImports (modName : Name) (modData : ModuleData) (reqImports : Ar /-- Check directory entry in `Batteries/Data/` -/ def checkBatteriesDataDir - (modMap : HashMap Name ModuleData) + (modMap : Std.HashMap Name ModuleData) (entry : IO.FS.DirEntry) (autofix : Bool := false) : LogIO Unit := do let moduleName := `Batteries.Data ++ .mkSimple entry.fileName let requiredImports ← addModulesIn (recurse := true) #[] (root := moduleName) entry.path - let .some module := modMap.find? moduleName + let .some module := modMap[moduleName]? | warn true s!"Could not find {moduleName}; Not imported into Batteries." let path := modulePath moduleName -- We refuse to generate imported modules whose path doesn't exist. @@ -134,7 +134,7 @@ def checkBatteriesDataImports : MetaM Unit := do if ← entry.path.isDir then checkBatteriesDataDir (autofix := autofix) modMap entry let batteriesImports ← expectedBatteriesImports - let .some batteriesMod := modMap.find? `Batteries + let .some batteriesMod := modMap[`Batteries]? | warn false "Missing Batteries module!; Run `lake build`." let warned ← checkMissingImports `Batteries batteriesMod batteriesImports if autofix && warned then diff --git a/scripts/runLinter.lean b/scripts/runLinter.lean index 87d8774ce9..89976f0e47 100644 --- a/scripts/runLinter.lean +++ b/scripts/runLinter.lean @@ -1,8 +1,8 @@ +import Lean.Util.SearchPath import Batteries.Tactic.Lint import Batteries.Data.Array.Basic -import Batteries.Lean.Util.Path -open Lean Core Elab Command Std.Tactic.Lint +open Lean Core Elab Command Batteries.Tactic.Lint open System (FilePath) /-- The list of `nolints` pulled from the `nolints.json` file -/ @@ -15,7 +15,7 @@ def readJsonFile (α) [FromJson α] (path : System.FilePath) : IO α := do /-- Serialize the given value `a : α` to the file as JSON. -/ def writeJsonFile [ToJson α] (path : System.FilePath) (a : α) : IO Unit := - IO.FS.writeFile path <| toJson a |>.pretty + IO.FS.writeFile path <| toJson a |>.pretty.push '\n' /-- Usage: `runLinter [--update] [Batteries.Data.Nat.Basic]` @@ -47,17 +47,29 @@ unsafe def main (args : List String) : IO Unit := do stdin := .null } _ ← child.wait + -- If the linter is being run on a target that doesn't import `Batteries.Tactic.List`, + -- the linters are ineffective. So we import it here. + let lintModule := `Batteries.Tactic.Lint + let lintFile ← findOLean lintModule + unless (← lintFile.pathExists) do + -- run `lake build +Batteries.Tactic.Lint` (and ignore result) if the file hasn't been built yet + let child ← IO.Process.spawn { + cmd := (← IO.getEnv "LAKE").getD "lake" + args := #["build", s!"+{lintModule}"] + stdin := .null + } + _ ← child.wait let nolintsFile : FilePath := "scripts/nolints.json" let nolints ← if ← nolintsFile.pathExists then readJsonFile NoLints nolintsFile else pure #[] - withImportModules #[{module}] {} (trustLevel := 1024) fun env => + 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) (useOnly := false) + let linters ← getChecks (slow := true) (runAlways := none) (runOnly := none) let results ← lintCore decls linters if update then writeJsonFile (α := NoLints) nolintsFile <| diff --git a/test/MLList.lean b/test/MLList.lean index 278d6dc83d..ad53377237 100644 --- a/test/MLList.lean +++ b/test/MLList.lean @@ -1,4 +1,5 @@ import Batteries.Data.MLList.IO +import Batteries.Data.List.Basic set_option linter.missingDocs false @@ -18,7 +19,7 @@ def g (n : Nat) : MLList Lean.Meta.MetaM Nat := do /-! ### Test `MLList.ofTaskList`. -We generate three tasks which sleep for `100`, `10`, and `1` milliseconds respectively, +We generate three tasks which sleep for `100`, `50`, and `1` milliseconds respectively, and then verify that `MLList.ofTaskList` return their results in the order they complete. -/ @@ -28,9 +29,9 @@ def sleep (n : UInt32) : BaseIO (Task UInt32) := | .error _ => 0 def sleeps : MLList BaseIO UInt32 := .squash fun _ => do - let r ← [100,10,1].map sleep |>.traverse id + let r ← [100,50,1].map sleep |>.traverse id return .ofTaskList r -/-- info: [1, 10, 100] -/ +/-- info: [1, 50, 100] -/ #guard_msgs in #eval sleeps.force diff --git a/test/absurd.lean b/test/absurd.lean index 4974467e5a..1817c0e715 100644 --- a/test/absurd.lean +++ b/test/absurd.lean @@ -43,5 +43,5 @@ h : p → False ⊢ p -/ #guard_msgs in -example (h : p → False) : 0 = 3 := by +example {p : Prop} (h : p → False) : 0 = 3 := by absurd h diff --git a/test/array.lean b/test/array.lean index 41338a8bd4..2ba3a29577 100644 --- a/test/array.lean +++ b/test/array.lean @@ -1,4 +1,3 @@ -import Batteries.Util.CheckTactic import Batteries.Data.Array section diff --git a/test/congr.lean b/test/congr.lean index 5303fbd74b..065a899f99 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -19,8 +19,6 @@ example {α β γ δ} {F : ∀ {α β}, (α → β) → γ → δ} {f g : α → -- apply_assumption -- FIXME apply h -attribute [ext] Subtype.eq - example {α β : Type _} {f : _ → β} {x y : { x : { x : α // x = x } // x = x }} (h : x.1 = y.1) : f x = f y := by congr with : 1 @@ -38,7 +36,7 @@ section -- Adaptation note: the next two examples have always failed if `List.ext` was in scope, -- but until nightly-2024-04-24 (when `List.ext` was upstreamed), it wasn't in scope. -- In order to preserve the test behaviour we locally remove the `ext` attribute. -attribute [-ext] List.ext +attribute [-ext] List.ext_getElem? private opaque List.sum : List Nat → Nat diff --git a/test/lemma_cmd.lean b/test/lemma_cmd.lean new file mode 100644 index 0000000000..7952f5766f --- /dev/null +++ b/test/lemma_cmd.lean @@ -0,0 +1,34 @@ +import Batteries.Tactic.Lemma + +-- lemma disabled by default +/-- +info: Try this: theorem +--- +error: `lemma` is not supported by default, please use `theorem` instead. +Use `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file. +Use the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally. +-/ +#guard_msgs in +lemma test1 : 3 < 7 := by decide + +-- lemma enabled for one command +set_option lang.lemmaCmd true in +lemma test2 : 3 < 7 := by decide + +-- lemma disabled again +/-- +info: Try this: theorem +--- +error: `lemma` is not supported by default, please use `theorem` instead. +Use `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file. +Use the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally. +-/ +#guard_msgs in +lemma test3 : 3 < 7 := by decide + +-- lemma enabled for rest of file +set_option lang.lemmaCmd true + +lemma test4 : 3 < 7 := by decide + +lemma test5 : 3 < 7 := by decide diff --git a/test/lintTC.lean b/test/lintTC.lean index 1f0ade6987..2a5f6f2640 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,7 +1,7 @@ import Batteries.Tactic.Lint.TypeClass import Lean.Elab.Command -open Std.Tactic.Lint +open Batteries.Tactic.Lint namespace A diff --git a/test/lint_lean.lean b/test/lint_lean.lean new file mode 100644 index 0000000000..46eb6591ff --- /dev/null +++ b/test/lint_lean.lean @@ -0,0 +1,47 @@ +import Batteries.Tactic.Lint + +/-! +This test file runs the environment linters set up in Batteries on the core Lean4 repository. + +Everything is commented out as it is too slow to run in regular Batteries CI +(and in any case there are many failures still), +but it is useful to run locally to see what the linters would catch. +-/ + +-- We can't apply `nolint` attributes to imported declarations, +-- but if we move the environment linters up to Lean, +-- these nolints should be installed there. +-- (And in the meantime you can "manually" ignore them!) +-- 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 + +/-! Failing lints that need work. -/ + +-- #lint only explicitVarsOfIff in all -- Found 156 errors + +-- Many fixed in https://github.com/leanprover/lean4/pull/4620 +-- and should be checked again. +-- #lint only simpNF in all -- Found 12 errors + +/-! Lints that fail, but that we're not intending to do anything about. -/ + +-- Mostly fixed in https://github.com/leanprover/lean4/pull/4621 +-- There are many false positives here. +-- To run this properly we would need to ignore all declarations with `@[extern]`. +-- #lint only unusedArguments in all -- Found 89 errors + +-- After https://github.com/leanprover/lean4/pull/4616, these are all intentional and have +-- `nolint` attributes above. +-- #lint only dupNamespace in all -- Found 6 errors + +-- After https://github.com/leanprover/lean4/pull/4619 all of these should be caused by `abbrev`. +-- Unless we decide to upstream something like `alias`, we're not planning on fixing these. +-- #lint only defLemma in all -- Found 31 errors + +/-! Lints that have succeeded in the past, and hopefully still do! -/ + +-- #lint only impossibleInstance in all -- Found 0 errors +-- #lint only simpVarHead in all -- Found 0 error +-- #lint only unusedHavesSuffices in all -- Found 0 errors +-- #lint only checkUnivs in all -- Found 0 errors diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 0950578665..ad2a589247 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,6 +1,6 @@ import Batteries.Tactic.Lint -open Std.Tactic.Lint +open Batteries.Tactic.Lint set_option linter.missingDocs false def f : Nat := 0 diff --git a/test/where.lean b/test/where.lean index 6fd098ce53..a88f1ed8e5 100644 --- a/test/where.lean +++ b/test/where.lean @@ -2,6 +2,7 @@ import Batteries.Tactic.Where -- Return to pristine state set_option linter.missingDocs false +set_option internal.cmdlineSnapshots false /-- info: -- In root namespace with initial scope -/ #guard_msgs in #where