diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 15d72c6876..61af30e96e 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -20,7 +20,7 @@ jobs: name: build, test, and lint batteries uses: leanprover/lean-action@v1 with: - build-args: '-Kwerror' + build-args: '--wfail' - 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..3bb9c6dd71 --- /dev/null +++ b/.github/workflows/test_mathlib.yml @@ -0,0 +1,88 @@ +# 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: Checkout PR + uses: actions/checkout@v4 + with: + fetch-depth: 0 + + - name: Get PR info + id: pr-info + run: | + echo "pullRequestNumber=$(gh pr list --search $SHA --json number -q '.[0].number' || echo '')" >> $GITHUB_OUTPUT + echo "targetBranch=$(gh pr list --search $SHA --json baseRefName -q '.[0].baseRefName' || echo '')" >> $GITHUB_OUTPUT + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + SHA: ${{ github.event.workflow_run.head_sha }} + + - name: Checkout mathlib4 repository + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' + uses: actions/checkout@v4 + with: + repository: leanprover-community/mathlib4 + token: ${{ secrets.MATHLIB4_BOT }} + ref: master + fetch-depth: 0 + + - name: Install elan + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' + run: | + set -o pipefail + curl -sSfL https://github.com/leanprover/elan/releases/download/v3.0.0/elan-x86_64-unknown-linux-gnu.tar.gz | tar xz + ./elan-init -y --default-toolchain none + echo "$HOME/.elan/bin" >> "${GITHUB_PATH}" + + - name: Check if tag exists + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' + id: check_mathlib_tag + env: + PR_NUMBER: ${{ steps.pr-info.outputs.pullRequestNumber }} + HEAD_REPO: ${{ github.event.workflow_run.head_repository.full_name }} + HEAD_BRANCH: ${{ github.event.workflow_run.head_branch }} + run: | + git config user.name "leanprover-community-mathlib4-bot" + git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com" + + 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" + + # Modify the lakefile.lean with the fork and branch name + sed -i "s,require \"leanprover-community\" / \"batteries\" @ git \".\+\",require \"leanprover-community\" / \"batteries\" from git \"https://github.com/$HEAD_REPO\" @ \"$HEAD_BRANCH\",g" lakefile.lean + + lake update batteries + 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.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' + env: + PR_NUMBER: ${{ steps.pr-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 38e7617093..d199525058 100644 --- a/Batteries.lean +++ b/Batteries.lean @@ -16,20 +16,17 @@ 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 @@ -48,9 +45,7 @@ import Batteries.Lean.HashMap import Batteries.Lean.HashSet import Batteries.Lean.IO.Process import Batteries.Lean.Json -import Batteries.Lean.Meta.AssertHypotheses import Batteries.Lean.Meta.Basic -import Batteries.Lean.Meta.Clear import Batteries.Lean.Meta.DiscrTree import Batteries.Lean.Meta.Expr import Batteries.Lean.Meta.Inaccessible @@ -76,9 +71,9 @@ import Batteries.StdDeprecations import Batteries.Tactic.Alias import Batteries.Tactic.Basic import Batteries.Tactic.Case -import Batteries.Tactic.Classical import Batteries.Tactic.Congr import Batteries.Tactic.Exact +import Batteries.Tactic.HelpCmd import Batteries.Tactic.Init import Batteries.Tactic.Instances import Batteries.Tactic.Lemma @@ -96,12 +91,16 @@ import Batteries.Tactic.PrintPrefix import Batteries.Tactic.SeqFocus import Batteries.Tactic.ShowUnused import Batteries.Tactic.SqueezeScope +import Batteries.Tactic.Trans import Batteries.Tactic.Unreachable import Batteries.Tactic.Where import Batteries.Test.Internal.DummyLabelAttr +import Batteries.Test.Internal.DummyLibraryNote +import Batteries.Test.Internal.DummyLibraryNote2 import Batteries.Util.Cache import Batteries.Util.ExtendedBinder import Batteries.Util.LibraryNote +import Batteries.Util.Panic import Batteries.Util.Pickle import Batteries.Util.ProofWanted import Batteries.WF diff --git a/Batteries/Classes/SatisfiesM.lean b/Batteries/Classes/SatisfiesM.lean index c8fc1f0be9..89f264963a 100644 --- a/Batteries/Classes/SatisfiesM.lean +++ b/Batteries/Classes/SatisfiesM.lean @@ -52,7 +52,7 @@ protected theorem trivial [Applicative m] [LawfulApplicative m] {x : m α} : /-- The `SatisfiesM p x` predicate is monotonic in `p`. -/ theorem imp [Functor m] [LawfulFunctor m] {x : m α} (h : SatisfiesM p x) (H : ∀ {a}, p a → q a) : SatisfiesM q x := - let ⟨x, h⟩ := h; ⟨(fun ⟨a, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ + let ⟨x, h⟩ := h; ⟨(fun ⟨_, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ /-- `SatisfiesM` distributes over `<$>`, general version. -/ protected theorem map [Functor m] [LawfulFunctor m] {x : m α} @@ -171,7 +171,7 @@ theorem SatisfiesM_StateRefT_eq [Monad m] : · refine ⟨fun s => (fun ⟨⟨a, h⟩, s'⟩ => ⟨⟨a, s'⟩, h⟩) <$> f s, fun s => ?_⟩ rw [← comp_map, map_eq_pure_bind]; rfl · refine ⟨fun s => (fun ⟨⟨a, s'⟩, h⟩ => ⟨⟨a, h⟩, s'⟩) <$> f s, funext fun s => ?_⟩ - show _ >>= _ = _; simp [map_eq_pure_bind, ← h] + show _ >>= _ = _; simp [← h] @[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by @@ -179,4 +179,4 @@ theorem SatisfiesM_StateRefT_eq [Monad m] : · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) - show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl + show _ >>= _ = _; simp [← comp_map, ← bind_pure_comp]; congr; funext ⟨a, h⟩; cases a <;> rfl diff --git a/Batteries/CodeAction/Attr.lean b/Batteries/CodeAction/Attr.lean index 79802d6932..308c4c7ad3 100644 --- a/Batteries/CodeAction/Attr.lean +++ b/Batteries/CodeAction/Attr.lean @@ -14,7 +14,7 @@ import Lean.Server.CodeActions.Basic * 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 ce98bcc5c6..30745d161d 100644 --- a/Batteries/CodeAction/Deprecated.lean +++ b/Batteries/CodeAction/Deprecated.lean @@ -14,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 diff --git a/Batteries/CodeAction/Misc.lean b/Batteries/CodeAction/Misc.lean index 0bea77ff55..4ad0a8099d 100644 --- a/Batteries/CodeAction/Misc.lean +++ b/Batteries/CodeAction/Misc.lean @@ -15,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 ad6b8129e6..403c42d9e2 100644 --- a/Batteries/Data/Array/Basic.lean +++ b/Batteries/Data/Array/Basic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Batteries.Data.Array.Init.Lemmas +import Batteries.Tactic.Alias /-! ## Definitions on Arrays @@ -14,10 +15,6 @@ proofs about these definitions, those are contained in other files in `Batteries namespace Array -/-- Drop `none`s from a Array, and replace each remaining `some a` with `a`. -/ -def reduceOption (l : Array (Option α)) : Array α := - l.filterMap id - /-- Check whether `xs` and `ys` are equal as sets, i.e. they contain the same elements when disregarding order and duplicates. `O(n*m)`! If your element type @@ -27,13 +24,6 @@ arrays, remove duplicates and then compare them elementwise. def equalSet [BEq α] (xs ys : Array α) : Bool := xs.all (ys.contains ·) && ys.all (xs.contains ·) -set_option linter.unusedVariables.funArgs false in -/-- -Sort an array using `compare` to compare elements. --/ -def qsortOrd [ord : Ord α] (xs : Array α) : Array α := - xs.qsort fun x y => compare x y |>.isLT - set_option linter.unusedVariables.funArgs false in /-- Returns the first minimal element among `d` and elements of the array. @@ -129,11 +119,7 @@ protected def maxI [ord : Ord α] [Inhabited α] (xs : Array α) (start := 0) (stop := xs.size) : α := xs.minI (ord := ord.opposite) start stop -/-- -`O(|join L|)`. `join L` concatenates all the arrays in `L` into one array. -* `join #[#[a], #[], #[b, c], #[d, e, f]] = #[a, b, c, d, e, f]` --/ -@[inline] def join (l : Array (Array α)) : Array α := l.foldl (· ++ ·) #[] +@[deprecated (since := "2024-10-15")] alias join := flatten /-! ### Safe Nat Indexed Array functions @@ -148,7 +134,7 @@ should prove the index bound. A proof by `get_elem_tactic` is provided as a default argument for `h`. This will perform the update destructively provided that `a` has a reference count of 1 when called. -/ -def setN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) (x : α) : Array α := +abbrev setN (a : Array α) (i : Nat) (x : α) (h : i < a.size := by get_elem_tactic) : Array α := a.set ⟨i, h⟩ x /-- @@ -157,7 +143,7 @@ Uses `get_elem_tactic` to supply a proof that the indices are in range. `hi` and `hj` are both given a default argument `by get_elem_tactic`. This will perform the update destructively provided that `a` has a reference count of 1 when called. -/ -def swapN (a : Array α) (i j : Nat) +abbrev swapN (a : Array α) (i j : Nat) (hi : i < a.size := by get_elem_tactic) (hj : j < a.size := by get_elem_tactic) : Array α := Array.swap a ⟨i,hi⟩ ⟨j, hj⟩ @@ -166,8 +152,8 @@ def swapN (a : Array α) (i j : Nat) The old entry is returned alongwith the modified vector. Automatically generates proof of `i < a.size` with `get_elem_tactic` where feasible. -/ -def swapAtN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) (x : α) : α × Array α := - swapAt a ⟨i,h⟩ x +abbrev swapAtN (a : Array α) (i : Nat) (x : α) (h : i < a.size := by get_elem_tactic) : + α × Array α := swapAt a ⟨i,h⟩ x /-- `eraseIdxN a i h` Removes the element at position `i` from a vector of length `n`. @@ -176,29 +162,23 @@ that the index is valid. This function takes worst case O(n) time because it has to backshift all elements at positions greater than i. -/ -def eraseIdxN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) : Array α := +abbrev eraseIdxN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) : Array α := a.feraseIdx ⟨i, h⟩ -end Array - - -namespace Subarray - /-- -The empty subarray. +Remove the element at a given index from an array, panics if index is out of bounds. -/ -protected def empty : Subarray α where - array := #[] - start := 0 - stop := 0 - start_le_stop := Nat.le_refl 0 - stop_le_array_size := Nat.le_refl 0 +def eraseIdx! (a : Array α) (i : Nat) : Array α := + if h : i < a.size then + a.feraseIdx ⟨i, h⟩ + else + have : Inhabited (Array α) := ⟨a⟩ + panic! s!"index {i} out of bounds" + +end Array -instance : EmptyCollection (Subarray α) := - ⟨Subarray.empty⟩ -instance : Inhabited (Subarray α) := - ⟨{}⟩ +namespace Subarray /-- Check whether a subarray is empty. diff --git a/Batteries/Data/Array/Lemmas.lean b/Batteries/Data/Array/Lemmas.lean index dd4fe12424..8a5544089d 100644 --- a/Batteries/Data/Array/Lemmas.lean +++ b/Batteries/Data/Array/Lemmas.lean @@ -11,30 +11,22 @@ import Batteries.Util.ProofWanted namespace Array -theorem forIn_eq_forIn_data [Monad m] +theorem forIn_eq_forIn_toList [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : - forIn as b f = forIn as.data b f := by - let rec loop : ∀ {i h b j}, j + i = as.size → - Array.forIn.loop as f i h b = forIn (as.data.drop j) b f - | 0, _, _, _, rfl => by rw [List.drop_length]; rfl - | i+1, _, _, j, ij => by - simp only [forIn.loop, Nat.add] - have j_eq : j = size as - 1 - i := by simp [← ij, ← Nat.add_assoc] - have : as.size - 1 - i < as.size := j_eq ▸ ij ▸ Nat.lt_succ_of_le (Nat.le_add_right ..) - have : as[size as - 1 - i] :: as.data.drop (j + 1) = as.data.drop j := by - rw [j_eq]; exact List.getElem_cons_drop _ _ this - simp only [← this, List.forIn_cons]; congr; funext x; congr; funext b - rw [loop (i := i)]; rw [← ij, Nat.succ_add]; rfl - conv => lhs; simp only [forIn, Array.forIn] - rw [loop (Nat.zero_add _)]; rfl + forIn as b f = forIn as.toList b f := by + cases as + simp + +@[deprecated (since := "2024-09-09")] alias forIn_eq_forIn_data := forIn_eq_forIn_toList @[deprecated (since := "2024-08-13")] alias forIn_eq_data_forIn := forIn_eq_forIn_data /-! ### zipWith / zip -/ -theorem data_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : - (as.zipWith bs f).data = as.data.zipWith f bs.data := by +theorem toList_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : + (as.zipWith bs f).toList = as.toList.zipWith f bs.toList := by let rec loop : ∀ (i : Nat) cs, i ≤ as.size → i ≤ bs.size → - (zipWithAux f as bs i cs).data = cs.data ++ (as.data.drop i).zipWith f (bs.data.drop i) := by + (zipWithAux f as bs i cs).toList = + cs.toList ++ (as.toList.drop i).zipWith f (bs.toList.drop i) := by intro i cs hia hib unfold zipWithAux by_cases h : i = as.size ∨ i = bs.size @@ -59,30 +51,33 @@ theorem data_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : have has : i < as.size := Nat.lt_of_le_of_ne hia h.1 have hbs : i < bs.size := Nat.lt_of_le_of_ne hib h.2 simp only [has, hbs, dite_true] - rw [loop (i+1) _ has hbs, Array.push_data] + rw [loop (i+1) _ has hbs, Array.push_toList] have h₁ : [f as[i] bs[i]] = List.zipWith f [as[i]] [bs[i]] := rfl - let i_as : Fin as.data.length := ⟨i, has⟩ - let i_bs : Fin bs.data.length := ⟨i, hbs⟩ + let i_as : Fin as.toList.length := ⟨i, has⟩ + let i_bs : Fin bs.toList.length := ⟨i, hbs⟩ rw [h₁, List.append_assoc] congr - rw [← List.zipWith_append (h := by simp), getElem_eq_data_getElem, getElem_eq_data_getElem] - show List.zipWith f (as.data[i_as] :: List.drop (i_as + 1) as.data) - ((List.get bs.data i_bs) :: List.drop (i_bs + 1) bs.data) = - List.zipWith f (List.drop i as.data) (List.drop i bs.data) - simp only [data_length, Fin.getElem_fin, List.getElem_cons_drop, List.get_eq_getElem] + rw [← List.zipWith_append (h := by simp), getElem_eq_getElem_toList, + getElem_eq_getElem_toList] + show List.zipWith f (as.toList[i_as] :: List.drop (i_as + 1) as.toList) + ((List.get bs.toList i_bs) :: List.drop (i_bs + 1) bs.toList) = + List.zipWith f (List.drop i as.toList) (List.drop i bs.toList) + simp only [length_toList, Fin.getElem_fin, List.getElem_cons_drop, List.get_eq_getElem] simp [zipWith, loop 0 #[] (by simp) (by simp)] +@[deprecated (since := "2024-09-09")] alias data_zipWith := toList_zipWith @[deprecated (since := "2024-08-13")] alias zipWith_eq_zipWith_data := data_zipWith -theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : +@[simp] theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : (as.zipWith bs f).size = min as.size bs.size := by - rw [size_eq_length_data, data_zipWith, List.length_zipWith] + rw [size_eq_length_toList, toList_zipWith, List.length_zipWith] -theorem data_zip (as : Array α) (bs : Array β) : - (as.zip bs).data = as.data.zip bs.data := - data_zipWith Prod.mk as bs +theorem toList_zip (as : Array α) (bs : Array β) : + (as.zip bs).toList = as.toList.zip bs.toList := + toList_zipWith Prod.mk as bs +@[deprecated (since := "2024-09-09")] alias data_zip := toList_zip @[deprecated (since := "2024-08-13")] alias zip_eq_zip_data := data_zip -theorem size_zip (as : Array α) (bs : Array β) : +@[simp] theorem size_zip (as : Array α) (bs : Array β) : (as.zip bs).size = min as.size bs.size := as.size_zipWith bs Prod.mk @@ -90,58 +85,60 @@ theorem size_zip (as : Array α) (bs : Array β) : theorem size_filter_le (p : α → Bool) (l : Array α) : (l.filter p).size ≤ l.size := by - simp only [← data_length, filter_data] + simp only [← length_toList, toList_filter] apply List.length_filter_le -/-! ### join -/ - -@[simp] theorem data_join {l : Array (Array α)} : l.join.data = (l.data.map data).join := by - dsimp [join] - simp only [foldl_eq_foldl_data] - generalize l.data = l - have : ∀ a : Array α, (List.foldl ?_ a l).data = a.data ++ ?_ := ?_ - exact this #[] - induction l with - | nil => simp - | cons h => induction h.data <;> simp [*] -@[deprecated (since := "2024-08-13")] alias join_data := data_join - -theorem mem_join : ∀ {L : Array (Array α)}, a ∈ L.join ↔ ∃ l, l ∈ L ∧ a ∈ l := by - simp only [mem_def, data_join, List.mem_join, List.mem_map] - intro l - constructor - · rintro ⟨_, ⟨s, m, rfl⟩, h⟩ - exact ⟨s, m, h⟩ - · rintro ⟨s, h₁, h₂⟩ - refine ⟨s.data, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩ +/-! ### flatten -/ + +@[deprecated (since := "2024-09-09")] alias data_join := toList_flatten +@[deprecated (since := "2024-08-13")] alias join_data := toList_flatten +@[deprecated (since := "2024-10-15")] alias mem_join := mem_flatten + +/-! ### indexOf? -/ + +theorem indexOf?_toList [BEq α] {a : α} {l : Array α} : + l.toList.indexOf? a = (l.indexOf? a).map Fin.val := by + simpa using aux l 0 +where + aux (l : Array α) (i : Nat) : + ((l.toList.drop i).indexOf? a).map (·+i) = (indexOfAux l a i).map Fin.val := by + rw [indexOfAux] + if h : i < l.size then + rw [List.drop_eq_getElem_cons h, ←getElem_eq_getElem_toList, 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 data_erase [BEq α] {l : Array α} {a : α} : (l.erase a).data = l.data.erase a +@[simp] proof_wanted toList_erase [BEq α] {l : Array α} {a : α} : + (l.erase a).toList = l.toList.erase a + +@[simp] theorem eraseIdx!_eq_eraseIdx (a : Array α) (i : Nat) : + a.eraseIdx! i = a.eraseIdx i := rfl -/-! ### shrink -/ +@[simp] theorem size_eraseIdx (a : Array α) (i : Nat) : + (a.eraseIdx i).size = if i < a.size then a.size-1 else a.size := by + simp only [eraseIdx]; split; simp; rfl -theorem size_shrink_loop (a : Array α) (n) : (shrink.loop n a).size = a.size - n := by - induction n generalizing a with simp[shrink.loop] - | succ n ih => - simp[ih] - omega +/-! ### set -/ -theorem size_shrink (a : Array α) (n) : (a.shrink n).size = min a.size n := by - simp [shrink, size_shrink_loop] - omega +theorem size_set! (a : Array α) (i v) : (a.set! i v).size = a.size := by simp /-! ### map -/ theorem mapM_empty [Monad m] (f : α → m β) : mapM f #[] = pure #[] := by rw [mapM, mapM.map]; rfl -@[simp] theorem map_empty (f : α → β) : map f #[] = #[] := mapM_empty .. +theorem map_empty (f : α → β) : map f #[] = #[] := mapM_empty f /-! ### mem -/ -alias not_mem_empty := not_mem_nil - theorem mem_singleton : a ∈ #[b] ↔ a = b := by simp /-! ### append -/ @@ -149,3 +146,97 @@ theorem mem_singleton : a ∈ #[b] ↔ a = b := by simp 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 + +@[simp] theorem size_insertAt (as : Array α) (i : Fin (as.size+1)) (v : α) : + (as.insertAt i v).size = as.size + 1 := by + rw [insertAt, size_insertAt_loop, size_push] + +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, getElem_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, getElem_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, getElem_swap, if_pos rfl] + 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, getElem_swap, if_neg h1, if_pos rfl]; rfl + exact Nat.pred_lt_of_lt hgt + else + have h1 : k - 1 ≠ j - 1 := by omega + have h2 : k - 1 ≠ j := by omega + rw [get_insertAt_loop_gt_le, getElem_swap, if_neg h1, if_neg h2] + apply Nat.le_of_lt_add_one + rw [Nat.sub_one_add_one] + exact Nat.lt_of_le_of_ne hle h0 + exact Nat.not_eq_zero_of_lt h + exact hgt + · next h => + absurd h + exact Nat.lt_of_lt_of_le hgt hle + +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, getElem_push, dif_pos hk'] + exact hlt + +theorem getElem_insertAt_gt (as : Array α) (i : Fin (as.size+1)) (v : α) + (k) (hgt : k > i.val) {hk : k < (as.insertAt i v).size} {hk' : k - 1 < as.size} : + (as.insertAt i v)[k] = as[k - 1] := by + simp only [insertAt] + rw [get_insertAt_loop_gt_le, getElem_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, getElem_push_eq] + exact heq + exact Nat.le_of_lt_succ i.is_lt diff --git a/Batteries/Data/Array/Match.lean b/Batteries/Data/Array/Match.lean index 46b2239f6f..b47ee90adc 100644 --- a/Batteries/Data/Array/Match.lean +++ b/Batteries/Data/Array/Match.lean @@ -52,7 +52,7 @@ termination_by k => k.val def PrefixTable.extend [BEq α] (t : PrefixTable α) (x : α) : PrefixTable α where toArray := t.toArray.push (x, t.step x ⟨t.size, Nat.lt_succ_self _⟩) valid _ := by - rw [Array.get_push] + rw [Array.getElem_push] split · exact t.valid .. · next h => exact Nat.le_trans (Nat.lt_succ.1 <| Fin.isLt ..) (Nat.not_lt.1 h) diff --git a/Batteries/Data/Array/Merge.lean b/Batteries/Data/Array/Merge.lean index aa83e0200b..4b806a35d6 100644 --- a/Batteries/Data/Array/Merge.lean +++ b/Batteries/Data/Array/Merge.lean @@ -31,6 +31,8 @@ set_option linter.unusedVariables false in def mergeSortedPreservingDuplicates [ord : Ord α] (xs ys : Array α) : Array α := merge (compare · · |>.isLT) xs ys +-- We name `ord` so it can be provided as a named argument. +set_option linter.unusedVariables.funArgs false in /-- `O(|xs| + |ys|)`. Merge arrays `xs` and `ys`, which must be sorted according to `compare` and must not contain duplicates. Equal elements are merged using `merge`. If `merge` respects the order @@ -85,6 +87,8 @@ where @[deprecated (since := "2024-04-24")] alias mergeUnsortedDeduplicating := mergeUnsortedDedup +-- We name `eq` so it can be provided as a named argument. +set_option linter.unusedVariables.funArgs false in /-- `O(|xs|)`. Replace each run `[x₁, ⋯, xₙ]` of equal elements in `xs` with `f ⋯ (f (f x₁ x₂) x₃) ⋯ xₙ`. diff --git a/Batteries/Data/Array/Monadic.lean b/Batteries/Data/Array/Monadic.lean index a9821eb689..934111e131 100644 --- a/Batteries/Data/Array/Monadic.lean +++ b/Batteries/Data/Array/Monadic.lean @@ -44,7 +44,7 @@ theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m · case s => intro ⟨i, hi⟩ arr ⟨ih₁, eq, ih₂⟩ refine (hs _ ih₁).map fun ⟨h₁, h₂⟩ => ⟨h₂, by simp [eq], fun j hj => ?_⟩ - simp [get_push] at hj ⊢; split; {apply ih₂} + simp [getElem_push] at hj ⊢; split; {apply ih₂} cases j; cases (Nat.le_or_eq_of_le_succ hj).resolve_left ‹_›; cases eq; exact h₁ theorem SatisfiesM_mapM' [Monad m] [LawfulMonad m] (as : Array α) (f : α → m β) @@ -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)] @@ -125,27 +125,36 @@ theorem SatisfiesM_foldrM [Monad m] [LawfulMonad m] simp [foldrM]; split; {exact go _ h0} · next h => exact .pure (Nat.eq_zero_of_not_pos h ▸ h0) -theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as.size → α → m β) +theorem SatisfiesM_mapFinIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as.size → α → m β) (motive : Nat → Prop) (h0 : motive 0) (p : Fin as.size → β → Prop) (hs : ∀ i, motive i.1 → SatisfiesM (p i · ∧ motive (i + 1)) (f i as[i])) : SatisfiesM (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) - (Array.mapIdxM as f) := by + (Array.mapFinIdxM as f) := by let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : ∀ i h h', p ⟨i, h⟩ bs[i]) (hm : motive j) : SatisfiesM (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) - (Array.mapIdxM.map as f i j h bs) := by - induction i generalizing j bs with simp [mapIdxM.map] + (Array.mapFinIdxM.map as f i j h bs) := by + induction i generalizing j bs with simp [mapFinIdxM.map] | zero => have := (Nat.zero_add _).symm.trans h exact .pure ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩ | succ i ih => refine (hs _ (by exact hm)).bind fun b hb => ih (by simp [h₁]) (fun i hi hi' => ?_) hb.2 - simp at hi'; simp [get_push]; split + simp at hi'; simp [getElem_push]; split · next h => exact h₂ _ _ h · next h => cases h₁.symm ▸ (Nat.le_or_eq_of_le_succ hi').resolve_left h; exact hb.1 - simp [mapIdxM]; exact go rfl nofun h0 + simp [mapFinIdxM]; exact go rfl nofun h0 + +theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Nat → α → m β) + (motive : Nat → Prop) (h0 : motive 0) + (p : Fin as.size → β → Prop) + (hs : ∀ i, motive i.1 → SatisfiesM (p i · ∧ motive (i + 1)) (f i as[i])) : + SatisfiesM + (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) + (Array.mapIdxM as f) := + SatisfiesM_mapFinIdxM as (fun i => f i) motive h0 p hs theorem size_modifyM [Monad m] [LawfulMonad m] (a : Array α) (i : Nat) (f : α → m α) : SatisfiesM (·.size = a.size) (a.modifyM i f) := by diff --git a/Batteries/Data/Array/OfFn.lean b/Batteries/Data/Array/OfFn.lean new file mode 100644 index 0000000000..5233fd1f96 --- /dev/null +++ b/Batteries/Data/Array/OfFn.lean @@ -0,0 +1,14 @@ +/- +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 -/ + +end Array diff --git a/Batteries/Data/Array/Pairwise.lean b/Batteries/Data/Array/Pairwise.lean new file mode 100644 index 0000000000..82ace9609f --- /dev/null +++ b/Batteries/Data/Array/Pairwise.lean @@ -0,0 +1,62 @@ +/- +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.toList.Pairwise R + +theorem pairwise_iff_get {as : Array α} : as.Pairwise R ↔ + ∀ (i j : Fin as.size), i < j → R (as.get i) (as.get j) := by + unfold Pairwise; simp [List.pairwise_iff_get, getElem_fin_eq_getElem_toList] + +theorem pairwise_iff_getElem {as : Array α} : as.Pairwise R ↔ + ∀ (i j : Nat) (_ : i < as.size) (_ : j < as.size), i < j → R as[i] as[j] := by + unfold Pairwise; simp [List.pairwise_iff_getElem, length_toList] + +instance (R : α → α → Prop) [DecidableRel R] (as) : Decidable (Pairwise R as) := + have : (∀ (j : Fin as.size) (i : Fin j.val), R as[i.val] (as[j.val])) ↔ Pairwise R as := by + 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_toList, toList_append, ← List.pairwise_append] + +theorem pairwise_push {as : Array α} : + (as.push a).Pairwise R ↔ as.Pairwise R ∧ (∀ x ∈ as, R x a) := by + unfold Pairwise + simp [← mem_toList, push_toList, List.pairwise_append, List.pairwise_singleton, + List.mem_singleton] + +theorem pairwise_extract {as : Array α} (h : as.Pairwise R) (start stop) : + (as.extract start stop).Pairwise R := by + simp only [pairwise_iff_getElem, getElem_extract, size_extract] at h ⊢ + intro _ _ _ _ hlt + apply h + exact Nat.add_lt_add_left hlt start diff --git a/Batteries/Data/AssocList.lean b/Batteries/Data/AssocList.lean index 1492304efa..eba8927cef 100644 --- a/Batteries/Data/AssocList.lean +++ b/Batteries/Data/AssocList.lean @@ -78,7 +78,7 @@ def toListTR (as : AssocList α β) : List (α × β) := @[csimp] theorem toList_eq_toListTR : @toList = @toListTR := by funext α β as; simp [toListTR] - exact .symm <| (Array.foldl_data_eq_map (toList as) _ id).trans (List.map_id _) + exact .symm <| (Array.foldl_toList_eq_map (toList as) _ id).trans (List.map_id _) /-- `O(n)`. Run monadic function `f` on all elements in the list, from head to tail. -/ @[specialize] def forM [Monad m] (f : α → β → m PUnit) : AssocList α β → m PUnit @@ -244,8 +244,8 @@ instance : ForIn m (AssocList α β) (α × β) where @[simp] theorem forIn_eq [Monad m] (l : AssocList α β) (init : δ) (f : (α × β) → δ → m (ForInStep δ)) : forIn l init f = forIn l.toList init f := by - simp [forIn, List.forIn] - induction l generalizing init <;> simp [AssocList.forIn, List.forIn.loop] + simp only [forIn] + induction l generalizing init <;> simp [AssocList.forIn] congr; funext a; split <;> simp [*] /-- Split the list into head and tail, if possible. -/ diff --git a/Batteries/Data/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 2bcd3ce4aa..0000000000 --- a/Batteries/Data/BitVec/Lemmas.lean +++ /dev/null @@ -1,16 +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 - -@[deprecated (since := "2024-02-07")] alias zero_is_unique := eq_nil - -/-! ### sub/neg -/ - -@[deprecated (since := "2024-02-07")] alias sub_toNat := toNat_sub - -@[deprecated (since := "2024-02-07")] alias neg_toNat := toNat_neg diff --git a/Batteries/Data/Bool.lean b/Batteries/Data/Bool.lean deleted file mode 100644 index b6c0c9b4e7..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 (since := "2023-10-27")] alias not_inj' := not_inj_iff - -@[deprecated (since := "2023-10-27")] alias and_or_inj_right' := and_or_inj_right_iff - -@[deprecated (since := "2023-10-27")] 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 e051e01fd2..6a95a241aa 100644 --- a/Batteries/Data/ByteArray.lean +++ b/Batteries/Data/ByteArray.lean @@ -36,11 +36,11 @@ theorem getElem_eq_data_getElem (a : ByteArray) (h : i < a.size) : a[i] = a.data Array.size_push .. @[simp] theorem get_push_eq (a : ByteArray) (x : UInt8) : (a.push x)[a.size] = x := - Array.get_push_eq .. + Array.getElem_push_eq .. theorem get_push_lt (a : ByteArray) (x : UInt8) (i : Nat) (h : i < a.size) : (a.push x)[i]'(size_push .. ▸ Nat.lt_succ_of_lt h) = a[i] := - Array.get_push_lt .. + Array.getElem_push_lt .. /-! ### set -/ @@ -85,12 +85,12 @@ theorem size_append (a b : ByteArray) : (a ++ b).size = a.size + b.size := by theorem get_append_left {a b : ByteArray} (hlt : i < a.size) (h : i < (a ++ b).size := size_append .. ▸ Nat.lt_of_lt_of_le hlt (Nat.le_add_right ..)) : (a ++ b)[i] = a[i] := by - simp [getElem_eq_data_getElem]; exact Array.get_append_left hlt + simp [getElem_eq_data_getElem]; exact Array.getElem_append_left hlt theorem get_append_right {a b : ByteArray} (hle : a.size ≤ i) (h : i < (a ++ b).size) (h' : i - a.size < b.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) : (a ++ b)[i] = b[i - a.size] := by - simp [getElem_eq_data_getElem]; exact Array.get_append_right hle + simp [getElem_eq_data_getElem]; exact Array.getElem_append_right hle /-! ### extract -/ @@ -146,3 +146,38 @@ where (ofFnAux.go f i acc).data = Array.ofFn.go f i acc.data := by 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/DList.lean b/Batteries/Data/DList.lean index 6a5450f0ba..00a2d9fadf 100644 --- a/Batteries/Data/DList.lean +++ b/Batteries/Data/DList.lean @@ -1,70 +1,2 @@ -/- -Copyright (c) 2018 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -namespace Batteries -/-- -A difference List is a Function that, given a List, returns the original -contents of the difference List prepended to the given List. -This structure supports `O(1)` `append` and `concat` operations on lists, making it -useful for append-heavy uses such as logging and pretty printing. --/ -structure DList (α : Type u) where - /-- "Run" a `DList` by appending it on the right by a `List α` to get another `List α`. -/ - apply : List α → List α - /-- The `apply` function of a `DList` is completely determined by the list `apply []`. -/ - invariant : ∀ l, apply l = apply [] ++ l - -namespace DList -variable {α : Type u} -open List - -/-- `O(1)` (`apply` is `O(|l|)`). Convert a `List α` into a `DList α`. -/ -def ofList (l : List α) : DList α := - ⟨(l ++ ·), fun t => by simp⟩ - -/-- `O(1)` (`apply` is `O(1)`). Return an empty `DList α`. -/ -def empty : DList α := - ⟨id, fun _ => rfl⟩ - -instance : EmptyCollection (DList α) := ⟨DList.empty⟩ - -/-- `O(apply())`. Convert a `DList α` into a `List α` by running the `apply` function. -/ -def toList : DList α → List α - | ⟨f, _⟩ => f [] - -/-- `O(1)` (`apply` is `O(1)`). A `DList α` corresponding to the list `[a]`. -/ -def singleton (a : α) : DList α where - apply := fun t => a :: t - invariant := fun _ => rfl - -/-- `O(1)` (`apply` is `O(1)`). Prepend `a` on a `DList α`. -/ -def cons : α → DList α → DList α - | a, ⟨f, h⟩ => { - apply := fun t => a :: f t - invariant := by intro t; simp; rw [h] - } - -/-- `O(1)` (`apply` is `O(1)`). Append two `DList α`. -/ -def append : DList α → DList α → DList α - | ⟨f, h₁⟩, ⟨g, h₂⟩ => { - apply := f ∘ g - invariant := by - intro t - show f (g t) = (f (g [])) ++ t - rw [h₁ (g t), h₂ t, ← append_assoc (f []) (g []) t, ← h₁ (g [])] - } - -/-- `O(1)` (`apply` is `O(1)`). Append an element at the end of a `DList α`. -/ -def push : DList α → α → DList α - | ⟨f, h⟩, a => { - apply := fun t => f (a :: t) - invariant := by - intro t - show f (a :: t) = f (a :: nil) ++ t - rw [h [a], h (a::t), append_assoc (f []) [a] t] - rfl - } - -instance : Append (DList α) := ⟨DList.append⟩ +import Batteries.Data.DList.Basic +import Batteries.Data.DList.Lemmas diff --git a/Batteries/Data/DList/Basic.lean b/Batteries/Data/DList/Basic.lean new file mode 100644 index 0000000000..b3eb0bbc97 --- /dev/null +++ b/Batteries/Data/DList/Basic.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2018 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Batteries.Tactic.Alias + +namespace Batteries +/-- +A difference List is a Function that, given a List, returns the original +contents of the difference List prepended to the given List. +This structure supports `O(1)` `append` and `push` operations on lists, making it +useful for append-heavy uses such as logging and pretty printing. +-/ +structure DList (α : Type u) where + /-- "Run" a `DList` by appending it on the right by a `List α` to get another `List α`. -/ + apply : List α → List α + /-- The `apply` function of a `DList` is completely determined by the list `apply []`. -/ + invariant : ∀ l, apply l = apply [] ++ l + +attribute [simp] DList.apply + +namespace DList +variable {α : Type u} +open List + +/-- `O(1)` (`apply` is `O(|l|)`). Convert a `List α` into a `DList α`. -/ +def ofList (l : List α) : DList α := + ⟨(l ++ ·), fun t => by simp⟩ + +/-- `O(1)` (`apply` is `O(1)`). Return an empty `DList α`. -/ +def empty : DList α := + ⟨id, fun _ => rfl⟩ + +instance : EmptyCollection (DList α) := ⟨DList.empty⟩ + +instance : Inhabited (DList α) := ⟨DList.empty⟩ + +/-- `O(apply())`. Convert a `DList α` into a `List α` by running the `apply` function. -/ +@[simp] def toList : DList α → List α + | ⟨f, _⟩ => f [] + +/-- `O(1)` (`apply` is `O(1)`). A `DList α` corresponding to the list `[a]`. -/ +def singleton (a : α) : DList α where + apply := fun t => a :: t + invariant := fun _ => rfl + +/-- `O(1)` (`apply` is `O(1)`). Prepend `a` on a `DList α`. -/ +def cons : α → DList α → DList α + | a, ⟨f, h⟩ => { + apply := fun t => a :: f t + invariant := by intro t; simp; rw [h] + } + +/-- `O(1)` (`apply` is `O(1)`). Append two `DList α`. -/ +def append : DList α → DList α → DList α + | ⟨f, h₁⟩, ⟨g, h₂⟩ => { + apply := f ∘ g + invariant := by + intro t + show f (g t) = (f (g [])) ++ t + rw [h₁ (g t), h₂ t, ← append_assoc (f []) (g []) t, ← h₁ (g [])] + } + +/-- `O(1)` (`apply` is `O(1)`). Append an element at the end of a `DList α`. -/ +def push : DList α → α → DList α + | ⟨f, h⟩, a => { + apply := fun t => f (a :: t) + invariant := by + intro t + show f (a :: t) = f (a :: nil) ++ t + rw [h [a], h (a::t), append_assoc (f []) [a] t] + rfl + } + +instance : Append (DList α) := ⟨DList.append⟩ + +/-- Convert a lazily-evaluated `List` to a `DList` -/ +def ofThunk (l : Thunk (List α)) : DList α := + ⟨fun xs => l.get ++ xs, fun t => by simp⟩ + +@[deprecated (since := "2024-10-16")] alias lazy_ofList := ofThunk + +/-- Concatenates a list of difference lists to form a single difference list. Similar to +`List.join`. -/ +def join {α : Type _} : List (DList α) → DList α + | [] => DList.empty + | x :: xs => x ++ DList.join xs diff --git a/Batteries/Data/DList/Lemmas.lean b/Batteries/Data/DList/Lemmas.lean new file mode 100644 index 0000000000..6c17e9e00a --- /dev/null +++ b/Batteries/Data/DList/Lemmas.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2017 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Batteries.Data.DList.Basic + +/-! +# Difference list + +This file provides a few results about `DList`. + +A difference list is a function that, given a list, returns the original content of the +difference list prepended to the given list. It is useful to represent elements of a given type +as `a₁ + ... + aₙ` where `+ : α → α → α` is any operation, without actually computing. + +This structure supports `O(1)` `append` and `push` operations on lists, making it +useful for append-heavy uses such as logging and pretty printing. +-/ + +namespace Batteries.DList + +open Function + +theorem toList_ofList (l : List α) : DList.toList (DList.ofList l) = l := by + cases l; rfl; simp [ofList] + +theorem ofList_toList (l : DList α) : DList.ofList (DList.toList l) = l := by + obtain ⟨app, inv⟩ := l + simp only [ofList, toList, mk.injEq] + funext x + rw [(inv x)] + +theorem toList_empty : toList (@empty α) = [] := by simp [empty] + +theorem toList_singleton (x : α) : toList (singleton x) = [x] := by simp [singleton] + +theorem toList_append (l₁ l₂ : DList α) : toList (l₁ ++ l₂) = toList l₁ ++ toList l₂ := by + simp only [toList, append, Function.comp]; rw [invariant] + +theorem toList_cons (x : α) (l : DList α) : toList (cons x l) = x :: toList l := by + cases l; simp [cons] + +theorem toList_push (x : α) (l : DList α) : toList (push l x) = toList l ++ [x] := by + simp only [toList, push]; rw [invariant] + +@[simp] +theorem singleton_eq_ofThunk {α : Type _} {a : α} : singleton a = ofThunk [a] := + rfl + +@[simp] +theorem ofThunk_coe {α : Type _} {l : List α} : ofThunk l = ofList l := + rfl + +@[deprecated (since := "2024-10-16")] alias DList_singleton := singleton_eq_ofThunk +@[deprecated (since := "2024-10-16")] alias DList_lazy := ofThunk_coe + +end Batteries.DList diff --git a/Batteries/Data/Fin/Basic.lean b/Batteries/Data/Fin/Basic.lean index 3632d4f254..346f3006e5 100644 --- a/Batteries/Data/Fin/Basic.lean +++ b/Batteries/Data/Fin/Basic.lean @@ -13,4 +13,4 @@ def clamp (n m : Nat) : Fin (m + 1) := ⟨min n m, Nat.lt_succ_of_le (Nat.min_le def enum (n) : Array (Fin n) := Array.ofFn id /-- `list n` is the list of all elements of `Fin n` in order -/ -def list (n) : List (Fin n) := (enum n).data +def list (n) : List (Fin n) := (enum n).toList diff --git a/Batteries/Data/Fin/Lemmas.lean b/Batteries/Data/Fin/Lemmas.lean index 4d4eb59a1a..d799e2e6f3 100644 --- a/Batteries/Data/Fin/Lemmas.lean +++ b/Batteries/Data/Fin/Lemmas.lean @@ -4,17 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Batteries.Data.Fin.Basic +import Batteries.Data.List.Lemmas namespace Fin 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 @@ -32,7 +27,7 @@ protected theorem le_antisymm {x y : Fin n} (h1 : x ≤ y) (h2 : y ≤ x) : x = @[simp] theorem getElem_list (i : Nat) (h : i < (list n).length) : (list n)[i] = cast (length_list n) ⟨i, h⟩ := by - simp only [list]; rw [← Array.getElem_eq_data_getElem, getElem_enum, cast_mk] + simp only [list]; rw [← Array.getElem_eq_getElem_toList, getElem_enum, cast_mk] @[deprecated getElem_list (since := "2024-06-12")] theorem get_list (i : Fin (list n).length) : (list n).get i = i.cast (length_list n) := by @@ -46,48 +41,39 @@ 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 | 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 | succ n ih => conv => lhs; rw [list_succ_last] conv => rhs; rw [list_succ] simp [← List.map_reverse, ih, Function.comp_def, rev_succ] -/-! ### foldl -/ - -theorem foldl_loop_lt (f : α → Fin n → α) (x) (h : m < n) : - foldl.loop n f x m = foldl.loop n f (f x ⟨m, h⟩) (m+1) := by - rw [foldl.loop, dif_pos h] - -theorem foldl_loop_eq (f : α → Fin n → α) (x) : foldl.loop n f x n = x := by - rw [foldl.loop, dif_neg (Nat.lt_irrefl _)] +/-! ### foldlM -/ -theorem foldl_loop (f : α → Fin (n+1) → α) (x) (h : m < n+1) : - foldl.loop (n+1) f x m = foldl.loop n (fun x i => f x i.succ) (f x ⟨m, h⟩) m := by - if h' : m < n then - rw [foldl_loop_lt _ _ h, foldl_loop_lt _ _ h', foldl_loop]; rfl - else - cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h') - rw [foldl_loop_lt, foldl_loop_eq, foldl_loop_eq] -termination_by n - m +theorem foldlM_eq_foldlM_list [Monad m] (f : α → Fin n → m α) (x) : + foldlM n f x = (list n).foldlM f x := by + induction n generalizing x with + | zero => simp + | succ n ih => + rw [foldlM_succ, list_succ, List.foldlM_cons] + congr; funext + rw [List.foldlM_map, ih] -@[simp] theorem foldl_zero (f : α → Fin 0 → α) (x) : foldl 0 f x = x := by simp [foldl, foldl.loop] +/-! ### foldrM -/ -theorem foldl_succ (f : α → Fin (n+1) → α) (x) : - foldl (n+1) f x = foldl n (fun x i => f x i.succ) (f x 0) := foldl_loop .. +theorem foldrM_eq_foldrM_list [Monad m] [LawfulMonad m] (f : Fin n → α → m α) (x) : + foldrM n f x = (list n).foldrM f x := by + induction n with + | zero => simp + | succ n ih => rw [foldrM_succ, ih, list_succ, List.foldrM_cons, List.foldrM_map] -theorem foldl_succ_last (f : α → Fin (n+1) → α) (x) : - foldl (n+1) f x = f (foldl n (f · ·.castSucc) x) (last n) := by - rw [foldl_succ] - induction n generalizing x with - | zero => simp [foldl_succ, Fin.last] - | succ n ih => rw [foldl_succ, ih (f · ·.succ), foldl_succ]; simp [succ_castSucc] +/-! ### foldl -/ theorem foldl_eq_foldl_list (f : α → Fin n → α) (x) : foldl n f x = (list n).foldl f x := by induction n generalizing x with @@ -96,49 +82,7 @@ theorem foldl_eq_foldl_list (f : α → Fin n → α) (x) : foldl n f x = (list /-! ### foldr -/ -unseal foldr.loop in -theorem foldr_loop_zero (f : Fin n → α → α) (x) : foldr.loop n f ⟨0, Nat.zero_le _⟩ x = x := - rfl - -unseal foldr.loop in -theorem foldr_loop_succ (f : Fin n → α → α) (x) (h : m < n) : - foldr.loop n f ⟨m+1, h⟩ x = foldr.loop n f ⟨m, Nat.le_of_lt h⟩ (f ⟨m, h⟩ x) := - rfl - -theorem foldr_loop (f : Fin (n+1) → α → α) (x) (h : m+1 ≤ n+1) : - foldr.loop (n+1) f ⟨m+1, h⟩ x = - f 0 (foldr.loop n (fun i => f i.succ) ⟨m, Nat.le_of_succ_le_succ h⟩ x) := by - induction m generalizing x with - | zero => simp [foldr_loop_zero, foldr_loop_succ] - | succ m ih => rw [foldr_loop_succ, ih, foldr_loop_succ, Fin.succ] - -@[simp] theorem foldr_zero (f : Fin 0 → α → α) (x) : - foldr 0 f x = x := foldr_loop_zero .. - -theorem foldr_succ (f : Fin (n+1) → α → α) (x) : - foldr (n+1) f x = f 0 (foldr n (fun i => f i.succ) x) := foldr_loop .. - -theorem foldr_succ_last (f : Fin (n+1) → α → α) (x) : - foldr (n+1) f x = foldr n (f ·.castSucc) (f (last n) x) := by - induction n generalizing x with - | zero => simp [foldr_succ, Fin.last] - | succ n ih => rw [foldr_succ, ih (f ·.succ), foldr_succ]; simp [succ_castSucc] - theorem foldr_eq_foldr_list (f : Fin n → α → α) (x) : foldr n f x = (list n).foldr f x := by induction n with | zero => rw [foldr_zero, list_zero, List.foldr_nil] | succ n ih => rw [foldr_succ, ih, list_succ, List.foldr_cons, List.foldr_map] - -/-! ### foldl/foldr -/ - -theorem foldl_rev (f : Fin n → α → α) (x) : - foldl n (fun x i => f i.rev x) x = foldr n f x := by - induction n generalizing x with - | zero => simp - | succ n ih => rw [foldl_succ, foldr_succ_last, ← ih]; simp [rev_succ] - -theorem foldr_rev (f : α → Fin n → α) (x) : - foldr n (fun i x => f x i.rev) x = foldl n f x := by - induction n generalizing x with - | zero => simp - | succ n ih => rw [foldl_succ_last, foldr_succ, ← ih]; simp [rev_succ] 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 3419ba35ab..3fd1d3350d 100644 --- a/Batteries/Data/HashMap/Basic.lean +++ b/Batteries/Data/HashMap/Basic.lean @@ -37,7 +37,7 @@ def update (data : Buckets α β) (i : USize) The number of elements in the bucket array. Note: this is marked `noncomputable` because it is only intended for specification. -/ -noncomputable def size (data : Buckets α β) : Nat := .sum (data.1.data.map (·.toList.length)) +noncomputable def size (data : Buckets α β) : Nat := (data.1.toList.map (·.toList.length)).sum @[simp] theorem update_size (self : Buckets α β) (i d h) : (self.update i d h).1.size = self.1.size := Array.size_uset .. @@ -52,11 +52,11 @@ The well-formedness invariant for the bucket array says that every element hashe -/ structure WF [BEq α] [Hashable α] (buckets : Buckets α β) : Prop where /-- The elements of a bucket are all distinct according to the `BEq` relation. -/ - distinct [LawfulHashable α] [PartialEquivBEq α] : ∀ bucket ∈ buckets.1.data, + distinct [LawfulHashable α] [PartialEquivBEq α] : ∀ bucket ∈ buckets.1.toList, bucket.toList.Pairwise fun a b => ¬(a.1 == b.1) /-- Every element in a bucket should hash to its location. -/ hash_self (i : Nat) (h : i < buckets.1.size) : - buckets.1[i].All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i + buckets.1[i].All fun k _ => ((hash k).toUSize % USize.ofNat buckets.1.size).toNat = i end Buckets end Imp @@ -93,7 +93,7 @@ def empty (capacity := 0) : Imp α β := /-- Calculates the bucket index from a hash value `u`. -/ def mkIdx {n : Nat} (h : 0 < n) (u : USize) : {u : USize // u.toNat < n} := - ⟨u % n, USize.modn_lt _ h⟩ + ⟨u % USize.ofNat n, USize.toNat_mod_lt _ h⟩ /-- Inserts a key-value pair into the bucket array. This function assumes that the data is not @@ -237,7 +237,7 @@ inductive WF [BEq α] [Hashable α] : Imp α β → Prop where /-- Replacing an element in a well formed hash map yields a well formed hash map. -/ | modify : WF m → WF (modify m a f) -theorem WF.empty [BEq α] [Hashable α] : WF (empty n : Imp α β) := by unfold empty; apply empty' +theorem WF.empty [BEq α] [Hashable α] : WF (empty n : Imp α β) := empty' end Imp diff --git a/Batteries/Data/HashMap/WF.lean b/Batteries/Data/HashMap/WF.lean index 9f69994638..aa33711633 100644 --- a/Batteries/Data/HashMap/WF.lean +++ b/Batteries/Data/HashMap/WF.lean @@ -15,26 +15,28 @@ attribute [-simp] Bool.not_eq_true namespace Buckets -@[ext] protected theorem ext : ∀ {b₁ b₂ : Buckets α β}, b₁.1.data = b₂.1.data → b₁ = b₂ +@[ext] protected theorem ext : ∀ {b₁ b₂ : Buckets α β}, b₁.1.toList = b₂.1.toList → b₁ = b₂ | ⟨⟨_⟩, _⟩, ⟨⟨_⟩, _⟩, rfl => rfl -theorem update_data (self : Buckets α β) (i d h) : - (self.update i d h).1.data = self.1.data.set i.toNat d := rfl +theorem toList_update (self : Buckets α β) (i d h) : + (self.update i d h).1.toList = self.1.toList.set i.toNat d := rfl + +@[deprecated (since := "2024-09-09")] alias update_data := toList_update theorem exists_of_update (self : Buckets α β) (i d h) : - ∃ l₁ l₂, self.1.data = l₁ ++ self.1[i] :: l₂ ∧ List.length l₁ = i.toNat ∧ - (self.update i d h).1.data = l₁ ++ d :: l₂ := by - simp only [Array.data_length, Array.ugetElem_eq_getElem, Array.getElem_eq_data_getElem] + ∃ l₁ l₂, self.1.toList = l₁ ++ self.1[i] :: l₂ ∧ List.length l₁ = i.toNat ∧ + (self.update i d h).1.toList = l₁ ++ d :: l₂ := by + simp only [Array.length_toList, Array.ugetElem_eq_getElem, Array.getElem_eq_getElem_toList] exact List.exists_of_set h theorem update_update (self : Buckets α β) (i d d' h h') : (self.update i d h).update i d' h' = self.update i d' h := by - simp only [update, Array.uset, Array.data_length] + simp only [update, Array.uset, Array.length_toList] congr 1 rw [Array.set_set] theorem size_eq (data : Buckets α β) : - size data = .sum (data.1.data.map (·.toList.length)) := rfl + size data = (data.1.toList.map (·.toList.length)).sum := rfl theorem mk_size (h) : (mk n h : Buckets α β).size = 0 := by simp only [mk, mkArray, size_eq]; clear h @@ -44,32 +46,32 @@ theorem WF.mk' [BEq α] [Hashable α] (h) : (Buckets.mk n h : Buckets α β).WF refine ⟨fun _ h => ?_, fun i h => ?_⟩ · simp only [Buckets.mk, mkArray, List.mem_replicate, ne_eq] at h simp [h, List.Pairwise.nil] - · simp [Buckets.mk, empty', mkArray, Array.getElem_eq_data_getElem, AssocList.All] + · simp [Buckets.mk, empty', mkArray, Array.getElem_eq_getElem_toList, AssocList.All] theorem WF.update [BEq α] [Hashable α] {buckets : Buckets α β} {i d h} (H : buckets.WF) (h₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], (buckets.1[i].toList.Pairwise fun a b => ¬(a.1 == b.1)) → d.toList.Pairwise fun a b => ¬(a.1 == b.1)) - (h₂ : (buckets.1[i].All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) → - d.All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) : + (h₂ : (buckets.1[i].All fun k _ => ((hash k).toUSize % .ofNat buckets.1.size).toNat = i.toNat) → + d.All fun k _ => ((hash k).toUSize % USize.ofNat buckets.1.size).toNat = i.toNat) : (buckets.update i d h).WF := by refine ⟨fun l hl => ?_, fun i hi p hp => ?_⟩ · exact match List.mem_or_eq_of_mem_set hl with | .inl hl => H.1 _ hl - | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_data ..)) + | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_toList ..)) · revert hp - simp only [Array.getElem_eq_data_getElem, update_data, List.getElem_set, Array.data_length, - update_size] + simp only [Array.getElem_eq_getElem_toList, toList_update, List.getElem_set, + Array.length_toList, update_size] split <;> intro hp · next eq => exact eq ▸ h₂ (H.2 _ _) _ hp - · simp only [update_size, Array.data_length] at hi + · simp only [update_size, Array.length_toList] at hi exact H.2 i hi _ hp end Buckets theorem reinsertAux_size [Hashable α] (data : Buckets α β) (a : α) (b : β) : (reinsertAux data a b).size = data.size.succ := by - simp only [reinsertAux, Array.data_length, Array.ugetElem_eq_getElem, Buckets.size_eq, + simp only [reinsertAux, Array.length_toList, Array.ugetElem_eq_getElem, Buckets.size_eq, Nat.succ_eq_add_one] refine have ⟨l₁, l₂, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h₁, Nat.succ_add]; rfl @@ -89,33 +91,35 @@ theorem expand_size [Hashable α] {buckets : Buckets α β} : · rw [Buckets.mk_size]; simp [Buckets.size] · nofun where - go (i source) (target : Buckets α β) (hs : ∀ j < i, source.data[j]?.getD .nil = .nil) : + go (i source) (target : Buckets α β) (hs : ∀ j < i, source.toList[j]?.getD .nil = .nil) : (expand.go i source target).size = - .sum (source.data.map (·.toList.length)) + target.size := by + (source.toList.map (·.toList.length)).sum + target.size := by unfold expand.go; split · next H => - refine (go (i+1) _ _ fun j hj => ?a).trans ?b <;> simp + refine (go (i+1) _ _ fun j hj => ?a).trans ?b · case a => + simp only [Array.length_toList, Array.toList_set] simp [List.getD_eq_getElem?_getD, List.getElem?_set, Option.map_eq_map]; split - · cases source.data[j]? <;> rfl + · cases source.toList[j]? <;> rfl · next H => exact hs _ (Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) (Ne.symm H)) · case b => + simp only [Array.length_toList, Array.toList_set, Array.get_eq_getElem, AssocList.foldl_eq] refine have ⟨l₁, l₂, h₁, _, eq⟩ := List.exists_of_set H; eq ▸ ?_ rw [h₁] simp only [Buckets.size_eq, List.map_append, List.map_cons, AssocList.toList, - List.length_nil, Nat.sum_append, Nat.sum_cons, Nat.zero_add, Array.data_length] + List.length_nil, Nat.sum_append, List.sum_cons, Nat.zero_add, Array.length_toList] rw [Nat.add_assoc, Nat.add_assoc, Nat.add_assoc]; congr 1 (conv => rhs; rw [Nat.add_left_comm]); congr 1 - rw [← Array.getElem_eq_data_getElem] + rw [← Array.getElem_eq_getElem_toList] have := @reinsertAux_size α β _; simp [Buckets.size] at this induction source[i].toList generalizing target <;> simp [*, Nat.succ_add]; rfl · next H => - rw [(_ : Nat.sum _ = 0), Nat.zero_add] - rw [← (_ : source.data.map (fun _ => .nil) = source.data)] + rw [(_ : List.sum _ = 0), Nat.zero_add] + rw [← (_ : source.toList.map (fun _ => .nil) = source.toList)] · simp only [List.map_map] - induction source.data <;> simp [*] + induction source.toList <;> simp [*] refine List.ext_getElem (by simp) fun j h₁ h₂ => ?_ - simp only [List.getElem_map, Array.data_length] + simp only [List.getElem_map, Array.length_toList] have := (hs j (Nat.lt_of_lt_of_le h₂ (Nat.not_lt.1 H))).symm rwa [List.getElem?_eq_getElem] at this termination_by source.size - i @@ -124,21 +128,21 @@ theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α (hl₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], l.Pairwise fun a b => ¬(a.1 == b.1)) (hl₂ : ∀ x ∈ l, rank x.1 = i) {target : Buckets α β} (ht₁ : target.WF) - (ht₂ : ∀ bucket ∈ target.1.data, + (ht₂ : ∀ bucket ∈ target.1.toList, bucket.All fun k _ => rank k ≤ i ∧ ∀ [PartialEquivBEq α] [LawfulHashable α], ∀ x ∈ l, ¬(x.1 == k)) : (l.foldl (fun d x => reinsertAux d x.1 x.2) target).WF ∧ - ∀ bucket ∈ (l.foldl (fun d x => reinsertAux d x.1 x.2) target).1.data, + ∀ bucket ∈ (l.foldl (fun d x => reinsertAux d x.1 x.2) target).1.toList, bucket.All fun k _ => rank k ≤ i := by induction l generalizing target with | nil => exact ⟨ht₁, fun _ h₁ _ h₂ => (ht₂ _ h₁ _ h₂).1⟩ | cons _ _ ih => simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp] at hl₁ hl₂ ht₂ refine ih hl₁.2 hl₂.2 - (reinsertAux_WF ht₁ fun _ h => (ht₂ _ (Array.getElem_mem_data ..) _ h).2.1) + (reinsertAux_WF ht₁ fun _ h => (ht₂ _ (Array.getElem_mem_toList ..) _ h).2.1) (fun _ h => ?_) - simp only [reinsertAux, Buckets.update, Array.uset, Array.data_length, - Array.ugetElem_eq_getElem, Array.data_set] at h + simp only [reinsertAux, Buckets.update, Array.uset, Array.length_toList, + Array.ugetElem_eq_getElem, Array.toList_set] at h match List.mem_or_eq_of_mem_set h with | .inl h => intro _ hf @@ -148,7 +152,7 @@ theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α | _, .head .. => exact ⟨hl₂.1 ▸ Nat.le_refl _, fun _ h h' => hl₁.1 _ h (PartialEquivBEq.symm h')⟩ | _, .tail _ h => - have ⟨h₁, h₂⟩ := ht₂ _ (Array.getElem_mem_data ..) _ h + have ⟨h₁, h₂⟩ := ht₂ _ (Array.getElem_mem_toList ..) _ h exact ⟨h₁, h₂.2⟩ theorem expand_WF [BEq α] [Hashable α] {buckets : Buckets α β} (H : buckets.WF) : @@ -156,12 +160,12 @@ theorem expand_WF [BEq α] [Hashable α] {buckets : Buckets α β} (H : buckets. go _ H.1 H.2 ⟨.mk' _, fun _ _ _ _ => by simp_all [Buckets.mk, List.mem_replicate]⟩ where go (i) {source : Array (AssocList α β)} - (hs₁ : ∀ [LawfulHashable α] [PartialEquivBEq α], ∀ bucket ∈ source.data, + (hs₁ : ∀ [LawfulHashable α] [PartialEquivBEq α], ∀ bucket ∈ source.toList, bucket.toList.Pairwise fun a b => ¬(a.1 == b.1)) (hs₂ : ∀ (j : Nat) (h : j < source.size), - source[j].All fun k _ => ((hash k).toUSize % source.size).toNat = j) - {target : Buckets α β} (ht : target.WF ∧ ∀ bucket ∈ target.1.data, - bucket.All fun k _ => ((hash k).toUSize % source.size).toNat < i) : + source[j].All fun k _ => ((hash k).toUSize % USize.ofNat source.size).toNat = j) + {target : Buckets α β} (ht : target.WF ∧ ∀ bucket ∈ target.1.toList, + bucket.All fun k _ => ((hash k).toUSize % USize.ofNat source.size).toNat < i) : (expand.go i source target).WF := by unfold expand.go; split · next H => @@ -169,16 +173,16 @@ where · match List.mem_or_eq_of_mem_set hl with | .inl hl => exact hs₁ _ hl | .inr e => exact e ▸ .nil - · simp only [Array.data_length, Array.size_set, Array.getElem_eq_data_getElem, Array.data_set, - List.getElem_set] + · simp only [Array.length_toList, Array.size_set, Array.getElem_eq_getElem_toList, + Array.toList_set, List.getElem_set] split · nofun · exact hs₂ _ (by simp_all) - · let rank (k : α) := ((hash k).toUSize % source.size).toNat + · let rank (k : α) := ((hash k).toUSize % USize.ofNat source.size).toNat have := expand_WF.foldl rank ?_ (hs₂ _ H) ht.1 (fun _ h₁ _ h₂ => ?_) · simp only [Array.get_eq_getElem, AssocList.foldl_eq, Array.size_set] exact ⟨this.1, fun _ h₁ _ h₂ => Nat.lt_succ_of_le (this.2 _ h₁ _ h₂)⟩ - · exact hs₁ _ (Array.getElem_mem_data ..) + · exact hs₁ _ (Array.getElem_mem_toList ..) · have := ht.2 _ h₁ _ h₂ refine ⟨Nat.le_of_lt this, fun _ h h' => Nat.ne_of_lt this ?_⟩ exact LawfulHashable.hash_eq h' ▸ hs₂ _ H _ h @@ -196,7 +200,7 @@ theorem insert_size [BEq α] [Hashable α] {m : Imp α β} {k v} · unfold Buckets.size refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h, h₁, Buckets.size_eq, Nat.succ_add]; rfl - · rw [expand_size]; simp only [expand, h, Buckets.size, Array.data_length, Buckets.update_size] + · rw [expand_size]; simp only [expand, h, Buckets.size, Array.length_toList, Buckets.update_size] refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h₁, Buckets.size_eq, Nat.succ_add]; rfl @@ -262,8 +266,8 @@ theorem erase_size [BEq α] [Hashable α] {m : Imp α β} {k} · next H => simp only [h, Buckets.size] refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ - simp only [h₁, Array.data_length, Array.ugetElem_eq_getElem, List.map_append, List.map_cons, - Nat.sum_append, Nat.sum_cons, AssocList.toList_erase] + simp only [h₁, Array.length_toList, Array.ugetElem_eq_getElem, List.map_append, List.map_cons, + Nat.sum_append, List.sum_cons, AssocList.toList_erase] rw [(_ : List.length _ = _ + 1), Nat.add_right_comm]; {rfl} clear h₁ eq simp only [AssocList.contains_eq, List.any_eq_true] at H @@ -315,8 +319,8 @@ theorem WF.mapVal {α β γ} {f : α → β → γ} [BEq α] [Hashable α] {m : Imp α β} (H : WF m) : WF (mapVal f m) := by have ⟨h₁, h₂⟩ := H.out simp only [Imp.mapVal, h₁, Buckets.mapVal, WF_iff]; refine ⟨?_, ?_, fun i h => ?_⟩ - · simp only [Buckets.size, Array.map_data, List.map_map]; congr; funext l; simp - · simp only [Array.map_data, List.forall_mem_map] + · simp only [Buckets.size, Array.toList_map, List.map_map]; congr; funext l; simp + · simp only [Array.toList_map, List.forall_mem_map] simp only [AssocList.toList_mapVal, List.pairwise_map] exact fun _ => h₂.1 _ · simp only [Array.size_map, AssocList.All, Array.getElem_map, AssocList.toList_mapVal, @@ -343,7 +347,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable let M := StateT (ULift Nat) Id have H2 (l : List (AssocList α β)) n : l.mapM (m := M) (filterMap.go f .nil) n = - (l.map g, ⟨n.1 + .sum ((l.map g).map (·.toList.length))⟩) := by + (l.map g, ⟨n.1 + ((l.map g).map (·.toList.length)).sum⟩) := by induction l generalizing n with | nil => rfl | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc, g]; rfl @@ -359,7 +363,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable suffices ∀ bk sz (h : 0 < bk.length), m.buckets.val.mapM (m := M) (filterMap.go f .nil) ⟨0⟩ = (⟨bk⟩, ⟨sz⟩) → WF ⟨sz, ⟨bk⟩, h⟩ from this _ _ _ rfl - simp only [Array.mapM_eq_mapM_data, bind, StateT.bind, H2, List.map_map, Nat.zero_add, g] + simp only [Array.mapM_eq_mapM_toList, Functor.map, StateT.map, H2, List.map_map, Nat.zero_add, g] intro bk sz h e'; cases e' refine .mk (by simp [Buckets.size]) ⟨?_, fun i h => ?_⟩ · simp only [List.forall_mem_map, List.toList_toAssocList] @@ -367,7 +371,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable have := H.out.2.1 _ h rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢ exact this.sublist (H3 l.toList) - · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_getElem, + · simp only [Array.size_mk, List.length_map, Array.length_toList, Array.getElem_eq_getElem_toList, List.getElem_map] at h ⊢ have := H.out.2.2 _ h simp only [AssocList.All, List.toList_toAssocList, List.mem_reverse, List.mem_filterMap, diff --git a/Batteries/Data/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 daab75c612..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 (since := "2024-01-24")] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Batteries/Data/LazyList.lean b/Batteries/Data/LazyList.lean index a9100fcd48..7a3074d1b6 100644 --- a/Batteries/Data/LazyList.lean +++ b/Batteries/Data/LazyList.lean @@ -229,8 +229,8 @@ protected def Mem {α} (x : α) : LazyList α → Prop | nil => False | cons y ys => x = y ∨ ys.get.Mem x -instance {α} : Membership α (LazyList α) := - ⟨LazyList.Mem⟩ +instance {α} : Membership α (LazyList α) where + mem l a := LazyList.Mem a l instance Mem.decidable {α} [DecidableEq α] (x : α) : ∀ xs : LazyList α, Decidable (x ∈ xs) | LazyList.nil => by @@ -243,7 +243,7 @@ instance Mem.decidable {α} [DecidableEq α] (x : α) : ∀ xs : LazyList α, De exact Or.inl h else by have := Mem.decidable x ys.get - have : (x ∈ ys.get) ↔ (x ∈ cons y ys) := by simp [(· ∈ ·), LazyList.Mem, h] + have : (x ∈ ys.get) ↔ (x ∈ cons y ys) := by simp [Membership.mem, LazyList.Mem, h] exact decidable_of_decidable_of_iff this @[simp] diff --git a/Batteries/Data/List.lean b/Batteries/Data/List.lean index 998160b904..f93f90a6c2 100644 --- a/Batteries/Data/List.lean +++ b/Batteries/Data/List.lean @@ -3,5 +3,6 @@ import Batteries.Data.List.Count import Batteries.Data.List.EraseIdx import Batteries.Data.List.Init.Lemmas import Batteries.Data.List.Lemmas +import Batteries.Data.List.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 a44f430c8d..da8e21f3b8 100644 --- a/Batteries/Data/List/Basic.lean +++ b/Batteries/Data/List/Basic.lean @@ -32,17 +32,6 @@ open Option Nat | [] => none | a :: l => some (a, l) -/-- -Given a function `f : Nat → α → β` and `as : list α`, `as = [a₀, a₁, ...]`, returns the list -`[f 0 a₀, f 1 a₁, ...]`. --/ -@[inline] def mapIdx (f : Nat → α → β) (as : List α) : List β := go as #[] where - /-- Auxiliary for `mapIdx`: - `mapIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | a :: as, acc => go as (acc.push (f acc.size a)) - /-- Monadic variant of `mapIdx`. -/ @[inline] def mapIdxM {m : Type v → Type w} [Monad m] (as : List α) (f : Nat → α → m β) : m (List β) := go as #[] where @@ -86,7 +75,7 @@ drop_while (· != 1) [0, 1, 2, 3] = [1, 2, 3] @[csimp] theorem replaceF_eq_replaceFTR : @replaceF = @replaceFTR := by funext α p l; simp [replaceFTR] - let rec go (acc) : ∀ xs, replaceFTR.go p xs acc = acc.data ++ xs.replaceF p + let rec go (acc) : ∀ xs, replaceFTR.go p xs acc = acc.toList ++ xs.replaceF p | [] => by simp [replaceFTR.go, replaceF] | x::xs => by simp [replaceFTR.go, replaceF]; cases p x <;> simp @@ -149,8 +138,9 @@ def splitOnP (P : α → Bool) (l : List α) : List (List α) := go l [] where @[csimp] theorem splitOnP_eq_splitOnPTR : @splitOnP = @splitOnPTR := by funext α P l; simp [splitOnPTR] - suffices ∀ xs acc r, splitOnPTR.go P xs acc r = r.data ++ splitOnP.go P xs acc.data.reverse from - (this l #[] #[]).symm + suffices ∀ xs acc r, + splitOnPTR.go P xs acc r = r.toList ++ splitOnP.go P xs acc.toList.reverse from + (this l #[] #[]).symm intro xs acc r; induction xs generalizing acc r with simp [splitOnP.go, splitOnPTR.go] | cons x xs IH => cases P x <;> simp [*] @@ -162,47 +152,8 @@ Split a list at every occurrence of a separator element. The separators are not -/ @[inline] def splitOn [BEq α] (a : α) (as : List α) : List (List α) := as.splitOnP (· == a) -/-- -Apply a function to the nth tail of `l`. Returns the input without -using `f` if the index is larger than the length of the List. -``` -modifyNthTail f 2 [a, b, c] = [a, b] ++ f [c] -``` --/ -@[simp] def modifyNthTail (f : List α → List α) : Nat → List α → List α - | 0, l => f l - | _+1, [] => [] - | n+1, a :: l => a :: modifyNthTail f n l - -/-- Apply `f` to the head of the list, if it exists. -/ -@[inline] def modifyHead (f : α → α) : List α → List α - | [] => [] - | a :: l => f a :: l - -@[simp] theorem modifyHead_nil (f : α → α) : [].modifyHead f = [] := by rw [modifyHead] - -@[simp] theorem modifyHead_cons (a : α) (l : List α) (f : α → α) : - (a :: l).modifyHead f = f a :: l := by rw [modifyHead] - -/-- Apply `f` to the nth element of the list, if it exists. -/ -def modifyNth (f : α → α) : Nat → List α → List α := - modifyNthTail (modifyHead f) - -/-- Tail-recursive version of `modifyNth`. -/ -def modifyNthTR (f : α → α) (n : Nat) (l : List α) : List α := go l n #[] where - /-- Auxiliary for `modifyNthTR`: `modifyNthTR.go f l n acc = acc.toList ++ modifyNth f n l`. -/ - go : List α → Nat → Array α → List α - | [], _, acc => acc.toList - | a :: l, 0, acc => acc.toListAppend (f a :: l) - | a :: l, n+1, acc => go l n (acc.push a) - -theorem modifyNthTR_go_eq : ∀ l n, modifyNthTR.go f l n acc = acc.data ++ modifyNth f n l - | [], n => by cases n <;> simp [modifyNthTR.go, modifyNth] - | a :: l, 0 => by simp [modifyNthTR.go, modifyNth] - | a :: l, n+1 => by simp [modifyNthTR.go, modifyNth, modifyNthTR_go_eq l] - -@[csimp] theorem modifyNth_eq_modifyNthTR : @modifyNth = @modifyNthTR := by - funext α f n l; simp [modifyNthTR, modifyNthTR_go_eq] +@[deprecated (since := "2024-10-21")] alias modifyNthTail := modifyTailIdx +@[deprecated (since := "2024-10-21")] alias modifyNth := modify /-- Apply `f` to the last element of `l`, if it exists. -/ @[inline] def modifyLast (f : α → α) (l : List α) : List α := go l #[] where @@ -213,28 +164,30 @@ theorem modifyNthTR_go_eq : ∀ l n, modifyNthTR.go f l n acc = acc.data ++ modi | x :: xs, acc => go xs (acc.push x) /-- -`insertNth n a l` inserts `a` into the list `l` after the first `n` elements of `l` +`insertIdx n a l` inserts `a` into the list `l` after the first `n` elements of `l` ``` -insertNth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4] +insertIdx 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4] ``` -/ -def insertNth (n : Nat) (a : α) : List α → List α := - modifyNthTail (cons a) n +def insertIdx (n : Nat) (a : α) : List α → List α := + modifyTailIdx (cons a) n + +@[deprecated (since := "2024-10-21")] alias insertNth := insertIdx -/-- Tail-recursive version of `insertNth`. -/ -@[inline] def insertNthTR (n : Nat) (a : α) (l : List α) : List α := go n l #[] where - /-- Auxiliary for `insertNthTR`: `insertNthTR.go a n l acc = acc.toList ++ insertNth n a l`. -/ +/-- Tail-recursive version of `insertIdx`. -/ +@[inline] def insertIdxTR (n : Nat) (a : α) (l : List α) : List α := go n l #[] where + /-- Auxiliary for `insertIdxTR`: `insertIdxTR.go a n l acc = acc.toList ++ insertIdx n a l`. -/ go : Nat → List α → Array α → List α | 0, l, acc => acc.toListAppend (a :: l) | _, [], acc => acc.toList | n+1, a :: l, acc => go n l (acc.push a) -theorem insertNthTR_go_eq : ∀ n l, insertNthTR.go a n l acc = acc.data ++ insertNth n a l - | 0, l | _+1, [] => by simp [insertNthTR.go, insertNth] - | n+1, a :: l => by simp [insertNthTR.go, insertNth, insertNthTR_go_eq n l] +theorem insertIdxTR_go_eq : ∀ n l, insertIdxTR.go a n l acc = acc.toList ++ insertIdx n a l + | 0, l | _+1, [] => by simp [insertIdxTR.go, insertIdx] + | n+1, a :: l => by simp [insertIdxTR.go, insertIdx, insertIdxTR_go_eq n l] -@[csimp] theorem insertNth_eq_insertNthTR : @insertNth = @insertNthTR := by - funext α f n l; simp [insertNthTR, insertNthTR_go_eq] +@[csimp] theorem insertIdx_eq_insertIdxTR : @insertIdx = @insertIdxTR := by + funext α f n l; simp [insertIdxTR, insertIdxTR_go_eq] theorem headD_eq_head? (l) (a : α) : headD l a = (head? l).getD a := by cases l <;> rfl @@ -261,7 +214,7 @@ def takeDTR (n : Nat) (l : List α) (dflt : α) : List α := go n l #[] where | 0, _, acc => acc.toList | n, [], acc => acc.toListAppend (replicate n dflt) -theorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.data ++ takeD n l dflt +theorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.toList ++ takeD n l dflt | 0, _ => by simp [takeDTR.go] | _+1, [] => by simp [takeDTR.go, replicate_succ] | _+1, _::l => by simp [takeDTR.go, takeDTR_go_eq _ l] @@ -286,7 +239,7 @@ scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6] | [], a, acc => acc.toListAppend [a] | b :: l, a, acc => go l (f a b) (acc.push a) -theorem scanlTR_go_eq : ∀ l, scanlTR.go f l a acc = acc.data ++ scanl f a l +theorem scanlTR_go_eq : ∀ l, scanlTR.go f l a acc = acc.toList ++ scanl f a l | [] => by simp [scanlTR.go, scanl] | a :: l => by simp [scanlTR.go, scanl, scanlTR_go_eq l] @@ -415,7 +368,7 @@ sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]] ``` -/ def sublists (l : List α) : List (List α) := - l.foldr (fun a acc => acc.bind fun x => [x, a :: x]) [[]] + l.foldr (fun a acc => acc.flatMap fun x => [x, a :: x]) [[]] /-- A version of `List.sublists` that has faster runtime performance but worse kernel performance -/ def sublistsFast (l : List α) : List (List α) := @@ -513,7 +466,7 @@ of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from -/ @[simp] def sections : List (List α) → List (List α) | [] => [[]] - | l :: L => (sections L).bind fun s => l.map fun a => a :: s + | l :: L => (sections L).flatMap fun s => l.map fun a => a :: s /-- Optimized version of `sections`. -/ def sectionsTR (L : List (List α)) : List (List α) := @@ -538,8 +491,8 @@ theorem sections_eq_nil_of_isEmpty : ∀ {L}, L.any isEmpty → @sections α L = cases e : L.any isEmpty <;> simp [sections_eq_nil_of_isEmpty, *] clear e; induction L with | nil => rfl | cons l L IH => ?_ simp [IH, sectionsTR.go] - rw [Array.foldl_eq_foldl_data, Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map + rw [Array.foldl_eq_foldl_toList, Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `extractP p l` returns a pair of an element `a` of `l` satisfying the predicate @@ -568,7 +521,7 @@ def revzip (l : List α) : List (α × α) := zip l l.reverse product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)] ``` -/ -def product (l₁ : List α) (l₂ : List β) : List (α × β) := l₁.bind fun a => l₂.map (Prod.mk a) +def product (l₁ : List α) (l₂ : List β) : List (α × β) := l₁.flatMap fun a => l₂.map (Prod.mk a) /-- Optimized version of `product`. -/ def productTR (l₁ : List α) (l₂ : List β) : List (α × β) := @@ -576,15 +529,15 @@ def productTR (l₁ : List α) (l₂ : List β) : List (α × β) := @[csimp] theorem product_eq_productTR : @product = @productTR := by funext α β l₁ l₂; simp [product, productTR] - rw [Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map + rw [Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`. ``` sigma [1, 2] (λ_, [(5 : Nat), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] ``` -/ protected def sigma {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) := - l₁.bind fun a => (l₂ a).map (Sigma.mk a) + l₁.flatMap fun a => (l₂ a).map (Sigma.mk a) /-- Optimized version of `sigma`. -/ def sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) := @@ -592,37 +545,8 @@ def sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : @[csimp] theorem sigma_eq_sigmaTR : @List.sigma = @sigmaTR := by funext α β l₁ l₂; simp [List.sigma, sigmaTR] - rw [Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map - -/-- -`ofFn f` with `f : fin n → α` returns the list whose ith element is `f i` -``` -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 + rw [Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `ofFnNthVal f i` returns `some (f i)` if `i < n` and `none` otherwise. -/ def ofFnNthVal {n} (f : Fin n → α) (i : Nat) : Option α := @@ -706,23 +630,6 @@ Defined as `pwFilter (≠)`. eraseDup [1, 0, 2, 2, 1] = [0, 2, 1] -/ @[inline] def eraseDup [BEq α] : List α → List α := pwFilter (· != ·) -/-- -`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 (since := "2024-01-09")] 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? (since := "2024-01-09")] def last' {α} : List α → Option α - | [] => none - | [a] => some a - | _ :: l => last' l - /-- `rotate l n` rotates the elements of `l` to the left by `n` ``` @@ -796,15 +703,15 @@ where | x::xs, n+1, acc => go m xs n (acc.push x) theorem dropSlice_zero₂ : ∀ n l, @dropSlice α n 0 l = l - | 0, [] | 0, _::_ | n+1, [] => rfl + | 0, [] | 0, _::_ | _+1, [] => rfl | n+1, x::xs => by simp [dropSlice, dropSlice_zero₂] @[csimp] theorem dropSlice_eq_dropSliceTR : @dropSlice = @dropSliceTR := by funext α n m l; simp [dropSliceTR] split; { rw [dropSlice_zero₂] } rename_i m - let rec go (acc) : ∀ xs n, l = acc.data ++ xs → - dropSliceTR.go l m xs n acc = acc.data ++ xs.dropSlice n (m+1) + let rec go (acc) : ∀ xs n, l = acc.toList ++ xs → + dropSliceTR.go l m xs n acc = acc.toList ++ xs.dropSlice n (m+1) | [], n | _::xs, 0 => fun h => by simp [dropSliceTR.go, dropSlice, h] | x::xs, n+1 => by simp [dropSliceTR.go, dropSlice]; intro h; rw [go _ xs]; {simp}; simp [h] @@ -839,7 +746,7 @@ zipWithLeft' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b']) let rec go (acc) : ∀ as bs, zipWithLeft'TR.go f as bs acc = let (l, r) := as.zipWithLeft' f bs; (acc.toList ++ l, r) | [], bs => by simp [zipWithLeft'TR.go] - | _::_, [] => by simp [zipWithLeft'TR.go, Array.foldl_data_eq_map] + | _::_, [] => by simp [zipWithLeft'TR.go, Array.foldl_toList_eq_map] | a::as, b::bs => by simp [zipWithLeft'TR.go, go _ as bs] simp [zipWithLeft'TR, go] @@ -908,7 +815,7 @@ zipWithLeft f as bs = (zipWithLeft' f as bs).fst funext α β γ f as bs; simp [zipWithLeftTR] let rec go (acc) : ∀ as bs, zipWithLeftTR.go f as bs acc = acc.toList ++ as.zipWithLeft f bs | [], bs => by simp [zipWithLeftTR.go] - | _::_, [] => by simp [zipWithLeftTR.go, Array.foldl_data_eq_map] + | _::_, [] => by simp [zipWithLeftTR.go, Array.foldl_toList_eq_map] | a::as, b::bs => by simp [zipWithLeftTR.go, go _ as bs] simp [zipWithLeftTR, go] @@ -984,7 +891,7 @@ fillNones [none, some 1, none, none] [2, 3] = [2, 1, 3] @[csimp] theorem fillNones_eq_fillNonesTR : @fillNones = @fillNonesTR := by funext α as as'; simp [fillNonesTR] - let rec go (acc) : ∀ as as', @fillNonesTR.go α as as' acc = acc.data ++ as.fillNones as' + let rec go (acc) : ∀ as as', @fillNonesTR.go α as as' acc = acc.toList ++ as.fillNones as' | [], _ => by simp [fillNonesTR.go] | some a :: as, as' => by simp [fillNonesTR.go, go _ as as'] | none :: as, [] => by simp [fillNonesTR.go, reduceOption, filterMap_eq_filterMapTR.go] diff --git a/Batteries/Data/List/Count.lean b/Batteries/Data/List/Count.lean index 036a76b4b8..151169f74b 100644 --- a/Batteries/Data/List/Count.lean +++ b/Batteries/Data/List/Count.lean @@ -29,11 +29,3 @@ variable [DecidableEq α] 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 - -@[deprecated filter_eq (since := "2023-12-14")] -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 (since := "2023-12-14")] -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 diff --git a/Batteries/Data/List/Lemmas.lean b/Batteries/Data/List/Lemmas.lean index df55714b96..07d69d7145 100644 --- a/Batteries/Data/List/Lemmas.lean +++ b/Batteries/Data/List/Lemmas.lean @@ -10,174 +10,56 @@ import Batteries.Tactic.Alias namespace List -open Nat +/-! ### toArray-/ -/-! ### mem -/ - -@[simp] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by - simp [Array.mem_def] +@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : + (Array.mk xs)[i] = xs[i] := rfl /-! ### next? -/ @[simp] theorem next?_nil : @next? α [] = none := rfl @[simp] theorem next?_cons (a l) : @next? α (a :: l) = some (a, l) := rfl -/-! ### get? -/ - -@[deprecated getElem_eq_iff (since := "2024-06-12")] -theorem get_eq_iff : List.get l n = x ↔ l.get? n.1 = some x := by - simp - -@[deprecated getElem?_inj (since := "2024-06-12")] -theorem get?_inj - (h₀ : i < xs.length) (h₁ : Nodup xs) (h₂ : xs.get? i = xs.get? j) : i = j := by - apply getElem?_inj h₀ h₁ - simp_all - -/-! ### modifyNth -/ - -@[simp] theorem modifyNth_nil (f : α → α) (n) : [].modifyNth f n = [] := by cases n <;> rfl - -@[simp] theorem modifyNth_zero_cons (f : α → α) (a : α) (l : List α) : - (a :: l).modifyNth f 0 = f a :: l := rfl - -@[simp] theorem modifyNth_succ_cons (f : α → α) (a : α) (l : List α) (n) : - (a :: l).modifyNth f (n + 1) = a :: l.modifyNth f n := by rfl - -theorem modifyNthTail_id : ∀ n (l : List α), l.modifyNthTail id n = l - | 0, _ => rfl - | _+1, [] => rfl - | n+1, a :: l => congrArg (cons a) (modifyNthTail_id n l) - -theorem eraseIdx_eq_modifyNthTail : ∀ n (l : List α), eraseIdx l n = modifyNthTail tail n l - | 0, l => by cases l <;> rfl - | n+1, [] => rfl - | n+1, a :: l => congrArg (cons _) (eraseIdx_eq_modifyNthTail _ _) - -@[deprecated (since := "2024-05-06")] alias removeNth_eq_nth_tail := eraseIdx_eq_modifyNthTail - -theorem getElem?_modifyNth (f : α → α) : - ∀ n (l : List α) m, (modifyNth f n l)[m]? = (fun a => if n = m then f a else a) <$> l[m]? - | n, l, 0 => by cases l <;> cases n <;> simp - | n, [], _+1 => by cases n <;> rfl - | 0, _ :: l, m+1 => by cases h : l[m]? <;> simp [h, modifyNth, m.succ_ne_zero.symm] - | n+1, a :: l, m+1 => by - simp only [modifyNth_succ_cons, getElem?_cons_succ, Nat.reduceEqDiff, Option.map_eq_map] - refine (getElem?_modifyNth f n l m).trans ?_ - cases h' : l[m]? <;> by_cases h : n = m <;> - simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h'] - -@[deprecated getElem?_modifyNth (since := "2024-06-12")] -theorem get?_modifyNth (f : α → α) (n) (l : List α) (m) : - (modifyNth f n l).get? m = (fun a => if n = m then f a else a) <$> l.get? m := by - simp [getElem?_modifyNth] - -theorem modifyNthTail_length (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 _ _) - -theorem modifyNthTail_add (f : List α → List α) (n) (l₁ l₂ : List α) : - modifyNthTail f (l₁.length + n) (l₁ ++ l₂) = l₁ ++ modifyNthTail f n l₂ := by - induction l₁ <;> simp [*, Nat.succ_add] - -theorem exists_of_modifyNthTail (f : List α → List α) {n} {l : List α} (h : n ≤ l.length) : - ∃ l₁ l₂, l = l₁ ++ l₂ ∧ l₁.length = n ∧ modifyNthTail f n l = l₁ ++ f l₂ := - have ⟨_, _, eq, hl⟩ : ∃ l₁ l₂, l = l₁ ++ l₂ ∧ l₁.length = n := - ⟨_, _, (take_append_drop n l).symm, length_take_of_le h⟩ - ⟨_, _, eq, hl, hl ▸ eq ▸ modifyNthTail_add (n := 0) ..⟩ - -@[simp] theorem modify_get?_length (f : α → α) : ∀ n l, length (modifyNth f n l) = length l := - modifyNthTail_length _ fun l => by cases l <;> rfl - -@[simp] theorem getElem?_modifyNth_eq (f : α → α) (n) (l : List α) : - (modifyNth f n l)[n]? = f <$> l[n]? := by - simp only [getElem?_modifyNth, if_pos] - -@[deprecated getElem?_modifyNth_eq (since := "2024-06-12")] -theorem get?_modifyNth_eq (f : α → α) (n) (l : List α) : - (modifyNth f n l).get? n = f <$> l.get? n := by - simp [getElem?_modifyNth_eq] - -@[simp] theorem getElem?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : - (modifyNth f m l)[n]? = l[n]? := by - simp only [getElem?_modifyNth, if_neg h, id_map'] - -@[deprecated getElem?_modifyNth_ne (since := "2024-06-12")] -theorem get?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : - (modifyNth f m l).get? n = l.get? n := by - simp [h] - -theorem exists_of_modifyNth (f : α → α) {n} {l : List α} (h : n < l.length) : - ∃ l₁ a l₂, l = l₁ ++ a :: l₂ ∧ l₁.length = n ∧ modifyNth f n l = l₁ ++ f a :: l₂ := - match exists_of_modifyNthTail _ (Nat.le_of_lt h) with - | ⟨_, _::_, eq, hl, H⟩ => ⟨_, _, _, eq, hl, H⟩ - | ⟨_, [], eq, hl, _⟩ => nomatch Nat.ne_of_gt h (eq ▸ append_nil _ ▸ hl) - -theorem modifyNthTail_eq_take_drop (f : List α → List α) (H : f [] = []) : - ∀ n l, modifyNthTail f n l = take n l ++ f (drop n l) - | 0, _ => rfl - | _ + 1, [] => H.symm - | n + 1, b :: l => congrArg (cons b) (modifyNthTail_eq_take_drop f H n l) - -theorem modifyNth_eq_take_drop (f : α → α) : - ∀ n l, modifyNth f n l = take n l ++ modifyHead f (drop n l) := - modifyNthTail_eq_take_drop _ rfl - -theorem modifyNth_eq_take_cons_drop (f : α → α) {n l} (h : n < length l) : - modifyNth f n l = take n l ++ f l[n] :: drop (n + 1) l := by - rw [modifyNth_eq_take_drop, drop_eq_getElem_cons h]; rfl +/-! ### 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 /-! ### set -/ -theorem set_eq_modifyNth (a : α) : ∀ n (l : List α), set l n a = modifyNth (fun _ => a) n l +theorem set_eq_modify (a : α) : ∀ n (l : List α), set l n a = modify (fun _ => a) n l | 0, l => by cases l <;> rfl - | n+1, [] => rfl - | n+1, b :: l => congrArg (cons _) (set_eq_modifyNth _ _ _) + | _+1, [] => rfl + | _+1, _ :: _ => congrArg (cons _) (set_eq_modify _ _ _) theorem set_eq_take_cons_drop (a : α) {n l} (h : n < length l) : set l n a = take n l ++ a :: drop (n + 1) l := by - rw [set_eq_modifyNth, modifyNth_eq_take_cons_drop _ h] + rw [set_eq_modify, modify_eq_take_cons_drop h] -theorem modifyNth_eq_set_get? (f : α → α) : - ∀ n (l : List α), l.modifyNth f n = ((fun a => l.set n (f a)) <$> l.get? n).getD l +theorem modify_eq_set_get? (f : α → α) : + ∀ n (l : List α), l.modify f n = ((fun a => l.set n (f a)) <$> l.get? n).getD l | 0, l => by cases l <;> rfl - | n+1, [] => rfl + | _+1, [] => rfl | n+1, b :: l => - (congrArg (cons _) (modifyNth_eq_set_get? ..)).trans <| by cases h : l[n]? <;> simp [h] + (congrArg (cons _) (modify_eq_set_get? ..)).trans <| by cases h : l[n]? <;> simp [h] -theorem modifyNth_eq_set_get (f : α → α) {n} {l : List α} (h) : - l.modifyNth f n = l.set n (f (l.get ⟨n, h⟩)) := by - rw [modifyNth_eq_set_get?, get?_eq_get h]; rfl - --- The naming of `exists_of_set'` and `exists_of_set` have been swapped. --- If no one complains, we will remove this version later. -@[deprecated exists_of_set (since := "2024-07-04")] -theorem exists_of_set' {l : List α} (h : n < l.length) : - ∃ l₁ a l₂, l = l₁ ++ a :: l₂ ∧ l₁.length = n ∧ l.set n a' = l₁ ++ a' :: l₂ := by - rw [set_eq_modifyNth]; exact exists_of_modifyNth _ h - -@[deprecated getElem?_set_eq' (since := "2024-06-12")] -theorem get?_set_eq (a : α) (n) (l : List α) : (set l n a).get? n = (fun _ => a) <$> l.get? n := by - simp +theorem modify_eq_set_get (f : α → α) {n} {l : List α} (h) : + l.modify f n = l.set n (f (l.get ⟨n, h⟩)) := by + rw [modify_eq_set_get?, get?_eq_get h]; rfl theorem getElem?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) : - (set l n a)[n]? = some a := by rw [getElem?_set_eq', getElem?_eq_getElem h]; rfl - -@[deprecated getElem?_set_eq_of_lt (since := "2024-06-12")] -theorem get?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) : - (set l n a).get? n = some a := by - rw [get?_eq_getElem?, getElem?_set_eq', getElem?_eq_getElem h]; rfl - -@[deprecated getElem?_set_ne (since := "2024-06-12")] -theorem get?_set_ne (a : α) {m n} (l : List α) (h : m ≠ n) : (set l m a).get? n = l.get? n := by - simp [h] - -@[deprecated getElem?_set (since := "2024-06-12")] -theorem get?_set (a : α) {m n} (l : List α) : - (set l m a).get? n = if m = n then (fun _ => a) <$> l.get? n else l.get? n := by - simp [getElem?_set'] + (set l n a)[n]? = some a := by rw [getElem?_set_self', getElem?_eq_getElem h]; rfl theorem get?_set_of_lt (a : α) {m n} (l : List α) (h : n < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by @@ -187,14 +69,14 @@ theorem get?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by simp [getElem?_set]; split <;> subst_vars <;> simp [*, getElem?_eq_getElem h] -@[deprecated (since := "2024-05-06")] alias length_removeNth := length_eraseIdx +/-! ### tail -/ /-! ### eraseP -/ @[simp] theorem extractP_eq_find?_eraseP (l : List α) : extractP p l = (find? p l, eraseP p l) := by - let rec go (acc) : ∀ xs, l = acc.data ++ xs → - extractP.go p l xs acc = (xs.find? p, acc.data ++ xs.eraseP p) + let rec go (acc) : ∀ xs, l = acc.toList ++ xs → + extractP.go p l xs acc = (xs.find? p, acc.toList ++ xs.eraseP p) | [] => fun h => by simp [extractP.go, find?, eraseP, h] | x::xs => by simp [extractP.go, find?, eraseP]; cases p x <;> simp @@ -203,7 +85,22 @@ theorem get?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) : /-! ### erase -/ -@[deprecated (since := "2024-04-22")] alias sublist.erase := Sublist.erase +theorem erase_eq_self_iff_forall_bne [BEq α] (a : α) (xs : List α) : + xs.erase a = xs ↔ ∀ (x : α), x ∈ xs → ¬x == a := by + rw [erase_eq_eraseP', eraseP_eq_self_iff] + +/-! ### findIdx? -/ + +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 => + rw [findIdx_cons, findIdx?_cons] + if h : p x then + simp [h] + else + cases h' : findIdx? p xs <;> simp [h, h', ih] /-! ### replaceF -/ @@ -226,10 +123,10 @@ theorem replaceF_of_forall_none {l : List α} (h : ∀ a, a ∈ l → p a = none | nil => rfl | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2] -theorem exists_of_replaceF : ∀ {l : List α} {a a'} (al : a ∈ l) (pa : p a = some a'), +theorem exists_of_replaceF : ∀ {l : List α} {a a'} (_ : a ∈ l) (_ : p a = some a'), ∃ a a' l₁ l₂, (∀ b ∈ l₁, p b = none) ∧ p a = some a' ∧ l = l₁ ++ a :: l₂ ∧ l.replaceF p = l₁ ++ a' :: l₂ - | b :: l, a, a', al, pa => + | b :: l, _, _, al, pa => match pb : p b with | some b' => ⟨b, b', [], l, forall_mem_nil _, pb, by simp [pb]⟩ | none => @@ -345,14 +242,14 @@ theorem inter_def [BEq α] (l₁ l₂ : List α) : l₁ ∩ l₂ = filter (elem theorem pair_mem_product {xs : List α} {ys : List β} {x : α} {y : β} : (x, y) ∈ product xs ys ↔ x ∈ xs ∧ y ∈ ys := by simp only [product, and_imp, mem_map, Prod.mk.injEq, - exists_eq_right_right, mem_bind, iff_self] + exists_eq_right_right, mem_flatMap, iff_self] /-! ### monadic operations -/ theorem forIn_eq_bindList [Monad m] [LawfulMonad m] (f : α → β → m (ForInStep β)) (l : List α) (init : β) : forIn l init f = ForInStep.run <$> (ForInStep.yield init).bindList f l := by - induction l generalizing init <;> simp [*, map_eq_pure_bind] + induction l generalizing init <;> simp [*] congr; ext (b | b) <;> simp /-! ### diff -/ @@ -422,7 +319,7 @@ theorem Sublist.diff_right : ∀ {l₁ l₂ l₃ : List α}, l₁ <+ l₂ → l theorem Sublist.erase_diff_erase_sublist {a : α} : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → (l₂.erase a).diff (l₁.erase a) <+ l₂.diff l₁ - | [], l₂, _ => erase_sublist _ _ + | [], _, _ => erase_sublist _ _ | b :: l₁, l₂, h => by if heq : b = a then simp [heq] @@ -548,6 +445,14 @@ 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 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 induction xs with @@ -562,6 +467,19 @@ theorem indexOf_mem_indexesOf [BEq α] [LawfulBEq α] {xs : List α} (m : x ∈ specialize ih m simpa +@[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 indexOf?_eq_none_iff [BEq α] {a : α} {l : List α} : + l.indexOf? a = none ↔ ∀ x ∈ l, ¬x == a := by + simp [indexOf?, findIdx?_eq_none_iff] + +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 α) : diff --git a/Batteries/Data/List/OfFn.lean b/Batteries/Data/List/OfFn.lean new file mode 100644 index 0000000000..c66846e61a --- /dev/null +++ b/Batteries/Data/List/OfFn.lean @@ -0,0 +1,15 @@ +/- +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 + +end List diff --git a/Batteries/Data/List/Pairwise.lean b/Batteries/Data/List/Pairwise.lean index 9df947bf4c..de13a5e292 100644 --- a/Batteries/Data/List/Pairwise.lean +++ b/Batteries/Data/List/Pairwise.lean @@ -29,18 +29,6 @@ namespace List /-! ### Pairwise -/ -@[deprecated pairwise_iff_forall_sublist (since := "2023-09-18")] -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 - theorem pairwise_iff_get : Pairwise R l ↔ ∀ (i j) (_hij : i < j), R (get l i) (get l j) := by rw [pairwise_iff_getElem] constructor <;> intro h diff --git a/Batteries/Data/List/Perm.lean b/Batteries/Data/List/Perm.lean index b14878bf36..699e9de278 100644 --- a/Batteries/Data/List/Perm.lean +++ b/Batteries/Data/List/Perm.lean @@ -25,7 +25,7 @@ open Perm (swap) section Subperm -theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩ +@[simp] theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩ theorem Perm.subperm_left {l l₁ l₂ : List α} (p : l₁ ~ l₂) : l <+~ l₁ ↔ l <+~ l₂ := suffices ∀ {l₁ l₂ : List α}, l₁ ~ l₂ → l <+~ l₁ → l <+~ l₂ from ⟨this p, this p.symm⟩ @@ -47,6 +47,8 @@ theorem Subperm.trans {l₁ l₂ l₃ : List α} (s₁₂ : l₁ <+~ l₂) (s₂ let ⟨l₁', p₁, s₁⟩ := p₂.subperm_left.2 s₁₂ ⟨l₁', p₁, s₁.trans s₂⟩ +theorem Subperm.cons_self : l <+~ a :: l := ⟨l, .refl _, sublist_cons_self ..⟩ + theorem Subperm.cons_right {α : Type _} {l l' : List α} (x : α) (h : l <+~ l') : l <+~ x :: l' := h.trans (sublist_cons_self x l').subperm @@ -67,6 +69,9 @@ theorem Subperm.filter (p : α → Bool) ⦃l l' : List α⦄ (h : l <+~ l') : let ⟨xs, hp, h⟩ := h exact ⟨_, hp.filter p, h.filter p⟩ +@[simp] theorem subperm_nil : l <+~ [] ↔ l = [] := + ⟨fun h => length_eq_zero.1 $ Nat.le_zero.1 h.length_le, by rintro rfl; rfl⟩ + @[simp] theorem singleton_subperm_iff {α} {l : List α} {a : α} : [a] <+~ l ↔ a ∈ l := by refine ⟨fun ⟨s, hla, h⟩ => ?_, fun h => ⟨[a], .rfl, singleton_sublist.mpr h⟩⟩ rwa [perm_singleton.mp hla, singleton_sublist] at h @@ -144,7 +149,7 @@ 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 @@ -215,7 +220,7 @@ 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] + 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 @@ -235,8 +240,8 @@ theorem subperm_append_diff_self_of_count_le {l₁ l₂ : List α} | nil => simp | cons hd tl IH => have : hd ∈ l₂ := by - rw [← count_pos_iff_mem] - exact Nat.lt_of_lt_of_le (count_pos_iff_mem.mpr (.head _)) (h hd (.head _)) + rw [← count_pos_iff] + exact Nat.lt_of_lt_of_le (count_pos_iff.mpr (.head _)) (h hd (.head _)) have := perm_cons_erase this refine Perm.trans ?_ this.symm rw [cons_append, diff_cons, perm_cons] @@ -279,11 +284,13 @@ theorem perm_insertNth {α} (x : α) (l : List α) {n} (h : n ≤ l.length) : | succ => cases h | cons _ _ ih => cases n with - | zero => simp [insertNth] + | zero => simp [insertIdx] | succ => - simp only [insertNth, modifyNthTail] + simp only [insertIdx, modifyTailIdx] refine .trans (.cons _ (ih (Nat.le_of_succ_le_succ h))) (.swap ..) +@[deprecated (since := "2024-10-21")] alias perm_insertNth := perm_insertIdx + theorem Perm.union_right {l₁ l₂ : List α} (t₁ : List α) (h : l₁ ~ l₂) : l₁ ∪ t₁ ~ l₂ ∪ t₁ := by induction h with | nil => rfl @@ -312,7 +319,7 @@ end DecidableEq 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₂) + | _ :: _, _ :: _, .cons h₁ h₂ => h₁.append (Perm.flatten_congr h₂) theorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by induction l with simp [insertP, insertP.loop, cond] @@ -325,7 +332,7 @@ theorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by theorem Perm.insertP (p : α → Bool) (a) (h : l₁ ~ l₂) : insertP p a l₁ ~ insertP p a l₂ := Perm.trans (perm_insertP ..) <| Perm.trans (Perm.cons _ h) <| Perm.symm (perm_insertP ..) -theorem perm_merge (s : α → α → Bool) (l r) : merge s l r ~ l ++ r := by +theorem perm_merge (s : α → α → Bool) (l r) : merge l r s ~ l ++ r := by match l, r with | [], r => simp | l, [] => simp @@ -342,5 +349,5 @@ theorem perm_merge (s : α → α → Bool) (l r) : merge s l r ~ l ++ r := by exact Perm.rfl theorem Perm.merge (s₁ s₂ : α → α → Bool) (hl : l₁ ~ l₂) (hr : r₁ ~ r₂) : - merge s₁ l₁ r₁ ~ merge s₂ l₂ r₂ := + merge l₁ r₁ s₁ ~ merge l₂ r₂ s₂ := Perm.trans (perm_merge ..) <| Perm.trans (Perm.append hl hr) <| Perm.symm (perm_merge ..) diff --git a/Batteries/Data/Nat.lean b/Batteries/Data/Nat.lean index f1a6ddcca1..dbf3161213 100644 --- a/Batteries/Data/Nat.lean +++ b/Batteries/Data/Nat.lean @@ -1,3 +1,4 @@ import Batteries.Data.Nat.Basic +import Batteries.Data.Nat.Bisect import Batteries.Data.Nat.Gcd import Batteries.Data.Nat.Lemmas diff --git a/Batteries/Data/Nat/Basic.lean b/Batteries/Data/Nat/Basic.lean index 1d9658f49e..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 -/ diff --git a/Batteries/Data/Nat/Bisect.lean b/Batteries/Data/Nat/Bisect.lean new file mode 100644 index 0000000000..f692675944 --- /dev/null +++ b/Batteries/Data/Nat/Bisect.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2024 François G. Dorais. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: François G. Dorais +-/ +import Batteries.Tactic.Basic +import Batteries.Data.Nat.Basic + +namespace Nat + +/-- Average of two natural numbers rounded toward zero. -/ +abbrev avg (a b : Nat) := (a + b) / 2 + +theorem avg_comm (a b : Nat) : avg a b = avg b a := by + rw [avg, Nat.add_comm] + +theorem avg_le_left (h : b ≤ a) : avg a b ≤ a := by + apply Nat.div_le_of_le_mul; simp_arith [*] + +theorem avg_le_right (h : a ≤ b) : avg a b ≤ b := by + apply Nat.div_le_of_le_mul; simp_arith [*] + +theorem avg_lt_left (h : b < a) : avg a b < a := by + apply Nat.div_lt_of_lt_mul; omega + +theorem avg_lt_right (h : a < b) : avg a b < b := by + apply Nat.div_lt_of_lt_mul; omega + +theorem le_avg_left (h : a ≤ b) : a ≤ avg a b := by + apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp_arith [*] + +theorem le_avg_right (h : b ≤ a) : b ≤ avg a b := by + apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp_arith [*] + +theorem le_add_one_of_avg_eq_left (h : avg a b = a) : b ≤ a + 1 := by + cases Nat.lt_or_ge b (a+2) with + | inl hlt => exact Nat.le_of_lt_add_one hlt + | inr hge => + absurd Nat.lt_irrefl a + conv => rhs; rw [← h] + rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two] + omega + +theorem le_add_one_of_avg_eq_right (h : avg a b = b) : a ≤ b + 1 := by + cases Nat.lt_or_ge a (b+2) with + | inl hlt => exact Nat.le_of_lt_add_one hlt + | inr hge => + absurd Nat.lt_irrefl b + conv => rhs; rw [← h] + rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two] + omega + +/-- +Given natural numbers `a < b` such that `p a = true` and `p b = false`, `bisect` finds a natural +number `a ≤ c < b` such that `p c = true` and `p (c+1) = false`. +-/ +def bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true) (hstop : p stop = false) := + let mid := avg start stop + have hmidstop : mid < stop := by apply Nat.div_lt_of_lt_mul; omega + if hstartmid : start < mid then + match hmid : p mid with + | false => bisect hstartmid hstart hmid + | true => bisect hmidstop hmid hstop + else + mid +termination_by stop - start + +theorem bisect_lt_stop {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : bisect h hstart hstop < stop := by + unfold bisect + simp only; split + · split + · next h' _ => + have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_of_lt h' + · exact Nat.avg_lt_right h + apply Nat.lt_trans + · exact bisect_lt_stop .. + · exact avg_lt_right h + · exact bisect_lt_stop .. + · exact avg_lt_right h + +theorem start_le_bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : start ≤ bisect h hstart hstop := by + unfold bisect + simp only; split + · split + · next h' _ => + have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_of_lt h' + · exact avg_lt_right h + exact start_le_bisect .. + · next h' _ => + apply Nat.le_trans + · exact Nat.le_of_lt h' + · exact start_le_bisect .. + · exact le_avg_left (Nat.le_of_lt h) + +theorem bisect_true {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : p (bisect h hstart hstop) = true := by + unfold bisect + simp only; split + · split + · have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_avg_left (Nat.le_of_lt h) + · exact Nat.avg_lt_right h + exact bisect_true .. + · exact bisect_true .. + · next h' => + rw [← hstart]; congr + apply Nat.le_antisymm + · exact Nat.le_of_not_gt h' + · exact Nat.le_avg_left (Nat.le_of_lt h) + +theorem bisect_add_one_false {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : p (bisect h hstart hstop + 1) = false := by + unfold bisect + simp only; split + · split + · have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_avg_left (Nat.le_of_lt h) + · exact Nat.avg_lt_right h + exact bisect_add_one_false .. + · exact bisect_add_one_false .. + · next h' => + have heq : avg start stop = start := by + apply Nat.le_antisymm + · exact Nat.le_of_not_gt h' + · exact Nat.le_avg_left (Nat.le_of_lt h) + rw [← hstop, heq]; congr + apply Nat.le_antisymm + · exact Nat.succ_le_of_lt h + · exact Nat.le_add_one_of_avg_eq_left heq diff --git a/Batteries/Data/Nat/Lemmas.lean b/Batteries/Data/Nat/Lemmas.lean index 1c3edddeaf..a97c558c44 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,24 +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 (since := "2023-11-25")] alias succ_add_eq_succ_add := Nat.succ_add_eq_add_succ - -/-! ## sub -/ - -@[deprecated (since := "2023-11-25")] -protected alias le_of_le_of_sub_le_sub_right := Nat.le_of_sub_le_sub_right - -@[deprecated (since := "2023-11-25")] -protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left - -/-! ### mul -/ - -@[deprecated (since := "2024-01-11")] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' - -@[deprecated (since := "2024-01-11")] protected alias mul_lt_mul' := Nat.mul_lt_mul_of_le_of_lt - /-! ### div/mod -/ -- TODO mod_core_congr, mod_def @@ -177,8 +159,6 @@ protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left /-! ### sum -/ -@[simp] theorem sum_append : Nat.sum (l₁ ++ l₂) = Nat.sum l₁ + Nat.sum l₂ := by - induction l₁ <;> simp [*, Nat.add_assoc] -@[deprecated (since := "2024-03-05")] protected alias lt_connex := Nat.lt_or_gt_of_ne -@[deprecated (since := "2024-02-09")] alias pow_two_pos := Nat.two_pow_pos +@[simp] theorem sum_append {l₁ l₂ : List Nat}: (l₁ ++ l₂).sum = l₁.sum + l₂.sum := by + induction l₁ <;> simp [*, Nat.add_assoc] diff --git a/Batteries/Data/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 05a38b25a7..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 (since := "2024-03-05")] alias to_list_some := toList_some -@[deprecated (since := "2024-03-05")] alias to_list_none := toList_none - -end Option diff --git a/Batteries/Data/RBMap/Alter.lean b/Batteries/Data/RBMap/Alter.lean index 1148221081..fd1e8f205a 100644 --- a/Batteries/Data/RBMap/Alter.lean +++ b/Batteries/Data/RBMap/Alter.lean @@ -204,16 +204,22 @@ theorem _root_.Batteries.RBNode.Ordered.zoom {t : RBNode α} theorem Ordered.ins : ∀ {path : Path α} {t : RBNode α}, t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.ins t).Ordered cmp - | .root, t, ht, _, _ => Ordered.setBlack.2 ht + | .root, _, ht, _, _ => Ordered.setBlack.2 ht | .left red parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold ins; have ⟨ax, ap⟩ := All_and.1 H; exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.ins + have ⟨ax, ap⟩ := All_and.1 H + exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .right red a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold ins; have ⟨xb, bp⟩ := All_and.1 H; exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.ins + have ⟨xb, bp⟩ := All_and.1 H + exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .left black parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold ins; have ⟨ax, ap⟩ := All_and.1 H + unfold Path.ins + have ⟨ax, ap⟩ := All_and.1 H exact hp.ins (ha.balance1 ax xb hb) (balance1_All.2 ⟨xp, ap, bp⟩) | .right black a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold ins; have ⟨xb, bp⟩ := All_and.1 H + unfold Path.ins + have ⟨xb, bp⟩ := All_and.1 H exact hp.ins (ha.balance2 ax xb hb) (balance2_All.2 ⟨xp, ap, bp⟩) theorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.RootOrdered cmp v) : @@ -222,16 +228,22 @@ theorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.Ro theorem Ordered.del : ∀ {path : Path α} {t : RBNode α} {c}, t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.del t c).Ordered cmp - | .root, t, _, ht, _, _ => Ordered.setBlack.2 ht + | .root, _, _, ht, _, _ => Ordered.setBlack.2 ht | .left _ parent x b, a, red, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold del; have ⟨ax, ap⟩ := All_and.1 H; exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.del + have ⟨ax, ap⟩ := All_and.1 H + exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .right _ a x parent, b, red, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold del; have ⟨xb, bp⟩ := All_and.1 H; exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.del + have ⟨xb, bp⟩ := All_and.1 H + exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .left _ parent x b, a, black, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold del; have ⟨ax, ap⟩ := All_and.1 H + unfold Path.del + have ⟨ax, ap⟩ := All_and.1 H exact hp.del (ha.balLeft ax xb hb) (ap.balLeft xp bp) | .right _ a x parent, b, black, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold del; have ⟨xb, bp⟩ := All_and.1 H + unfold Path.del + have ⟨xb, bp⟩ := All_and.1 H exact hp.del (ha.balRight ax xb hb) (ap.balRight xp bp) end Path diff --git a/Batteries/Data/RBMap/Basic.lean b/Batteries/Data/RBMap/Basic.lean index d1aff2dc3b..8eb202591c 100644 --- a/Batteries/Data/RBMap/Basic.lean +++ b/Batteries/Data/RBMap/Basic.lean @@ -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) @@ -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. diff --git a/Batteries/Data/RBMap/Lemmas.lean b/Batteries/Data/RBMap/Lemmas.lean index 0a6d7d820a..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, *] diff --git a/Batteries/Data/RBMap/WF.lean b/Batteries/Data/RBMap/WF.lean index 6fbd669e6e..220852c0ab 100644 --- a/Batteries/Data/RBMap/WF.lean +++ b/Batteries/Data/RBMap/WF.lean @@ -261,7 +261,8 @@ so this is only suitable for use on the root of the tree.) -/ theorem Balanced.insert {t : RBNode α} (h : t.Balanced c n) : ∃ c' n', (insert cmp t v).Balanced c' n' := by - unfold insert; match ins cmp v t, h.ins cmp v with + unfold RBNode.insert + match ins cmp v t, h.ins cmp v with | _, .balanced h => split <;> [exact ⟨_, h.setBlack⟩; exact ⟨_, _, h⟩] | _, .redred _ ha hb => have .node red .. := t; exact ⟨_, _, .black ha hb⟩ diff --git a/Batteries/Data/Range/Lemmas.lean b/Batteries/Data/Range/Lemmas.lean index d71082848f..a075e0b6b4 100644 --- a/Batteries/Data/Range/Lemmas.lean +++ b/Batteries/Data/Range/Lemmas.lean @@ -69,7 +69,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) suffices ∀ fuel l i hle H, l ≤ fuel → (∀ j, stop ≤ i + step * j ↔ l ≤ j) → ∀ init, forIn'.loop start stop step f fuel i hle init = - List.forIn ((List.range' i l step).pmap Subtype.mk H) init f' by + forIn ((List.range' i l step).pmap Subtype.mk H) init f' by refine this _ _ _ _ _ ((numElems_le_iff hstep).2 (Nat.le_trans ?_ (Nat.le_add_left ..))) (fun _ => (numElems_le_iff hstep).symm) _ @@ -85,7 +85,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) (List.forall_mem_cons.1 H).2 (Nat.le_of_succ_le_succ h1) fun i => by rw [Nat.add_right_comm, Nat.add_assoc, ← Nat.mul_succ, h2, Nat.succ_le_succ_iff] have := h2 0; simp at this - rw [forIn'.loop]; simp [List.forIn, this, ih]; rfl + rw [forIn'.loop]; simp [this, ih]; rfl else simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h), L] cases stop <;> unfold forIn'.loop <;> simp [List.forIn', h] @@ -94,13 +94,6 @@ theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range) (init : β) (f : Nat → β → m (ForInStep β)) : forIn r init f = forIn (List.range' r.start r.numElems r.step) init f := by refine Eq.trans ?_ <| (forIn'_eq_forIn_range' r init (fun x _ => f x)).trans ?_ - · simp [forIn, forIn', Range.forIn, Range.forIn'] - suffices ∀ fuel i hl b, forIn'.loop r.start r.stop r.step (fun x _ => f x) fuel i hl b = - forIn.loop f fuel i r.stop r.step b from (this _ ..).symm - intro fuel; induction fuel <;> intro i hl b <;> - unfold forIn.loop forIn'.loop <;> simp [*] - split - · simp [if_neg (Nat.not_le.2 ‹_›)] - · simp [if_pos (Nat.not_lt.1 ‹_›)] + · simp [forIn, forIn'] · suffices ∀ L H, forIn (List.pmap Subtype.mk L H) init (f ·.1) = forIn L init f from this _ .. intro L; induction L generalizing init <;> intro H <;> simp [*] diff --git a/Batteries/Data/Rat/Basic.lean b/Batteries/Data/Rat/Basic.lean index f96651d34c..01cbd07859 100644 --- a/Batteries/Data/Rat/Basic.lean +++ b/Batteries/Data/Rat/Basic.lean @@ -45,23 +45,23 @@ Auxiliary definition for `Rat.normalize`. Constructs `num / den` as a rational n dividing both `num` and `den` by `g` (which is the gcd of the two) if it is not 1. -/ @[inline] def Rat.maybeNormalize (num : Int) (den g : Nat) - (den_nz : den / g ≠ 0) (reduced : (num.div g).natAbs.Coprime (den / g)) : Rat := + (den_nz : den / g ≠ 0) (reduced : (num.tdiv g).natAbs.Coprime (den / g)) : Rat := if hg : g = 1 then { num, den den_nz := by simp [hg] at den_nz; exact den_nz reduced := by simp [hg, Int.natAbs_ofNat] at reduced; exact reduced } - else { num := num.div g, den := den / g, den_nz, reduced } + else { num := num.tdiv g, den := den / g, den_nz, reduced } theorem Rat.normalize.den_nz {num : Int} {den g : Nat} (den_nz : den ≠ 0) (e : g = num.natAbs.gcd den) : den / g ≠ 0 := e ▸ Nat.ne_of_gt (Nat.div_gcd_pos_of_pos_right _ (Nat.pos_of_ne_zero den_nz)) theorem Rat.normalize.reduced {num : Int} {den g : Nat} (den_nz : den ≠ 0) - (e : g = num.natAbs.gcd den) : (num.div g).natAbs.Coprime (den / g) := - have : Int.natAbs (num.div ↑g) = num.natAbs / g := by + (e : g = num.natAbs.gcd den) : (num.tdiv g).natAbs.Coprime (den / g) := + have : Int.natAbs (num.tdiv ↑g) = num.natAbs / g := by match num, num.eq_nat_or_neg with | _, ⟨_, .inl rfl⟩ => rfl - | _, ⟨_, .inr rfl⟩ => rw [Int.neg_div, Int.natAbs_neg, Int.natAbs_neg]; rfl + | _, ⟨_, .inr rfl⟩ => rw [Int.neg_tdiv, Int.natAbs_neg, Int.natAbs_neg]; rfl this ▸ e ▸ Nat.coprime_div_gcd_div_gcd (Nat.gcd_pos_of_pos_right _ (Nat.pos_of_ne_zero den_nz)) /-- @@ -112,7 +112,8 @@ def divInt : Int → Int → Rat else (m * 10 ^ e : Nat) -instance : OfScientific Rat where ofScientific := Rat.ofScientific +instance : OfScientific Rat where + ofScientific m s e := Rat.ofScientific (OfNat.ofNat m) s (OfNat.ofNat e) /-- Rational number strictly less than relation, as a `Bool`. -/ protected def blt (a b : Rat) : Bool := @@ -141,12 +142,12 @@ want to unfold it. Use `Rat.mul_def` instead.) -/ @[irreducible] protected def mul (a b : Rat) : Rat := let g1 := Nat.gcd a.num.natAbs b.den let g2 := Nat.gcd b.num.natAbs a.den - { num := (a.num.div g1) * (b.num.div g2) + { num := (a.num.tdiv g1) * (b.num.tdiv g2) den := (a.den / g2) * (b.den / g1) den_nz := Nat.ne_of_gt <| Nat.mul_pos (Nat.div_gcd_pos_of_pos_right _ a.den_pos) (Nat.div_gcd_pos_of_pos_right _ b.den_pos) reduced := by - simp only [Int.natAbs_mul, Int.natAbs_div, Nat.coprime_mul_iff_left] + simp only [Int.natAbs_mul, Int.natAbs_tdiv, Nat.coprime_mul_iff_left] refine ⟨Nat.coprime_mul_iff_right.2 ⟨?_, ?_⟩, Nat.coprime_mul_iff_right.2 ⟨?_, ?_⟩⟩ · exact a.reduced.coprime_div_left (Nat.gcd_dvd_left ..) |>.coprime_div_right (Nat.gcd_dvd_right ..) diff --git a/Batteries/Data/Rat/Lemmas.lean b/Batteries/Data/Rat/Lemmas.lean index e70914f6e0..844dc7b552 100644 --- a/Batteries/Data/Rat/Lemmas.lean +++ b/Batteries/Data/Rat/Lemmas.lean @@ -23,14 +23,14 @@ theorem ext : {p q : Rat} → p.num = q.num → p.den = q.den → p = q @[simp] theorem maybeNormalize_eq {num den g} (den_nz reduced) : maybeNormalize num den g den_nz reduced = - { num := num.div g, den := den / g, den_nz, reduced } := by + { num := num.tdiv g, den := den / g, den_nz, reduced } := by unfold maybeNormalize; split · subst g; simp · rfl theorem normalize.reduced' {num : Int} {den g : Nat} (den_nz : den ≠ 0) (e : g = num.natAbs.gcd den) : (num / g).natAbs.Coprime (den / g) := by - rw [← Int.div_eq_ediv_of_dvd (e ▸ Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] + rw [← Int.tdiv_eq_ediv_of_dvd (e ▸ Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] exact normalize.reduced den_nz e theorem normalize_eq {num den} (den_nz) : normalize num den den_nz = @@ -39,10 +39,10 @@ theorem normalize_eq {num den} (den_nz) : normalize num den den_nz = den_nz := normalize.den_nz den_nz rfl reduced := normalize.reduced' den_nz rfl } := by simp only [normalize, maybeNormalize_eq, - Int.div_eq_ediv_of_dvd (Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] + Int.tdiv_eq_ediv_of_dvd (Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] @[simp] theorem normalize_zero (nz) : normalize 0 d nz = 0 := by - simp [normalize, Int.zero_div, Int.natAbs_zero, Nat.div_self (Nat.pos_of_ne_zero nz)]; rfl + simp [normalize, Int.zero_tdiv, Int.natAbs_zero, Nat.div_self (Nat.pos_of_ne_zero nz)]; rfl theorem mk_eq_normalize (num den nz c) : ⟨num, den, nz, c⟩ = normalize num den nz := by simp [normalize_eq, c.gcd_eq_one] @@ -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₁, @@ -76,7 +76,7 @@ theorem normalize_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) : theorem maybeNormalize_eq_normalize {num : Int} {den g : Nat} (den_nz reduced) (hn : ↑g ∣ num) (hd : g ∣ den) : maybeNormalize num den g den_nz reduced = normalize num den (mt (by simp [·]) den_nz) := by - simp only [maybeNormalize_eq, mk_eq_normalize, Int.div_eq_ediv_of_dvd hn] + simp only [maybeNormalize_eq, mk_eq_normalize, Int.tdiv_eq_ediv_of_dvd hn] have : g ≠ 0 := mt (by simp [·]) den_nz rw [← normalize_mul_right _ this, Int.ediv_mul_cancel hn] congr 1; exact Nat.div_mul_cancel hd @@ -267,9 +267,9 @@ theorem mul_def (a b : Rat) : have H1 : a.num.natAbs.gcd b.den ≠ 0 := Nat.gcd_ne_zero_right b.den_nz have H2 : b.num.natAbs.gcd a.den ≠ 0 := Nat.gcd_ne_zero_right a.den_nz rw [mk_eq_normalize, ← normalize_mul_right _ (Nat.mul_ne_zero H1 H2)]; congr 1 - · rw [Int.ofNat_mul, ← Int.mul_assoc, Int.mul_right_comm (Int.div ..), - Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..), Int.mul_assoc, - Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)] + · rw [Int.ofNat_mul, ← Int.mul_assoc, Int.mul_right_comm (Int.tdiv ..), + Int.tdiv_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..), Int.mul_assoc, + Int.tdiv_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)] · rw [← Nat.mul_assoc, Nat.mul_right_comm, Nat.mul_right_comm (_/_), Nat.div_mul_cancel (Nat.gcd_dvd_right ..), Nat.mul_assoc, Nat.div_mul_cancel (Nat.gcd_dvd_right ..)] @@ -332,6 +332,12 @@ theorem ofScientific_def : Rat.ofScientific m s e = if s then mkRat m (10 ^ e) else (m * 10 ^ e : Nat) := by cases s; exact ofScientific_false_def; exact ofScientific_true_def +/-- `Rat.ofScientific` applied to numeric literals is the same as a scientific literal. -/ +@[simp] +theorem ofScientific_ofNat_ofNat : + Rat.ofScientific (no_index (OfNat.ofNat m)) s (no_index (OfNat.ofNat e)) + = OfScientific.ofScientific m s e := rfl + @[simp] theorem intCast_den (a : Int) : (a : Rat).den = 1 := rfl @[simp] theorem intCast_num (a : Int) : (a : Rat).num = a := rfl diff --git a/Batteries/Data/String/Basic.lean b/Batteries/Data/String/Basic.lean index d06df6eefa..aad3484c05 100644 --- a/Batteries/Data/String/Basic.lean +++ b/Batteries/Data/String/Basic.lean @@ -8,99 +8,29 @@ instance : Coe String Substring := ⟨String.toSubstring⟩ namespace String -protected theorem Pos.ne_zero_of_lt : {a b : Pos} → a < b → b ≠ 0 - | _, _, hlt, rfl => Nat.not_lt_zero _ hlt - -end String - -namespace Substring - -/-- -Returns the longest common prefix of two substrings. -The returned substring will use the same underlying string as `s`. --/ -def commonPrefix (s t : Substring) : Substring := - { s with stopPos := loop s.startPos t.startPos } -where - /-- Returns the ending position of the common prefix, working up from `spos, tpos`. -/ - loop spos tpos := - if h : spos < s.stopPos ∧ tpos < t.stopPos then - if s.str.get spos == t.str.get tpos then - have := Nat.sub_lt_sub_left h.1 (s.str.lt_next spos) - loop (s.str.next spos) (t.str.next tpos) - else - spos - else - spos - termination_by s.stopPos.byteIdx - spos.byteIdx - -/-- -Returns the longest common suffix of two substrings. -The returned substring will use the same underlying string as `s`. --/ -def commonSuffix (s t : Substring) : Substring := - { s with startPos := loop s.stopPos t.stopPos } -where - /-- Returns the starting position of the common prefix, working down from `spos, tpos`. -/ - loop spos tpos := - if h : s.startPos < spos ∧ t.startPos < tpos then - let spos' := s.str.prev spos - let tpos' := t.str.prev tpos - if s.str.get spos' == t.str.get tpos' then - have : spos' < spos := s.str.prev_lt_of_pos spos (String.Pos.ne_zero_of_lt h.1) - loop spos' tpos' - else - spos - else - spos - termination_by spos.byteIdx - -/-- -If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`. --/ -def dropPrefix? (s : Substring) (pre : Substring) : Option Substring := - let t := s.commonPrefix pre - if t.bsize = pre.bsize then - some { s with startPos := t.stopPos } - else - none - -/-- -If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`. --/ -def dropSuffix? (s : Substring) (suff : Substring) : Option Substring := - let t := s.commonSuffix suff - if t.bsize = suff.bsize then - some { s with stopPos := t.startPos } - else - none - -end Substring - -namespace String +/-- 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 /-- -If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`. --/ -def dropPrefix? (s : String) (pre : Substring) : Option Substring := - Substring.dropPrefix? s pre +Convert a string of assumed-ASCII characters into a byte array. +(If any characters are non-ASCII they will be reduced modulo 256.) -/-- -If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`. +Note: if you just need the underlying `ByteArray` of a non-ASCII string, +use `String.toUTF8`. -/ -def dropSuffix? (s : String) (suff : Substring) : Option Substring := - Substring.dropSuffix? s suff - -/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there, -or otherwise return `s`. -/ -def stripPrefix (s : String) (pre : Substring) : String := - s.dropPrefix? pre |>.map Substring.toString |>.getD s - -/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there, -or otherwise return `s`. -/ -def stripSuffix (s : String) (suff : Substring) : String := - s.dropSuffix? suff |>.map Substring.toString |>.getD s - -/-- Count the occurrences of a character in a string. -/ -def count (s : String) (c : Char) : Nat := - s.foldl (fun n d => if d = c then n + 1 else n) 0 +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 7789f9dcd2..5854890f25 100644 --- a/Batteries/Data/String/Lemmas.lean +++ b/Batteries/Data/String/Lemmas.lean @@ -15,11 +15,11 @@ namespace String attribute [ext (iff := false)] ext theorem lt_trans {s₁ s₂ s₃ : String} : s₁ < s₂ → s₂ < s₃ → s₁ < s₃ := - List.lt_trans' (α := Char) Nat.lt_trans + List.lt_trans (α := Char) Nat.lt_trans (fun h1 h2 => Nat.not_lt.2 <| Nat.le_trans (Nat.not_lt.1 h2) (Nat.not_lt.1 h1)) theorem lt_antisymm {s₁ s₂ : String} (h₁ : ¬s₁ < s₂) (h₂ : ¬s₂ < s₁) : s₁ = s₂ := - ext <| List.lt_antisymm' (α := Char) + ext <| List.lt_antisymm (α := Char) (fun h1 h2 => Char.le_antisymm (Nat.not_lt.1 h2) (Nat.not_lt.1 h1)) h₁ h₂ instance : Batteries.TransOrd String := .compareOfLessAndEq @@ -209,7 +209,7 @@ theorem next_of_valid (cs : List Char) (c : Char) (cs' : List Char) : next ⟨cs ++ c :: cs'⟩ ⟨utf8Len cs⟩ = ⟨utf8Len cs + c.utf8Size⟩ := next_of_valid' .. @[simp] theorem atEnd_iff (s : String) (p : Pos) : atEnd s p ↔ s.endPos ≤ p := - decide_eq_true_iff _ + decide_eq_true_iff theorem valid_next {p : Pos} (h : p.Valid s) (h₂ : p < s.endPos) : (next s p).Valid s := by match s, p, h with @@ -447,12 +447,12 @@ theorem split_of_valid (s p) : split s p = (List.splitOnP p s.1).map mk := by attribute [simp] toSubstring' -theorem join_eq (ss : List String) : join ss = ⟨(ss.map data).join⟩ := go ss [] where - go : ∀ (ss : List String) cs, ss.foldl (· ++ ·) (mk cs) = ⟨cs ++ (ss.map data).join⟩ +theorem join_eq (ss : List String) : join ss = ⟨(ss.map data).flatten⟩ := go ss [] where + go : ∀ (ss : List String) cs, ss.foldl (· ++ ·) (mk cs) = ⟨cs ++ (ss.map data).flatten⟩ | [], _ => by simp | ⟨s⟩::ss, _ => (go ss _).trans (by simp) -@[simp] theorem data_join (ss : List String) : (join ss).data = (ss.map data).join := by +@[simp] theorem data_join (ss : List String) : (join ss).data = (ss.map data).flatten := by rw [join_eq] @[deprecated (since := "2024-06-06")] alias append_nil := append_empty @@ -922,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 diff --git a/Batteries/Data/Sum.lean b/Batteries/Data/Sum.lean deleted file mode 100644 index 51d4518942..0000000000 --- a/Batteries/Data/Sum.lean +++ /dev/null @@ -1,2 +0,0 @@ -import Batteries.Data.Sum.Basic -import Batteries.Data.Sum.Lemmas diff --git a/Batteries/Data/Sum/Basic.lean b/Batteries/Data/Sum/Basic.lean deleted file mode 100644 index 6740f19228..0000000000 --- a/Batteries/Data/Sum/Basic.lean +++ /dev/null @@ -1,164 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Yury G. Kudryashov --/ - -/-! -# Disjoint union of types - -This file defines basic operations on the the sum type `α ⊕ β`. - -`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*. - -## Main declarations - -* `Sum.isLeft`: Returns whether `x : α ⊕ β` comes from the left component or not. -* `Sum.isRight`: Returns whether `x : α ⊕ β` comes from the right component or not. -* `Sum.getLeft`: Retrieves the left content of a `x : α ⊕ β` that is known to come from the left. -* `Sum.getRight`: Retrieves the right content of `x : α ⊕ β` that is known to come from the right. -* `Sum.getLeft?`: Retrieves the left content of `x : α ⊕ β` as an option type or returns `none` - if it's coming from the right. -* `Sum.getRight?`: Retrieves the right content of `x : α ⊕ β` as an option type or returns `none` - if it's coming from the left. -* `Sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise. -* `Sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`. -* `Sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components. -* `Sum.LiftRel`: The disjoint union of two relations. -* `Sum.Lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`. - -## Further material - -See `Batteries.Data.Sum.Lemmas` for theorems about these definitions. - -## Notes - -The definition of `Sum` takes values in `Type _`. This effectively forbids `Prop`- valued sum types. -To this effect, we have `PSum`, which takes value in `Sort _` and carries a more complicated -universe signature in consequence. The `Prop` version is `Or`. --/ - -namespace Sum - -deriving instance DecidableEq for Sum -deriving instance BEq for Sum - -section get - -/-- Check if a sum is `inl`. -/ -def isLeft : α ⊕ β → Bool - | inl _ => true - | inr _ => false - -/-- Check if a sum is `inr`. -/ -def isRight : α ⊕ β → Bool - | inl _ => false - | inr _ => true - -/-- Retrieve the contents from a sum known to be `inl`.-/ -def getLeft : (ab : α ⊕ β) → ab.isLeft → α - | inl a, _ => a - -/-- Retrieve the contents from a sum known to be `inr`.-/ -def getRight : (ab : α ⊕ β) → ab.isRight → β - | inr b, _ => b - -@[simp] theorem isLeft_inl : (inl x : α ⊕ β).isLeft = true := rfl -@[simp] theorem isLeft_inr : (inr x : α ⊕ β).isLeft = false := rfl -@[simp] theorem isRight_inl : (inl x : α ⊕ β).isRight = false := rfl -@[simp] theorem isRight_inr : (inr x : α ⊕ β).isRight = true := rfl - -@[simp] theorem getLeft_inl (h : (inl x : α ⊕ β).isLeft) : (inl x).getLeft h = x := rfl -@[simp] theorem getRight_inr (h : (inr x : α ⊕ β).isRight) : (inr x).getRight h = x := rfl - -@[simp] theorem getLeft?_inl : (inl x : α ⊕ β).getLeft? = some x := rfl -@[simp] theorem getLeft?_inr : (inr x : α ⊕ β).getLeft? = none := rfl -@[simp] theorem getRight?_inl : (inl x : α ⊕ β).getRight? = none := rfl -@[simp] theorem getRight?_inr : (inr x : α ⊕ β).getRight? = some x := rfl - -end get - -/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/ -protected def elim {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ := - fun x => Sum.casesOn x f g - -@[simp] theorem elim_inl (f : α → γ) (g : β → γ) (x : α) : - Sum.elim f g (inl x) = f x := rfl - -@[simp] theorem elim_inr (f : α → γ) (g : β → γ) (x : β) : - Sum.elim f g (inr x) = g x := rfl - -/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/ -protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' := - Sum.elim (inl ∘ f) (inr ∘ g) - -@[simp] theorem map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl - -@[simp] theorem map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl - -/-- Swap the factors of a sum type -/ -def swap : α ⊕ β → β ⊕ α := Sum.elim inr inl - -@[simp] theorem swap_inl : swap (inl x : α ⊕ β) = inr x := rfl - -@[simp] theorem swap_inr : swap (inr x : α ⊕ β) = inl x := rfl - -section LiftRel - -/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between -`α ⊕ β` and `γ ⊕ δ`. -/ -inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop - /-- `inl a` and `inl c` are related via `LiftRel r s` if `a` and `c` are related via `r`. -/ - | protected inl {a c} : r a c → LiftRel r s (inl a) (inl c) - /-- `inr b` and `inr d` are related via `LiftRel r s` if `b` and `d` are related via `s`. -/ - | protected inr {b d} : s b d → LiftRel r s (inr b) (inr d) - -@[simp] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) ↔ r a c := - ⟨fun h => by cases h; assumption, LiftRel.inl⟩ - -@[simp] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun - -@[simp] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun - -@[simp] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) ↔ s b d := - ⟨fun h => by cases h; assumption, LiftRel.inr⟩ - -instance {r : α → γ → Prop} {s : β → δ → Prop} - [∀ a c, Decidable (r a c)] [∀ b d, Decidable (s b d)] : - ∀ (ab : α ⊕ β) (cd : γ ⊕ δ), Decidable (LiftRel r s ab cd) - | inl _, inl _ => decidable_of_iff' _ liftRel_inl_inl - | inl _, inr _ => Decidable.isFalse not_liftRel_inl_inr - | inr _, inl _ => Decidable.isFalse not_liftRel_inr_inl - | inr _, inr _ => decidable_of_iff' _ liftRel_inr_inr - -end LiftRel - -section Lex - -/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the -respective order on `α` or `β`. -/ -inductive Lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop - /-- `inl a₁` and `inl a₂` are related via `Lex r s` if `a₁` and `a₂` are related via `r`. -/ - | protected inl {a₁ a₂} (h : r a₁ a₂) : Lex r s (inl a₁) (inl a₂) - /-- `inr b₁` and `inr b₂` are related via `Lex r s` if `b₁` and `b₂` are related via `s`. -/ - | protected inr {b₁ b₂} (h : s b₁ b₂) : Lex r s (inr b₁) (inr b₂) - /-- `inl a` and `inr b` are always related via `Lex r s`. -/ - | sep (a b) : Lex r s (inl a) (inr b) - -attribute [simp] Lex.sep - -@[simp] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ := - ⟨fun h => by cases h; assumption, Lex.inl⟩ - -@[simp] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ := - ⟨fun h => by cases h; assumption, Lex.inr⟩ - -@[simp] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun - -instance instDecidableRelSumLex [DecidableRel r] [DecidableRel s] : DecidableRel (Lex r s) - | inl _, inl _ => decidable_of_iff' _ lex_inl_inl - | inl _, inr _ => Decidable.isTrue (Lex.sep _ _) - | inr _, inl _ => Decidable.isFalse lex_inr_inl - | inr _, inr _ => decidable_of_iff' _ lex_inr_inr - -end Lex diff --git a/Batteries/Data/Sum/Lemmas.lean b/Batteries/Data/Sum/Lemmas.lean deleted file mode 100644 index 9d55bd1919..0000000000 --- a/Batteries/Data/Sum/Lemmas.lean +++ /dev/null @@ -1,250 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Yury G. Kudryashov --/ - -import Batteries.Data.Sum.Basic -import Batteries.Logic - -/-! -# Disjoint union of types - -Theorems about the definitions introduced in `Batteries.Data.Sum.Basic`. --/ - -open Function - -namespace Sum - -@[simp] protected theorem «forall» {p : α ⊕ β → Prop} : - (∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) := - ⟨fun h => ⟨fun _ => h _, fun _ => h _⟩, fun ⟨h₁, h₂⟩ => Sum.rec h₁ h₂⟩ - -@[simp] protected theorem «exists» {p : α ⊕ β → Prop} : - (∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) := - ⟨ fun - | ⟨inl a, h⟩ => Or.inl ⟨a, h⟩ - | ⟨inr b, h⟩ => Or.inr ⟨b, h⟩, - fun - | Or.inl ⟨a, h⟩ => ⟨inl a, h⟩ - | Or.inr ⟨b, h⟩ => ⟨inr b, h⟩⟩ - -theorem forall_sum {γ : α ⊕ β → Sort _} (p : (∀ ab, γ ab) → Prop) : - (∀ fab, p fab) ↔ (∀ fa fb, p (Sum.rec fa fb)) := by - refine ⟨fun h fa fb => h _, fun h fab => ?_⟩ - have h1 : fab = Sum.rec (fun a => fab (Sum.inl a)) (fun b => fab (Sum.inr b)) := by - ext ab; cases ab <;> rfl - rw [h1]; exact h _ _ - -section get - -@[simp] theorem inl_getLeft : ∀ (x : α ⊕ β) (h : x.isLeft), inl (x.getLeft h) = x - | inl _, _ => rfl -@[simp] theorem inr_getRight : ∀ (x : α ⊕ β) (h : x.isRight), inr (x.getRight h) = x - | inr _, _ => rfl - -@[simp] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by - cases x <;> simp only [getLeft?, isRight, eq_self_iff_true] - -@[simp] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by - cases x <;> simp only [getRight?, isLeft, eq_self_iff_true] - -theorem eq_left_getLeft_of_isLeft : ∀ {x : α ⊕ β} (h : x.isLeft), x = inl (x.getLeft h) - | inl _, _ => rfl - -@[simp] theorem getLeft_eq_iff (h : x.isLeft) : x.getLeft h = a ↔ x = inl a := by - cases x <;> simp at h ⊢ - -theorem eq_right_getRight_of_isRight : ∀ {x : α ⊕ β} (h : x.isRight), x = inr (x.getRight h) - | inr _, _ => rfl - -@[simp] theorem getRight_eq_iff (h : x.isRight) : x.getRight h = b ↔ x = inr b := by - cases x <;> simp at h ⊢ - -@[simp] theorem getLeft?_eq_some_iff : x.getLeft? = some a ↔ x = inl a := by - cases x <;> simp only [getLeft?, Option.some.injEq, inl.injEq] - -@[simp] theorem getRight?_eq_some_iff : x.getRight? = some b ↔ x = inr b := by - cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq] - -@[simp] theorem bnot_isLeft (x : α ⊕ β) : !x.isLeft = x.isRight := by cases x <;> rfl - -@[simp] theorem isLeft_eq_false {x : α ⊕ β} : x.isLeft = false ↔ x.isRight := by cases x <;> simp - -theorem not_isLeft {x : α ⊕ β} : ¬x.isLeft ↔ x.isRight := by simp - -@[simp] theorem bnot_isRight (x : α ⊕ β) : !x.isRight = x.isLeft := by cases x <;> rfl - -@[simp] theorem isRight_eq_false {x : α ⊕ β} : x.isRight = false ↔ x.isLeft := by cases x <;> simp - -theorem not_isRight {x : α ⊕ β} : ¬x.isRight ↔ x.isLeft := by simp - -theorem isLeft_iff : x.isLeft ↔ ∃ y, x = Sum.inl y := by cases x <;> simp - -theorem isRight_iff : x.isRight ↔ ∃ y, x = Sum.inr y := by cases x <;> simp - -end get - -theorem inl.inj_iff : (inl a : α ⊕ β) = inl b ↔ a = b := ⟨inl.inj, congrArg _⟩ - -theorem inr.inj_iff : (inr a : α ⊕ β) = inr b ↔ a = b := ⟨inr.inj, congrArg _⟩ - -theorem inl_ne_inr : inl a ≠ inr b := nofun - -theorem inr_ne_inl : inr b ≠ inl a := nofun - -/-! ### `Sum.elim` -/ - -@[simp] theorem elim_comp_inl (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inl = f := - rfl - -@[simp] theorem elim_comp_inr (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inr = g := - rfl - -@[simp] theorem elim_inl_inr : @Sum.elim α β _ inl inr = id := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -theorem comp_elim (f : γ → δ) (g : α → γ) (h : β → γ) : - f ∘ Sum.elim g h = Sum.elim (f ∘ g) (f ∘ h) := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -@[simp] theorem elim_comp_inl_inr (f : α ⊕ β → γ) : - Sum.elim (f ∘ inl) (f ∘ inr) = f := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -theorem elim_eq_iff {u u' : α → γ} {v v' : β → γ} : - Sum.elim u v = Sum.elim u' v' ↔ u = u' ∧ v = v' := by - simp [funext_iff] - -/-! ### `Sum.map` -/ - -@[simp] theorem map_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') : - ∀ x : Sum α β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g) - | inl _ => rfl - | inr _ => rfl - -@[simp] theorem map_comp_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') : - Sum.map f' g' ∘ Sum.map f g = Sum.map (f' ∘ f) (g' ∘ g) := - funext <| map_map f' g' f g - -@[simp] theorem map_id_id : Sum.map (@id α) (@id β) = id := - funext fun x => Sum.recOn x (fun _ => rfl) fun _ => rfl - -theorem elim_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} : - Sum.elim f₂ g₂ (Sum.map f₁ g₁ x) = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x := by - cases x <;> rfl - -theorem elim_comp_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} : - Sum.elim f₂ g₂ ∘ Sum.map f₁ g₁ = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) := - funext fun _ => elim_map - -@[simp] theorem isLeft_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - isLeft (x.map f g) = isLeft x := by - cases x <;> rfl - -@[simp] theorem isRight_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - isRight (x.map f g) = isRight x := by - cases x <;> rfl - -@[simp] theorem getLeft?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - (x.map f g).getLeft? = x.getLeft?.map f := by - cases x <;> rfl - -@[simp] theorem getRight?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - (x.map f g).getRight? = x.getRight?.map g := by cases x <;> rfl - -/-! ### `Sum.swap` -/ - -@[simp] theorem swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x <;> rfl - -@[simp] theorem swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext <| swap_swap - -@[simp] theorem isLeft_swap (x : α ⊕ β) : x.swap.isLeft = x.isRight := by cases x <;> rfl - -@[simp] theorem isRight_swap (x : α ⊕ β) : x.swap.isRight = x.isLeft := by cases x <;> rfl - -@[simp] theorem getLeft?_swap (x : α ⊕ β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl - -@[simp] theorem getRight?_swap (x : α ⊕ β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl - -section LiftRel - -theorem LiftRel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) - (h : LiftRel r₁ s₁ x y) : LiftRel r₂ s₂ x y := by - cases h - · exact LiftRel.inl (hr _ _ ‹_›) - · exact LiftRel.inr (hs _ _ ‹_›) - -theorem LiftRel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : LiftRel r₁ s x y) : - LiftRel r₂ s x y := - (h.mono hr) fun _ _ => id - -theorem LiftRel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : LiftRel r s₁ x y) : - LiftRel r s₂ x y := - h.mono (fun _ _ => id) hs - -protected theorem LiftRel.swap (h : LiftRel r s x y) : LiftRel s r x.swap y.swap := by - cases h - · exact LiftRel.inr ‹_› - · exact LiftRel.inl ‹_› - -@[simp] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap ↔ LiftRel r s x y := - ⟨fun h => by rw [← swap_swap x, ← swap_swap y]; exact h.swap, LiftRel.swap⟩ - -end LiftRel - -section Lex - -protected theorem LiftRel.lex {a b : α ⊕ β} (h : LiftRel r s a b) : Lex r s a b := by - cases h - · exact Lex.inl ‹_› - · exact Lex.inr ‹_› - -theorem liftRel_subrelation_lex : Subrelation (LiftRel r s) (Lex r s) := LiftRel.lex - -theorem Lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r₁ s₁ x y) : - Lex r₂ s₂ x y := by - cases h - · exact Lex.inl (hr _ _ ‹_›) - · exact Lex.inr (hs _ _ ‹_›) - · exact Lex.sep _ _ - -theorem Lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : Lex r₁ s x y) : Lex r₂ s x y := - (h.mono hr) fun _ _ => id - -theorem Lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r s₁ x y) : Lex r s₂ x y := - h.mono (fun _ _ => id) hs - -theorem lex_acc_inl (aca : Acc r a) : Acc (Lex r s) (inl a) := by - induction aca with - | intro _ _ IH => - constructor - intro y h - cases h with - | inl h' => exact IH _ h' - -theorem lex_acc_inr (aca : ∀ a, Acc (Lex r s) (inl a)) {b} (acb : Acc s b) : - Acc (Lex r s) (inr b) := by - induction acb with - | intro _ _ IH => - constructor - intro y h - cases h with - | inr h' => exact IH _ h' - | sep => exact aca _ - -theorem lex_wf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (Lex r s) := - have aca : ∀ a, Acc (Lex r s) (inl a) := fun a => lex_acc_inl (ha.apply a) - ⟨fun x => Sum.recOn x aca fun b => lex_acc_inr aca (hb.apply b)⟩ - -end Lex - -theorem elim_const_const (c : γ) : - Sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c := by - ext x - cases x <;> rfl - -@[simp] theorem elim_lam_const_lam_const (c : γ) : - Sum.elim (fun _ : α => c) (fun _ : β => c) = fun _ => c := - Sum.elim_const_const c diff --git a/Batteries/Data/UInt.lean b/Batteries/Data/UInt.lean index a7c2a4cbaa..3f9b495629 100644 --- a/Batteries/Data/UInt.lean +++ b/Batteries/Data/UInt.lean @@ -12,9 +12,6 @@ import Batteries.Classes.Order @[simp] theorem UInt8.val_val_eq_toNat (x : UInt8) : x.val.val = x.toNat := rfl -@[simp] theorem UInt8.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt8).val = OfNat.ofNat n := rfl - @[simp] theorem UInt8.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt8).toNat = n % UInt8.size := rfl @@ -49,9 +46,6 @@ instance : Batteries.LawfulOrd UInt8 := .compareOfLessAndEq @[simp] theorem UInt16.val_val_eq_toNat (x : UInt16) : x.val.val = x.toNat := rfl -@[simp] theorem UInt16.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt16).val = OfNat.ofNat n := rfl - @[simp] theorem UInt16.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt16).toNat = n % UInt16.size := rfl @@ -86,9 +80,6 @@ instance : Batteries.LawfulOrd UInt16 := .compareOfLessAndEq @[simp] theorem UInt32.val_val_eq_toNat (x : UInt32) : x.val.val = x.toNat := rfl -@[simp] theorem UInt32.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt32).val = OfNat.ofNat n := rfl - @[simp] theorem UInt32.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt32).toNat = n % UInt32.size := rfl @@ -123,9 +114,6 @@ instance : Batteries.LawfulOrd UInt32 := .compareOfLessAndEq @[simp] theorem UInt64.val_val_eq_toNat (x : UInt64) : x.val.val = x.toNat := rfl -@[simp] theorem UInt64.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt64).val = OfNat.ofNat n := rfl - @[simp] theorem UInt64.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt64).toNat = n % UInt64.size := rfl @@ -160,15 +148,11 @@ instance : Batteries.LawfulOrd UInt64 := .compareOfLessAndEq @[simp] theorem USize.val_val_eq_toNat (x : USize) : x.val.val = x.toNat := rfl -@[simp] theorem USize.val_ofNat (n) : - (no_index (OfNat.ofNat n) : USize).val = OfNat.ofNat n := rfl - @[simp] theorem USize.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : USize).toNat = n % USize.size := rfl theorem USize.size_eq : USize.size = 2 ^ System.Platform.numBits := by - have : 1 ≤ 2 ^ System.Platform.numBits := Nat.succ_le_of_lt (Nat.two_pow_pos _) - rw [USize.size, Nat.sub_add_cancel this] + rw [USize.size] theorem USize.le_size : 2 ^ 32 ≤ USize.size := by rw [size_eq] diff --git a/Batteries/Data/UnionFind/Basic.lean b/Batteries/Data/UnionFind/Basic.lean index 549c9e1cde..14bc600887 100644 --- a/Batteries/Data/UnionFind/Basic.lean +++ b/Batteries/Data/UnionFind/Basic.lean @@ -3,6 +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 Batteries.Tactic.Alias import Batteries.Tactic.Lint.Misc import Batteries.Tactic.SeqFocus import Batteries.Data.Array.Lemmas @@ -18,11 +19,6 @@ structure UFNode where namespace UnionFind -/-- Panic with return value -/ -def panicWith (v : α) (msg : String) : α := @panic α ⟨v⟩ msg - -@[simp] theorem panicWith_eq (v : α) (msg) : panicWith v msg = v := rfl - /-- Parent of a union-find node, defaults to self when the node is a root -/ def parentD (arr : Array UFNode) (i : Nat) : Nat := if h : i < arr.size then (arr.get ⟨i, h⟩).parent else i @@ -128,7 +124,7 @@ abbrev parent (self : UnionFind) (i : Nat) : Nat := parentD self.arr i theorem parent'_lt (self : UnionFind) (i : Fin self.size) : (self.arr.get i).parent < self.size := by - simp only [← parentD_eq, parentD_lt, Fin.is_lt, Array.data_length] + simp only [← parentD_eq, parentD_lt, Fin.is_lt, Array.length_toList] theorem parent_lt (self : UnionFind) (i : Nat) : self.parent i < self.size ↔ i < self.size := by simp only [parentD]; split <;> simp only [*, parent'_lt] @@ -151,8 +147,8 @@ theorem rank'_lt_rankMax (self : UnionFind) (i : Fin self.size) : let rec go : ∀ {l} {x : UFNode}, x ∈ l → x.rank ≤ List.foldr (max ·.rank) 0 l | a::l, _, List.Mem.head _ => by dsimp; apply Nat.le_max_left | a::l, _, .tail _ h => by dsimp; exact Nat.le_trans (go h) (Nat.le_max_right ..) - simp only [Array.get_eq_getElem, rankMax, Array.foldr_eq_foldr_data] - exact Nat.lt_succ.2 <| go (self.arr.data.get_mem i.1 i.2) + simp only [Array.get_eq_getElem, rankMax, Array.foldr_eq_foldr_toList] + exact Nat.lt_succ.2 <| go (self.arr.toList.get_mem i.1 i.2) theorem rankD_lt_rankMax (self : UnionFind) (i : Nat) : rankD self.arr i < self.rankMax := by @@ -161,11 +157,11 @@ theorem rankD_lt_rankMax (self : UnionFind) (i : Nat) : theorem lt_rankMax (self : UnionFind) (i : Nat) : self.rank i < self.rankMax := rankD_lt_rankMax .. theorem push_rankD (arr : Array UFNode) : rankD (arr.push ⟨arr.size, 0⟩) i = rankD arr i := by - simp only [rankD, Array.size_push, Array.get_eq_getElem, Array.get_push, dite_eq_ite] + simp only [rankD, Array.size_push, Array.get_eq_getElem, Array.getElem_push, dite_eq_ite] split <;> split <;> first | simp | cases ‹¬_› (Nat.lt_succ_of_lt ‹_›) theorem push_parentD (arr : Array UFNode) : parentD (arr.push ⟨arr.size, 0⟩) i = parentD arr i := by - simp only [parentD, Array.size_push, Array.get_eq_getElem, Array.get_push, dite_eq_ite] + simp only [parentD, Array.size_push, Array.get_eq_getElem, Array.getElem_push, dite_eq_ite] split <;> split <;> try simp · exact Nat.le_antisymm (Nat.ge_of_not_lt ‹_›) (Nat.le_of_lt_succ ‹_›) · cases ‹¬_› (Nat.lt_succ_of_lt ‹_›) @@ -217,7 +213,7 @@ theorem parent_rootD (self : UnionFind) (x : Nat) : @[nolint unusedHavesSuffices] theorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = self.rootD x := by - simp only [rootD, Array.data_length, parent_lt] + simp only [rootD, Array.length_toList, parent_lt] split · simp only [parentD, ↓reduceDIte, *] (conv => rhs; rw [root]); split @@ -226,7 +222,7 @@ theorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = · simp only [not_false_eq_true, parentD_of_not_lt, *] theorem rootD_lt {self : UnionFind} {x : Nat} : self.rootD x < self.size ↔ x < self.size := by - simp only [rootD, Array.data_length]; split <;> simp [*] + simp only [rootD, Array.length_toList]; split <;> simp [*] @[nolint unusedHavesSuffices] theorem rootD_eq_self {self : UnionFind} {x : Nat} : self.rootD x = x ↔ self.parent x = x := by @@ -284,7 +280,7 @@ termination_by self.rankMax - self.rank x theorem findAux_root {self : UnionFind} {x : Fin self.size} : (findAux self x).root = self.root x := by rw [findAux, root] - simp only [Array.data_length, Array.get_eq_getElem, dite_eq_ite] + simp only [Array.length_toList, Array.get_eq_getElem, dite_eq_ite] split <;> simp only have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact findAux_root @@ -298,7 +294,7 @@ theorem findAux_s {self : UnionFind} {x : Fin self.size} : rw [show self.rootD _ = (self.findAux ⟨_, self.parent'_lt x⟩).root from _] · rw [findAux]; split <;> rfl · rw [← rootD_parent, parent, parentD_eq] - simp only [rootD, Array.get_eq_getElem, Array.data_length, findAux_root] + simp only [rootD, Array.get_eq_getElem, Array.length_toList, findAux_root] apply dif_pos exact parent'_lt .. @@ -364,7 +360,7 @@ theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : · simp [*] · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact (parentD_findAux_or self ⟨_, self.parent'_lt x⟩ i).imp_left <| .imp_right fun h => by - simp only [h, ← parentD_eq, rootD_parent, Array.data_length] + simp only [h, ← parentD_eq, rootD_parent, Array.length_toList] termination_by self.rankMax - self.rank x theorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} : @@ -386,7 +382,7 @@ def find (self : UnionFind) (x : Fin self.size) : { 1.arr := r.s 2.1.val := r.root 1.parentD_lt := fun h => by - simp only [Array.data_length, FindAux.size_eq] at * + simp only [Array.length_toList, FindAux.size_eq] at * exact parentD_findAux_lt h 1.rankD_lt := fun h => by rw [rankD_findAux, rankD_findAux]; exact lt_rankD_findAux h 2.1.isLt := show _ < r.s.size by rw [r.size_eq]; exact r.root.2 @@ -420,7 +416,7 @@ def findD (self : UnionFind) (x : Nat) : UnionFind × Nat := @[simp] theorem find_parent_1 (self : UnionFind) (x : Fin self.size) : (self.find x).1.parent x = self.rootD x := by - simp only [parent, Array.data_length, find] + simp only [parent, Array.length_toList, find] rw [parentD_findAux, if_pos rfl] theorem find_parent_or (self : UnionFind) (x : Fin self.size) (i) : @@ -500,7 +496,7 @@ theorem setParent_rankD_lt {arr : Array UFNode} {x y : Fin arr.size} def link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : UnionFind where arr := linkAux self.arr x y parentD_lt h := by - simp only [Array.data_length, linkAux_size] at * + simp only [Array.length_toList, linkAux_size] at * simp only [linkAux, Array.get_eq_getElem] split <;> [skip; split <;> [skip; split]] · exact self.parentD_lt h @@ -522,7 +518,7 @@ def link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : simp only [rankD_set, Fin.eta, Array.get_eq_getElem] split · simp_all - · simp_all only [Array.get_eq_getElem, Array.data_length, Nat.lt_irrefl, not_false_eq_true, + · simp_all only [Array.get_eq_getElem, Array.length_toList, Nat.lt_irrefl, not_false_eq_true, and_true, ite_false, ite_eq_right_iff] rintro rfl simp [rankD_eq, *] diff --git a/Batteries/Data/UnionFind/Lemmas.lean b/Batteries/Data/UnionFind/Lemmas.lean index a42ece4508..9a7b0dac58 100644 --- a/Batteries/Data/UnionFind/Lemmas.lean +++ b/Batteries/Data/UnionFind/Lemmas.lean @@ -16,7 +16,7 @@ namespace Batteries.UnionFind @[simp] theorem parentD_push {arr : Array UFNode} : parentD (arr.push ⟨arr.size, 0⟩) a = parentD arr a := by - simp [parentD]; split <;> split <;> try simp [Array.get_push, *] + simp [parentD]; split <;> split <;> try simp [Array.getElem_push, *] · next h1 h2 => simp [Nat.lt_succ] at h1 h2 exact Nat.le_antisymm h2 h1 @@ -26,7 +26,7 @@ namespace Batteries.UnionFind @[simp] theorem rankD_push {arr : Array UFNode} : rankD (arr.push ⟨arr.size, 0⟩) a = rankD arr a := by - simp [rankD]; split <;> split <;> try simp [Array.get_push, *] + simp [rankD]; split <;> split <;> try simp [Array.getElem_push, *] next h1 h2 => cases h1 (Nat.lt_succ_of_lt h2) @[simp] theorem rank_push {m : UnionFind} : m.push.rank a = m.rank a := by simp [rank] diff --git a/Batteries/Data/Vector/Basic.lean b/Batteries/Data/Vector/Basic.lean index 6fc8166b6d..2d4708d5b2 100644 --- a/Batteries/Data/Vector/Basic.lean +++ b/Batteries/Data/Vector/Basic.lean @@ -80,7 +80,7 @@ def get (v : Vector α n) (i : Fin n) : α := v.toArray.get <| i.cast v.size_eq. /-- 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` nstance for the `GetElem` typeclass. -/ +/-- `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⟩ @@ -102,6 +102,9 @@ if it exists. Else the vector is empty and it returns `none` -/ abbrev back? (v : Vector α n) : Option α := v[n - 1]? +/-- Abbreviation for the last element of a non-empty `Vector`.-/ +abbrev back (v : Vector α (n + 1)) : α := v[n] + /-- `Vector.head` produces the head of a vector -/ abbrev head (v : Vector α (n+1)) := v[0] @@ -235,11 +238,13 @@ Otherwise it panics The old entry is returned with the modified vector. 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`. +`take 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]⟩ +def take (v : Vector α n) (m : Nat) : Vector α (min n m) := + ⟨v.toArray.take m, by simp [Array.size_take, v.size_eq, Nat.min_comm]⟩ + +@[deprecated (since := "2024-10-22")] alias shrink := take /-- Drops the first (up to) `i` elements from a vector of length `n`. @@ -249,18 +254,12 @@ 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 + Array.isEqvAux a.toArray b.toArray (a.size_eq.trans b.size_eq.symm) p 0 (Nat.zero_le _) instance [BEq α] : BEq (Vector α n) := ⟨fun a b => isEqv a b BEq.beq⟩ diff --git a/Batteries/Data/Vector/Lemmas.lean b/Batteries/Data/Vector/Lemmas.lean index 02acccb8ce..d40c7b79cb 100644 --- a/Batteries/Data/Vector/Lemmas.lean +++ b/Batteries/Data/Vector/Lemmas.lean @@ -8,6 +8,7 @@ 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 @@ -18,6 +19,26 @@ namespace Batteries namespace Vector +attribute [simp] Vector.size_eq + +@[simp] theorem length_toList {α n} (xs : Vector α n) : xs.toList.length = n := + xs.size_eq + +@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) : + (Vector.mk data size)[i] = data[i] := rfl + +@[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) : + xs.toArray[i] = xs[i]'(by simpa using h) := by + cases xs + simp + +@[simp] theorem getElem_toList {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toList.length) : + xs.toList[i] = xs[i]'(by simpa using h) := by + simp [toList] + +@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) : + (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by + simp [ofFn] /-- An `empty` vector maps to a `empty` vector. -/ @[simp] @@ -45,3 +66,80 @@ protected theorem ext {a b : Vector α n} (h : (i : Nat) → (_ : i < n) → a[i · intro i hi _ rw [a.size_eq] at hi exact h i hi + +@[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.getElem_push_lt, h] + +@[simp] theorem getElem_pop {v : Vector α n} {i : Nat} (h : i < n - 1) : (v.pop)[i] = v[i] := by + rcases v with ⟨data, rfl⟩ + simp + +/-- +Variant of `getElem_pop` that will sometimes fire when `getElem_pop` gets stuck because of +defeq issues in the implicit size argument. +-/ +@[simp] theorem getElem_pop' (v : Vector α (n + 1)) (i : Nat) (h : i < n + 1 - 1) : + @getElem (Vector α n) Nat α (fun _ i => i < n) instGetElemNatLt v.pop i h = v[i] := + getElem_pop h + +@[simp] theorem push_pop_back (v : Vector α (n + 1)) : v.pop.push v.back = v := by + ext i + by_cases h : i < n + · simp [h] + · replace h : i = n := by omega + subst h + simp + +/-! ### Decidable quantifiers. -/ + +theorem forall_zero_iff {P : Vector α 0 → Prop} : + (∀ v, P v) ↔ P .empty := by + constructor + · intro h + apply h + · intro h v + obtain (rfl : v = .empty) := (by ext i h; simp at h) + apply h + +theorem forall_cons_iff {P : Vector α (n + 1) → Prop} : + (∀ v : Vector α (n + 1), P v) ↔ (∀ (x : α) (v : Vector α n), P (v.push x)) := by + constructor + · intro h _ _ + apply h + · intro h v + have w : v = v.pop.push v.back := by simp + rw [w] + apply h + +instance instDecidableForallVectorZero (P : Vector α 0 → Prop) : + ∀ [Decidable (P .empty)], Decidable (∀ v, P v) + | .isTrue h => .isTrue fun ⟨v, s⟩ => by + obtain (rfl : v = .empty) := (by ext i h₁ h₂; exact s; cases h₂) + exact h + | .isFalse h => .isFalse (fun w => h (w _)) + +instance instDecidableForallVectorSucc (P : Vector α (n+1) → Prop) + [Decidable (∀ (x : α) (v : Vector α n), P (v.push x))] : Decidable (∀ v, P v) := + decidable_of_iff' (∀ x (v : Vector α n), P (v.push x)) forall_cons_iff + +instance instDecidableExistsVectorZero (P : Vector α 0 → Prop) [Decidable (P .empty)] : + Decidable (∃ v, P v) := + decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not + +instance instDecidableExistsVectorSucc (P : Vector α (n+1) → Prop) + [Decidable (∀ (x : α) (v : Vector α n), ¬ P (v.push x))] : Decidable (∃ v, P v) := + decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not diff --git a/Batteries/Lean/Expr.lean b/Batteries/Lean/Expr.lean index 20338d3424..9ac9a09238 100644 --- a/Batteries/Lean/Expr.lean +++ b/Batteries/Lean/Expr.lean @@ -24,6 +24,9 @@ def toSyntax (e : Expr) : TermElabM Syntax.Term := withFreshMacroScope do mvar.mvarId!.assign e pure stx +@[deprecated (since := "2024-10-16"), inherit_doc getNumHeadLambdas] +abbrev lambdaArity := @getNumHeadLambdas + /-- Returns the number of leading `∀` binders of an expression. Ignores metadata. -/ @@ -32,23 +35,9 @@ def forallArity : Expr → Nat | forallE _ _ body _ => 1 + forallArity body | _ => 0 -/-- -Returns the number of leading `λ` binders of an expression. Ignores metadata. --/ -def lambdaArity : Expr → Nat - | mdata _ b => lambdaArity b - | lam _ _ b _ => 1 + lambdaArity b - | _ => 0 - -/-- Like `getAppNumArgs` but ignores metadata. -/ -def getAppNumArgs' (e : Expr) : Nat := - go e 0 -where - /-- Auxiliary definition for `getAppNumArgs'`. -/ - go : Expr → Nat → Nat - | mdata _ b, n => go b n - | app f _ , n => go f (n + 1) - | _ , n => n +-- TODO: replace `forallArity` after https://github.com/leanprover/lean4/pull/5729 +-- @[deprecated (since := "2024-10-16"), inherit_doc getNumHeadForalls] +-- abbrev forallArity := @getNumHeadForalls /-- Like `withApp` but ignores metadata. -/ @[inline] diff --git a/Batteries/Lean/HashSet.lean b/Batteries/Lean/HashSet.lean index 7882358c40..80de1bf5f5 100644 --- a/Batteries/Lean/HashSet.lean +++ b/Batteries/Lean/HashSet.lean @@ -23,13 +23,6 @@ def anyM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do return true return false -/-- -`O(n)`. Returns `true` if `f` returns `true` for any element of the set. --/ -@[inline] -def any (s : HashSet α) (f : α → Bool) : Bool := - Id.run <| s.anyM f - /-- `O(n)`. Returns `true` if `f` returns `true` for all elements of the set. -/ @@ -40,13 +33,6 @@ def allM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do return false return true -/-- -`O(n)`. Returns `true` if `f` returns `true` for all elements of the set. --/ -@[inline] -def all (s : HashSet α) (f : α → Bool) : Bool := - Id.run <| s.allM f - instance : BEq (HashSet α) where beq s t := s.all (t.contains ·) && t.all (s.contains ·) @@ -54,7 +40,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 diff --git a/Batteries/Lean/Meta/AssertHypotheses.lean b/Batteries/Lean/Meta/AssertHypotheses.lean deleted file mode 100644 index 6275032063..0000000000 --- a/Batteries/Lean/Meta/AssertHypotheses.lean +++ /dev/null @@ -1,40 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -import Lean.Meta.Tactic.Assert - -open Lean Lean.Meta - -namespace Lean.Meta - -/-- -Description of a hypothesis for `Lean.MVarId.assertHypotheses'`. --/ -structure Hypothesis' extends Hypothesis where - /-- The hypothesis' `BinderInfo` -/ - binderInfo : BinderInfo - /-- The hypothesis' `LocalDeclKind` -/ - kind : LocalDeclKind - -/-- -Add the given hypotheses to the local context. This is a generalisation of -`Lean.MVarId.assertHypotheses` which lets you specify --/ -def _root_.Lean.MVarId.assertHypotheses' (mvarId : MVarId) - (hs : Array Hypothesis') : MetaM (Array FVarId × MVarId) := do - let (fvarIds, mvarId) ← mvarId.assertHypotheses $ hs.map (·.toHypothesis) - mvarId.modifyLCtx fun lctx => Id.run do - let mut lctx := lctx - for h : i in [:hs.size] do - let h := hs[i] - if h.kind != .default then - lctx := lctx.setKind fvarIds[i]! h.kind - if h.binderInfo != .default then - lctx := lctx.setBinderInfo fvarIds[i]! h.binderInfo - pure lctx - return (fvarIds, mvarId) - -end Lean.Meta diff --git a/Batteries/Lean/Meta/Clear.lean b/Batteries/Lean/Meta/Clear.lean deleted file mode 100644 index 66f38b7798..0000000000 --- a/Batteries/Lean/Meta/Clear.lean +++ /dev/null @@ -1,26 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -import Batteries.Lean.Meta.Basic -import Lean.Meta.Tactic.Clear - -open Lean Lean.Meta - -/-- -Try to clear the given fvars from the local context. Returns the new goal and -the hypotheses that were cleared. Unlike `Lean.MVarId.tryClearMany`, this -function does not require the `hyps` to be given in the order in which they -appear in the local context. --/ -def Lean.MVarId.tryClearMany' (goal : MVarId) (hyps : Array FVarId) : - MetaM (MVarId × Array FVarId) := - goal.withContext do - let hyps ← sortFVarsByContextOrder hyps - hyps.foldrM (init := (goal, Array.mkEmpty hyps.size)) - fun h (goal, cleared) => do - let goal' ← goal.tryClear h - let cleared := if goal == goal' then cleared else cleared.push h - return (goal', cleared) diff --git a/Batteries/Logic.lean b/Batteries/Logic.lean index 03c82eb5ac..4bc5f9f102 100644 --- a/Batteries/Logic.lean +++ b/Batteries/Logic.lean @@ -31,7 +31,7 @@ end Classical theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩ @[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') : - (@Eq.rec α a (fun α _ => β) y a' h) = y := by cases h; rfl + (@Eq.rec α a (fun _ _ => β) y a' h) = y := by cases h; rfl theorem congrArg₂ (f : α → β → γ) {x x' : α} {y y' : β} (hx : x = x') (hy : y = y') : f x y = f x' y' := by subst hx hy; rfl @@ -54,11 +54,9 @@ theorem funext₃ {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a {f g : ∀ a b c, δ a b c} (h : ∀ a b c, f a b c = g a b c) : f = g := funext fun _ => funext₂ <| h _ +@[deprecated (since := "2024-10-17")] protected alias Function.funext_iff := funext_iff -theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} : f x ≠ f y → x ≠ y := - mt <| congrArg _ - protected theorem Eq.congr (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) : x₁ = x₂ ↔ y₁ = y₂ := by subst h₁; subst h₂; rfl @@ -79,39 +77,28 @@ theorem cast_eq_iff_heq : cast e a = a' ↔ HEq a a' := ⟨heq_of_cast_eq _, fun h => by cases h; rfl⟩ theorem eqRec_eq_cast {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _} - (x : motive a (rfl : a = a)) {a' : α} (e : a = a') : + (x : motive a rfl) {a' : α} (e : a = a') : @Eq.rec α a motive x a' e = cast (e ▸ rfl) x := by subst e; rfl --Porting note: new theorem. More general version of `eqRec_heq` theorem eqRec_heq_self {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _} - (x : motive a (rfl : a = a)) {a' : α} (e : a = a') : + (x : motive a rfl) {a' : α} (e : a = a') : HEq (@Eq.rec α a motive x a' e) x := by subst e; rfl @[simp] theorem eqRec_heq_iff_heq {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _} - (x : motive a (rfl : a = a)) {a' : α} (e : a = a') {β : Sort _} (y : β) : + {x : motive a rfl} {a' : α} {e : a = a'} {β : Sort _} {y : β} : HEq (@Eq.rec α a motive x a' e) y ↔ HEq x y := by subst e; rfl @[simp] theorem heq_eqRec_iff_heq {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _} - (x : motive a (rfl : a = a)) {a' : α} (e : a = a') {β : Sort _} (y : β) : + {x : motive a rfl} {a' : α} {e : a = a'} {β : Sort _} {y : β} : HEq y (@Eq.rec α a motive x a' e) ↔ HEq y x := by subst e; rfl -/-! ## membership -/ - -section Mem -variable [Membership α β] {s t : β} {a b : α} - -theorem ne_of_mem_of_not_mem (h : a ∈ s) : b ∉ s → a ≠ b := mt fun e => e ▸ h - -theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => e ▸ h - -end Mem - /-! ## miscellaneous -/ @[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim diff --git a/Batteries/StdDeprecations.lean b/Batteries/StdDeprecations.lean index cb49a3bdbf..74a00f4f5a 100644 --- a/Batteries/StdDeprecations.lean +++ b/Batteries/StdDeprecations.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kim Morrison -/ import Batteries.Tactic.Alias -import Batteries.Data.DList +import Batteries.Data.DList.Basic import Batteries.Data.PairingHeap import Batteries.Data.BinomialHeap.Basic import Batteries.Data.HashMap.Basic diff --git a/Batteries/Tactic/Alias.lean b/Batteries/Tactic/Alias.lean index 07b91dc76e..1f22940b0a 100644 --- a/Batteries/Tactic/Alias.lean +++ b/Batteries/Tactic/Alias.lean @@ -19,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 @@ -109,10 +109,7 @@ elab (name := alias) mods:declModifiers "alias " alias:ident " := " name:ident : addDecl decl else addAndCompile decl - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange alias - } + addDeclarationRangesFromSyntax declName (← getRef) alias Term.addTermInfo' alias (← mkConstWithLevelParams declName) (isBinder := true) addDocString' declName declMods.docString? Term.applyAttributes declName declMods.attrs @@ -174,16 +171,10 @@ elab (name := aliasLR) mods:declModifiers "alias " if let `(binderIdent| $idFwd:ident) := aliasFwd then let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idFwd.getId addSide true declName declMods thm - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange idFwd - } + addDeclarationRangesFromSyntax declName (← getRef) idFwd Term.addTermInfo' idFwd (← mkConstWithLevelParams declName) (isBinder := true) if let `(binderIdent| $idRev:ident) := aliasRev then let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idRev.getId addSide false declName declMods thm - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange idRev - } + addDeclarationRangesFromSyntax declName (← getRef) idRev Term.addTermInfo' idRev (← mkConstWithLevelParams declName) (isBinder := true) diff --git a/Batteries/Tactic/Classical.lean b/Batteries/Tactic/Classical.lean deleted file mode 100644 index a3bc78b0a4..0000000000 --- a/Batteries/Tactic/Classical.lean +++ /dev/null @@ -1,41 +0,0 @@ -/- -Copyright (c) 2021 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import Lean.Elab.Tactic.Basic - -/-! # `classical` tactic -/ - -namespace Batteries.Tactic -open Lean Meta Elab.Tactic - -/-- -`classical t` runs `t` in a scope where `Classical.propDecidable` is a low priority -local instance. --/ -def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t : m α) : - m α := do - modifyEnv Meta.instanceExtension.pushScope - Meta.addInstance ``Classical.propDecidable .local 10 - try - t - finally - modifyEnv Meta.instanceExtension.popScope - -/-- `classical!` has been removed; use `classical` instead -/ --- Deprecated 2024-04-19 -elab "classical!" : tactic => do - throwError "`classical!` has been removed; use `classical` instead" - -/-- -`classical tacs` runs `tacs` in a scope where `Classical.propDecidable` is a low priority -local instance. - -Note that (unlike lean 3) `classical` is a scoping tactic - it adds the instance only within the -scope of the tactic. --/ --- FIXME: using ppDedent looks good in the common case, but produces the incorrect result when --- the `classical` does not scope over the rest of the block. -elab "classical" tacs:ppDedent(tacticSeq) : tactic => do - classical <| Elab.Tactic.evalTactic tacs diff --git a/Batteries/Tactic/HelpCmd.lean b/Batteries/Tactic/HelpCmd.lean new file mode 100644 index 0000000000..1d955310a0 --- /dev/null +++ b/Batteries/Tactic/HelpCmd.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2024 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Edward van de Meent +-/ +import Lean.Elab.Syntax +import Lean.DocString +import Batteries.Util.LibraryNote + +/-! + +# The `#help` command + +The `#help` command can be used to list all definitions in a variety of extensible aspects of lean. + +* `#help option` lists options (used in `set_option myOption`) +* `#help attr` lists attributes (used in `@[myAttr] def foo := ...`) +* `#help cats` lists syntax categories (like `term`, `tactic`, `stx` etc) +* `#help cat C` lists elements of syntax category C + * `#help term`, `#help tactic`, `#help conv`, `#help command` + are shorthand for `#help cat term` etc. + * `#help cat+ C` also shows `elab` and `macro` definitions associated to the syntaxes +* `#help note "some note"` lists library notes for which "some note" is a prefix of the label + +Most forms take an optional identifier to narrow the search; for example `#help option pp` shows +only `pp.*` options. However, `#help cat` makes the identifier mandatory, while `#help note` takes +a mandatory string literal, rather than an identifier. + +-/ + +namespace Batteries.Tactic +open Lean Meta Elab Tactic Command + +/-- +The command `#help option` shows all options that have been defined in the current environment. +Each option has a format like: +``` +option pp.all : Bool := false + (pretty printer) display coercions, implicit parameters, proof terms, fully qualified names, + universe, and disable beta reduction and notations during pretty printing +``` +This says that `pp.all` is an option which can be set to a `Bool` value, and the default value is +`false`. If an option has been modified from the default using e.g. `set_option pp.all true`, +it will appear as a `(currently: true)` note next to the option. + +The form `#help option id` will show only options that begin with `id`. +-/ +syntax withPosition("#help " colGt &"option" (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpOption (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + for (name, decl) in show Lean.RBMap .. from ← getOptionDecls do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name decl + let mut msg := Format.nil + let opts ← getOptions + if decls.isEmpty then + match id with + | some id => throwError "no options start with {id}" + | none => throwError "no options found (!)" + for (name, decl) in decls do + let mut msg1 := match decl.defValue with + | .ofString val => s!"String := {repr val}" + | .ofBool val => s!"Bool := {repr val}" + | .ofName val => s!"Name := {repr val}" + | .ofNat val => s!"Nat := {repr val}" + | .ofInt val => s!"Int := {repr val}" + | .ofSyntax val => s!"Syntax := {repr val}" + if let some val := opts.find (.mkSimple name) then + msg1 := s!"{msg1} (currently: {val})" + msg := msg ++ .nest 2 (f!"option {name} : {msg1}" ++ .line ++ decl.descr) ++ .line ++ .line + logInfo msg + +elab_rules : command | `(#help option $(id)?) => elabHelpOption id + +/-- +The command `#help attribute` (or the short form `#help attr`) shows all attributes that have been +defined in the current environment. +Each attribute has a format like: +``` +[inline]: mark definition to always be inlined +``` +This says that `inline` is an attribute that can be placed on definitions like +`@[inline] def foo := 1`. (Individual attributes may have restrictions on where they can be +applied; see the attribute's documentation for details.) Both the attribute's `descr` field as well +as the docstring will be displayed here. + +The form `#help attr id` will show only attributes that begin with `id`. +-/ +syntax withPosition("#help " colGt (&"attr" <|> &"attribute") + (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpAttr (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + /- + #adaptation_note + On nightly-2024-06-21, added the `.toList` here: + without it the requisite `ForIn` instance can't be found. + -/ + for (name, decl) in (← attributeMapRef.get).toList do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name decl + let mut msg := Format.nil + let env ← getEnv + if decls.isEmpty then + match id with + | some id => throwError "no attributes start with {id}" + | none => throwError "no attributes found (!)" + for (name, decl) in decls do + let mut msg1 := s!"[{name}]: {decl.descr}" + if let some doc ← findDocString? env decl.ref then + msg1 := s!"{msg1}\n{doc.trim}" + msg := msg ++ .nest 2 msg1 ++ .line ++ .line + logInfo msg + +elab_rules : command + | `(#help attr $(id)?) => elabHelpAttr id + | `(#help attribute $(id)?) => elabHelpAttr id + +/-- Gets the initial string token in a parser description. For example, for a declaration like +`syntax "bla" "baz" term : tactic`, it returns `some "bla"`. Returns `none` for syntax declarations +that don't start with a string constant. -/ +partial def getHeadTk (e : Expr) : Option String := + match e.getAppFnArgs with + | (``ParserDescr.node, #[_, _, p]) + | (``ParserDescr.trailingNode, #[_, _, _, p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "withPosition")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "atomic")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "ppRealGroup")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "ppRealFill")), p]) + | (``Parser.ppRealFill, #[p]) + | (``Parser.withAntiquot, #[_, p]) + | (``Parser.leadingNode, #[_, _, p]) + | (``Parser.trailingNode, #[_, _, _, p]) + | (``Parser.group, #[p]) + | (``Parser.withCache, #[_, p]) + | (``Parser.withResetCache, #[p]) + | (``Parser.withPosition, #[p]) + | (``Parser.withOpen, #[p]) + | (``Parser.withPositionAfterLinebreak, #[p]) + | (``Parser.suppressInsideQuot, #[p]) + | (``Parser.ppRealGroup, #[p]) + | (``Parser.ppIndent, #[p]) + | (``Parser.ppDedent, #[p]) + => getHeadTk p + | (``ParserDescr.binary, #[.app _ (.lit (.strVal "andthen")), p, q]) + | (``HAndThen.hAndThen, #[_, _, _, _, p, .lam _ _ q _]) + => getHeadTk p <|> getHeadTk q + | (``ParserDescr.nonReservedSymbol, #[.lit (.strVal tk), _]) + | (``ParserDescr.symbol, #[.lit (.strVal tk)]) + | (``Parser.nonReservedSymbol, #[.lit (.strVal tk), _]) + | (``Parser.symbol, #[.lit (.strVal tk)]) + | (``Parser.unicodeSymbol, #[.lit (.strVal tk), _]) + => pure tk + | _ => none + +/-- +The command `#help cats` shows all syntax categories that have been defined in the +current environment. +Each syntax has a format like: +``` +category command [Lean.Parser.initFn✝] +``` +The name of the syntax category in this case is `command`, and `Lean.Parser.initFn✝` is the +name of the declaration that introduced it. (It is often an anonymous declaration like this, +but you can click to go to the definition.) It also shows the doc string if available. + +The form `#help cats id` will show only syntax categories that begin with `id`. +-/ +syntax withPosition("#help " colGt &"cats" (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpCats (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + for (name, cat) in (Parser.parserExtension.getState (← getEnv)).categories do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name cat + let mut msg := MessageData.nil + let env ← getEnv + if decls.isEmpty then + match id with + | some id => throwError "no syntax categories start with {id}" + | none => throwError "no syntax categories found (!)" + for (name, cat) in decls do + let mut msg1 := m!"category {name} [{mkConst cat.declName}]" + if let some doc ← findDocString? env cat.declName then + msg1 := msg1 ++ Format.line ++ doc.trim + msg := msg ++ .nest 2 msg1 ++ (.line ++ .line : Format) + logInfo msg + +elab_rules : command | `(#help cats $(id)?) => elabHelpCats id + +/-- +The command `#help cat C` shows all syntaxes that have been defined in syntax category `C` in the +current environment. +Each syntax has a format like: +``` +syntax "first"... [Parser.tactic.first] + `first | tac | ...` runs each `tac` until one succeeds, or else fails. +``` +The quoted string is the leading token of the syntax, if applicable. It is followed by the full +name of the syntax (which you can also click to go to the definition), and the documentation. + +* The form `#help cat C id` will show only attributes that begin with `id`. +* The form `#help cat+ C` will also show information about any `macro`s and `elab`s + associated to the listed syntaxes. +-/ +syntax withPosition("#help " colGt &"cat" "+"? colGt ident + (colGt ppSpace (Parser.rawIdent <|> str))?) : command + +private def elabHelpCat (more : Option Syntax) (catStx : Ident) (id : Option String) : + CommandElabM Unit := do + let mut decls : Lean.RBMap _ _ compare := {} + let mut rest : Lean.RBMap _ _ compare := {} + let catName := catStx.getId.eraseMacroScopes + let some cat := (Parser.parserExtension.getState (← getEnv)).categories.find? catName + | throwErrorAt catStx "{catStx} is not a syntax category" + liftTermElabM <| Term.addCategoryInfo catStx catName + let env ← getEnv + for (k, _) in cat.kinds do + let mut used := false + if let some tk := do getHeadTk (← (← env.find? k).value?) then + let tk := tk.trim + if let some id := id then + if !id.isPrefixOf tk then + continue + used := true + decls := decls.insert tk ((decls.findD tk #[]).push k) + if !used && id.isNone then + rest := rest.insert (k.toString false) k + let mut msg := MessageData.nil + if decls.isEmpty && rest.isEmpty then + match id with + | some id => throwError "no {catName} declarations start with {id}" + | none => throwError "no {catName} declarations found" + let env ← getEnv + let addMsg (k : SyntaxNodeKind) (msg msg1 : MessageData) : CommandElabM MessageData := do + let mut msg1 := msg1 + if let some doc ← findDocString? env k then + msg1 := msg1 ++ Format.line ++ doc.trim + msg1 := .nest 2 msg1 + if more.isSome then + let addElabs {α} (type : String) (attr : KeyedDeclsAttribute α) + (msg : MessageData) : CommandElabM MessageData := do + let mut msg := msg + for e in attr.getEntries env k do + let x := e.declName + msg := msg ++ Format.line ++ m!"+ {type} {mkConst x}" + if let some doc ← findDocString? env x then + msg := msg ++ .nest 2 (Format.line ++ doc.trim) + pure msg + msg1 ← addElabs "macro" macroAttribute msg1 + match catName with + | `term => msg1 ← addElabs "term elab" Term.termElabAttribute msg1 + | `command => msg1 ← addElabs "command elab" commandElabAttribute msg1 + | `tactic | `conv => msg1 ← addElabs "tactic elab" tacticElabAttribute msg1 + | _ => pure () + return msg ++ msg1 ++ (.line ++ .line : Format) + for (name, ks) in decls do + for k in ks do + msg ← addMsg k msg m!"syntax {repr name}... [{mkConst k}]" + for (_, k) in rest do + msg ← addMsg k msg m!"syntax ... [{mkConst k}]" + logInfo msg + +elab_rules : command + | `(#help cat $[+%$more]? $cat) => elabHelpCat more cat none + | `(#help cat $[+%$more]? $cat $id:ident) => elabHelpCat more cat (id.getId.toString false) + | `(#help cat $[+%$more]? $cat $id:str) => elabHelpCat more cat id.getString + +/-- +format the string to be included in a single markdown bullet +-/ +def _root_.String.makeBullet (s:String) := "* " ++ ("\n ").intercalate (s.splitOn "\n") + +open Lean Parser Batteries.Util.LibraryNote in +/-- +`#help note "foo"` searches for all library notes whose +label starts with "foo", then displays those library notes sorted alphabetically by label, +grouped by label. +The command only displays the library notes that are declared in +imported files or in the same file above the line containing the command. +-/ +elab "#help " colGt &"note" colGt ppSpace name:strLit : command => do + let env ← getEnv + + -- get the library notes from both this and imported files + let local_entries := (libraryNoteExt.getEntries env).reverse + let imported_entries := (libraryNoteExt.toEnvExtension.getState env).importedEntries + + -- filter for the appropriate notes while casting to list + let label_prefix := name.getString + let imported_entries_filtered := imported_entries.flatten.toList.filterMap + fun x => if label_prefix.isPrefixOf x.fst then some x else none + let valid_entries := imported_entries_filtered ++ local_entries.filterMap + fun x => if label_prefix.isPrefixOf x.fst then some x else none + let grouped_valid_entries := valid_entries.mergeSort (·.fst ≤ ·.fst) + |>.splitBy (·.fst == ·.fst) + + -- display results in a readable style + if grouped_valid_entries.isEmpty then + logError "Note not found" + else + logInfo <| "\n\n".intercalate <| + grouped_valid_entries.map + fun l => "library_note \"" ++ l.head!.fst ++ "\"\n" ++ + "\n\n".intercalate (l.map (·.snd.trim.makeBullet)) + +/-- +The command `#help term` shows all term syntaxes that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"term" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help term%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `term) $(id)?) + +/-- +The command `#help tactic` shows all tactics that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"tactic" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help tactic%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `tactic) $(id)?) + +/-- +The command `#help conv` shows all tactics that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"conv" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help conv%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `conv) $(id)?) + +/-- +The command `#help command` shows all commands that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"command" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help command%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `command) $(id)?) diff --git a/Batteries/Tactic/Lint/Basic.lean b/Batteries/Tactic/Lint/Basic.lean index 948bab5456..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 diff --git a/Batteries/Tactic/Lint/Frontend.lean b/Batteries/Tactic/Lint/Frontend.lean index 27ff3bf3b2..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 @@ -97,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? @@ -114,15 +114,15 @@ 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 @@ -140,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) => @@ -150,10 +150,10 @@ 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 @@ -174,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) diff --git a/Batteries/Tactic/Lint/Misc.lean b/Batteries/Tactic/Lint/Misc.lean index a0aa8bc884..0f9e9406b8 100644 --- a/Batteries/Tactic/Lint/Misc.lean +++ b/Batteries/Tactic/Lint/Misc.lean @@ -14,7 +14,7 @@ import Batteries.Tactic.Lint.Basic open Lean Meta Std -namespace Std.Tactic.Lint +namespace Batteries.Tactic.Lint /-! # Various linters diff --git a/Batteries/Tactic/Lint/Simp.lean b/Batteries/Tactic/Lint/Simp.lean index 9196e4ab74..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}") 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/PrintPrefix.lean b/Batteries/Tactic/PrintPrefix.lean index b83e7b0ad8..42b879b9b7 100644 --- a/Batteries/Tactic/PrintPrefix.lean +++ b/Batteries/Tactic/PrintPrefix.lean @@ -27,7 +27,7 @@ structure PrintPrefixConfig where internals : Bool := false /-- Function elaborating `Config`. -/ -declare_config_elab elabPrintPrefixConfig PrintPrefixConfig +declare_command_config_elab elabPrintPrefixConfig PrintPrefixConfig /-- `reverseName name` reverses the components of a name. @@ -108,12 +108,13 @@ by setting `showTypes` to `false`: The complete set of flags can be seen in the documentation for `Lean.Elab.Command.PrintPrefixConfig`. -/ -elab (name := printPrefix) "#print" tk:"prefix" - cfg:(Lean.Parser.Tactic.config)? name:ident : command => liftTermElabM do - let nameId := name.getId - let opts ← elabPrintPrefixConfig (mkOptionalNode cfg) - let mut msgs ← matchingConstants opts nameId - if msgs.isEmpty then - if let [name] ← resolveGlobalConst name then - msgs ← matchingConstants opts name - logInfoAt tk (.joinSep msgs.toList "") +elab (name := printPrefix) tk:"#print " colGt "prefix" + cfg:Lean.Parser.Tactic.optConfig name:(ident)? : command => do + if let some name := name then + let opts ← elabPrintPrefixConfig cfg + liftTermElabM do + let mut msgs ← matchingConstants opts name.getId + if msgs.isEmpty then + if let [name] ← resolveGlobalConst name then + msgs ← matchingConstants opts name + logInfoAt tk (.joinSep msgs.toList "") diff --git a/Batteries/Tactic/Trans.lean b/Batteries/Tactic/Trans.lean new file mode 100644 index 0000000000..7070c843ac --- /dev/null +++ b/Batteries/Tactic/Trans.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Siddhartha Gadgil, Mario Carneiro +-/ +import Lean.Elab.Tactic.ElabTerm +import Batteries.Tactic.Alias + +/-! +# `trans` tactic + +This implements the `trans` tactic, which can apply transitivity theorems with an optional middle +variable argument. +-/ + +/-- Compose using transitivity, homogeneous case. -/ +def Trans.simple {r : α → α → Sort _} [Trans r r r] : r a b → r b c → r a c := trans + +@[deprecated (since := "2024-10-18")] +alias Trans.heq := Trans.trans + +namespace Batteries.Tactic +open Lean Meta Elab + +initialize registerTraceClass `Tactic.trans + +/-- Discrimation tree settings for the `trans` extension. -/ +def transExt.config : WhnfCoreConfig := {} + +/-- Environment extension storing transitivity lemmas -/ +initialize transExt : + SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← + registerSimpleScopedEnvExtension { + addEntry := fun dt (n, ks) => dt.insertCore ks n + initial := {} + } + +initialize registerBuiltinAttribute { + name := `trans + descr := "transitive relation" + add := fun decl _ kind => MetaM.run' do + let declTy := (← getConstInfo decl).type + let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy + let fail := throwError + "@[trans] attribute only applies to lemmas proving + x ∼ y → y ∼ z → x ∼ z, got {indentExpr declTy} with target {indentExpr targetTy}" + let .app (.app rel _) _ := targetTy | fail + let some yzHyp := xs.back? | fail + let some xyHyp := xs.pop.back? | fail + let .app (.app _ _) _ ← inferType yzHyp | fail + let .app (.app _ _) _ ← inferType xyHyp | fail + let key ← withReducible <| DiscrTree.mkPath rel transExt.config + transExt.add (decl, key) kind +} + +open Lean.Elab.Tactic + +/-- solving `e ← mkAppM' f #[x]` -/ +def getExplicitFuncArg? (e : Expr) : MetaM (Option <| Expr × Expr) := do + match e with + | Expr.app f a => do + if ← isDefEq (← mkAppM' f #[a]) e then + return some (f, a) + else + getExplicitFuncArg? f + | _ => return none + +/-- solving `tgt ← mkAppM' rel #[x, z]` given `tgt = f z` -/ +def getExplicitRelArg? (tgt f z : Expr) : MetaM (Option <| Expr × Expr) := do + match f with + | Expr.app rel x => do + let check: Bool ← do + try + let folded ← mkAppM' rel #[x, z] + isDefEq folded tgt + catch _ => + pure false + if check then + return some (rel, x) + else + getExplicitRelArg? tgt rel z + | _ => return none + +/-- refining `tgt ← mkAppM' rel #[x, z]` dropping more arguments if possible -/ +def getExplicitRelArgCore (tgt rel x z : Expr) : MetaM (Expr × Expr) := do + match rel with + | Expr.app rel' _ => do + let check: Bool ← do + try + let folded ← mkAppM' rel' #[x, z] + isDefEq folded tgt + catch _ => + pure false + if !check then + return (rel, x) + else + getExplicitRelArgCore tgt rel' x z + | _ => return (rel ,x) + +/-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent +arrow. -/ +inductive TransRelation + /-- Expression for transitive relation. -/ + | app (rel : Expr) + /-- Constant name for transitive relation. -/ + | implies (name : Name) (bi : BinderInfo) + +/-- Finds an explicit binary relation in the argument, if possible. -/ +def getRel (tgt : Expr) : MetaM (Option (TransRelation × Expr × Expr)) := do + match tgt with + | .forallE name binderType body info => return .some (.implies name info, binderType, body) + | .app f z => + match (← getExplicitRelArg? tgt f z) with + | some (rel, x) => + let (rel, x) ← getExplicitRelArgCore tgt rel x z + return some (.app rel, x, z) + | none => + return none + | _ => return none + +/-- +`trans` applies to a goal whose target has the form `t ~ u` where `~` is a transitive relation, +that is, a relation which has a transitivity lemma tagged with the attribute [trans]. + +* `trans s` replaces the goal with the two subgoals `t ~ s` and `s ~ u`. +* If `s` is omitted, then a metavariable is used instead. + +Additionally, `trans` also applies to a goal whose target has the form `t → u`, +in which case it replaces the goal with `t → s` and `s → u`. +-/ +elab "trans" t?:(ppSpace colGt term)? : tactic => withMainContext do + let tgt := (← instantiateMVars (← (← getMainGoal).getType)).cleanupAnnotations + let .some (rel, x, z) ← getRel tgt | + throwError (m!"transitivity lemmas only apply to binary relations and " ++ + m!"non-dependent arrows, not {indentExpr tgt}") + match rel with + | .implies name info => + -- only consider non-dependent arrows + if z.hasLooseBVars then + throwError "`trans` is not implemented for dependent arrows{indentExpr tgt}" + -- parse the intermeditate term + let middleType ← mkFreshExprMVar none + let t'? ← t?.mapM (elabTermWithHoles · middleType (← getMainTag)) + let middle ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar middleType) + liftMetaTactic fun goal => do + -- create two new goals + let g₁ ← mkFreshExprMVar (some <| .forallE name x middle info) .synthetic + let g₂ ← mkFreshExprMVar (some <| .forallE name middle z info) .synthetic + -- close the original goal with `fun x => g₂ (g₁ x)` + goal.assign (.lam name x (.app g₂ (.app g₁ (.bvar 0))) .default) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [middle.mvarId!] + return + | .app rel => + trace[Tactic.trans]"goal decomposed" + trace[Tactic.trans]"rel: {indentExpr rel}" + trace[Tactic.trans]"x: {indentExpr x}" + trace[Tactic.trans]"z: {indentExpr z}" + -- first trying the homogeneous case + try + let ty ← inferType x + let t'? ← t?.mapM (elabTermWithHoles · ty (← getMainTag)) + let s ← saveState + trace[Tactic.trans]"trying homogeneous case" + let lemmas := + (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push ``Trans.simple + for lem in lemmas do + trace[Tactic.trans]"trying lemma {lem}" + try + liftMetaTactic fun g => do + let lemTy ← inferType (← mkConstWithLevelParams lem) + let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size + let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar ty) + let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic + let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic + g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂])) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ + if let some (_, gs') := t'? then gs' else [y.mvarId!] + return + catch _ => s.restore + pure () + catch _ => + trace[Tactic.trans]"trying heterogeneous case" + let t'? ← t?.mapM (elabTermWithHoles · none (← getMainTag)) + let s ← saveState + for lem in (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push + ``HEq.trans |>.push ``Trans.trans do + try + liftMetaTactic fun g => do + trace[Tactic.trans]"trying lemma {lem}" + let lemTy ← inferType (← mkConstWithLevelParams lem) + let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size + trace[Tactic.trans]"arity: {arity}" + trace[Tactic.trans]"lemma-type: {lemTy}" + let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar none) + trace[Tactic.trans]"obtained y: {y}" + trace[Tactic.trans]"rel: {indentExpr rel}" + trace[Tactic.trans]"x:{indentExpr x}" + trace[Tactic.trans]"z: {indentExpr z}" + let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic + trace[Tactic.trans]"obtained g₂: {g₂}" + let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic + trace[Tactic.trans]"obtained g₁: {g₁}" + g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂])) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [y.mvarId!] + return + catch e => + trace[Tactic.trans]"failed: {e.toMessageData}" + s.restore + throwError m!"no applicable transitivity lemma found for {indentExpr tgt}" + +/-- Synonym for `trans` tactic. -/ +syntax "transitivity" (ppSpace colGt term)? : tactic +set_option hygiene false in +macro_rules + | `(tactic| transitivity) => `(tactic| trans) + | `(tactic| transitivity $e) => `(tactic| trans $e) + +end Batteries.Tactic diff --git a/Batteries/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/Test/Internal/DummyLibraryNote.lean b/Batteries/Test/Internal/DummyLibraryNote.lean new file mode 100644 index 0000000000..f934823474 --- /dev/null +++ b/Batteries/Test/Internal/DummyLibraryNote.lean @@ -0,0 +1,14 @@ +import Batteries.Util.LibraryNote + +library_note "test" /-- +1: This is a testnote for testing the library note feature of batteries. +The `#help note` command should be able to find this note when imported. +-/ + +library_note "test" /-- +2: This is a second testnote for testing the library note feature of batteries. +-/ + +library_note "temporary note" /-- +1: This is a testnote whose label also starts with "te", but gets sorted before "test" +-/ diff --git a/Batteries/Test/Internal/DummyLibraryNote2.lean b/Batteries/Test/Internal/DummyLibraryNote2.lean new file mode 100644 index 0000000000..3a5bc35dc0 --- /dev/null +++ b/Batteries/Test/Internal/DummyLibraryNote2.lean @@ -0,0 +1,15 @@ +import Batteries.Test.Internal.DummyLibraryNote + +library_note "test" /-- +3: this is a note in a different file importing the above testnotes, +but still imported by the actual testfile. +-/ + +library_note "Test" /-- +1: this is a testnote with a label starting with "Te" +-/ + +library_note "Other" /-- +1: this is a testnote with a label not starting with "te", +so it shouldn't appear when looking for notes with label starting with "te". +-/ diff --git a/Batteries/Util/LibraryNote.lean b/Batteries/Util/LibraryNote.lean index 8c1d45f786..8268c757ca 100644 --- a/Batteries/Util/LibraryNote.lean +++ b/Batteries/Util/LibraryNote.lean @@ -15,12 +15,13 @@ open Lean /-- A library note consists of a (short) tag and a (long) note. -/ def LibraryNoteEntry := String × String +deriving Inhabited /-- Environment extension supporting `library_note`. -/ initialize libraryNoteExt : SimplePersistentEnvExtension LibraryNoteEntry (Array LibraryNoteEntry) ← registerSimplePersistentEnvExtension { addEntryFn := Array.push - addImportedFn := Array.concatMap id + addImportedFn := Array.flatMap id } open Lean Parser Command in @@ -35,6 +36,8 @@ creates a new "library note", which can then be cross-referenced using -- See note [some tag] ``` in doc-comments. +Use `#help note "some tag"` to display all notes with the tag `"some tag"` in the infoview. +This command can be imported from Batteries.Tactic.HelpCmd . -/ elab "library_note " title:strLit ppSpace text:docComment : command => do modifyEnv (libraryNoteExt.addEntry · (title.getString, text.getDocString)) diff --git a/Batteries/Util/Panic.lean b/Batteries/Util/Panic.lean new file mode 100644 index 0000000000..e6317bee71 --- /dev/null +++ b/Batteries/Util/Panic.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2024 François G. Dorais. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: François G. Dorais +-/ + +namespace Batteries + +/-- Panic with a specific default value `v`. -/ +def panicWith (v : α) (msg : String) : α := @panic α ⟨v⟩ msg + +@[simp] theorem panicWith_eq (v : α) (msg) : panicWith v msg = v := rfl diff --git a/Batteries/Util/ProofWanted.lean b/Batteries/Util/ProofWanted.lean index 97f1473f70..3a6fd90981 100644 --- a/Batteries/Util/ProofWanted.lean +++ b/Batteries/Util/ProofWanted.lean @@ -33,7 +33,10 @@ elaboration, but it's then removed from the environment. def elabProofWanted : CommandElab | `($mods:declModifiers proof_wanted $name $args* : $res) => withoutModifyingEnv do -- The helper axiom is used instead of `sorry` to avoid spurious warnings - elabCommand <| ← `(axiom helper (p : Prop) : p - $mods:declModifiers - theorem $name $args* : $res := helper _) + elabCommand <| ← `( + section + set_option linter.unusedVariables false + axiom helper {α : Sort _} : α + $mods:declModifiers theorem $name $args* : $res := helper + end) | _ => throwUnsupportedSyntax diff --git a/Batteries/WF.lean b/Batteries/WF.lean index 73428fe3bd..2c36dccebd 100644 --- a/Batteries/WF.lean +++ b/Batteries/WF.lean @@ -50,7 +50,7 @@ instance wfRel {r : α → α → Prop} : WellFoundedRelation { val // Acc r val (intro : (x : α) → (h : ∀ (y : α), r y x → Acc r y) → ((y : α) → (hr : r y x) → motive y (h y hr)) → motive x (intro x h)) {a : α} (t : Acc r a) : motive a t := - intro a (fun x h => t.inv h) (fun y hr => recC intro (t.inv hr)) + intro a (fun _ h => t.inv h) (fun _ hr => recC intro (t.inv hr)) termination_by Subtype.mk a t unseal recC diff --git a/lake-manifest.json b/lake-manifest.json index 68d5a83837..b44d4b4a5f 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -1,4 +1,4 @@ -{"version": "1.0.0", +{"version": "1.1.0", "packagesDir": ".lake/packages", "packages": [], "name": "batteries", diff --git a/lakefile.lean b/lakefile.lean deleted file mode 100644 index e55e8b2639..0000000000 --- a/lakefile.lean +++ /dev/null @@ -1,23 +0,0 @@ -import Lake - -open Lake DSL - -macro "opt_arg?" x:ident v:term : term => `(if get_config? $x |>.isSome then $v else default) - -package batteries where - moreLeanArgs := opt_arg? werror #["-DwarningAsError=true"] - leanOptions := - #[⟨`linter.missingDocs, true⟩] ++ - opt_arg? disable_new_compiler #[⟨`compiler.enableNew, false⟩] - -@[default_target] -lean_lib Batteries - -@[default_target, lint_driver] -lean_exe runLinter where - srcDir := "scripts" - supportInterpreter := true - -@[test_driver] -lean_exe test where - srcDir := "scripts" diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000000..a8a658ef9f --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,19 @@ +name = "batteries" +testDriver = "test" +lintDriver = "runLinter" +defaultTargets = ["Batteries", "runLinter"] + +[leanOptions] +linter.missingDocs = true + +[[lean_lib]] +name = "Batteries" + +[[lean_exe]] +name = "runLinter" +srcDir = "scripts" +supportInterpreter = true + +[[lean_exe]] +name = "test" +srcDir = "scripts" diff --git a/scripts/check_imports.lean b/scripts/check_imports.lean index 55bf0e8342..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]! @@ -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 4f18be6b50..e22dc36da5 100644 --- a/scripts/runLinter.lean +++ b/scripts/runLinter.lean @@ -2,7 +2,7 @@ import Lean.Util.SearchPath import Batteries.Tactic.Lint import Batteries.Data.Array.Basic -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]` @@ -37,7 +37,7 @@ unsafe def main (args : List String) : IO Unit := do | name => some name | _ => none | IO.eprintln "Usage: runLinter [--update] [Batteries.Data.Nat.Basic]" *> IO.Process.exit 1 - searchPathRef.set compile_time_search_path% + initSearchPath (← findSysroot) let mFile ← findOLean module unless (← mFile.pathExists) do -- run `lake build module` (and ignore result) if the file hasn't been built yet @@ -47,12 +47,24 @@ 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 diff --git a/test/MLList.lean b/test/MLList.lean index ad53377237..bc7546df0a 100644 --- a/test/MLList.lean +++ b/test/MLList.lean @@ -23,6 +23,8 @@ We generate three tasks which sleep for `100`, `50`, and `1` milliseconds respec and then verify that `MLList.ofTaskList` return their results in the order they complete. -/ +/- This test is very flaky, so it's disabled for now. + def sleep (n : UInt32) : BaseIO (Task UInt32) := IO.asTask (do IO.sleep n; return n) |>.map fun t => t.map fun | .ok n => n @@ -35,3 +37,4 @@ def sleeps : MLList BaseIO UInt32 := .squash fun _ => do /-- info: [1, 50, 100] -/ #guard_msgs in #eval sleeps.force +-/ diff --git a/test/array.lean b/test/array.lean index 2ba3a29577..89f784293e 100644 --- a/test/array.lean +++ b/test/array.lean @@ -10,7 +10,7 @@ variable (g : i < (a.set! i v).size) variable (j_lt : j < (a.set! i v).size) #check_simp (a.set! i v).get ⟨i, g⟩ ~> v -#check_simp (a.set! i v).get! i ~> if i < a.size then v else default +#check_simp (a.set! i v).get! i ~> (a.setD i v)[i]! #check_simp (a.set! i v).getD i d ~> if i < a.size then v else d #check_simp (a.set! i v)[i] ~> v diff --git a/test/case.lean b/test/case.lean index 4e7892d964..b8e3444d1d 100644 --- a/test/case.lean +++ b/test/case.lean @@ -182,16 +182,6 @@ example : True ∧ ∀ x : Nat, x = x := by rfl -- Test focusing by full match, suffix match, and prefix match -/-- -warning: unused variable `x` -note: this linter can be disabled with `set_option linter.unusedVariables false` ---- -warning: unused variable `y` -note: this linter can be disabled with `set_option linter.unusedVariables false` ---- -warning: unused variable `z` -note: this linter can be disabled with `set_option linter.unusedVariables false` --/ #guard_msgs in example : True := by have x : Bool := ?a diff --git a/test/classical.lean b/test/classical.lean deleted file mode 100644 index d2d460253c..0000000000 --- a/test/classical.lean +++ /dev/null @@ -1,23 +0,0 @@ -import Batteries.Tactic.Classical -import Batteries.Tactic.PermuteGoals - -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - classical - have := ∀ p, decide p -- uses the classical instance - guard_expr decide (0 < 1) = @decide (0 < 1) (Nat.decLt 0 1) - exact decide (0 < 1) -- will use the decidable instance - --- double check no leakage -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - exact decide (0 < 1) -- uses the decidable instance - --- check that classical respects tactic blocks -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - on_goal 1 => - classical - have := ∀ p, decide p -- uses the classical instance - fail_if_success have := ∀ p, decide p -- no classical in scope again - exact decide (0 < 1) -- will use the decidable instance diff --git a/test/congr.lean b/test/congr.lean index 065a899f99..eee4c6dbac 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -38,11 +38,9 @@ section -- In order to preserve the test behaviour we locally remove the `ext` attribute. attribute [-ext] List.ext_getElem? -private opaque List.sum : List Nat → Nat - example {ls : List Nat} : - (ls.map fun x => (ls.map fun y => 1 + y).sum + 1) = - (ls.map fun x => (ls.map fun y => Nat.succ y).sum + 1) := by + (ls.map fun _ => (ls.map fun y => 1 + y).sum + 1) = + (ls.map fun _ => (ls.map fun y => Nat.succ y).sum + 1) := by rcongr (_x y) guard_target =ₐ 1 + y = y.succ rw [Nat.add_comm] diff --git a/test/help_cmd.lean b/test/help_cmd.lean new file mode 100644 index 0000000000..23e3698b6d --- /dev/null +++ b/test/help_cmd.lean @@ -0,0 +1,428 @@ +import Batteries.Tactic.HelpCmd + +/-! The `#help` command + +The `#help` command family currently contains these subcommands: + +* `#help attr` / `#help attribute` +* `#help cat` +* `#help cats` +* `#help command` (abbrev for `#help cat command`) +* `#help conv` (abbrev for `#help cat conv`) +* `#help option` +* `#help tactic` (abbrev for `#help cat tactic`) +* `#help term` (abbrev for `#help cat term`) + +All forms take an optional identifier prefix to narrow the search. The `#help cat` command has a +variant `#help cat+` that displays additional information, similarly for commands derived from +`#help cat`. + +WARNING: Some of these tests will need occasional updates when new features are added and even when +some documentation is edited. This type of break will be unexpected but the fix will not be +unexpected! Just update the guard text to match the output after your addition. +-/ + +/-! `#help attr` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help attr + +/-- +error: no attributes start with foobarbaz +-/ +#guard_msgs in +#help attr foobarbaz + +/-- +info: +[inline]: mark definition to be inlined + +[inline_if_reduce]: mark definition to be inlined when resultant term after reduction is not a +`cases_on` application +-/ +#guard_msgs in +#help attr inl + +/-! `#help cat` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help cat term + +/-- +error: foobarbaz is not a syntax category +-/ +#guard_msgs in +#help cat foobarbaz + +/-- +info: +syntax "("... [«prec(_)»] + Parentheses are used for grouping precedence expressions. + +syntax "+"... [Lean.Parser.Syntax.addPrec] + Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`. + +syntax "-"... [Lean.Parser.Syntax.subPrec] + Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`. + +syntax "arg"... [precArg] + Precedence used for application arguments (`do`, `by`, ...). + +syntax "lead"... [precLead] + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). + +syntax "max"... [precMax] + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) + +syntax "min"... [precMin] + Minimum precedence used in term parsers. + +syntax "min1"... [precMin1] + `(min+1)` (we can only write `min+1` after `Meta.lean`) + +syntax ... [Lean.Parser.Syntax.numPrec] +-/ +#guard_msgs in +#help cat prec + +/-- +info: +syntax "("... [«prec(_)»] + Parentheses are used for grouping precedence expressions. ++ macro «_aux_Init_Notation___macroRules_prec(_)_1» + Parentheses are used for grouping precedence expressions. + +syntax "+"... [Lean.Parser.Syntax.addPrec] + Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`. ++ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_addPrec_1 + +syntax "-"... [Lean.Parser.Syntax.subPrec] + Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`. ++ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_subPrec_1 + +syntax "arg"... [precArg] + Precedence used for application arguments (`do`, `by`, ...). ++ macro _aux_Init_Notation___macroRules_precArg_1 + Precedence used for application arguments (`do`, `by`, ...). + +syntax "lead"... [precLead] + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). ++ macro _aux_Init_Notation___macroRules_precLead_1 + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). + +syntax "max"... [precMax] + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) ++ macro _aux_Init_Notation___macroRules_precMax_1 + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) + +syntax "min"... [precMin] + Minimum precedence used in term parsers. ++ macro _aux_Init_Notation___macroRules_precMin_1 + Minimum precedence used in term parsers. + +syntax "min1"... [precMin1] + `(min+1)` (we can only write `min+1` after `Meta.lean`) ++ macro _aux_Init_Notation___macroRules_precMin1_1 + `(min+1)` (we can only write `min+1` after `Meta.lean`) + +syntax ... [Lean.Parser.Syntax.numPrec] +-/ +#guard_msgs in +#help cat+ prec + +/-! `#help cats` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help cats + +/-- +error: no syntax categories start with foobarbaz +-/ +#guard_msgs in +#help cats foobarbaz + +/-- +info: +category prec [Lean.Parser.Category.prec] + `prec` is a builtin syntax category for precedences. A precedence is a value + that expresses how tightly a piece of syntax binds: for example `1 + 2 * 3` is + parsed as `1 + (2 * 3)` because `*` has a higher pr0ecedence than `+`. + Higher numbers denote higher precedence. + In addition to literals like `37`, there are some special named priorities: + * `arg` for the precedence of function arguments + * `max` for the highest precedence used in term parsers (not actually the maximum possible value) + * `lead` for the precedence of terms not supposed to be used as arguments + and you can also add and subtract precedences. + +category prio [Lean.Parser.Category.prio] + `prio` is a builtin syntax category for priorities. + Priorities are used in many different attributes. + Higher numbers denote higher priority, and for example typeclass search will + try high priority instances before low priority. + In addition to literals like `37`, you can also use `low`, `mid`, `high`, as well as + add and subtract priorities. +-/ +#guard_msgs in +#help cats pr + +/-! `#help command` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help command + +/-- +error: no command declarations start with foobarbaz +-/ +#guard_msgs in +#help command foobarbaz + +/-- +info: syntax "#eval"... [Lean.Parser.Command.eval] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. + +syntax "#eval!"... [Lean.Parser.Command.evalBang] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. syntax "#exit"... [Lean.Parser.Command.exit] +-/ +#guard_msgs in +#help command "#e" + +/-- +info: syntax "#eval"... [Lean.Parser.Command.eval] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. ++ command elab Lean.Elab.Command.elabEval + +syntax "#eval!"... [Lean.Parser.Command.evalBang] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. ++ command elab Lean.Elab.Command.elabEvalBang + +syntax "#exit"... [Lean.Parser.Command.exit] ++ command elab Lean.Elab.Command.elabExit +-/ +#guard_msgs in +#help command+ "#e" + +/-! #help conv -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help conv + +/-- +error: no conv declarations start with foobarbaz +-/ +#guard_msgs in +#help conv foobarbaz + +/-- +info: +syntax "reduce"... [Lean.Parser.Tactic.Conv.reduce] + Puts term in normal form, this tactic is meant for debugging purposes only. + +syntax "repeat"... [Lean.Parser.Tactic.Conv.convRepeat_] + `repeat convs` runs the sequence `convs` repeatedly until it fails to apply. + +syntax "rewrite"... [Lean.Parser.Tactic.Conv.rewrite] + `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. +-/ +#guard_msgs in +#help conv "re" + +/-- +info: +syntax "reduce"... [Lean.Parser.Tactic.Conv.reduce] + Puts term in normal form, this tactic is meant for debugging purposes only. ++ tactic elab Lean.Elab.Tactic.Conv.evalReduce + +syntax "repeat"... [Lean.Parser.Tactic.Conv.convRepeat_] + `repeat convs` runs the sequence `convs` repeatedly until it fails to apply. ++ macro Lean.Parser.Tactic.Conv._aux_Init_Conv___macroRules_Lean_Parser_Tactic_Conv_convRepeat__1 + +syntax "rewrite"... [Lean.Parser.Tactic.Conv.rewrite] + `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. ++ tactic elab Lean.Elab.Tactic.Conv.evalRewrite +-/ +#guard_msgs in +#help conv+ "re" + +/-! `#help option` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help option + +/-- +error: no options start with foobarbaz +-/ +#guard_msgs in +#help option foobarbaz + +/-- +info: +option pp.instanceTypes : Bool := false + (pretty printer) when printing explicit applications, show the types of inst-implicit arguments + +option pp.instances : Bool := true + (pretty printer) if set to false, replace inst-implicit arguments to explicit applications with +placeholders + +option pp.instantiateMVars : Bool := true + (pretty printer) instantiate mvars before delaborating +-/ +#guard_msgs in +#help option pp.ins + +/-! `#help tactic` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help tactic + +/-- +error: no tactic declarations start with foobarbaz +-/ +#guard_msgs in +#help tactic foobarbaz + +/-- +info: +syntax "by_cases"... [«tacticBy_cases_:_»] + `by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, +and `h : ¬ p` in the second branch. +-/ +#guard_msgs in +#help tactic by + +/-- +info: +syntax "by_cases"... [«tacticBy_cases_:_»] + `by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch. ++ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__2» ++ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__1» +-/ +#guard_msgs in +#help tactic+ by + +/-! #help term -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help term + +/-- +error: no term declarations start with foobarbaz +-/ +#guard_msgs in +#help term foobarbaz + +/-- +info: +syntax "decl_name%"... [Lean.Parser.Term.declName] + A macro which evaluates to the name of the currently elaborating declaration. + +syntax "default_or_ofNonempty%"... [Lean.Parser.Term.defaultOrOfNonempty] +-/ +#guard_msgs in +#help term de + +/-- +info: +syntax "decl_name%"... [Lean.Parser.Term.declName] + A macro which evaluates to the name of the currently elaborating declaration. ++ term elab Lean.Elab.Term.elabDeclName + +syntax "default_or_ofNonempty%"... [Lean.Parser.Term.defaultOrOfNonempty] ++ term elab Lean.Elab.Term.Op.elabDefaultOrNonempty +-/ +#guard_msgs in +#help term+ de diff --git a/test/library_note.lean b/test/library_note.lean new file mode 100644 index 0000000000..f7ac514cdc --- /dev/null +++ b/test/library_note.lean @@ -0,0 +1,47 @@ +import Batteries.Tactic.HelpCmd +import Batteries.Test.Internal.DummyLibraryNote2 + +/-- +error: Note not found +-/ +#guard_msgs in +#help note "no note" + +/-- +info: library_note "Other" +* 1: this is a testnote with a label not starting with "te", + so it shouldn't appear when looking for notes with label starting with "te". +-/ +#guard_msgs in +#help note "Other" + +library_note "test"/-- +4: This note was not imported, and therefore appears below the imported notes. +-/ + +library_note "test"/-- +5: This note was also not imported, and therefore appears below the imported notes, +and the previously added note. +-/ + + +/-- +info: library_note "temporary note" +* 1: This is a testnote whose label also starts with "te", but gets sorted before "test" + +library_note "test" +* 1: This is a testnote for testing the library note feature of batteries. + The `#help note` command should be able to find this note when imported. + +* 2: This is a second testnote for testing the library note feature of batteries. + +* 3: this is a note in a different file importing the above testnotes, + but still imported by the actual testfile. + +* 4: This note was not imported, and therefore appears below the imported notes. + +* 5: This note was also not imported, and therefore appears below the imported notes, + and the previously added note. +-/ +#guard_msgs in +#help note "te" diff --git a/test/lintTC.lean b/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 index 2b2f8b89e1..f5657a5b96 100644 --- a/test/lint_lean.lean +++ b/test/lint_lean.lean @@ -15,14 +15,13 @@ but it is useful to run locally to see what the linters would catch. -- attribute [nolint dupNamespace] Lean.Elab.Tactic.Tactic -- attribute [nolint dupNamespace] Lean.Parser.Parser Lean.Parser.Parser.rec Lean.Parser.Parser.mk -- Lean.Parser.Parser.info Lean.Parser.Parser.fn +-- attribute [nolint explicitVarsOfIff] Iff.refl /-! Failing lints that need work. -/ --- #lint only explicitVarsOfIff in all -- Found 109 errors - --- Many fixed in https://github.com/leanprover/lean4/pull/4620 +-- Many fixed in https://github.com/leanprover/lean4/pull/4620 and subsequent PRs -- and should be checked again. --- #lint only simpNF in all -- Found 34 errors +-- #lint only simpNF in all -- Found 22 errors /-! Lints that fail, but that we're not intending to do anything about. -/ @@ -41,6 +40,7 @@ but it is useful to run locally to see what the linters would catch. /-! Lints that have succeeded in the past, and hopefully still do! -/ +-- #lint only explicitVarsOfIff in all -- Found 1 errors, `Iff.refl`, which could be nolinted. -- #lint only impossibleInstance in all -- Found 0 errors -- #lint only simpVarHead in all -- Found 0 error -- #lint only unusedHavesSuffices in all -- Found 0 errors diff --git a/test/lint_simpNF.lean b/test/lint_simpNF.lean index e06e067d18..c9c8f9d307 100644 --- a/test/lint_simpNF.lean +++ b/test/lint_simpNF.lean @@ -2,9 +2,6 @@ import Batteries.Tactic.Lint set_option linter.missingDocs false -protected def Sum.elim {α β γ : Sort _} (f : α → γ) (g : β → γ) : Sum α β → γ := - fun x => Sum.casesOn x f g - structure Equiv (α : Sort _) (β : Sort _) where toFun : α → β invFun : β → α diff --git a/test/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/print_prefix.lean b/test/print_prefix.lean index 77f89437c1..32467e4b37 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -14,7 +14,7 @@ TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t /-- info: -/ #guard_msgs in -#print prefix (config := {imported := false}) Empty +#print prefix -imported Empty namespace EmptyPrefixTest @@ -52,10 +52,10 @@ TestStruct.casesOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t TestStruct.foo (self : TestStruct) : Int TestStruct.mk (foo bar : Int) : TestStruct -TestStruct.mk.inj {foo bar : Int} : - ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 -TestStruct.mk.injEq (foo bar : Int) : - ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) +TestStruct.mk.inj {foo bar foo✝ bar✝ : Int} : + { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝ +TestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) : + ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar TestStruct.noConfusion.{u} {P : Sort u} {v1 v2 : TestStruct} (h12 : v1 = v2) : TestStruct.noConfusionType P v1 v2 TestStruct.noConfusionType.{u} (P : Sort u) (v1 v2 : TestStruct) : Sort u @@ -82,17 +82,17 @@ TestStruct.recOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t -/ #guard_msgs in -#print prefix (config := {propositions := false}) TestStruct +#print prefix -propositions TestStruct /-- -info: TestStruct.mk.inj {foo bar : Int} : - ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 -TestStruct.mk.injEq (foo bar : Int) : - ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) +info: TestStruct.mk.inj {foo bar foo✝ bar✝ : Int} : + { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝ +TestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) : + ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar -/ #guard_msgs in -#print prefix (config := {propositionsOnly := true}) TestStruct +#print prefix +propositionsOnly TestStruct /-- info: TestStruct @@ -109,7 +109,7 @@ TestStruct.rec TestStruct.recOn -/ #guard_msgs in -#print prefix (config := {showTypes := false}) TestStruct +#print prefix -showTypes TestStruct /-- Artificial test function to show #print prefix filters out internals @@ -133,21 +133,17 @@ testMatchProof._cstage1 (n : Nat) : Fin n → Unit testMatchProof._cstage2 : _obj → _obj → _obj testMatchProof._sunfold (n : Nat) : Fin n → Unit testMatchProof._unsafe_rec (n : Nat) : Fin n → Unit -testMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : - (x : Nat) → - (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 -testMatchProof.match_1._cstage1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : - (x : Nat) → - (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 +testMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) (x✝ : Nat) (x✝¹ : Fin x✝) + (h_1 : (n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) + (h_2 : (as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) : motive x✝ x✝¹ +testMatchProof.match_1._cstage1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) (x✝ : Nat) (x✝¹ : Fin x✝) + (h_1 : (n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) + (h_2 : (as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) : motive x✝ x✝¹ testMatchProof.proof_1 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as testMatchProof.proof_2 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as -/ #guard_msgs in -#print prefix (config := {internals := true}) testMatchProof +#print prefix +internals testMatchProof private inductive TestInd where | foo : TestInd @@ -171,3 +167,7 @@ TestInd.toCtorIdx : TestInd → Nat -/ #guard_msgs in #print prefix TestInd + +-- `#print prefix` does nothing if no identifier is provided +#guard_msgs in +#print prefix diff --git a/test/proof_wanted.lean b/test/proof_wanted.lean new file mode 100644 index 0000000000..38f5714eb3 --- /dev/null +++ b/test/proof_wanted.lean @@ -0,0 +1,15 @@ +import Batteries.Util.ProofWanted + +/-! +No unused variable warnings. +-/ +#guard_msgs in proof_wanted foo (x : Nat) : True + +/-! +When not a proposition, rely on `theorem` command failing. +-/ +/-- +error: type of theorem 'foo' is not a proposition + Nat → Nat +-/ +#guard_msgs in proof_wanted foo (x : Nat) : Nat diff --git a/test/simpa.lean b/test/simpa.lean index 9528b26382..edbd58c161 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -70,7 +70,7 @@ end Prod theorem implicit_lambda (h : ∀ {x : Nat}, a = x) : a = 2 := by simpa using h -theorem implicit_lambda2 (h : a = 2) : ∀ {x : Nat}, a = 2 := by +theorem implicit_lambda2 (h : a = 2) : ∀ {_ : Nat}, a = 2 := by simpa using h theorem no_implicit_lambda (h : ∀ {x : Nat}, a = x) : ∀ {x : Nat}, a = x := by diff --git a/test/trans.lean b/test/trans.lean new file mode 100644 index 0000000000..d05874399b --- /dev/null +++ b/test/trans.lean @@ -0,0 +1,107 @@ +import Batteries.Tactic.Trans + +-- testing that the attribute is recognized and used +def nleq (a b : Nat) : Prop := a ≤ b + +@[trans] def nleq_trans : nleq a b → nleq b c → nleq a c := Nat.le_trans + +example (a b c : Nat) : nleq a b → nleq b c → nleq a c := by + intro h₁ h₂ + trans b + assumption + assumption + +example (a b c : Nat) : nleq a b → nleq b c → nleq a c := by intros; trans <;> assumption + +-- using `Trans` typeclass +@[trans] def eq_trans {a b c : α} : a = b → b = c → a = c := by + intro h₁ h₂ + apply Eq.trans h₁ h₂ + +example (a b c : Nat) : a = b → b = c → a = c := by intros; trans <;> assumption + +example (a b c : Nat) : a = b → b = c → a = c := by + intro h₁ h₂ + trans b + assumption + assumption + +example : @Trans Nat Nat Nat (· ≤ ·) (· ≤ ·) (· ≤ ·) := inferInstance + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by + intros h₁ h₂ + trans ?b + case b => exact b + exact h₁ + exact h₂ + +example (a b c : α) (R : α → α → Prop) [Trans R R R] : R a b → R b c → R a c := by + intros h₁ h₂ + trans ?b + case b => exact b + exact h₁ + exact h₂ + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by + intros h₁ h₂ + trans + exact h₁ + exact h₂ + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by intros; trans <;> assumption + +example (a b c : Nat) : a < b → b < c → a < c := by + intro h₁ h₂ + trans b + assumption + assumption + +example (a b c : Nat) : a < b → b < c → a < c := by intros; trans <;> assumption + +example (x n p : Nat) (h₁ : n * Nat.succ p ≤ x) : n * p ≤ x := by + trans + · apply Nat.mul_le_mul_left; apply Nat.le_succ + · apply h₁ + +example (a : α) (c : γ) : ∀ b : β, HEq a b → HEq b c → HEq a c := by + intro b h₁ h₂ + trans b + assumption + assumption + +def MyLE (n m : Nat) := ∃ k, n + k = m + +@[trans] theorem MyLE.trans {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by + cases h1 + cases h2 + subst_vars + exact ⟨_, Eq.symm <| Nat.add_assoc _ _ _⟩ + +example {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by + trans <;> assumption + +/-- `trans` for implications. -/ +example {A B C : Prop} (h : A → B) (g : B → C) : A → C := by + trans B + · guard_target =ₛ A → B -- ensure we have `B` and not a free metavariable. + exact h + · guard_target =ₛ B → C + exact g + +/-- `trans` for arrows between types. -/ +example {A B C : Type} (h : A → B) (g : B → C) : A → C := by + trans + rotate_right + · exact B + · exact h + · exact g + +universe u v w + +/-- `trans` for arrows between types. -/ +example {A : Type u} {B : Type v} {C : Type w} (h : A → B) (g : B → C) : A → C := by + trans + rotate_right + · exact B + · exact h + · exact g diff --git a/test/vector.lean b/test/vector.lean new file mode 100644 index 0000000000..7c93888528 --- /dev/null +++ b/test/vector.lean @@ -0,0 +1,25 @@ +import Batteries.Data.Vector + +/-! ### Testing decidable quantifiers for `Vector`. -/ + +open Batteries + +example : ∃ v : Vector Bool 6, v.toList.count true = 3 := by decide + +inductive Gate : Nat → Type +| const : Bool → Gate 0 +| if : ∀ {n}, Gate n → Gate n → Gate (n + 1) + +namespace Gate + +def and : Gate 2 := .if (.if (.const true) (.const false)) (.if (.const false) (.const false)) + +def eval (g : Gate n) (v : Vector Bool n) : Bool := + match g, v with + | .const b, _ => b + | .if g₁ g₂, v => if v.1.back! then eval g₁ v.pop else eval g₂ v.pop + +example : ∀ v, and.eval v = (v[0] && v[1]) := by decide +example : ∃ v, and.eval v = false := by decide + +end Gate