From 63e50b7099ce9ffea7a1526ee3f045d5d6514999 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 18:48:13 +1100 Subject: [PATCH 1/8] chore: adaptations for nightly-2024-03-11 (#692) --- Std/Classes/BEq.lean | 5 - Std/Data/Array/Lemmas.lean | 1 - Std/Data/Array/Match.lean | 1 - Std/Data/Array/Merge.lean | 2 - Std/Data/BinomialHeap/Basic.lean | 1 - Std/Data/BitVec/Lemmas.lean | 5 +- Std/Data/HashMap/WF.lean | 2 +- Std/Data/Int/DivMod.lean | 3 +- Std/Data/Int/Gcd.lean | 1 - Std/Data/Int/Order.lean | 9 +- Std/Data/List/Lemmas.lean | 13 +- Std/Data/List/Perm.lean | 7 +- Std/Data/Nat/Basic.lean | 18 --- Std/Data/Nat/Gcd.lean | 227 +------------------------------ Std/Data/Nat/Lemmas.lean | 79 +---------- Std/Data/RBMap/Lemmas.lean | 1 - Std/Data/String/Basic.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Lean/Meta/UnusedNames.lean | 1 + Std/Logic.lean | 10 -- lean-toolchain | 2 +- test/alias.lean | 4 +- test/case.lean | 2 +- 23 files changed, 27 insertions(+), 369 deletions(-) diff --git a/Std/Classes/BEq.lean b/Std/Classes/BEq.lean index c27aa35d0e..98318f97c9 100644 --- a/Std/Classes/BEq.lean +++ b/Std/Classes/BEq.lean @@ -16,8 +16,3 @@ class PartialEquivBEq (α) [BEq α] : Prop where symm : (a : α) == b → b == a /-- Transitivity for `BEq`. If `a == b` and `b == c` then `a == c`. -/ trans : (a : α) == b → b == c → a == c - -@[simp] theorem beq_eq_false_iff_ne [BEq α] [LawfulBEq α] - (a b : α) : (a == b) = false ↔ a ≠ b := by - rw [ne_eq, ← beq_iff_eq a b] - cases a == b <;> decide diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 555598b53c..b28aca375f 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index 282846f956..46b2239f6f 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 F. G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: F. G. Dorais -/ -import Std.Data.Nat.Lemmas namespace Array diff --git a/Std/Data/Array/Merge.lean b/Std/Data/Array/Merge.lean index 35c5f4b4b0..fbda9fbe3c 100644 --- a/Std/Data/Array/Merge.lean +++ b/Std/Data/Array/Merge.lean @@ -4,8 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Data.Nat.Lemmas - namespace Array /-- diff --git a/Std/Data/BinomialHeap/Basic.lean b/Std/Data/BinomialHeap/Basic.lean index 1756167cf8..c14eb7f083 100644 --- a/Std/Data/BinomialHeap/Basic.lean +++ b/Std/Data/BinomialHeap/Basic.lean @@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Jannis Limperg, Mario Carneiro -/ import Std.Classes.Order import Std.Control.ForInStep.Basic -import Std.Data.Nat.Lemmas namespace Std namespace BinomialHeap diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 437ab0358e..3316865e45 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -3,10 +3,7 @@ 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 Std.Data.Bool -import Std.Data.Fin.Lemmas -import Std.Data.Nat.Lemmas -import Std.Util.ProofWanted +import Std.Tactic.Alias namespace BitVec diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 025f31252b..25075d4dd4 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.HashMap.Basic -import Std.Data.List.Lemmas import Std.Data.Array.Lemmas +import Std.Data.Nat.Lemmas namespace Std.HashMap namespace Imp diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 4ba5091ade..1d7371c7f9 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -3,7 +3,6 @@ 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 Std.Data.Nat.Lemmas import Std.Data.Int.Order /-! @@ -153,7 +152,7 @@ theorem add_mul_ediv_left (a : Int) {b : Int} /-! ### mod -/ -theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod] +theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod, succ_eq_add_one] theorem negSucc_emod (m : Nat) {b : Int} (bpos : 0 < b) : -[m+1] % b = b - 1 - m % b := by rw [Int.sub_sub, Int.add_comm] diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean index a825845693..02506a13a4 100644 --- a/Std/Data/Int/Gcd.lean +++ b/Std/Data/Int/Gcd.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.Int.DivMod -import Std.Data.Nat.Gcd /-! # Results about `Int.gcd`. diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 3efb3be5ea..2763b0bb7c 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,7 +3,7 @@ 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 Std.Data.Nat.Lemmas +import Std.Tactic.Alias /-! # Results about the order properties of the integers, and the integers as an ordered ring. @@ -15,7 +15,8 @@ namespace Int /-! ## Order properties of the integers -/ -protected alias ⟨lt_of_not_ge, not_le_of_gt⟩ := Int.not_le +protected theorem lt_of_not_ge {a b : Int} : ¬a ≤ b → b < a := Int.not_le.mp +protected theorem not_le_of_gt {a b : Int} : b < a → ¬a ≤ b := Int.not_le.mpr protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left @@ -489,8 +490,6 @@ theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat} theorem natAbs_eq_iff {a : Int} {n : Nat} : a.natAbs = n ↔ a = n ∨ a = -↑n := by rw [← Int.natAbs_eq_natAbs_iff, Int.natAbs_ofNat] -@[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg - theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by suffices ∀ a b : Nat, natAbs (subNatNat a b.succ) ≤ (a + b).succ by match a, b with @@ -527,3 +526,5 @@ theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm | -[m+1], n => by constructor <;> nofun + +@[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 93b17c1d4b..e69977f247 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -4,12 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro -/ import Std.Control.ForInStep.Lemmas -import Std.Data.Bool -import Std.Data.Fin.Basic -import Std.Data.Nat.Lemmas +import Std.Data.Nat.Basic import Std.Data.List.Basic -import Std.Data.Option.Lemmas -import Std.Classes.BEq +import Std.Tactic.Init namespace List @@ -163,7 +160,7 @@ theorem cons_eq_append : theorem append_eq_append_iff {a b c d : List α} : a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by induction a generalizing c with - | nil => simp; exact (or_iff_left_of_imp fun ⟨_, ⟨e, rfl⟩, h⟩ => e ▸ h.symm).symm + | nil => simp_all | cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left] @[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by @@ -1040,10 +1037,10 @@ theorem contains_eq_any_beq [BEq α] (l : List α) (a : α) : l.contains a = l.a induction l with simp | cons b l => cases a == b <;> simp [*] theorem not_all_eq_any_not (l : List α) (p : α → Bool) : (!l.all p) = l.any fun a => !p a := by - induction l with simp | cons _ _ ih => rw [Bool.not_and, ih] + induction l with simp | cons _ _ ih => rw [ih] theorem not_any_eq_all_not (l : List α) (p : α → Bool) : (!l.any p) = l.all fun a => !p a := by - induction l with simp | cons _ _ ih => rw [Bool.not_or, ih] + induction l with simp | cons _ _ ih => rw [ih] theorem or_all_distrib_left (l : List α) (p : α → Bool) (q : Bool) : (q || l.all p) = l.all fun a => q || p a := by diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index ec36d6b15c..aa382e3ad4 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -3,11 +3,10 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ +import Std.Tactic.Alias import Std.Tactic.Relation.Rfl -import Std.Data.List.Lemmas -import Std.Data.List.Count -import Std.Data.List.Pairwise import Std.Data.List.Init.Attach +import Std.Data.List.Pairwise /-! # List Permutations @@ -548,7 +547,7 @@ theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l | nil => rfl | cons b l₂ => specialize H b - simp at H; cases H + simp at H | cons a l₁ IH => have : a ∈ l₂ := count_pos_iff_mem.mp (by rw [← H]; simp) refine ((IH fun b => ?_).cons a).trans (perm_cons_erase this).symm diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index aaa4e6bfed..9f7c7d8f36 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -6,14 +6,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro namespace Nat -/-- - Recursor identical to `Nat.rec` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` --/ -@[elab_as_elim] -protected def recAux {motive : Nat → Sort _} - (zero : motive 0) (succ : ∀ n, motive n → motive (n+1)) : (t : Nat) → motive t - | 0 => zero - | _+1 => succ _ (Nat.recAux zero succ _) /-- Recursor identical to `Nat.recOn` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` @@ -22,13 +14,6 @@ protected def recAux {motive : Nat → Sort _} protected def recAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0) (succ : ∀ n, motive n → motive (n+1)) : motive t := Nat.recAux zero succ t -/-- - Recursor identical to `Nat.casesOn` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` --/ -@[elab_as_elim] -protected def casesAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0) - (succ : ∀ n, motive (n+1)) : motive t := Nat.recAux zero (fun n _ => succ n) t - /-- Strong recursor for `Nat` -/ @@ -100,9 +85,6 @@ protected def casesDiagOn {motive : Nat → Nat → Sort _} (m n : Nat) Nat.recDiag zero_zero (fun _ _ => zero_succ _) (fun _ _ => succ_zero _) (fun _ _ _ => succ_succ _ _) m n -/-- The least common multiple of `m` and `n`, defined using `gcd`. -/ -def lcm (m n : Nat) : Nat := m * n / gcd m n - /-- Sum of a list of natural numbers. -/ protected def sum (l : List Nat) : Nat := l.foldr (·+·) 0 diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index 27842c51ad..3fd0108927 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,218 +3,22 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ -import Std.Data.Nat.Lemmas /-! -# Definitions and properties of `gcd`, `lcm`, and `coprime` - +# Definitions and properties of `coprime` -/ namespace Nat -/-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ -@[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 - ---- - -theorem dvd_gcd_iff : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := - ⟨fun h => let ⟨h₁, h₂⟩ := gcd_dvd m n; ⟨Nat.dvd_trans h h₁, Nat.dvd_trans h h₂⟩, - fun ⟨h₁, h₂⟩ => dvd_gcd h₁ h₂⟩ - -theorem gcd_comm (m n : Nat) : gcd m n = gcd n m := - Nat.dvd_antisymm - (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n)) - (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m)) - -theorem gcd_eq_left_iff_dvd : m ∣ n ↔ gcd m n = m := - ⟨fun h => by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left], - fun h => h ▸ gcd_dvd_right m n⟩ - -theorem gcd_eq_right_iff_dvd : m ∣ n ↔ gcd n m = m := by - rw [gcd_comm]; exact gcd_eq_left_iff_dvd - -theorem gcd_assoc (m n k : Nat) : gcd (gcd m n) k = gcd m (gcd n k) := - Nat.dvd_antisymm - (dvd_gcd - (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n)) - (dvd_gcd (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n)) - (gcd_dvd_right (gcd m n) k))) - (dvd_gcd - (dvd_gcd (gcd_dvd_left m (gcd n k)) - (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k))) - (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k))) - -@[simp] theorem gcd_one_right (n : Nat) : gcd n 1 = 1 := (gcd_comm n 1).trans (gcd_one_left n) - -theorem gcd_mul_left (m n k : Nat) : gcd (m * n) (m * k) = m * gcd n k := by - induction n, k using gcd.induction with - | H0 k => simp - | H1 n k _ IH => rwa [← mul_mod_mul_left, ← gcd_rec, ← gcd_rec] at IH - -theorem gcd_mul_right (m n k : Nat) : gcd (m * n) (k * n) = gcd m k * n := by - rw [Nat.mul_comm m n, Nat.mul_comm k n, Nat.mul_comm (gcd m k) n, gcd_mul_left] - -theorem gcd_pos_of_pos_left {m : Nat} (n : Nat) (mpos : 0 < m) : 0 < gcd m n := - pos_of_dvd_of_pos (gcd_dvd_left m n) mpos - -theorem gcd_pos_of_pos_right (m : Nat) {n : Nat} (npos : 0 < n) : 0 < gcd m n := - pos_of_dvd_of_pos (gcd_dvd_right m n) npos - -theorem div_gcd_pos_of_pos_left (b : Nat) (h : 0 < a) : 0 < a / a.gcd b := - (Nat.le_div_iff_mul_le <| Nat.gcd_pos_of_pos_left _ h).2 (Nat.one_mul _ ▸ Nat.gcd_le_left _ h) - -theorem div_gcd_pos_of_pos_right (a : Nat) (h : 0 < b) : 0 < b / a.gcd b := - (Nat.le_div_iff_mul_le <| Nat.gcd_pos_of_pos_right _ h).2 (Nat.one_mul _ ▸ Nat.gcd_le_right _ h) - -theorem eq_zero_of_gcd_eq_zero_left {m n : Nat} (H : gcd m n = 0) : m = 0 := - match eq_zero_or_pos m with - | .inl H0 => H0 - | .inr H1 => absurd (Eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1)) - -theorem eq_zero_of_gcd_eq_zero_right {m n : Nat} (H : gcd m n = 0) : n = 0 := by - rw [gcd_comm] at H - exact eq_zero_of_gcd_eq_zero_left H - -theorem gcd_ne_zero_left : m ≠ 0 → gcd m n ≠ 0 := mt eq_zero_of_gcd_eq_zero_left - -theorem gcd_ne_zero_right : n ≠ 0 → gcd m n ≠ 0 := mt eq_zero_of_gcd_eq_zero_right - -theorem gcd_div {m n k : Nat} (H1 : k ∣ m) (H2 : k ∣ n) : - gcd (m / k) (n / k) = gcd m n / k := - match eq_zero_or_pos k with - | .inl H0 => by simp [H0] - | .inr H3 => by - apply Nat.eq_of_mul_eq_mul_right H3 - rw [Nat.div_mul_cancel (dvd_gcd H1 H2), ← gcd_mul_right, - Nat.div_mul_cancel H1, Nat.div_mul_cancel H2] - -theorem gcd_dvd_gcd_of_dvd_left {m k : Nat} (n : Nat) (H : m ∣ k) : gcd m n ∣ gcd k n := - dvd_gcd (Nat.dvd_trans (gcd_dvd_left m n) H) (gcd_dvd_right m n) - -theorem gcd_dvd_gcd_of_dvd_right {m k : Nat} (n : Nat) (H : m ∣ k) : gcd n m ∣ gcd n k := - dvd_gcd (gcd_dvd_left n m) (Nat.dvd_trans (gcd_dvd_right n m) H) - -theorem gcd_dvd_gcd_mul_left (m n k : Nat) : gcd m n ∣ gcd (k * m) n := - gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right (m n k : Nat) : gcd m n ∣ gcd (m * k) n := - gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_right _ _) - -theorem gcd_dvd_gcd_mul_left_right (m n k : Nat) : gcd m n ∣ gcd m (k * n) := - gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right_right (m n k : Nat) : gcd m n ∣ gcd m (n * k) := - gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_right _ _) - -theorem gcd_eq_left {m n : Nat} (H : m ∣ n) : gcd m n = m := - Nat.dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd (Nat.dvd_refl _) H) - -theorem gcd_eq_right {m n : Nat} (H : n ∣ m) : gcd m n = n := by - rw [gcd_comm, gcd_eq_left H] - -@[simp] theorem gcd_mul_left_left (m n : Nat) : gcd (m * n) n = n := - Nat.dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (Nat.dvd_mul_left _ _) (Nat.dvd_refl _)) - -@[simp] theorem gcd_mul_left_right (m n : Nat) : gcd n (m * n) = n := by - rw [gcd_comm, gcd_mul_left_left] - -@[simp] theorem gcd_mul_right_left (m n : Nat) : gcd (n * m) n = n := by - rw [Nat.mul_comm, gcd_mul_left_left] - -@[simp] theorem gcd_mul_right_right (m n : Nat) : gcd n (n * m) = n := by - rw [gcd_comm, gcd_mul_right_left] - -@[simp] theorem gcd_gcd_self_right_left (m n : Nat) : gcd m (gcd m n) = gcd m n := - Nat.dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) (Nat.dvd_refl _)) - -@[simp] theorem gcd_gcd_self_right_right (m n : Nat) : gcd m (gcd n m) = gcd n m := by - rw [gcd_comm n m, gcd_gcd_self_right_left] - -@[simp] theorem gcd_gcd_self_left_right (m n : Nat) : gcd (gcd n m) m = gcd n m := by - rw [gcd_comm, gcd_gcd_self_right_right] - -@[simp] theorem gcd_gcd_self_left_left (m n : Nat) : gcd (gcd m n) m = gcd m n := by - rw [gcd_comm m n, gcd_gcd_self_left_right] - -theorem gcd_add_mul_self (m n k : Nat) : gcd m (n + k * m) = gcd m n := by - simp [gcd_rec m (n + k * m), gcd_rec m n] - -theorem gcd_eq_zero_iff {i j : Nat} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := - ⟨fun h => ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩, - fun h => by simp [h]⟩ - -/-- Characterization of the value of `Nat.gcd`. -/ -theorem gcd_eq_iff (a b : Nat) : - gcd a b = g ↔ g ∣ a ∧ g ∣ b ∧ (∀ c, c ∣ a → c ∣ b → c ∣ g) := by - constructor - · rintro rfl - exact ⟨gcd_dvd_left _ _, gcd_dvd_right _ _, fun _ => Nat.dvd_gcd⟩ - · rintro ⟨ha, hb, hc⟩ - apply Nat.dvd_antisymm - · apply hc - · exact gcd_dvd_left a b - · exact gcd_dvd_right a b - · exact Nat.dvd_gcd ha hb - -/-! ### `lcm` -/ - -theorem lcm_comm (m n : Nat) : lcm m n = lcm n m := by - rw [lcm, lcm, Nat.mul_comm n m, gcd_comm n m] - -@[simp] theorem lcm_zero_left (m : Nat) : lcm 0 m = 0 := by simp [lcm] - -@[simp] theorem lcm_zero_right (m : Nat) : lcm m 0 = 0 := by simp [lcm] - -@[simp] theorem lcm_one_left (m : Nat) : lcm 1 m = m := by simp [lcm] - -@[simp] theorem lcm_one_right (m : Nat) : lcm m 1 = m := by simp [lcm] - -@[simp] theorem lcm_self (m : Nat) : lcm m m = m := by - match eq_zero_or_pos m with - | .inl h => rw [h, lcm_zero_left] - | .inr h => simp [lcm, Nat.mul_div_cancel _ h] - -theorem dvd_lcm_left (m n : Nat) : m ∣ lcm m n := - ⟨n / gcd m n, by rw [← Nat.mul_div_assoc m (Nat.gcd_dvd_right m n)]; rfl⟩ - -theorem dvd_lcm_right (m n : Nat) : n ∣ lcm m n := lcm_comm n m ▸ dvd_lcm_left n m - -theorem gcd_mul_lcm (m n : Nat) : gcd m n * lcm m n = m * n := by - rw [lcm, Nat.mul_div_cancel' (Nat.dvd_trans (gcd_dvd_left m n) (Nat.dvd_mul_right m n))] - -theorem lcm_dvd {m n k : Nat} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k := by - match eq_zero_or_pos k with - | .inl h => rw [h]; exact Nat.dvd_zero _ - | .inr kpos => - apply Nat.dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) - rw [gcd_mul_lcm, ← gcd_mul_right, Nat.mul_comm n k] - exact dvd_gcd (Nat.mul_dvd_mul_left _ H2) (Nat.mul_dvd_mul_right H1 _) - -theorem lcm_assoc (m n k : Nat) : lcm (lcm m n) k = lcm m (lcm n k) := -Nat.dvd_antisymm - (lcm_dvd - (lcm_dvd (dvd_lcm_left m (lcm n k)) - (Nat.dvd_trans (dvd_lcm_left n k) (dvd_lcm_right m (lcm n k)))) - (Nat.dvd_trans (dvd_lcm_right n k) (dvd_lcm_right m (lcm n k)))) - (lcm_dvd - (Nat.dvd_trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k)) - (lcm_dvd (Nat.dvd_trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k)) - (dvd_lcm_right (lcm m n) k))) - -theorem lcm_ne_zero (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := by - intro h - have h1 := gcd_mul_lcm m n - rw [h, Nat.mul_zero] at h1 - match mul_eq_zero.1 h1.symm with - | .inl hm1 => exact hm hm1 - | .inr hn1 => exact hn hn1 - /-! ### `coprime` See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.Coprime m n`. -/ +/-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ +@[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 + instance (m n : Nat) : Decidable (Coprime m n) := inferInstanceAs (Decidable (_ = 1)) theorem coprime_iff_gcd_eq_one : Coprime m n ↔ gcd m n = 1 := .rfl @@ -358,29 +162,6 @@ theorem Coprime.pow {k l : Nat} (m n : Nat) (H1 : Coprime k l) : Coprime (k ^ m) theorem Coprime.eq_one_of_dvd {k m : Nat} (H : Coprime k m) (d : k ∣ m) : k = 1 := by rw [← H.gcd_eq_one, gcd_eq_left d] -/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. -/ -def prod_dvd_and_dvd_of_dvd_prod {k m n : Nat} (H : k ∣ m * n) : - {d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1.val * d.2.val} := - if h0 : gcd k m = 0 then - ⟨⟨⟨0, eq_zero_of_gcd_eq_zero_right h0 ▸ Nat.dvd_refl 0⟩, - ⟨n, Nat.dvd_refl n⟩⟩, - eq_zero_of_gcd_eq_zero_left h0 ▸ (Nat.zero_mul n).symm⟩ - else by - have hd : gcd k m * (k / gcd k m) = k := Nat.mul_div_cancel' (gcd_dvd_left k m) - refine ⟨⟨⟨gcd k m, gcd_dvd_right k m⟩, ⟨k / gcd k m, ?_⟩⟩, hd.symm⟩ - apply Nat.dvd_of_mul_dvd_mul_left (Nat.pos_of_ne_zero h0) - rw [hd, ← gcd_mul_right] - exact Nat.dvd_gcd (Nat.dvd_mul_right _ _) H - -theorem gcd_mul_dvd_mul_gcd (k m n : Nat) : gcd k (m * n) ∣ gcd k m * gcd k n := by - let ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, (h : gcd k (m * n) = m' * n')⟩ := - prod_dvd_and_dvd_of_dvd_prod <| gcd_dvd_right k (m * n) - rw [h] - have h' : m' * n' ∣ k := h ▸ gcd_dvd_left .. - exact Nat.mul_dvd_mul - (dvd_gcd (Nat.dvd_trans (Nat.dvd_mul_right m' n') h') hm') - (dvd_gcd (Nat.dvd_trans (Nat.dvd_mul_left n' m') h') hn') - theorem Coprime.gcd_mul (k : Nat) (h : Coprime m n) : gcd k (m * n) = gcd k m * gcd k n := Nat.dvd_antisymm (gcd_mul_dvd_mul_gcd k m n) diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index a0c16adb9d..aea9678b6d 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias -import Std.Tactic.Init import Std.Data.Nat.Basic /-! # Basic lemmas about natural numbers @@ -38,7 +37,7 @@ theorem recAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) (succ : ∀ n, motive (n+1)) : Nat.casesAuxOn 0 zero succ = zero := rfl -@[simp] theorem casesAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) +theorem casesAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) (succ : ∀ n, motive (n+1)) (n) : Nat.casesAuxOn (n+1) zero succ = succ n := rfl @@ -137,47 +136,7 @@ theorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motiv (succ_succ : ∀ m n, motive (m+1) (n+1)) (m n) : Nat.casesDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ = succ_succ m n := rfl -/-! ## compare -/ - -theorem compare_def_lt (a b : Nat) : - compare a b = if a < b then .lt else if b < a then .gt else .eq := by - simp only [compare, compareOfLessAndEq] - split - · rfl - · next h => - match Nat.lt_or_eq_of_le (Nat.not_lt.1 h) with - | .inl h => simp [h, Nat.ne_of_gt h] - | .inr rfl => simp - -theorem compare_def_le (a b : Nat) : - compare a b = if a ≤ b then if b ≤ a then .eq else .lt else .gt := by - rw [compare_def_lt] - split - · next hlt => simp [Nat.le_of_lt hlt, Nat.not_le.2 hlt] - · next hge => - split - · next hgt => simp [Nat.le_of_lt hgt, Nat.not_le.2 hgt] - · next hle => simp [Nat.not_lt.1 hge, Nat.not_lt.1 hle] - -protected theorem compare_swap (a b : Nat) : (compare a b).swap = compare b a := by - simp only [compare_def_le]; (repeat' split) <;> try rfl - next h1 h2 => cases h1 (Nat.le_of_not_le h2) - -protected theorem compare_eq_eq {a b : Nat} : compare a b = .eq ↔ a = b := by - rw [compare_def_lt]; (repeat' split) <;> simp [Nat.ne_of_lt, Nat.ne_of_gt, *] - next hlt hgt => exact Nat.le_antisymm (Nat.not_lt.1 hgt) (Nat.not_lt.1 hlt) - -protected theorem compare_eq_lt {a b : Nat} : compare a b = .lt ↔ a < b := by - rw [compare_def_lt]; (repeat' split) <;> simp [*] - -protected theorem compare_eq_gt {a b : Nat} : compare a b = .gt ↔ b < a := by - rw [compare_def_lt]; (repeat' split) <;> simp [Nat.le_of_lt, *] - -protected theorem compare_ne_gt {a b : Nat} : compare a b ≠ .gt ↔ a ≤ b := by - rw [compare_def_le]; (repeat' split) <;> simp [*] - -protected theorem compare_ne_lt {a b : Nat} : compare a b ≠ .lt ↔ b ≤ a := by - rw [compare_def_le]; (repeat' split) <;> simp [Nat.le_of_not_le, *] +/-! ## strong case -/ /-- Strong case analysis on `a < b ∨ b ≤ a` -/ protected def lt_sum_ge (a b : Nat) : a < b ⊕' b ≤ a := @@ -200,40 +159,6 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := @[deprecated] protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left -/-! ### min/max -/ - -protected theorem sub_min_sub_left (a b c : Nat) : min (a - b) (a - c) = a - max b c := by - induction b, c using Nat.recDiagAux with - | zero_left => rw [Nat.sub_zero, Nat.zero_max]; exact Nat.min_eq_right (Nat.sub_le ..) - | zero_right => rw [Nat.sub_zero, Nat.max_zero]; exact Nat.min_eq_left (Nat.sub_le ..) - | succ_succ _ _ ih => simp only [Nat.sub_succ, Nat.succ_max_succ, Nat.pred_min_pred, ih] - -protected theorem sub_max_sub_left (a b c : Nat) : max (a - b) (a - c) = a - min b c := by - induction b, c using Nat.recDiagAux with - | zero_left => rw [Nat.sub_zero, Nat.zero_min]; exact Nat.max_eq_left (Nat.sub_le ..) - | zero_right => rw [Nat.sub_zero, Nat.min_zero]; exact Nat.max_eq_right (Nat.sub_le ..) - | succ_succ _ _ ih => simp only [Nat.sub_succ, Nat.succ_min_succ, Nat.pred_max_pred, ih] - -protected theorem mul_max_mul_right (a b c : Nat) : max (a * c) (b * c) = max a b * c := by - induction a, b using Nat.recDiagAux with - | zero_left => simp only [Nat.zero_mul, Nat.zero_max] - | zero_right => simp only [Nat.zero_mul, Nat.max_zero] - | succ_succ _ _ ih => simp only [Nat.succ_mul, Nat.add_max_add_right, ih] - -protected theorem mul_min_mul_right (a b c : Nat) : min (a * c) (b * c) = min a b * c := by - induction a, b using Nat.recDiagAux with - | zero_left => simp only [Nat.zero_mul, Nat.zero_min] - | zero_right => simp only [Nat.zero_mul, Nat.min_zero] - | succ_succ _ _ ih => simp only [Nat.succ_mul, Nat.add_min_add_right, ih] - -protected theorem mul_max_mul_left (a b c : Nat) : max (a * b) (a * c) = a * max b c := by - repeat rw [Nat.mul_comm a] - exact Nat.mul_max_mul_right .. - -protected theorem mul_min_mul_left (a b c : Nat) : min (a * b) (a * c) = a * min b c := by - repeat rw [Nat.mul_comm a] - exact Nat.mul_min_mul_right .. - /-! ### mul -/ @[deprecated] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index 884472710e..64e26eb4a7 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.RBMap.Alter -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas /-! diff --git a/Std/Data/String/Basic.lean b/Std/Data/String/Basic.lean index 072fbe0222..982c9560f4 100644 --- a/Std/Data/String/Basic.lean +++ b/Std/Data/String/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg, James Gallicchio, F. G. Dorais -/ -import Std.Data.Nat.Lemmas import Std.Data.Array.Match instance : Coe String Substring := ⟨String.toSubstring⟩ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 11aee37ec7..f8131eeb14 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bulhwi Cha, Mario Carneiro -/ import Std.Data.Char -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic import Std.Tactic.Lint.Misc diff --git a/Std/Lean/Meta/UnusedNames.lean b/Std/Lean/Meta/UnusedNames.lean index 76c13ef81c..9e7a9ab414 100644 --- a/Std/Lean/Meta/UnusedNames.lean +++ b/Std/Lean/Meta/UnusedNames.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Data.String.Basic +import Lean.LocalContext open Lean Lean.Meta diff --git a/Std/Logic.lean b/Std/Logic.lean index 43a9b31f66..e7703371ff 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -75,16 +75,6 @@ alias congr_fun := congrFun alias congr_fun₂ := congrFun₂ alias congr_fun₃ := congrFun₃ -theorem eq_mp_eq_cast (h : α = β) : Eq.mp h = cast h := - rfl - -theorem eq_mpr_eq_cast (h : α = β) : Eq.mpr h = cast h.symm := - rfl - -@[simp] theorem cast_cast : ∀ (ha : α = β) (hb : β = γ) (a : α), - cast hb (cast ha a) = cast (ha.trans hb) a - | rfl, rfl, _ => rfl - theorem heq_of_cast_eq : ∀ (e : α = β) (_ : cast e a = a'), HEq a a' | rfl, rfl => .rfl diff --git a/lean-toolchain b/lean-toolchain index 6b26dd51ef..8465e8d271 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.7.0-rc1 +leanprover/lean4:nightly-2024-03-11 diff --git a/test/alias.lean b/test/alias.lean index 0b8e125329..b28d09921b 100644 --- a/test/alias.lean +++ b/test/alias.lean @@ -86,9 +86,9 @@ unsafe alias barbaz3 := id @[deprecated] alias ⟨mpId, mprId⟩ := Iff.rfl -/-- info: A.mpId {a : Prop} (a✝ : a) : a -/ +/-- info: A.mpId {a : Prop} : a → a -/ #guard_msgs in #check mpId -/-- info: A.mprId {a : Prop} (a✝ : a) : a -/ +/-- info: A.mprId {a : Prop} : a → a -/ #guard_msgs in #check mprId /-- diff --git a/test/case.lean b/test/case.lean index f0bb9d9b5e..ab0b664218 100644 --- a/test/case.lean +++ b/test/case.lean @@ -221,6 +221,6 @@ example (n : Nat) : 0 ≤ n := by case _ : 0 ≤ 0 | succ n ih · guard_target =ₛ 0 ≤ 0 constructor - · guard_target =ₛ 0 ≤ Nat.succ n + · guard_target =ₛ 0 ≤ n + 1 guard_hyp ih : 0 ≤ n simp From a5128fcc0f7a9cd115001b209b0c32cd7ea27587 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 19:21:33 +1100 Subject: [PATCH 2/8] chore: adaptations for nightly-2024-03-12 (#693) * chore: adaptations for nightly-2024-03-12 * fix test * delete --- Std/Data/Int.lean | 1 - Std/Data/Int/DivMod.lean | 793 ----------------------------------- Std/Data/Int/Gcd.lean | 43 -- Std/Data/Int/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 520 ----------------------- Std/Tactic/SqueezeScope.lean | 5 +- lean-toolchain | 2 +- test/simp_trace.lean | 2 +- 8 files changed, 5 insertions(+), 1362 deletions(-) delete mode 100644 Std/Data/Int/Gcd.lean diff --git a/Std/Data/Int.lean b/Std/Data/Int.lean index 9f2f799da1..685988478a 100644 --- a/Std/Data/Int.lean +++ b/Std/Data/Int.lean @@ -1,4 +1,3 @@ import Std.Data.Int.DivMod -import Std.Data.Int.Gcd import Std.Data.Int.Lemmas import Std.Data.Int.Order diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 1d7371c7f9..ed93565328 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -14,799 +14,6 @@ open Nat namespace Int -/-! ### `/` -/ - -theorem ofNat_div (m n : Nat) : ↑(m / n) = div ↑m ↑n := rfl - -theorem ofNat_fdiv : ∀ m n : Nat, ↑(m / n) = fdiv ↑m ↑n - | 0, _ => by simp [fdiv] - | succ _, _ => rfl - -theorem negSucc_ediv (m : Nat) {b : Int} (H : 0 < b) : -[m+1] / b = -(div m b + 1) := - match b, eq_succ_of_zero_lt H with - | _, ⟨_, rfl⟩ => rfl - -@[simp] protected theorem zero_div : ∀ b : Int, div 0 b = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => show -ofNat _ = _ by simp - -@[simp] theorem zero_fdiv (b : Int) : fdiv 0 b = 0 := by cases b <;> rfl - -@[simp] protected theorem div_zero : ∀ a : Int, div a 0 = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => rfl - -@[simp] protected theorem fdiv_zero : ∀ a : Int, fdiv a 0 = 0 - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b - | 0, _, _ | -[_+1], 0, _ => by simp - | succ _, ofNat _, _ | -[_+1], succ _, _ => rfl - -theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b - | 0, _, _, _ | _, 0, _, _ => by simp - | succ _, succ _, _, _ => rfl - -theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := - div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb - -@[simp] protected theorem div_neg : ∀ a b : Int, a.div (-b) = -(a.div b) - | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl - | ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - | ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl - -@[simp] protected theorem neg_div : ∀ a b : Int, (-a).div b = -(a.div b) - | 0, n => by simp [Int.neg_zero] - | succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl - | succ m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - -protected theorem neg_div_neg (a b : Int) : (-a).div (-b) = a.div b := by - simp [Int.div_neg, Int.neg_div, Int.neg_neg] - -protected theorem div_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.div b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_fdiv .. ▸ ofNat_zero_le _ - -theorem ediv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a / b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -protected theorem div_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a.div b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.div_neg .. ▸ Int.div_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_nonpos : ∀ {a b : Int}, 0 ≤ a → b ≤ 0 → a.fdiv b ≤ 0 - | 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => ⟨_⟩ - -theorem ediv_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.ediv_neg .. ▸ Int.ediv_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_neg' : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0 - | -[_+1], succ _, _, _ => negSucc_lt_zero _ - -theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := - match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => negSucc_lt_zero _ - -@[simp] protected theorem div_one : ∀ a : Int, a.div 1 = a - | (n:Nat) => congrArg ofNat (Nat.div_one _) - | -[n+1] => by simp [Int.div, neg_ofNat_succ] - -@[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a - | 0 => rfl - | succ _ => congrArg Nat.cast (Nat.div_one _) - | -[_+1] => congrArg negSucc (Nat.div_one _) - -theorem div_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.div b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem ediv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a / b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem add_mul_ediv_left (a : Int) {b : Int} - (c : Int) (H : b ≠ 0) : (a + b * c) / b = a / b + c := - Int.mul_comm .. ▸ Int.add_mul_ediv_right _ _ H - -@[simp] theorem mul_fdiv_cancel (a : Int) {b : Int} (H : b ≠ 0) : fdiv (a * b) b = a := - if b0 : 0 ≤ b then by - rw [fdiv_eq_ediv _ b0, mul_ediv_cancel _ H] - else - match a, b, Int.not_le.1 b0 with - | 0, _, _ => by simp [Int.zero_mul] - | succ a, -[b+1], _ => congrArg ofNat <| Nat.mul_div_cancel (succ a) b.succ_pos - | -[a+1], -[b+1], _ => congrArg negSucc <| Nat.div_eq_of_lt_le - (le_of_lt_succ <| Nat.mul_lt_mul_of_pos_right a.lt_succ_self b.succ_pos) - (lt_succ_self _) - -@[simp] protected theorem mul_div_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b).div b = a := - have : ∀ {a b : Nat}, (b : Int) ≠ 0 → (div (a * b) b : Int) = a := fun H => by - rw [← ofNat_mul, ← ofNat_div, - Nat.mul_div_cancel _ <| Nat.pos_of_ne_zero <| Int.ofNat_ne_zero.1 H] - match a, b, a.eq_nat_or_neg, b.eq_nat_or_neg with - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inl rfl⟩ => this H - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.mul_neg, Int.neg_div, Int.div_neg, Int.neg_neg, - this (Int.neg_ne_zero.1 H)] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inl rfl⟩ => by rw [Int.neg_mul, Int.neg_div, this H] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.neg_mul_neg, Int.div_neg, this (Int.neg_ne_zero.1 H)] - -@[simp] protected theorem mul_div_cancel_left (b : Int) (H : a ≠ 0) : (a * b).div a = b := - Int.mul_comm .. ▸ Int.mul_div_cancel _ H - -@[simp] theorem mul_fdiv_cancel_left (b : Int) (H : a ≠ 0) : fdiv (a * b) a = b := - Int.mul_comm .. ▸ Int.mul_fdiv_cancel _ H - -@[simp] protected theorem div_self {a : Int} (H : a ≠ 0) : a.div a = 1 := by - have := Int.mul_div_cancel 1 H; rwa [Int.one_mul] at this - -@[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by - have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this - -/-! ### mod -/ - -theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod, succ_eq_add_one] - -theorem negSucc_emod (m : Nat) {b : Int} (bpos : 0 < b) : -[m+1] % b = b - 1 - m % b := by - rw [Int.sub_sub, Int.add_comm] - match b, eq_succ_of_zero_lt bpos with - | _, ⟨n, rfl⟩ => rfl - -@[simp] theorem zero_mod (b : Int) : mod 0 b = 0 := by cases b <;> simp [mod] - -@[simp] theorem zero_fmod (b : Int) : fmod 0 b = 0 := by cases b <;> rfl - -@[simp] theorem mod_zero : ∀ a : Int, mod a 0 = a - | ofNat _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => rfl - -@[simp] theorem fmod_zero : ∀ a : Int, fmod a 0 = a - | 0 => rfl - | succ _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => congrArg negSucc <| Nat.mod_zero _ - -theorem mod_add_div : ∀ a b : Int, mod a b + b * (a.div b) = a - | ofNat _, ofNat _ => congrArg ofNat (Nat.mod_add_div ..) - | ofNat m, -[n+1] => by - show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m - rw [Int.neg_mul_neg]; exact congrArg ofNat (Nat.mod_add_div ..) - | -[_+1], 0 => rfl - | -[m+1], ofNat n => by - show -(↑((succ m) % n) : Int) + ↑n * -↑(succ m / n) = -↑(succ m) - rw [Int.mul_neg, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n) * ↑(succ m / succ n) = -↑(succ m) - rw [Int.neg_mul, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - -theorem fmod_add_fdiv : ∀ a b : Int, a.fmod b + b * a.fdiv b = a - | 0, ofNat _ | 0, -[_+1] => congrArg ofNat <| by simp - | succ m, ofNat n => congrArg ofNat <| Nat.mod_add_div .. - | succ m, -[n+1] => by - show subNatNat (m % succ n) n + (↑(succ n * (m / succ n)) + n + 1) = (m + 1) - rw [Int.add_comm _ n, ← Int.add_assoc, ← Int.add_assoc, - Int.subNatNat_eq_coe, Int.sub_add_cancel] - exact congrArg (ofNat · + 1) <| Nat.mod_add_div .. - | -[_+1], 0 => by rw [fmod_zero]; rfl - | -[m+1], succ n => by - show subNatNat .. - (↑(succ n * (m / succ n)) + ↑(succ n)) = -↑(succ m) - rw [Int.subNatNat_eq_coe, ← Int.sub_sub, ← Int.neg_sub, Int.sub_sub, Int.sub_sub_self] - exact congrArg (-ofNat ·) <| Nat.succ_add .. ▸ Nat.mod_add_div .. ▸ rfl - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n * (succ m / succ n)) = -↑(succ m) - rw [← Int.neg_add]; exact congrArg (-ofNat ·) <| Nat.mod_add_div .. - -theorem div_add_mod (a b : Int) : b * a.div b + mod a b = a := - (Int.add_comm ..).trans (mod_add_div ..) - -theorem fdiv_add_fmod (a b : Int) : b * a.fdiv b + a.fmod b = a := - (Int.add_comm ..).trans (fmod_add_fdiv ..) - -theorem mod_def (a b : Int) : mod a b = a - b * a.div b := by - rw [← Int.add_sub_cancel (mod a b), mod_add_div] - -theorem fmod_def (a b : Int) : a.fmod b = a - b * a.fdiv b := by - rw [← Int.add_sub_cancel (a.fmod b), fmod_add_fdiv] - -theorem fmod_eq_emod (a : Int) {b : Int} (hb : 0 ≤ b) : fmod a b = a % b := by - simp [fmod_def, emod_def, fdiv_eq_ediv _ hb] - -theorem mod_eq_emod {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : mod a b = a % b := by - simp [emod_def, mod_def, div_eq_ediv ha hb] - -theorem fmod_eq_mod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = mod a b := - mod_eq_emod Ha Hb ▸ fmod_eq_emod _ Hb - -@[simp] theorem mod_neg (a b : Int) : mod a (-b) = mod a b := by - rw [mod_def, mod_def, Int.div_neg, Int.neg_mul_neg] - -@[simp] theorem emod_neg (a b : Int) : a % -b = a % b := by - rw [emod_def, emod_def, Int.ediv_neg, Int.neg_mul_neg] - -@[simp] theorem mod_one (a : Int) : mod a 1 = 0 := by - simp [mod_def, Int.div_one, Int.one_mul, Int.sub_self] - -@[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by - simp [fmod_def, Int.one_mul, Int.sub_self] - -theorem emod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a := - have b0 := Int.le_trans H1 (Int.le_of_lt H2) - match a, b, eq_ofNat_of_zero_le H1, eq_ofNat_of_zero_le b0 with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg ofNat <| Nat.mod_eq_of_lt (Int.ofNat_lt.1 H2) - -@[simp] theorem emod_self_add_one {x : Int} (h : 0 ≤ x) : x % (x + 1) = x := - emod_eq_of_lt h (Int.lt_succ x) - -theorem mod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : mod a b = a := by - rw [mod_eq_emod H1 (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem fmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fmod b = a := by - rw [fmod_eq_emod _ (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem mod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ mod a b - | ofNat _, -[_+1], _ | ofNat _, ofNat _, _ => ofNat_nonneg _ - -theorem fmod_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a.fmod b := - fmod_eq_mod ha hb ▸ mod_nonneg _ ha - -theorem fmod_nonneg' (a : Int) {b : Int} (hb : 0 < b) : 0 ≤ a.fmod b := - fmod_eq_emod _ (Int.le_of_lt hb) ▸ emod_nonneg _ (Int.ne_of_lt hb).symm - -theorem mod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : mod a b < b := - match a, b, eq_succ_of_zero_lt H with - | ofNat _, _, ⟨n, rfl⟩ => ofNat_lt.2 <| Nat.mod_lt _ n.succ_pos - | -[_+1], _, ⟨n, rfl⟩ => Int.lt_of_le_of_lt - (Int.neg_nonpos_of_nonneg <| Int.ofNat_nonneg _) (ofNat_pos.2 n.succ_pos) - -theorem fmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a.fmod b < b := - fmod_eq_emod _ (Int.le_of_lt H) ▸ emod_lt_of_pos a H - -theorem emod_two_eq (x : Int) : x % 2 = 0 ∨ x % 2 = 1 := by - have h₁ : 0 ≤ x % 2 := Int.emod_nonneg x (by decide) - have h₂ : x % 2 < 2 := Int.emod_lt_of_pos x (by decide) - match x % 2, h₁, h₂ with - | 0, _, _ => simp - | 1, _, _ => simp - -theorem mod_add_div' (m k : Int) : mod m k + m.div k * k = m := by - rw [Int.mul_comm]; apply mod_add_div - -theorem div_add_mod' (m k : Int) : m.div k * k + mod m k = m := by - rw [Int.mul_comm]; apply div_add_mod - -theorem ediv_add_emod' (m k : Int) : m / k * k + m % k = m := by - rw [Int.mul_comm]; apply ediv_add_emod - -theorem add_emod_eq_add_emod_left {m n k : Int} (i : Int) - (H : m % n = k % n) : (i + m) % n = (i + k) % n := by - rw [Int.add_comm, add_emod_eq_add_emod_right _ H, Int.add_comm] - -theorem emod_add_cancel_left {m n k i : Int} : (i + m) % n = (i + k) % n ↔ m % n = k % n := by - rw [Int.add_comm, Int.add_comm i, emod_add_cancel_right] - -theorem emod_sub_cancel_right {m n k : Int} (i) : (m - i) % n = (k - i) % n ↔ m % n = k % n := - emod_add_cancel_right _ - -theorem emod_eq_emod_iff_emod_sub_eq_zero {m n k : Int} : m % n = k % n ↔ (m - k) % n = 0 := - (emod_sub_cancel_right k).symm.trans <| by simp [Int.sub_self] - -@[simp] theorem mul_mod_left (a b : Int) : (a * b).mod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.mod_def, Int.mul_div_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_fmod_left (a b : Int) : (a * b).fmod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.fmod_def, Int.mul_fdiv_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_mod_right (a b : Int) : (a * b).mod a = 0 := by - rw [Int.mul_comm, mul_mod_left] - -@[simp] theorem mul_fmod_right (a b : Int) : (a * b).fmod a = 0 := by - rw [Int.mul_comm, mul_fmod_left] - -@[simp] theorem mod_self {a : Int} : a.mod a = 0 := by - have := mul_mod_left 1 a; rwa [Int.one_mul] at this - -@[simp] theorem fmod_self {a : Int} : a.fmod a = 0 := by - have := mul_fmod_left 1 a; rwa [Int.one_mul] at this - -protected theorem ediv_emod_unique {a b r q : Int} (h : 0 < b) : - a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b := by - constructor - · intro ⟨rfl, rfl⟩ - exact ⟨emod_add_ediv a b, emod_nonneg _ (Int.ne_of_gt h), emod_lt_of_pos _ h⟩ - · intro ⟨rfl, hz, hb⟩ - constructor - · rw [Int.add_mul_ediv_left r q (Int.ne_of_gt h), ediv_eq_zero_of_lt hz hb] - simp [Int.zero_add] - · rw [add_mul_emod_self_left, emod_eq_of_lt hz hb] - -/-! ### properties of `/` and `%` -/ - -@[simp] theorem mul_ediv_mul_of_pos {a : Int} - (b c : Int) (H : 0 < a) : (a * b) / (a * c) = b / c := - suffices ∀ (m k : Nat) (b : Int), (m.succ * b) / (m.succ * k) = b / k from - match a, eq_succ_of_zero_lt H, c, Int.eq_nat_or_neg c with - | _, ⟨m, rfl⟩, _, ⟨k, .inl rfl⟩ => this _ .. - | _, ⟨m, rfl⟩, _, ⟨k, .inr rfl⟩ => by - rw [Int.mul_neg, Int.ediv_neg, Int.ediv_neg]; apply congrArg Neg.neg; apply this - fun m k b => - match b, k with - | ofNat n, k => congrArg ofNat (Nat.mul_div_mul_left _ _ m.succ_pos) - | -[n+1], 0 => by - rw [Int.ofNat_zero, Int.mul_zero, Int.ediv_zero, Int.ediv_zero] - | -[n+1], succ k => congrArg negSucc <| - show (m.succ * n + m) / (m.succ * k.succ) = n / k.succ by - apply Nat.div_eq_of_lt_le - · refine Nat.le_trans ?_ (Nat.le_add_right _ _) - rw [← Nat.mul_div_mul_left _ _ m.succ_pos] - apply Nat.div_mul_le_self - · show m.succ * n.succ ≤ _ - rw [Nat.mul_left_comm] - apply Nat.mul_le_mul_left - apply (Nat.div_lt_iff_lt_mul k.succ_pos).1 - apply Nat.lt_succ_self - - -@[simp] theorem mul_ediv_mul_of_pos_left - (a : Int) {b : Int} (c : Int) (H : 0 < b) : (a * b) / (c * b) = a / c := by - rw [Int.mul_comm, Int.mul_comm c, mul_ediv_mul_of_pos _ _ H] - -@[simp] theorem mul_emod_mul_of_pos - {a : Int} (b c : Int) (H : 0 < a) : (a * b) % (a * c) = a * (b % c) := by - rw [emod_def, emod_def, mul_ediv_mul_of_pos _ _ H, Int.mul_sub, Int.mul_assoc] - -theorem lt_div_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.div b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.mod_def .. ▸ mod_lt_of_pos _ H - -theorem lt_ediv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a / b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.emod_def .. ▸ emod_lt_of_pos _ H - -theorem lt_fdiv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.fdiv b + 1) * b := - Int.fdiv_eq_ediv _ (Int.le_of_lt H) ▸ lt_ediv_add_one_mul_self a H - -@[simp] theorem natAbs_div (a b : Int) : natAbs (a.div b) = (natAbs a).div (natAbs b) := - match a, b, eq_nat_or_neg a, eq_nat_or_neg b with - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inl rfl⟩ => rfl - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.div_neg, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inl rfl⟩ => by rw [Int.neg_div, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.neg_div_neg, natAbs_neg, natAbs_neg]; rfl - -theorem natAbs_div_le_natAbs (a b : Int) : natAbs (a / b) ≤ natAbs a := - match b, eq_nat_or_neg b with - | _, ⟨n, .inl rfl⟩ => aux _ _ - | _, ⟨n, .inr rfl⟩ => by rw [Int.ediv_neg, natAbs_neg]; apply aux -where - aux : ∀ (a : Int) (n : Nat), natAbs (a / n) ≤ natAbs a - | ofNat _, _ => Nat.div_le_self .. - | -[_+1], 0 => Nat.zero_le _ - | -[_+1], succ _ => Nat.succ_le_succ (Nat.div_le_self _ _) - -theorem ediv_le_self {a : Int} (b : Int) (Ha : 0 ≤ a) : a / b ≤ a := by - have := Int.le_trans le_natAbs (ofNat_le.2 <| natAbs_div_le_natAbs a b) - rwa [natAbs_of_nonneg Ha] at this - -theorem mul_div_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : b * (a.div b) = a := by - have := mod_add_div a b; rwa [H, Int.zero_add] at this - -theorem div_mul_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : a.div b * b = a := by - rw [Int.mul_comm, mul_div_cancel_of_mod_eq_zero H] - -/-! ### dvd -/ - -protected theorem dvd_add_left {a b c : Int} (H : a ∣ c) : a ∣ b + c ↔ a ∣ b := - ⟨fun h => by have := Int.dvd_sub h H; rwa [Int.add_sub_cancel] at this, (Int.dvd_add · H)⟩ - -protected theorem dvd_add_right {a b c : Int} (H : a ∣ b) : a ∣ b + c ↔ a ∣ c := by - rw [Int.add_comm, Int.dvd_add_left H] - -protected theorem dvd_iff_dvd_of_dvd_sub {a b c : Int} (H : a ∣ b - c) : a ∣ b ↔ a ∣ c := - ⟨fun h => Int.sub_sub_self b c ▸ Int.dvd_sub h H, - fun h => Int.sub_add_cancel b c ▸ Int.dvd_add H h⟩ - -protected theorem dvd_iff_dvd_of_dvd_add {a b c : Int} (H : a ∣ b + c) : a ∣ b ↔ a ∣ c := by - rw [← Int.sub_neg] at H; rw [Int.dvd_iff_dvd_of_dvd_sub H, Int.dvd_neg] - -theorem natAbs_dvd {a b : Int} : (a.natAbs : Int) ∣ b ↔ a ∣ b := - match natAbs_eq a with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.neg_dvd, ← e] - -theorem dvd_natAbs {a b : Int} : a ∣ b.natAbs ↔ a ∣ b := - match natAbs_eq b with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.dvd_neg, ← e] - -theorem natAbs_dvd_self {a : Int} : (a.natAbs : Int) ∣ a := by - rw [Int.natAbs_dvd] - exact Int.dvd_refl a - -theorem dvd_natAbs_self {a : Int} : a ∣ (a.natAbs : Int) := by - rw [Int.dvd_natAbs] - exact Int.dvd_refl a - -theorem ofNat_dvd_right {n : Nat} {z : Int} : z ∣ (↑n : Int) ↔ z.natAbs ∣ n := by - rw [← natAbs_dvd_natAbs, natAbs_ofNat] - -theorem dvd_antisymm {a b : Int} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b := by - rw [← natAbs_of_nonneg H1, ← natAbs_of_nonneg H2] - rw [ofNat_dvd, ofNat_dvd, ofNat_inj] - apply Nat.dvd_antisymm - -theorem dvd_of_mod_eq_zero {a b : Int} (H : mod b a = 0) : a ∣ b := - ⟨b.div a, (mul_div_cancel_of_mod_eq_zero H).symm⟩ - -theorem mod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → mod b a = 0 - | _, _, ⟨_, rfl⟩ => mul_mod_right .. - -theorem dvd_iff_mod_eq_zero (a b : Int) : a ∣ b ↔ mod b a = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -/-- If `a % b = c` then `b` divides `a - c`. -/ -theorem dvd_sub_of_emod_eq {a b c : Int} (h : a % b = c) : b ∣ a - c := by - have hx : (a % b) % b = c % b := by - rw [h] - rw [Int.emod_emod, ← emod_sub_cancel_right c, Int.sub_self, zero_emod] at hx - exact dvd_of_emod_eq_zero hx - -protected theorem div_mul_cancel {a b : Int} (H : b ∣ a) : a.div b * b = a := - div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H) - -protected theorem mul_div_cancel' {a b : Int} (H : a ∣ b) : a * b.div a = b := by - rw [Int.mul_comm, Int.div_mul_cancel H] - -protected theorem mul_div_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b).div c = a * (b.div c) - | _, c, ⟨d, rfl⟩ => - if cz : c = 0 then by simp [cz, Int.mul_zero] else by - rw [Int.mul_left_comm, Int.mul_div_cancel_left _ cz, Int.mul_div_cancel_left _ cz] - -protected theorem mul_div_assoc' (b : Int) {a c : Int} (h : c ∣ a) : - (a * b).div c = a.div c * b := by - rw [Int.mul_comm, Int.mul_div_assoc _ h, Int.mul_comm] - -theorem div_dvd_div : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.div a ∣ c.div a - | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ => by - if az : a = 0 then simp [az] else - rw [Int.mul_div_cancel_left _ az, Int.mul_assoc, Int.mul_div_cancel_left _ az] - apply Int.dvd_mul_right - -protected theorem eq_mul_of_div_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = b * c := by rw [← H2, Int.mul_div_cancel' H1] - -protected theorem eq_mul_of_ediv_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = b * c := by rw [← H2, Int.mul_ediv_cancel' H1] - -protected theorem div_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a.div b = c := by rw [H2, Int.mul_div_cancel_left _ H1] - -protected theorem ediv_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a / b = c := by rw [H2, Int.mul_ediv_cancel_left _ H1] - -protected theorem eq_div_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c.div a := - (Int.div_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem eq_ediv_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c / a := - (Int.ediv_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem div_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = b * c := - ⟨Int.eq_mul_of_div_eq_right H', Int.div_eq_of_eq_mul_right H⟩ - -protected theorem ediv_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = b * c := - ⟨Int.eq_mul_of_ediv_eq_right H', Int.ediv_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.div_eq_iff_eq_mul_right H H' - -protected theorem ediv_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.ediv_eq_iff_eq_mul_right H H' - -protected theorem eq_mul_of_div_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_div_eq_right H1 H2] - -protected theorem eq_mul_of_ediv_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_ediv_eq_right H1 H2] - -protected theorem div_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a.div b = c := - Int.div_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem ediv_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a / b = c := - Int.ediv_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem eq_zero_of_div_eq_zero {d n : Int} (h : d ∣ n) (H : n.div d = 0) : n = 0 := by - rw [← Int.mul_div_cancel' h, H, Int.mul_zero] - -protected theorem eq_zero_of_ediv_eq_zero {d n : Int} (h : d ∣ n) (H : n / d = 0) : n = 0 := by - rw [← Int.mul_ediv_cancel' h, H, Int.mul_zero] - -theorem div_eq_ediv_of_dvd {a b : Int} (h : b ∣ a) : a.div b = a / b := by - if b0 : b = 0 then simp [b0] - else rw [Int.div_eq_iff_eq_mul_left b0 h, ← Int.ediv_eq_iff_eq_mul_left b0 h] - -theorem fdiv_eq_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → a.fdiv b = a / b - | _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else - rw [mul_fdiv_cancel_left _ bz, mul_ediv_cancel_left _ bz] - -theorem sub_ediv_of_dvd_sub {a b c : Int} - (hcab : c ∣ a - b) : (a - b) / c = a / c - b / c := by - rw [← Int.add_sub_cancel ((a-b) / c), ← Int.add_ediv_of_dvd_left hcab, Int.sub_add_cancel] - -@[simp] protected theorem div_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a.div d = b.div d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (div · d)⟩ - rw [← Int.mul_div_cancel' hda, ← Int.mul_div_cancel' hdb, h] - -@[simp] protected theorem ediv_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (ediv · d)⟩ - rw [← Int.mul_ediv_cancel' hda, ← Int.mul_ediv_cancel' hdb, h] - -theorem div_sign : ∀ a b, a.div (sign b) = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -theorem ediv_sign : ∀ a b, a / sign b = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -protected theorem sign_eq_div_abs (a : Int) : sign a = a.div (natAbs a) := - if az : a = 0 then by simp [az] else - (Int.div_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az) - (sign_mul_natAbs _).symm).symm - -theorem mul_sign : ∀ i : Int, i * sign i = natAbs i - | succ _ => Int.mul_one _ - | 0 => Int.mul_zero _ - | -[_+1] => Int.mul_neg_one _ - -theorem le_of_dvd {a b : Int} (bpos : 0 < b) (H : a ∣ b) : a ≤ b := - match a, b, eq_succ_of_zero_lt bpos, H with - | ofNat _, _, ⟨n, rfl⟩, H => ofNat_le.2 <| Nat.le_of_dvd n.succ_pos <| ofNat_dvd.1 H - | -[_+1], _, ⟨_, rfl⟩, _ => Int.le_trans (Int.le_of_lt <| negSucc_lt_zero _) (ofNat_zero_le _) - -theorem eq_one_of_dvd_one {a : Int} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 := - match a, eq_ofNat_of_zero_le H, H' with - | _, ⟨_, rfl⟩, H' => congrArg ofNat <| Nat.eq_one_of_dvd_one <| ofNat_dvd.1 H' - -theorem eq_one_of_mul_eq_one_right {a b : Int} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 := - eq_one_of_dvd_one H ⟨b, H'.symm⟩ - -theorem eq_one_of_mul_eq_one_left {a b : Int} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 := - eq_one_of_mul_eq_one_right H <| by rw [Int.mul_comm, H'] - -theorem le_of_mul_le_mul_left {a b c : Int} (w : a * b ≤ a * c) (h : 0 < a) : b ≤ c := by - have w := Int.sub_nonneg_of_le w - rw [← Int.mul_sub] at w - have w := Int.ediv_nonneg w (Int.le_of_lt h) - rw [Int.mul_ediv_cancel_left _ (Int.ne_of_gt h)] at w - exact Int.le_of_sub_nonneg w - -theorem le_of_mul_le_mul_right {a b c : Int} (w : b * a ≤ c * a) (h : 0 < a) : b ≤ c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact le_of_mul_le_mul_left w h - -theorem lt_of_mul_lt_mul_left {a b c : Int} (w : a * b < a * c) (h : 0 ≤ a) : b < c := by - rcases Int.lt_trichotomy b c with lt | rfl | gt - · exact lt - · exact False.elim (Int.lt_irrefl _ w) - · rcases Int.lt_trichotomy a 0 with a_lt | rfl | a_gt - · exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le a_lt h)) - · exact False.elim (Int.lt_irrefl b (by simp at w)) - · have := le_of_mul_le_mul_left (Int.le_of_lt w) a_gt - exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le gt this)) - -theorem lt_of_mul_lt_mul_right {a b c : Int} (w : b * a < c * a) (h : 0 ≤ a) : b < c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact lt_of_mul_lt_mul_left w h - -/-! -# `bmod` ("balanced" mod) - --/ - -theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by - simp [bmod] - -@[simp] theorem bmod_bmod : bmod (bmod x m) m = bmod x m := by - rw [bmod, bmod_emod] - rfl - -@[simp] theorem bmod_zero : Int.bmod 0 m = 0 := by - dsimp [bmod] - simp only [zero_emod, Int.zero_sub, ite_eq_left_iff, Int.neg_eq_zero] - intro h - rw [@Int.not_lt] at h - match m with - | 0 => rfl - | (m+1) => - exfalso - rw [natCast_add, ofNat_one, Int.add_assoc, add_ediv_of_dvd_right] at h - change _ + 2 / 2 ≤ 0 at h - rw [Int.ediv_self, ← ofNat_two, ← ofNat_ediv, add_one_le_iff, ← @Int.not_le] at h - exact h (ofNat_nonneg _) - all_goals decide - -theorem dvd_bmod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ bmod x m - x := by - dsimp [bmod] - split - · exact dvd_emod_sub_self - · rw [Int.sub_sub, Int.add_comm, ← Int.sub_sub] - exact Int.dvd_sub dvd_emod_sub_self (Int.dvd_refl _) - -theorem le_bmod {x : Int} {m : Nat} (h : 0 < m) : - (m/2) ≤ Int.bmod x m := by - dsimp [bmod] - have v : (m : Int) % 2 = 0 ∨ (m : Int) % 2 = 1 := emod_two_eq _ - split <;> rename_i w - · refine Int.le_trans ?_ (Int.emod_nonneg _ ?_) - · exact Int.neg_nonpos_of_nonneg (Int.ediv_nonneg (Int.ofNat_nonneg _) (by decide)) - · exact Int.ne_of_gt (ofNat_pos.mpr h) - · simp [Int.not_lt] at w - refine Int.le_trans ?_ (Int.sub_le_sub_right w _) - rw [← ediv_add_emod m 2] - generalize (m : Int) / 2 = q - generalize h : (m : Int) % 2 = r at * - rcases v with rfl | rfl - · rw [Int.add_zero, Int.mul_ediv_cancel_left, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show (1 / 2 : Int) = 0 by decide, Int.add_zero, - Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.sub_mul, show (1 - 2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals apply Int.dvd_mul_right - · rw [Int.add_ediv_of_dvd_left, Int.mul_ediv_cancel_left, - show (1 / 2 : Int) = 0 by decide, Int.add_assoc, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show ((1 + 1) / 2 : Int) = 1 by decide, ← Int.sub_sub, - Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.add_assoc q, - show (1 + -1 : Int) = 0 by decide, Int.add_zero, ← Int.neg_mul] - rw [Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.add_mul, show (1 + -2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals try apply Int.dvd_mul_right - -theorem bmod_lt {x : Int} {m : Nat} (h : 0 < m) : bmod x m < (m + 1) / 2 := by - dsimp [bmod] - split - · assumption - · apply Int.lt_of_lt_of_le - · show _ < 0 - have : x % m < m := emod_lt_of_pos x (ofNat_pos.mpr h) - exact Int.sub_neg_of_lt this - · exact Int.le.intro_sub _ rfl - -theorem bmod_le {x : Int} {m : Nat} (h : 0 < m) : bmod x m ≤ (m - 1) / 2 := by - refine lt_add_one_iff.mp ?_ - calc - bmod x m < (m + 1) / 2 := bmod_lt h - _ = ((m + 1 - 2) + 2)/2 := by simp - _ = (m - 1) / 2 + 1 := by - rw [add_ediv_of_dvd_right] - · simp (config := {decide := true}) only [Int.ediv_self] - congr 2 - rw [Int.add_sub_assoc, ← Int.sub_neg] - congr - · trivial - --- This could be strengthed by changing to `w : x ≠ -1` if needed. -theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1) = - x.sign := by - have t₁ : ∀ (x : Nat), x % (x + 2) = x := - fun x => Nat.mod_eq_of_lt (Nat.lt_succ_of_lt (Nat.lt.base x)) - have t₂ : ∀ (x : Int), 0 ≤ x → x % (x + 2) = x := fun x h => by - match x, h with - | Int.ofNat x, _ => erw [← Int.ofNat_two, ← ofNat_add, ← ofNat_emod, t₁]; rfl - cases x with - | ofNat x => - simp only [bmod, ofNat_eq_coe, natAbs_ofNat, natCast_add, ofNat_one, - emod_self_add_one (ofNat_nonneg x)] - match x with - | 0 => rw [if_pos] <;> simp (config := {decide := true}) - | (x+1) => - rw [if_neg] - · simp [← Int.sub_sub] - · refine Int.not_lt.mpr ?_ - simp only [← natCast_add, ← ofNat_one, ← ofNat_two, ← ofNat_ediv] - match x with - | 0 => apply Int.le_refl - | (x+1) => - refine Int.ofNat_le.mpr ?_ - apply Nat.div_le_of_le_mul - simp only [Nat.two_mul, Nat.add_assoc] - apply Nat.add_le_add_left (Nat.add_le_add_left (Nat.add_le_add_left (Nat.le_add_left - _ _) _) _) - | negSucc x => - rw [bmod, natAbs_negSucc, natCast_add, ofNat_one, sign_negSucc, Int.neg_neg, - Nat.succ_eq_add_one, negSucc_emod] - erw [t₂] - · rw [natCast_add, ofNat_one, Int.add_sub_cancel, Int.add_comm, Int.add_sub_cancel, if_pos] - · match x, w with - | (x+1), _ => - rw [Int.add_assoc, add_ediv_of_dvd_right, show (1 + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.lt_add_one_of_le - rw [Int.add_comm, ofNat_add, Int.add_assoc, add_ediv_of_dvd_right, - show ((1 : Nat) + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.le_add_of_nonneg_left - exact Int.le.intro_sub _ rfl - all_goals decide - · exact ofNat_nonneg x - · exact succ_ofNat_pos (x + 1) - -/-! ### `/` and ordering -/ - -protected theorem ediv_mul_le (a : Int) {b : Int} (H : b ≠ 0) : a / b * b ≤ a := - Int.le_of_sub_nonneg <| by rw [Int.mul_comm, ← emod_def]; apply emod_nonneg _ H - -protected theorem ediv_le_of_le_mul {a b c : Int} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := - le_of_mul_le_mul_right (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') H - -protected theorem mul_lt_of_lt_ediv {a b c : Int} (H : 0 < c) (H3 : a < b / c) : a * c < b := - Int.lt_of_not_ge <| mt (Int.ediv_le_of_le_mul H) (Int.not_le_of_gt H3) - -protected theorem mul_le_of_le_ediv {a b c : Int} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := - Int.le_trans (Int.mul_le_mul_of_nonneg_right H2 (Int.le_of_lt H1)) - (Int.ediv_mul_le _ (Int.ne_of_gt H1)) - -protected theorem le_ediv_of_mul_le {a b c : Int} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c := - le_of_lt_add_one <| - lt_of_mul_lt_mul_right (Int.lt_of_le_of_lt H2 (lt_ediv_add_one_mul_self _ H1)) (Int.le_of_lt H1) - -protected theorem le_ediv_iff_mul_le {a b c : Int} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b := - ⟨Int.mul_le_of_le_ediv H, Int.le_ediv_of_mul_le H⟩ - -protected theorem ediv_le_ediv {a b c : Int} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c := - Int.le_ediv_of_mul_le H (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') - -protected theorem ediv_lt_of_lt_mul {a b c : Int} (H : 0 < c) (H' : a < b * c) : a / c < b := - Int.lt_of_not_ge <| mt (Int.mul_le_of_le_ediv H) (Int.not_le_of_gt H') - -protected theorem lt_mul_of_ediv_lt {a b c : Int} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := - Int.lt_of_not_ge <| mt (Int.le_ediv_of_mul_le H1) (Int.not_le_of_gt H2) - -protected theorem ediv_lt_iff_lt_mul {a b c : Int} (H : 0 < c) : a / c < b ↔ a < b * c := - ⟨Int.lt_mul_of_ediv_lt H, Int.ediv_lt_of_lt_mul H⟩ - -protected theorem le_mul_of_ediv_le {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) : - a ≤ c * b := by - rw [← Int.ediv_mul_cancel H2]; exact Int.mul_le_mul_of_nonneg_right H3 H1 - -protected theorem lt_ediv_of_mul_lt {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) : - a < c / b := - Int.lt_of_not_ge <| mt (Int.le_mul_of_ediv_le H1 H2) (Int.not_le_of_gt H3) - -protected theorem lt_ediv_iff_mul_lt {a b : Int} (c : Int) (H : 0 < c) (H' : c ∣ b) : - a < b / c ↔ a * c < b := - ⟨Int.mul_lt_of_lt_ediv H, Int.lt_ediv_of_mul_lt (Int.le_of_lt H) H'⟩ - -theorem ediv_pos_of_pos_of_dvd {a b : Int} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b := - Int.lt_ediv_of_mul_lt H2 H3 (by rwa [Int.zero_mul]) - -theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int} - (H2 : d ∣ c) (H3 : b ≠ 0) (H4 : d ≠ 0) (H5 : a * d = b * c) : a / b = c / d := - Int.ediv_eq_of_eq_mul_right H3 <| by - rw [← Int.mul_ediv_assoc _ H2]; exact (Int.ediv_eq_of_eq_mul_left H4 H5.symm).symm - /-! ### The following lemmas have been commented out here for a while, and need restoration. -/ diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean deleted file mode 100644 index 02506a13a4..0000000000 --- a/Std/Data/Int/Gcd.lean +++ /dev/null @@ -1,43 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.Int.DivMod - -/-! -# Results about `Int.gcd`. --/ - -namespace Int - -theorem gcd_dvd_left {a b : Int} : (gcd a b : Int) ∣ a := by - have := Nat.gcd_dvd_left a.natAbs b.natAbs - rw [← Int.ofNat_dvd] at this - exact Int.dvd_trans this natAbs_dvd_self - -theorem gcd_dvd_right {a b : Int} : (gcd a b : Int) ∣ b := by - have := Nat.gcd_dvd_right a.natAbs b.natAbs - rw [← Int.ofNat_dvd] at this - exact Int.dvd_trans this natAbs_dvd_self - -@[simp] theorem one_gcd {a : Int} : gcd 1 a = 1 := by simp [gcd] -@[simp] theorem gcd_one {a : Int} : gcd a 1 = 1 := by simp [gcd] - -@[simp] theorem neg_gcd {a b : Int} : gcd (-a) b = gcd a b := by simp [gcd] -@[simp] theorem gcd_neg {a b : Int} : gcd a (-b) = gcd a b := by simp [gcd] - -/-- Computes the least common multiple of two integers, as a `Nat`. -/ -def lcm (m n : Int) : Nat := m.natAbs.lcm n.natAbs - -theorem lcm_ne_zero (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := by - simp only [lcm] - apply Nat.lcm_ne_zero <;> simpa - -theorem dvd_lcm_left {a b : Int} : a ∣ lcm a b := - Int.dvd_trans dvd_natAbs_self (Int.ofNat_dvd.mpr (Nat.dvd_lcm_left a.natAbs b.natAbs)) - -theorem dvd_lcm_right {a b : Int} : b ∣ lcm a b := - Int.dvd_trans dvd_natAbs_self (Int.ofNat_dvd.mpr (Nat.dvd_lcm_right a.natAbs b.natAbs)) - -@[simp] theorem lcm_self {a : Int} : lcm a a = a.natAbs := Nat.lcm_self _ diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index a449fdb06f..a4c91a0005 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -1,6 +1,5 @@ -- This is a backwards compatibility shim, after `Std.Data.Int.Lemmas` was split into smaller files. -- Hopefully it can later be removed. -import Std.Data.Int.Gcd import Std.Data.Int.Order import Std.Data.Int.DivMod diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 2763b0bb7c..6aef66829d 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,526 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Tactic.Alias -/-! -# Results about the order properties of the integers, and the integers as an ordered ring. --/ - -open Nat - namespace Int -/-! ## Order properties of the integers -/ - -protected theorem lt_of_not_ge {a b : Int} : ¬a ≤ b → b < a := Int.not_le.mp -protected theorem not_le_of_gt {a b : Int} : b < a → ¬a ≤ b := Int.not_le.mpr - -protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left - -@[simp] theorem negSucc_not_pos (n : Nat) : 0 < -[n+1] ↔ False := by - simp only [Int.not_lt, iff_false]; constructor - -theorem eq_negSucc_of_lt_zero : ∀ {a : Int}, a < 0 → ∃ n : Nat, a = -[n+1] - | ofNat _, h => absurd h (Int.not_lt.2 (ofNat_zero_le _)) - | -[n+1], _ => ⟨n, rfl⟩ - -protected theorem lt_of_add_lt_add_left {a b c : Int} (h : a + b < a + c) : b < c := by - have : -a + (a + b) < -a + (a + c) := Int.add_lt_add_left h _ - simp [Int.neg_add_cancel_left] at this - assumption - -protected theorem lt_of_add_lt_add_right {a b c : Int} (h : a + b < c + b) : a < c := - Int.lt_of_add_lt_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c] - -protected theorem add_lt_add_iff_left (a : Int) : a + b < a + c ↔ b < c := - ⟨Int.lt_of_add_lt_add_left, (Int.add_lt_add_left · _)⟩ - -protected theorem add_lt_add_iff_right (c : Int) : a + c < b + c ↔ a < b := - ⟨Int.lt_of_add_lt_add_right, (Int.add_lt_add_right · _)⟩ - -protected theorem add_lt_add {a b c d : Int} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := - Int.lt_trans (Int.add_lt_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_le_of_lt {a b c d : Int} (h₁ : a ≤ b) (h₂ : c < d) : - a + c < b + d := - Int.lt_of_le_of_lt (Int.add_le_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_lt_of_le {a b c d : Int} (h₁ : a < b) (h₂ : c ≤ d) : - a + c < b + d := - Int.lt_of_lt_of_le (Int.add_lt_add_right h₁ c) (Int.add_le_add_left h₂ b) - -protected theorem lt_add_of_pos_right (a : Int) {b : Int} (h : 0 < b) : a < a + b := by - have : a + 0 < a + b := Int.add_lt_add_left h a - rwa [Int.add_zero] at this - -protected theorem lt_add_of_pos_left (a : Int) {b : Int} (h : 0 < b) : a < b + a := by - have : 0 + a < b + a := Int.add_lt_add_right h a - rwa [Int.zero_add] at this - -protected theorem add_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_pos_of_pos_of_nonneg {a b : Int} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_pos_of_nonneg_of_pos {a b : Int} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem add_nonpos {a b : Int} (ha : a ≤ 0) (hb : b ≤ 0) : a + b ≤ 0 := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_neg {a b : Int} (ha : a < 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_neg_of_neg_of_nonpos {a b : Int} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_neg_of_nonpos_of_neg {a b : Int} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem lt_add_of_le_of_pos {a b c : Int} (hbc : b ≤ c) (ha : 0 < a) : b < c + a := - Int.add_zero b ▸ Int.add_lt_add_of_le_of_lt hbc ha - -theorem add_one_le_iff {a b : Int} : a + 1 ≤ b ↔ a < b := .rfl - -theorem lt_add_one_iff {a b : Int} : a < b + 1 ↔ a ≤ b := Int.add_le_add_iff_right _ - -@[simp] theorem succ_ofNat_pos (n : Nat) : 0 < (n : Int) + 1 := - lt_add_one_iff.2 (ofNat_zero_le _) - -theorem le_add_one {a b : Int} (h : a ≤ b) : a ≤ b + 1 := - Int.le_of_lt (Int.lt_add_one_iff.2 h) - -protected theorem nonneg_of_neg_nonpos {a : Int} (h : -a ≤ 0) : 0 ≤ a := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem nonpos_of_neg_nonneg {a : Int} (h : 0 ≤ -a) : a ≤ 0 := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem lt_of_neg_lt_neg {a b : Int} (h : -b < -a) : a < b := - Int.neg_neg a ▸ Int.neg_neg b ▸ Int.neg_lt_neg h - -protected theorem pos_of_neg_neg {a : Int} (h : -a < 0) : 0 < a := - Int.lt_of_neg_lt_neg <| by rwa [Int.neg_zero] - -protected theorem neg_of_neg_pos {a : Int} (h : 0 < -a) : a < 0 := - have : -0 < -a := by rwa [Int.neg_zero] - Int.lt_of_neg_lt_neg this - -protected theorem le_neg_of_le_neg {a b : Int} (h : a ≤ -b) : b ≤ -a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_le_of_neg_le {a b : Int} (h : -a ≤ b) : -b ≤ a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem lt_neg_of_lt_neg {a b : Int} (h : a < -b) : b < -a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_lt_of_neg_lt {a b : Int} (h : -a < b) : -b < a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem sub_nonpos_of_le {a b : Int} (h : a ≤ b) : a - b ≤ 0 := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem le_of_sub_nonpos {a b : Int} (h : a - b ≤ 0) : a ≤ b := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_neg_of_lt {a b : Int} (h : a < b) : a - b < 0 := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem lt_of_sub_neg {a b : Int} (h : a - b < 0) : a < b := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem add_le_of_le_neg_add {a b c : Int} (h : b ≤ -a + c) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem le_neg_add_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ -a + c := by - have h := Int.add_le_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_le_of_le_sub_left {a b c : Int} (h : b ≤ c - a) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem le_sub_left_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ c - a := by - have h := Int.add_le_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_le_of_le_sub_right {a b c : Int} (h : a ≤ c - b) : a + b ≤ c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem le_sub_right_of_add_le {a b c : Int} (h : a + b ≤ c) : a ≤ c - b := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_le_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - have h := Int.add_le_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem le_add_of_sub_left_le {a b c : Int} (h : a - b ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem le_add_of_sub_right_le {a b c : Int} (h : a - c ≤ b) : a ≤ b + c := by - have h := Int.add_le_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - c ≤ b := by - have h := Int.add_le_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le_left {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_left_le h - -protected theorem neg_add_le_left_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - rw [Int.add_comm] - exact Int.sub_left_le_of_le_add h - -protected theorem le_add_of_neg_add_le_right {a b c : Int} (h : -c + a ≤ b) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_right_le h - -protected theorem neg_add_le_right_of_le_add {a b c : Int} (h : a ≤ b + c) : -c + a ≤ b := by - rw [Int.add_comm] at h - exact Int.neg_add_le_left_of_le_add h - -protected theorem le_add_of_neg_le_sub_left {a b c : Int} (h : -a ≤ b - c) : c ≤ a + b := - Int.le_add_of_neg_add_le_left (Int.add_le_of_le_sub_right h) - -protected theorem neg_le_sub_left_of_le_add {a b c : Int} (h : c ≤ a + b) : -a ≤ b - c := by - have h := Int.le_neg_add_of_add_le (Int.sub_left_le_of_le_add h) - rwa [Int.add_comm] at h - -protected theorem le_add_of_neg_le_sub_right {a b c : Int} (h : -b ≤ a - c) : c ≤ a + b := - Int.le_add_of_sub_right_le (Int.add_le_of_le_sub_left h) - -protected theorem neg_le_sub_right_of_le_add {a b c : Int} (h : c ≤ a + b) : -b ≤ a - c := - Int.le_sub_left_of_add_le (Int.sub_right_le_of_le_add h) - -protected theorem sub_le_of_sub_le {a b c : Int} (h : a - b ≤ c) : a - c ≤ b := - Int.sub_left_le_of_le_add (Int.le_add_of_sub_right_le h) - -protected theorem sub_le_sub_left {a b : Int} (h : a ≤ b) (c : Int) : c - b ≤ c - a := - Int.add_le_add_left (Int.neg_le_neg h) c - -protected theorem sub_le_sub_right {a b : Int} (h : a ≤ b) (c : Int) : a - c ≤ b - c := - Int.add_le_add_right h (-c) - -protected theorem sub_le_sub {a b c d : Int} (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := - Int.add_le_add hab (Int.neg_le_neg hcd) - -protected theorem add_lt_of_lt_neg_add {a b c : Int} (h : b < -a + c) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem lt_neg_add_of_add_lt {a b c : Int} (h : a + b < c) : b < -a + c := by - have h := Int.add_lt_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_lt_of_lt_sub_left {a b c : Int} (h : b < c - a) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem lt_sub_left_of_add_lt {a b c : Int} (h : a + b < c) : b < c - a := by - have h := Int.add_lt_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_lt_of_lt_sub_right {a b c : Int} (h : a < c - b) : a + b < c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem lt_sub_right_of_add_lt {a b c : Int} (h : a + b < c) : a < c - b := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt {a b c : Int} (h : -b + a < c) : a < b + c := by - have h := Int.add_lt_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_lt_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - have h := Int.add_lt_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem lt_add_of_sub_left_lt {a b c : Int} (h : a - b < c) : a < b + c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem sub_left_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - b < c := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_sub_right_lt {a b c : Int} (h : a - c < b) : a < b + c := by - have h := Int.add_lt_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - c < b := by - have h := Int.add_lt_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt_left {a b c : Int} (h : -b + a < c) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_left_lt h - -protected theorem neg_add_lt_left_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - rw [Int.add_comm] - exact Int.sub_left_lt_of_lt_add h - -protected theorem lt_add_of_neg_add_lt_right {a b c : Int} (h : -c + a < b) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_right_lt h - -protected theorem neg_add_lt_right_of_lt_add {a b c : Int} (h : a < b + c) : -c + a < b := by - rw [Int.add_comm] at h - exact Int.neg_add_lt_left_of_lt_add h - -protected theorem lt_add_of_neg_lt_sub_left {a b c : Int} (h : -a < b - c) : c < a + b := - Int.lt_add_of_neg_add_lt_left (Int.add_lt_of_lt_sub_right h) - -protected theorem neg_lt_sub_left_of_lt_add {a b c : Int} (h : c < a + b) : -a < b - c := by - have h := Int.lt_neg_add_of_add_lt (Int.sub_left_lt_of_lt_add h) - rwa [Int.add_comm] at h - -protected theorem lt_add_of_neg_lt_sub_right {a b c : Int} (h : -b < a - c) : c < a + b := - Int.lt_add_of_sub_right_lt (Int.add_lt_of_lt_sub_left h) - -protected theorem neg_lt_sub_right_of_lt_add {a b c : Int} (h : c < a + b) : -b < a - c := - Int.lt_sub_left_of_add_lt (Int.sub_right_lt_of_lt_add h) - -protected theorem sub_lt_of_sub_lt {a b c : Int} (h : a - b < c) : a - c < b := - Int.sub_left_lt_of_lt_add (Int.lt_add_of_sub_right_lt h) - -protected theorem sub_lt_sub_left {a b : Int} (h : a < b) (c : Int) : c - b < c - a := - Int.add_lt_add_left (Int.neg_lt_neg h) c - -protected theorem sub_lt_sub_right {a b : Int} (h : a < b) (c : Int) : a - c < b - c := - Int.add_lt_add_right h (-c) - -protected theorem sub_lt_sub {a b c d : Int} (hab : a < b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_le_of_lt {a b c d : Int} - (hab : a ≤ b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add_of_le_of_lt hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_lt_of_le {a b c d : Int} - (hab : a < b) (hcd : c ≤ d) : a - d < b - c := - Int.add_lt_add_of_lt_of_le hab (Int.neg_le_neg hcd) - -protected theorem add_le_add_three {a b c d e f : Int} - (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : a + b + c ≤ d + e + f := - Int.add_le_add (Int.add_le_add h₁ h₂) h₃ - -theorem exists_eq_neg_ofNat {a : Int} (H : a ≤ 0) : ∃ n : Nat, a = -(n : Int) := - let ⟨n, h⟩ := eq_ofNat_of_zero_le (Int.neg_nonneg_of_nonpos H) - ⟨n, Int.eq_neg_of_eq_neg h.symm⟩ - -theorem lt_of_add_one_le {a b : Int} (H : a + 1 ≤ b) : a < b := H - -theorem lt_add_one_of_le {a b : Int} (H : a ≤ b) : a < b + 1 := Int.add_le_add_right H 1 - -theorem le_of_lt_add_one {a b : Int} (H : a < b + 1) : a ≤ b := Int.le_of_add_le_add_right H - -theorem sub_one_lt_of_le {a b : Int} (H : a ≤ b) : a - 1 < b := - Int.sub_right_lt_of_lt_add <| lt_add_one_of_le H - -theorem le_of_sub_one_lt {a b : Int} (H : a - 1 < b) : a ≤ b := - le_of_lt_add_one <| Int.lt_add_of_sub_right_lt H - -theorem le_sub_one_of_lt {a b : Int} (H : a < b) : a ≤ b - 1 := Int.le_sub_right_of_add_le H - -theorem lt_of_le_sub_one {a b : Int} (H : a ≤ b - 1) : a < b := Int.add_le_of_le_sub_right H - -/- ### Order properties and multiplication -/ - -protected theorem mul_lt_mul {a b c d : Int} - (h₁ : a < c) (h₂ : b ≤ d) (h₃ : 0 < b) (h₄ : 0 ≤ c) : a * b < c * d := - Int.lt_of_lt_of_le (Int.mul_lt_mul_of_pos_right h₁ h₃) (Int.mul_le_mul_of_nonneg_left h₂ h₄) - -protected theorem mul_lt_mul' {a b c d : Int} - (h₁ : a ≤ c) (h₂ : b < d) (h₃ : 0 ≤ b) (h₄ : 0 < c) : a * b < c * d := - Int.lt_of_le_of_lt (Int.mul_le_mul_of_nonneg_right h₁ h₃) (Int.mul_lt_mul_of_pos_left h₂ h₄) - -protected theorem mul_neg_of_pos_of_neg {a b : Int} (ha : 0 < a) (hb : b < 0) : a * b < 0 := by - have h : a * b < a * 0 := Int.mul_lt_mul_of_pos_left hb ha - rwa [Int.mul_zero] at h - -protected theorem mul_neg_of_neg_of_pos {a b : Int} (ha : a < 0) (hb : 0 < b) : a * b < 0 := by - have h : a * b < 0 * b := Int.mul_lt_mul_of_pos_right ha hb - rwa [Int.zero_mul] at h - -protected theorem mul_nonneg_of_nonpos_of_nonpos {a b : Int} - (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := by - have : 0 * b ≤ a * b := Int.mul_le_mul_of_nonpos_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_lt_mul_of_neg_left {a b c : Int} (h : b < a) (hc : c < 0) : c * a < c * b := - have : -c > 0 := Int.neg_pos_of_neg hc - have : -c * b < -c * a := Int.mul_lt_mul_of_pos_left h this - have : -(c * b) < -(c * a) := by - rwa [← Int.neg_mul_eq_neg_mul, ← Int.neg_mul_eq_neg_mul] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_lt_mul_of_neg_right {a b c : Int} (h : b < a) (hc : c < 0) : a * c < b * c := - have : -c > 0 := Int.neg_pos_of_neg hc - have : b * -c < a * -c := Int.mul_lt_mul_of_pos_right h this - have : -(b * c) < -(a * c) := by - rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_pos_of_neg_of_neg {a b : Int} (ha : a < 0) (hb : b < 0) : 0 < a * b := by - have : 0 * b < a * b := Int.mul_lt_mul_of_neg_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_self_le_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := - Int.mul_le_mul h2 h2 h1 (Int.le_trans h1 h2) - -protected theorem mul_self_lt_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := - Int.mul_lt_mul' (Int.le_of_lt h2) h2 h1 (Int.lt_of_le_of_lt h1 h2) - -/- ## sign -/ - -@[simp] theorem sign_zero : sign 0 = 0 := rfl -@[simp] theorem sign_one : sign 1 = 1 := rfl -theorem sign_neg_one : sign (-1) = -1 := rfl - -@[simp] theorem sign_of_add_one (x : Nat) : Int.sign (x + 1) = 1 := rfl -@[simp] theorem sign_negSucc (x : Nat) : Int.sign (Int.negSucc x) = -1 := rfl - -theorem natAbs_sign (z : Int) : z.sign.natAbs = if z = 0 then 0 else 1 := - match z with | 0 | succ _ | -[_+1] => rfl - -theorem natAbs_sign_of_nonzero {z : Int} (hz : z ≠ 0) : z.sign.natAbs = 1 := by - rw [Int.natAbs_sign, if_neg hz] - -theorem sign_ofNat_of_nonzero {n : Nat} (hn : n ≠ 0) : Int.sign n = 1 := - match n, Nat.exists_eq_succ_of_ne_zero hn with - | _, ⟨n, rfl⟩ => Int.sign_of_add_one n - -@[simp] theorem sign_neg (z : Int) : Int.sign (-z) = -Int.sign z := by - match z with | 0 | succ _ | -[_+1] => rfl - -theorem sign_mul_natAbs : ∀ a : Int, sign a * natAbs a = a - | 0 => rfl - | succ _ => Int.one_mul _ - | -[_+1] => (Int.neg_eq_neg_one_mul _).symm - -@[simp] theorem sign_mul : ∀ a b, sign (a * b) = sign a * sign b - | a, 0 | 0, b => by simp [Int.mul_zero, Int.zero_mul] - | succ _, succ _ | succ _, -[_+1] | -[_+1], succ _ | -[_+1], -[_+1] => rfl - -theorem sign_eq_one_of_pos {a : Int} (h : 0 < a) : sign a = 1 := - match a, eq_succ_of_zero_lt h with - | _, ⟨_, rfl⟩ => rfl - -theorem sign_eq_neg_one_of_neg {a : Int} (h : a < 0) : sign a = -1 := - match a, eq_negSucc_of_lt_zero h with - | _, ⟨_, rfl⟩ => rfl - -theorem eq_zero_of_sign_eq_zero : ∀ {a : Int}, sign a = 0 → a = 0 - | 0, _ => rfl - -theorem pos_of_sign_eq_one : ∀ {a : Int}, sign a = 1 → 0 < a - | (_ + 1 : Nat), _ => ofNat_lt.2 (Nat.succ_pos _) - -theorem neg_of_sign_eq_neg_one : ∀ {a : Int}, sign a = -1 → a < 0 - | (_ + 1 : Nat), h => nomatch h - | 0, h => nomatch h - | -[_+1], _ => negSucc_lt_zero _ - -theorem sign_eq_one_iff_pos (a : Int) : sign a = 1 ↔ 0 < a := - ⟨pos_of_sign_eq_one, sign_eq_one_of_pos⟩ - -theorem sign_eq_neg_one_iff_neg (a : Int) : sign a = -1 ↔ a < 0 := - ⟨neg_of_sign_eq_neg_one, sign_eq_neg_one_of_neg⟩ - -@[simp] theorem sign_eq_zero_iff_zero (a : Int) : sign a = 0 ↔ a = 0 := - ⟨eq_zero_of_sign_eq_zero, fun h => by rw [h, sign_zero]⟩ - -@[simp] theorem sign_sign : sign (sign x) = sign x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => rfl - | .negSucc _ => rfl - -@[simp] theorem sign_nonneg : 0 ≤ sign x ↔ 0 ≤ x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => - simp (config := { decide := true }) only [sign, true_iff] - exact Int.le_add_one (ofNat_nonneg _) - | .negSucc _ => simp (config := { decide := true }) [sign] - -/- ## natAbs -/ - -theorem natAbs_ne_zero {a : Int} : a.natAbs ≠ 0 ↔ a ≠ 0 := not_congr Int.natAbs_eq_zero - -theorem natAbs_mul_self : ∀ {a : Int}, ↑(natAbs a * natAbs a) = a * a - | ofNat _ => rfl - | -[_+1] => rfl - -theorem eq_nat_or_neg (a : Int) : ∃ n : Nat, a = n ∨ a = -↑n := ⟨_, natAbs_eq a⟩ - -theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat} - (h : a * b = (c : Int)) : a.natAbs * b.natAbs = c := by rw [← natAbs_mul, h, natAbs] - -@[simp] theorem natAbs_mul_self' (a : Int) : (natAbs a * natAbs a : Int) = a * a := by - rw [← Int.ofNat_mul, natAbs_mul_self] - -theorem natAbs_eq_iff {a : Int} {n : Nat} : a.natAbs = n ↔ a = n ∨ a = -↑n := by - rw [← Int.natAbs_eq_natAbs_iff, Int.natAbs_ofNat] - -theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by - suffices ∀ a b : Nat, natAbs (subNatNat a b.succ) ≤ (a + b).succ by - match a, b with - | (a:Nat), (b:Nat) => rw [ofNat_add_ofNat, natAbs_ofNat]; apply Nat.le_refl - | (a:Nat), -[b+1] => rw [natAbs_ofNat, natAbs_negSucc]; apply this - | -[a+1], (b:Nat) => - rw [natAbs_negSucc, natAbs_ofNat, Nat.succ_add, Nat.add_comm a b]; apply this - | -[a+1], -[b+1] => rw [natAbs_negSucc, succ_add]; apply Nat.le_refl - refine fun a b => subNatNat_elim a b.succ - (fun m n i => n = b.succ → natAbs i ≤ (m + b).succ) ?_ - (fun i n (e : (n + i).succ = _) => ?_) rfl - · rintro i n rfl - rw [Nat.add_comm _ i, Nat.add_assoc] - exact Nat.le_add_right i (b.succ + b).succ - · apply succ_le_succ - rw [← succ.inj e, ← Nat.add_assoc, Nat.add_comm] - apply Nat.le_add_right - -theorem natAbs_sub_le (a b : Int) : natAbs (a - b) ≤ natAbs a + natAbs b := by - rw [← Int.natAbs_neg b]; apply natAbs_add_le - -theorem negSucc_eq' (m : Nat) : -[m+1] = -m - 1 := by simp only [negSucc_eq, Int.neg_add]; rfl - -theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} - (w₁ : 0 ≤ a) (w₂ : a < b) : a.natAbs < b.natAbs := - match a, b, eq_ofNat_of_zero_le w₁, eq_ofNat_of_zero_le (Int.le_trans w₁ (Int.le_of_lt w₂)) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_lt.1 w₂ - -theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by - rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] - -/-! ### toNat -/ - -theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n - | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> nofun - @[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 820618d84a..39fad08cfc 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -107,8 +107,9 @@ elab_rules : tactic | some mvarId => replaceMainGoal [mvarId] pure usedSimps | ``Parser.Tactic.dsimp => do - let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - dsimpLocation' ctx (expandOptLocation stx[5]) + let { ctx, simprocs, .. } ← withMainContext <| + mkSimpContext stx (eraseLocal := false) (kind := .dsimp) + dsimpLocation' ctx simprocs (expandOptLocation stx[5]) | _ => Elab.throwUnsupportedSyntax let a := a.getId; let x := x.getId squeezeScopes.modify fun map => Id.run do diff --git a/lean-toolchain b/lean-toolchain index 8465e8d271..45ede451b4 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-11 +leanprover/lean4:nightly-2024-03-12 diff --git a/test/simp_trace.lean b/test/simp_trace.lean index b3cefc454c..c8b0dc270f 100644 --- a/test/simp_trace.lean +++ b/test/simp_trace.lean @@ -5,7 +5,7 @@ set_option linter.missingDocs false /-- info: Try this: simp only [Nat.add_comm] -/ #guard_msgs in example : x + 1 = 1 + x := by simp? [Nat.add_comm, Nat.mul_comm] -/-- info: Try this: dsimp only -/ +/-- info: Try this: dsimp only [Nat.reduceAdd] -/ #guard_msgs in example : 1 + 1 = 2 := by dsimp? From 576d053acc2db94e9ae3bd2ee0c3bc71322f520a Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 13 Mar 2024 22:20:07 +1100 Subject: [PATCH 3/8] chore: adaptations for nightly-2024-03-13 (#695) --- Std/Data/List/Count.lean | 2 +- Std/Data/List/Lemmas.lean | 4 ++-- Std/Data/Rat/Lemmas.lean | 8 ++++++-- Std/Data/UInt.lean | 2 +- lean-toolchain | 2 +- 5 files changed, 11 insertions(+), 7 deletions(-) diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 0087e86007..4458c457dc 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -115,7 +115,7 @@ theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP . simp apply Nat.le_trans ?_ (Nat.le_add_right _ _) apply ihl hl - . simp [ha h, Nat.add_one] + . simp [ha h] apply Nat.succ_le_succ apply ihl hl diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index e69977f247..184e67a132 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -219,7 +219,7 @@ theorem forall_mem_map_iff {f : α → β} {l : List α} {P : β → Prop} : @[simp] theorem length_zipWith (f : α → β → γ) (l₁ l₂) : length (zipWith f l₁ l₂) = min (length l₁) (length l₂) := by induction l₁ generalizing l₂ <;> cases l₂ <;> - simp_all [add_one, succ_min_succ, Nat.zero_min, Nat.min_zero] + simp_all [succ_min_succ, Nat.zero_min, Nat.min_zero] @[simp] theorem zipWith_map {μ} (f : γ → δ → μ) (g : α → γ) (h : β → δ) (l₁ : List α) (l₂ : List β) : @@ -843,7 +843,7 @@ theorem get!_of_get? [Inhabited α] : ∀ {l : List α} {n}, get? l n = some a @[simp] theorem length_take : ∀ (i : Nat) (l : List α), length (take i l) = min i (length l) | 0, l => by simp [Nat.zero_min] | succ n, [] => by simp [Nat.min_zero] - | succ n, _ :: l => by simp [Nat.succ_min_succ, add_one, length_take] + | succ n, _ :: l => by simp [Nat.succ_min_succ, length_take] theorem length_take_le (n) (l : List α) : length (take n l) ≤ n := by simp [Nat.min_le_left] diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index ced2a09c08..8d2bb130dd 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -143,9 +143,13 @@ theorem divInt_self (a : Rat) : a.num /. a.den = a := by rw [divInt_ofNat, mkRat theorem neg_divInt_neg (num den) : -num /. -den = num /. den := by match den with - | Nat.succ n => simp [divInt, Int.neg_ofNat_succ, normalize_eq_mkRat, Int.neg_neg] + | Nat.succ n => + simp only [divInt, Int.neg_ofNat_succ] + simp [normalize_eq_mkRat, Int.neg_neg] | 0 => rfl - | Int.negSucc n => simp [divInt, Int.neg_negSucc, normalize_eq_mkRat, Int.neg_neg] + | Int.negSucc n => + simp only [divInt, Int.neg_negSucc] + simp [normalize_eq_mkRat, Int.neg_neg] theorem divInt_neg' (num den) : num /. -den = -num /. den := by rw [← neg_divInt_neg, Int.neg_neg] diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index 04929fa84e..d94c11ae26 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -79,7 +79,7 @@ theorem UInt64.toNat_lt (x : UInt64) : x.toNat < 2 ^ 64 := x.val.isLt 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.succ_eq_add_one, Nat.sub_eq, Nat.sub_add_cancel this] + rw [USize.size, Nat.sub_add_cancel this] theorem USize.le_size : 2 ^ 32 ≤ USize.size := by rw [size_eq] diff --git a/lean-toolchain b/lean-toolchain index 45ede451b4..c532a09f53 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-12 +leanprover/lean4:nightly-2024-03-13 From 94aa6fc17b51fae63cc17757ca8c6f0ac58ca551 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 09:40:36 +1100 Subject: [PATCH 4/8] chore: adaptations for nightly-2024-03-19 (#703) --- Std.lean | 1 - Std/CodeAction/Attr.lean | 2 +- Std/CodeAction/Deprecated.lean | 4 +- Std/Data/List/Perm.lean | 3 +- Std/Logic.lean | 3 -- Std/Tactic/Alias.lean | 4 +- Std/Tactic/Lint/Basic.lean | 6 ++- Std/Tactic/OpenPrivate.lean | 2 +- Std/Tactic/PrintDependents.lean | 4 +- Std/Tactic/Relation/Rfl.lean | 78 --------------------------------- lean-toolchain | 2 +- test/rfl.lean | 3 +- 12 files changed, 17 insertions(+), 95 deletions(-) delete mode 100644 Std/Tactic/Relation/Rfl.lean diff --git a/Std.lean b/Std.lean index 4141189d59..b7cbdd26d7 100644 --- a/Std.lean +++ b/Std.lean @@ -93,7 +93,6 @@ import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix -import Std.Tactic.Relation.Rfl import Std.Tactic.SeqFocus import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index f748450e7d..ad5e0f62d3 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -124,7 +124,7 @@ initialize if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticSeqCodeActionExt.addEntry · (decl, ← mkTacticSeqCodeAction decl)) else - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo + let args ← args.mapM realizeGlobalConstNoOverloadWithInfo if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () diff --git a/Std/CodeAction/Deprecated.lean b/Std/CodeAction/Deprecated.lean index 132edd575b..e17ed8b2f0 100644 --- a/Std/CodeAction/Deprecated.lean +++ b/Std/CodeAction/Deprecated.lean @@ -29,8 +29,8 @@ def deprecatedCodeActionProvider : CodeActionProvider := fun params snap => do let mut i := 0 let doc ← readDoc let mut msgs := #[] - for diag in snap.interactiveDiags do - if let some #[.deprecated] := diag.tags? then + for m in snap.msgLog.msgs do + if m.data.isDeprecationWarning then if h : _ then msgs := msgs.push (snap.cmdState.messages.msgs[i]'h) i := i + 1 diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index aa382e3ad4..2438d0f0f5 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -4,9 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias -import Std.Tactic.Relation.Rfl import Std.Data.List.Init.Attach import Std.Data.List.Pairwise +-- Adaptation note: nightly-2024-03-18. We should be able to remove this after nightly-2024-03-19. +import Lean.Elab.Tactic.Rfl /-! # List Permutations diff --git a/Std/Logic.lean b/Std/Logic.lean index e7703371ff..1069b48c75 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -32,9 +32,6 @@ end Classical theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩ -theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : HEq hp hq := by - cases propext (iff_of_true hp hq); rfl - @[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 diff --git a/Std/Tactic/Alias.lean b/Std/Tactic/Alias.lean index 87bbf2aba4..0be46ea599 100644 --- a/Std/Tactic/Alias.lean +++ b/Std/Tactic/Alias.lean @@ -79,7 +79,7 @@ def setDeprecatedTarget (target : Name) (arr : Array Attribute) : Array Attribut -/ elab (name := alias) mods:declModifiers "alias " alias:ident " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let cinfo ← getConstInfo name let declMods ← elabModifiers mods let (attrs, machineApplicable) := setDeprecatedTarget name declMods.attrs @@ -164,7 +164,7 @@ private def addSide (mp : Bool) (declName : Name) (declMods : Modifiers) (thm : elab (name := aliasLR) mods:declModifiers "alias " "⟨" aliasFwd:binderIdent ", " aliasRev:binderIdent "⟩" " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let declMods ← elabModifiers mods let declMods := { declMods with attrs := (setDeprecatedTarget name declMods.attrs).1 } let .thmInfo thm ← getConstInfo name | throwError "Target must be a theorem" diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index a14cea4afd..31ed595743 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -34,16 +34,18 @@ expansion. def isAutoDecl (decl : Name) : CoreM Bool := do if decl.hasMacroScopes then return true if decl.isInternal then return true + let env ← getEnv + if isReservedName env decl then return true if let Name.str n s := decl then if s.startsWith "proof_" || s.startsWith "match_" || s.startsWith "unsafe_" then return true - if (← getEnv).isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then + if env.isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then return true if let ConstantInfo.inductInfo _ := (← getEnv).find? n then if [casesOnSuffix, recOnSuffix, brecOnSuffix, binductionOnSuffix, belowSuffix, "ibelow", "ndrec", "ndrecOn", "noConfusionType", "noConfusion", "ofNat", "toCtorIdx" ].any (· == s) then return true - if let some _ := isSubobjectField? (← getEnv) n s then + if let some _ := isSubobjectField? env n s then return true pure false diff --git a/Std/Tactic/OpenPrivate.lean b/Std/Tactic/OpenPrivate.lean index 0d3686a264..7ade0b94d9 100644 --- a/Std/Tactic/OpenPrivate.lean +++ b/Std/Tactic/OpenPrivate.lean @@ -49,7 +49,7 @@ def elabOpenPrivateLike (ids : Array Ident) (tgts mods : Option (Array Ident)) (f : (priv full user : Name) → CommandElabM Name) : CommandElabM Unit := do let mut names := NameSet.empty for tgt in tgts.getD #[] do - let n ← resolveGlobalConstNoOverloadWithInfo tgt + let n ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo tgt names ← Meta.collectPrivateIn n names for mod in mods.getD #[] do let some modIdx := (← getEnv).moduleIdxForModule? mod.getId diff --git a/Std/Tactic/PrintDependents.lean b/Std/Tactic/PrintDependents.lean index 007bb6c7a0..3234456a63 100644 --- a/Std/Tactic/PrintDependents.lean +++ b/Std/Tactic/PrintDependents.lean @@ -16,7 +16,7 @@ of all theorems directly referenced that are "to blame" for this dependency. Use unexpected dependencies. -/ namespace Std.Tactic -open Lean Elab +open Lean Elab Command namespace CollectDependents @@ -88,7 +88,7 @@ theorem bar' : 1 = 1 ∨ 1 ≠ 1 := foo -/ elab tk:"#print" &"dependents" ids:(ppSpace colGt ident)* : command => do let env ← getEnv - let ids ← ids.mapM fun c => return (← resolveGlobalConstNoOverloadWithInfo c, true) + let ids ← ids.mapM fun c => return (← liftCoreM <| realizeGlobalConstNoOverloadWithInfo c, true) let init := CollectDependents.mkState ids false let mut state := init let mut out := #[] diff --git a/Std/Tactic/Relation/Rfl.lean b/Std/Tactic/Relation/Rfl.lean deleted file mode 100644 index 13a1c7d4c4..0000000000 --- a/Std/Tactic/Relation/Rfl.lean +++ /dev/null @@ -1,78 +0,0 @@ -/- -Copyright (c) 2022 Newell Jensen. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Newell Jensen, Thomas Murrills --/ -import Lean.Meta.Tactic.Apply -import Lean.Elab.Tactic.Basic - -/-! -# `rfl` tactic extension for reflexive relations - -This extends the `rfl` tactic so that it works on any reflexive relation, -provided the reflexivity lemma has been marked as `@[refl]`. --/ - -namespace Std.Tactic - -open Lean Meta - -/-- Discrimation tree settings for the `refl` extension. -/ -def reflExt.config : WhnfCoreConfig := {} - -/-- Environment extensions for `refl` lemmas -/ -initialize reflExt : - SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← - registerSimpleScopedEnvExtension { - addEntry := fun dt (n, ks) => dt.insertCore ks n - initial := {} - } - -initialize registerBuiltinAttribute { - name := `refl - descr := "reflexivity relation" - add := fun decl _ kind => MetaM.run' do - let declTy := (← getConstInfo decl).type - let (_, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy - let fail := throwError - "@[refl] attribute only applies to lemmas proving x ∼ x, got {declTy}" - let .app (.app rel lhs) rhs := targetTy | fail - unless ← withNewMCtxDepth <| isDefEq lhs rhs do fail - let key ← DiscrTree.mkPath rel reflExt.config - reflExt.add (decl, key) kind -} - -open Elab Tactic - -/-- `MetaM` version of the `rfl` tactic. - -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -def _root_.Lean.MVarId.applyRfl (goal : MVarId) : MetaM Unit := do - let .app (.app rel _) _ ← whnfR <|← instantiateMVars <|← goal.getType - | throwError "reflexivity lemmas only apply to binary relations, not{ - indentExpr (← goal.getType)}" - let s ← saveState - let mut ex? := none - for lem in ← (reflExt.getState (← getEnv)).getMatch rel reflExt.config do - try - let gs ← goal.apply (← mkConstWithFreshMVarLevels lem) - if gs.isEmpty then return () else - logError <| MessageData.tagged `Tactic.unsolvedGoals <| m!"unsolved goals\n{ - goalsToMessageData gs}" - catch e => - ex? := ex? <|> (some (← saveState, e)) -- stash the first failure of `apply` - s.restore - if let some (sErr, e) := ex? then - sErr.restore - throw e - else - throwError "rfl failed, no lemma with @[refl] applies" - -/-- -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -elab_rules : tactic - | `(tactic| rfl) => withMainContext do liftMetaFinishingTactic (·.applyRfl) diff --git a/lean-toolchain b/lean-toolchain index c532a09f53..5e613f5757 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-13 +leanprover/lean4:nightly-2024-03-19 diff --git a/test/rfl.lean b/test/rfl.lean index 8d2383785d..b9bb0db0ee 100644 --- a/test/rfl.lean +++ b/test/rfl.lean @@ -1,4 +1,5 @@ -import Std.Tactic.Relation.Rfl +import Lean.Elab.Tactic.Rfl +-- Adaptation note: we should be able to remove this import after nightly-2024-03-19 set_option linter.missingDocs false From 015ec0ded403d3b8a3221cd0ab8fc40e07f38929 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 2 Apr 2024 09:17:57 +1100 Subject: [PATCH 5/8] fix --- Std/Data/List/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 35f1ada533..924ad6d430 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -7,6 +7,7 @@ import Std.Control.ForInStep.Lemmas import Std.Data.Nat.Basic import Std.Data.List.Basic import Std.Tactic.Init +import Std.Tactic.Alias namespace List @@ -925,7 +926,6 @@ theorem get_take' (L : List α) {j i} : theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by induction n generalizing l m with | zero => - simp only [Nat.zero_eq] at h exact absurd h (Nat.not_lt_of_le m.zero_le) | succ _ hn => cases l with From 6d707f7c4d5c56495292637d5cefb0f4f691e8bc Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 2 Apr 2024 09:27:11 +1100 Subject: [PATCH 6/8] chore: adaptations for nightly-2024-04-01 (#721) * chore: adaptations for nightly-2024-04-01 * whitespace --- Std/Data/Array/Lemmas.lean | 24 ++-- Std/Data/List/Basic.lean | 244 ------------------------------------- Std/Data/List/Lemmas.lean | 2 +- Std/Tactic/Where.lean | 2 +- lean-toolchain | 2 +- scripts/check_imports.lean | 2 +- test/print_prefix.lean | 14 +-- 7 files changed, 22 insertions(+), 268 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index ada732af64..afd71f84f0 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -18,12 +18,6 @@ import Std.Util.ProofWanted @[simp] theorem getElem!_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl -theorem getElem?_pos [GetElem Cont Idx Elem Dom] - (a : Cont) (i : Idx) (h : Dom a i) [Decidable (Dom a i)] : a[i]? = a[i] := dif_pos h - -theorem getElem?_neg [GetElem Cont Idx Elem Dom] - (a : Cont) (i : Idx) (h : ¬Dom a i) [Decidable (Dom a i)] : a[i]? = none := dif_neg h - @[simp] theorem mkArray_data (n : Nat) (v : α) : (mkArray n v).data = List.replicate n v := rfl @[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) : @@ -91,13 +85,19 @@ theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := b rw [getElem?_pos, get_push_eq] theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by - split - . next heq => rw [heq, getElem?_pos, get_push_eq] - · next hne => + match Nat.lt_trichotomy i a.size with + | Or.inl g => + have h1 : i < a.size + 1 := by omega + have h2 : i ≠ a.size := by omega + simp [getElem?, size_push, g, h1, h2, get_push_lt] + | Or.inr (Or.inl heq) => + simp [heq, getElem?_pos, get_push_eq] + | Or.inr (Or.inr g) => simp only [getElem?, size_push] - split <;> split <;> try simp only [*, get_push_lt] - · next p q => exact Or.elim (Nat.eq_or_lt_of_le (Nat.le_of_lt_succ p)) hne q - · next p q => exact p (Nat.lt.step q) + have h1 : ¬ (i < a.size) := by omega + have h2 : ¬ (i < a.size + 1) := by omega + have h3 : i ≠ a.size := by omega + simp [h1, h2, h3] @[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by simp only [getElem?, Nat.lt_irrefl, dite_false] diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index c29dc224e9..d36dd9a897 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -6,250 +6,6 @@ Authors: Leonardo de Moura namespace List -/-! ## Tail recursive implementations for definitions from core -/ - -/-- Tail recursive version of `erase`. -/ -@[inline] def setTR (l : List α) (n : Nat) (a : α) : List α := go l n #[] where - /-- Auxiliary for `setTR`: `setTR.go l a xs n acc = acc.toList ++ set xs a`, - unless `n ≥ l.length` in which case it returns `l` -/ - go : List α → Nat → Array α → List α - | [], _, _ => l - | _::xs, 0, acc => acc.toListAppend (a::xs) - | x::xs, n+1, acc => go xs n (acc.push x) - -@[csimp] theorem set_eq_setTR : @set = @setTR := by - funext α l n a; simp [setTR] - let rec go (acc) : ∀ xs n, l = acc.data ++ xs → - setTR.go l a xs n acc = acc.data ++ xs.set n a - | [], _ => fun h => by simp [setTR.go, set, h] - | x::xs, 0 => by simp [setTR.go, set] - | x::xs, n+1 => fun h => by simp [setTR.go, set]; rw [go _ xs]; {simp}; simp [h] - exact (go #[] _ _ rfl).symm - -/-- Tail recursive version of `erase`. -/ -@[inline] def eraseTR [BEq α] (l : List α) (a : α) : List α := go l #[] where - /-- Auxiliary for `eraseTR`: `eraseTR.go l a xs acc = acc.toList ++ erase xs a`, - unless `a` is not present in which case it returns `l` -/ - go : List α → Array α → List α - | [], _ => l - | x::xs, acc => bif x == a then acc.toListAppend xs else go xs (acc.push x) - -@[csimp] theorem erase_eq_eraseTR : @List.erase = @eraseTR := by - funext α _ l a; simp [eraseTR] - suffices ∀ xs acc, l = acc.data ++ xs → eraseTR.go l a xs acc = acc.data ++ xs.erase a from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc h - | nil => simp [List.erase, eraseTR.go, h] - | cons x xs IH => - simp [List.erase, eraseTR.go] - cases x == a <;> simp - · rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `eraseIdx`. -/ -@[inline] def eraseIdxTR (l : List α) (n : Nat) : List α := go l n #[] where - /-- Auxiliary for `eraseIdxTR`: `eraseIdxTR.go l n xs acc = acc.toList ++ eraseIdx xs a`, - unless `a` is not present in which case it returns `l` -/ - go : List α → Nat → Array α → List α - | [], _, _ => l - | _::as, 0, acc => acc.toListAppend as - | a::as, n+1, acc => go as n (acc.push a) - -@[csimp] theorem eraseIdx_eq_eraseIdxTR : @eraseIdx = @eraseIdxTR := by - funext α l n; simp [eraseIdxTR] - suffices ∀ xs acc, l = acc.data ++ xs → eraseIdxTR.go l xs n acc = acc.data ++ xs.eraseIdx n from - (this l #[] (by simp)).symm - intro xs; induction xs generalizing n with intro acc h - | nil => simp [eraseIdx, eraseIdxTR.go, h] - | cons x xs IH => - match n with - | 0 => simp [eraseIdx, eraseIdxTR.go] - | n+1 => - simp [eraseIdx, eraseIdxTR.go] - rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `bind`. -/ -@[inline] def bindTR (as : List α) (f : α → List β) : List β := go as #[] where - /-- Auxiliary for `bind`: `bind.go f as = acc.toList ++ bind f as` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | x::xs, acc => go xs (acc ++ f x) - -@[csimp] theorem bind_eq_bindTR : @List.bind = @bindTR := by - funext α β as f - let rec go : ∀ as acc, bindTR.go f as acc = acc.data ++ as.bind f - | [], acc => by simp [bindTR.go, bind] - | x::xs, acc => by simp [bindTR.go, bind, go xs] - exact (go as #[]).symm - -/-- Tail recursive version of `join`. -/ -@[inline] def joinTR (l : List (List α)) : List α := bindTR l id - -@[csimp] theorem join_eq_joinTR : @join = @joinTR := by - funext α l; rw [← List.bind_id, List.bind_eq_bindTR]; rfl - -/-- Tail recursive version of `filterMap`. -/ -@[inline] def filterMapTR (f : α → Option β) (l : List α) : List β := go l #[] where - /-- Auxiliary for `filterMap`: `filterMap.go f l = acc.toList ++ filterMap f l` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | a::as, acc => match f a with - | none => go as acc - | some b => go as (acc.push b) - -@[csimp] theorem filterMap_eq_filterMapTR : @List.filterMap = @filterMapTR := by - funext α β f l - let rec go : ∀ as acc, filterMapTR.go f as acc = acc.data ++ as.filterMap f - | [], acc => by simp [filterMapTR.go, filterMap] - | a::as, acc => by simp [filterMapTR.go, filterMap, go as]; split <;> simp [*] - exact (go l #[]).symm - -/-- Tail recursive version of `replace`. -/ -@[inline] def replaceTR [BEq α] (l : List α) (b c : α) : List α := go l #[] where - /-- Auxiliary for `replace`: `replace.go l b c xs acc = acc.toList ++ replace xs b c`, - unless `b` is not found in `xs` in which case it returns `l`. -/ - @[specialize] go : List α → Array α → List α - | [], _ => l - | a::as, acc => bif a == b then acc.toListAppend (c::as) else go as (acc.push a) - -@[csimp] theorem replace_eq_replaceTR : @List.replace = @replaceTR := by - funext α _ l b c; simp [replaceTR] - suffices ∀ xs acc, l = acc.data ++ xs → - replaceTR.go l b c xs acc = acc.data ++ xs.replace b c from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc - | nil => simp [replace, replaceTR.go] - | cons x xs IH => - simp [replace, replaceTR.go]; split <;> simp [*] - · intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `take`. -/ -@[inline] def takeTR (n : Nat) (l : List α) : List α := go l n #[] where - /-- Auxiliary for `take`: `take.go l xs n acc = acc.toList ++ take n xs`, - unless `n ≥ xs.length` in which case it returns `l`. -/ - @[specialize] go : List α → Nat → Array α → List α - | [], _, _ => l - | _::_, 0, acc => acc.toList - | a::as, n+1, acc => go as n (acc.push a) - -@[csimp] theorem take_eq_takeTR : @take = @takeTR := by - funext α n l; simp [takeTR] - suffices ∀ xs acc, l = acc.data ++ xs → takeTR.go l xs n acc = acc.data ++ xs.take n from - (this l #[] (by simp)).symm - intro xs; induction xs generalizing n with intro acc - | nil => cases n <;> simp [take, takeTR.go] - | cons x xs IH => - cases n with simp [take, takeTR.go] - | succ n => intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `takeWhile`. -/ -@[inline] def takeWhileTR (p : α → Bool) (l : List α) : List α := go l #[] where - /-- Auxiliary for `takeWhile`: `takeWhile.go p l xs acc = acc.toList ++ takeWhile p xs`, - unless no element satisfying `p` is found in `xs` in which case it returns `l`. -/ - @[specialize] go : List α → Array α → List α - | [], _ => l - | a::as, acc => bif p a then go as (acc.push a) else acc.toList - -@[csimp] theorem takeWhile_eq_takeWhileTR : @takeWhile = @takeWhileTR := by - funext α p l; simp [takeWhileTR] - suffices ∀ xs acc, l = acc.data ++ xs → - takeWhileTR.go p l xs acc = acc.data ++ xs.takeWhile p from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc - | nil => simp [takeWhile, takeWhileTR.go] - | cons x xs IH => - simp [takeWhile, takeWhileTR.go]; split <;> simp [*] - · intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `foldr`. -/ -@[specialize] def foldrTR (f : α → β → β) (init : β) (l : List α) : β := l.toArray.foldr f init - -@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by - funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_data, -Array.size_toArray] - -/-- Tail recursive version of `zipWith`. -/ -@[inline] def zipWithTR (f : α → β → γ) (as : List α) (bs : List β) : List γ := go as bs #[] where - /-- Auxiliary for `zipWith`: `zipWith.go f as bs acc = acc.toList ++ zipWith f as bs` -/ - go : List α → List β → Array γ → List γ - | a::as, b::bs, acc => go as bs (acc.push (f a b)) - | _, _, acc => acc.toList - -@[csimp] theorem zipWith_eq_zipWithTR : @zipWith = @zipWithTR := by - funext α β γ f as bs - let rec go : ∀ as bs acc, zipWithTR.go f as bs acc = acc.data ++ as.zipWith f bs - | [], _, acc | _::_, [], acc => by simp [zipWithTR.go, zipWith] - | a::as, b::bs, acc => by simp [zipWithTR.go, zipWith, go as bs] - exact (go as bs #[]).symm - -/-- Tail recursive version of `unzip`. -/ -def unzipTR (l : List (α × β)) : List α × List β := - l.foldr (fun (a, b) (al, bl) => (a::al, b::bl)) ([], []) - -@[csimp] theorem unzip_eq_unzipTR : @unzip = @unzipTR := by - funext α β l; simp [unzipTR]; induction l <;> simp [*] - -/-- Tail recursive version of `enumFrom`. -/ -def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := - let arr := l.toArray - (arr.foldr (fun a (n, acc) => (n-1, (n-1, a) :: acc)) (n + arr.size, [])).2 - -@[csimp] theorem enumFrom_eq_enumFromTR : @enumFrom = @enumFromTR := by - funext α n l; simp [enumFromTR, -Array.size_toArray] - let f := fun (a : α) (n, acc) => (n-1, (n-1, a) :: acc) - let rec go : ∀ l n, l.foldr f (n + l.length, []) = (n, enumFrom n l) - | [], n => rfl - | a::as, n => by - rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] - simp [enumFrom, f] - rw [Array.foldr_eq_foldr_data] - simp [go] - -theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc - | 0 => rfl - | n+1 => by rw [← replicateTR_loop_replicate_eq _ 1 n, replicate, replicate, - replicateTR.loop, replicateTR_loop_eq n, replicateTR_loop_eq n, append_assoc]; rfl - -/-- Tail recursive version of `dropLast`. -/ -@[inline] def dropLastTR (l : List α) : List α := l.toArray.pop.toList - -@[csimp] theorem dropLast_eq_dropLastTR : @dropLast = @dropLastTR := by - funext α l; simp [dropLastTR] - -/-- Tail recursive version of `intersperse`. -/ -def intersperseTR (sep : α) : List α → List α - | [] => [] - | [x] => [x] - | x::y::xs => x :: sep :: y :: xs.foldr (fun a r => sep :: a :: r) [] - -@[csimp] theorem intersperse_eq_intersperseTR : @intersperse = @intersperseTR := by - funext α sep l; simp [intersperseTR] - match l with - | [] | [_] => rfl - | x::y::xs => simp [intersperse]; induction xs generalizing y <;> simp [*] - -/-- Tail recursive version of `intercalate`. -/ -def intercalateTR (sep : List α) : List (List α) → List α - | [] => [] - | [x] => x - | x::xs => go sep.toArray x xs #[] -where - /-- Auxiliary for `intercalateTR`: - `intercalateTR.go sep x xs acc = acc.toList ++ intercalate sep.toList (x::xs)` -/ - go (sep : Array α) : List α → List (List α) → Array α → List α - | x, [], acc => acc.toListAppend x - | x, y::xs, acc => go sep y xs (acc ++ x ++ sep) - -@[csimp] theorem intercalate_eq_intercalateTR : @intercalate = @intercalateTR := by - funext α sep l; simp [intercalate, intercalateTR] - match l with - | [] => rfl - | [_] => simp - | x::y::xs => - let rec go {acc x} : ∀ xs, - intercalateTR.go sep.toArray x xs acc = acc.data ++ join (intersperse sep (x::xs)) - | [] => by simp [intercalateTR.go] - | _::_ => by simp [intercalateTR.go, go] - simp [intersperse, go] - /-! ## New definitions -/ /-- diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 924ad6d430..1d1b2a5a71 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -753,7 +753,7 @@ theorem get?_zero (l : List α) : l.get? 0 = l.head? := by cases l <;> rfl @[simp] theorem getElem_eq_get (l : List α) (i : Nat) (h) : l[i]'h = l.get ⟨i, h⟩ := rfl @[simp] theorem getElem?_eq_get? (l : List α) (i : Nat) : l[i]? = l.get? i := by - unfold getElem?; split + simp only [getElem?]; split · exact (get?_eq_get ‹_›).symm · exact (get?_eq_none.2 <| Nat.not_lt.1 ‹_›).symm diff --git a/Std/Tactic/Where.lean b/Std/Tactic/Where.lean index 367670e49c..5a3cbbbfa3 100644 --- a/Std/Tactic/Where.lean +++ b/Std/Tactic/Where.lean @@ -35,7 +35,7 @@ private def describeOpenDecls (ds : List OpenDecl) : MessageData := Id.run do (lines, simple) := flush lines simple let ex' := ex.map toMessageData lines := lines.push m!"open {ns} hiding {MessageData.joinSep ex' ", "}" - (lines, simple) := flush lines simple + (lines, _) := flush lines simple return MessageData.joinSep lines.toList "\n" private def describeOptions (opts : Options) : CommandElabM (Option MessageData) := do diff --git a/lean-toolchain b/lean-toolchain index 5e613f5757..4610193327 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-19 +leanprover/lean4:nightly-2024-04-01 diff --git a/scripts/check_imports.lean b/scripts/check_imports.lean index 2023954e45..048981bba0 100644 --- a/scripts/check_imports.lean +++ b/scripts/check_imports.lean @@ -82,7 +82,7 @@ def checkMissingImports (modName : Name) (modData : ModuleData) (reqImports : Ar def checkStdDataDir (modMap : HashMap Name ModuleData) (entry : IO.FS.DirEntry) (autofix : Bool := false) : LogIO Unit := do - let moduleName := `Std.Data ++ entry.fileName + let moduleName := `Std.Data ++ .mkSimple entry.fileName let requiredImports ← addModulesIn (recurse := true) #[] (root := moduleName) entry.path let .some module := modMap.find? moduleName | warn true s!"Could not find {moduleName}; Not imported into Std." diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 9f742b382a..a506e926c6 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -133,17 +133,15 @@ testMatchProof._unsafe_rec : (n : Nat) → Fin n → Unit testMatchProof.match_1 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n { val := 0, isLt := isLt }) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) { val := Nat.succ i, isLt := h }) → - motive x x_1 + ((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 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n { val := 0, isLt := isLt }) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) { val := Nat.succ i, isLt := h }) → - motive x x_1 -testMatchProof.proof_1 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as -testMatchProof.proof_2 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as + ((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.proof_1 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as +testMatchProof.proof_2 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as -/ #guard_msgs in #print prefix (config:={internals:=true}) testMatchProof From dc4c58b8c90df6f88a3bbb4ac973116bcb822833 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 23 Apr 2024 10:48:15 +1000 Subject: [PATCH 7/8] chore: adaptations for nightly-2024-04-22 --- .docker/gitpod/Dockerfile | 41 ++++++++ .gitpod.yml | 6 ++ Std.lean | 2 +- Std/Classes/Order.lean | 6 ++ Std/Data/Array.lean | 1 + Std/Data/Array/Basic.lean | 26 +++-- Std/Data/Array/Init/Lemmas.lean | 47 +++++++++ Std/Data/Array/Lemmas.lean | 37 ------- Std/Data/ByteArray.lean | 1 + Std/Data/Fin/Lemmas.lean | 11 +- Std/Data/HashMap/Basic.lean | 170 +++++++++++++++++++++++++++---- Std/Data/List.lean | 1 + Std/Data/List/Basic.lean | 14 +-- Std/Data/List/Count.lean | 1 - Std/Data/List/Init/Attach.lean | 36 ++++--- Std/Data/List/Init/Lemmas.lean | 39 +++++++ Std/Data/List/Lemmas.lean | 128 ++++++++++++----------- Std/Data/List/Perm.lean | 33 +++--- Std/Data/RBMap/Alter.lean | 102 ------------------- Std/Data/RBMap/Basic.lean | 43 +++++--- Std/Data/RBMap/Lemmas.lean | 142 ++++++++++++++++++++++++++ Std/Data/RBMap/WF.lean | 131 ++++++++++++++++-------- Std/Data/String/Lemmas.lean | 6 ++ Std/Data/Sum/Lemmas.lean | 5 + Std/Data/UInt.lean | 21 ++-- Std/Lean/PersistentHashMap.lean | 6 -- Std/Logic.lean | 3 + Std/Tactic/Classical.lean | 20 +++- Std/Tactic/FalseOrByContra.lean | 65 ------------ Std/Tactic/PrintPrefix.lean | 107 +++++++++---------- Std/Tactic/ShowUnused.lean | 73 +++++++++++++ Std/Tactic/SqueezeScope.lean | 2 +- lean-toolchain | 2 +- test/case.lean | 9 +- test/false_or_by_contra.lean | 53 ---------- test/isIndependentOf.lean | 4 +- test/lintTC.lean | 5 +- test/lint_unreachableTactic.lean | 5 +- test/print_prefix.lean | 128 ++++++++++++----------- test/show_unused.lean | 14 +++ test/simpa.lean | 10 +- 41 files changed, 948 insertions(+), 608 deletions(-) create mode 100644 .docker/gitpod/Dockerfile create mode 100644 .gitpod.yml create mode 100644 Std/Data/Array/Init/Lemmas.lean create mode 100644 Std/Data/List/Init/Lemmas.lean delete mode 100644 Std/Tactic/FalseOrByContra.lean create mode 100644 Std/Tactic/ShowUnused.lean delete mode 100644 test/false_or_by_contra.lean create mode 100644 test/show_unused.lean diff --git a/.docker/gitpod/Dockerfile b/.docker/gitpod/Dockerfile new file mode 100644 index 0000000000..ededb0b68a --- /dev/null +++ b/.docker/gitpod/Dockerfile @@ -0,0 +1,41 @@ +# This is the Dockerfile for leanprover/std4 +# This file is mostly copied from [mathlib4](https://github.com/leanprover-community/mathlib4/blob/master/.docker/gitpod/Dockerfile) + +# gitpod doesn't support multiple FROM statements, (or rather, you can't copy from one to another) +# so we just install everything in one go +FROM ubuntu:jammy + +USER root + +RUN apt-get update && apt-get install sudo git curl bash-completion python3-requests gcc make -y && apt-get clean + +RUN useradd -l -u 33333 -G sudo -md /home/gitpod -s /bin/bash -p gitpod gitpod \ + # passwordless sudo for users in the 'sudo' group + && sed -i.bkp -e 's/%sudo\s\+ALL=(ALL\(:ALL\)\?)\s\+ALL/%sudo ALL=NOPASSWD:ALL/g' /etc/sudoers +USER gitpod +WORKDIR /home/gitpod + +SHELL ["/bin/bash", "-c"] + +# gitpod bash prompt +RUN { echo && echo "PS1='\[\033[01;32m\]\u\[\033[00m\] \[\033[01;34m\]\w\[\033[00m\]\$(__git_ps1 \" (%s)\") $ '" ; } >> .bashrc + +# install elan +RUN curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- -y --default-toolchain none + +# install whichever toolchain std4 is currently using +RUN . ~/.profile && elan toolchain install $(curl https://raw.githubusercontent.com/leanprover/std4/main/lean-toolchain) + +# install neovim (for any lean.nvim user), via tarball since the appimage doesn't work for some reason, and jammy's version is ancient +RUN curl -s -L https://github.com/neovim/neovim/releases/download/stable/nvim-linux64.tar.gz | tar xzf - && sudo mv nvim-linux64 /opt/nvim + +ENV PATH="/home/gitpod/.local/bin:/home/gitpod/.elan/bin:/opt/nvim/bin:${PATH}" + +# fix the infoview when the container is used on gitpod: +ENV VSCODE_API_VERSION="1.50.0" + +# ssh to github once to bypass the unknown fingerprint warning +RUN ssh -o StrictHostKeyChecking=no github.com || true + +# run sudo once to suppress usage info +RUN sudo echo finished diff --git a/.gitpod.yml b/.gitpod.yml new file mode 100644 index 0000000000..5170403ac3 --- /dev/null +++ b/.gitpod.yml @@ -0,0 +1,6 @@ +image: + file: .docker/gitpod/Dockerfile + +vscode: + extensions: + - leanprover.lean4 diff --git a/Std.lean b/Std.lean index b7cbdd26d7..1063d08efc 100644 --- a/Std.lean +++ b/Std.lean @@ -79,7 +79,6 @@ import Std.Tactic.Case import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact -import Std.Tactic.FalseOrByContra import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.Lint @@ -94,6 +93,7 @@ import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.SeqFocus +import Std.Tactic.ShowUnused import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index fcf0e23bf0..b3024c4bcd 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -88,6 +88,12 @@ theorem cmp_congr_right [TransCmp cmp] (yz : cmp y z = .eq) : cmp x y = cmp x z end TransCmp +instance [inst : OrientedCmp cmp] : OrientedCmp (flip cmp) where + symm _ _ := inst.symm .. + +instance [inst : TransCmp cmp] : TransCmp (flip cmp) where + le_trans h1 h2 := inst.le_trans h2 h1 + end Std namespace Ordering diff --git a/Std/Data/Array.lean b/Std/Data/Array.lean index 22f2f38305..3291a67387 100644 --- a/Std/Data/Array.lean +++ b/Std/Data/Array.lean @@ -1,4 +1,5 @@ import Std.Data.Array.Basic +import Std.Data.Array.Init.Lemmas import Std.Data.Array.Lemmas import Std.Data.Array.Match import Std.Data.Array.Merge diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index c000df3524..d0c937f1a9 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -130,15 +130,21 @@ protected def maxI [ord : Ord α] [Inhabited α] xs.minI (ord := ord.opposite) start stop /-- -Unsafe implementation of `attach`, taking advantage of the fact that the representation of -`Array {x // x ∈ xs}` is the same as the input `Array α`. +Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of +`Array {x // P x}` is the same as the input `Array α`. -/ -@[inline] private unsafe def attachImpl (xs : Array α) : Array {x // x ∈ xs} := unsafeCast xs +@[inline] private unsafe def attachWithImpl + (xs : Array α) (P : α → Prop) (_ : ∀ x ∈ xs, P x) : Array {x // P x} := unsafeCast xs -/-- "Attach" the proof that the elements of `xs` are in `xs` to produce a new list +/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `xs` to produce a new array + with the same elements but in the type `{x // P x}`. -/ +@[implemented_by attachWithImpl] def attachWith + (xs : Array α) (P : α → Prop) (H : ∀ x ∈ xs, P x) : Array {x // P x} := + ⟨xs.data.attachWith P fun x h => H x (Array.Mem.mk h)⟩ + +/-- `O(1)`. "Attach" the proof that the elements of `xs` are in `xs` to produce a new array with the same elements but in the type `{x // x ∈ xs}`. -/ -@[implemented_by attachImpl] def attach (xs : Array α) : Array {x // x ∈ xs} := - ⟨xs.data.pmap Subtype.mk fun _ => Array.Mem.mk⟩ +@[inline] def attach (xs : Array α) : Array {x // x ∈ xs} := xs.attachWith _ fun _ => id /-- `O(|join L|)`. `join L` concatenates all the arrays in `L` into one array. @@ -155,11 +161,11 @@ namespace Subarray The empty subarray. -/ protected def empty : Subarray α where - as := #[] + array := #[] start := 0 stop := 0 - h₁ := Nat.le_refl 0 - h₂ := Nat.le_refl 0 + start_le_stop := Nat.le_refl 0 + stop_le_array_size := Nat.le_refl 0 instance : EmptyCollection (Subarray α) := ⟨Subarray.empty⟩ @@ -192,7 +198,7 @@ def popHead? (as : Subarray α) : Option (α × Subarray α) := let tail := { as with start := as.start + 1 - h₁ := Nat.le_of_lt_succ $ Nat.succ_lt_succ h } + start_le_stop := Nat.le_of_lt_succ $ Nat.succ_lt_succ h } some (head, tail) else none diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean new file mode 100644 index 0000000000..443254f4d4 --- /dev/null +++ b/Std/Data/Array/Init/Lemmas.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2021 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. + +Authors: Mario Carneiro, Gabriel Ebner +-/ + +/-! # Bootstrapping properties of Arrays -/ + +namespace Array + +@[simp] theorem size_ofFn_go {n} (f : Fin n → α) (i acc) : + (ofFn.go f i acc).size = acc.size + (n - i) := by + if hin : i < n then + unfold ofFn.go + have : 1 + (n - (i + 1)) = n - i := + Nat.sub_sub .. ▸ Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. ▸ hin)) + rw [dif_pos hin, size_ofFn_go f (i+1), size_push, Nat.add_assoc, this] + else + have : n - i = 0 := Nat.sub_eq_zero_of_le (Nat.le_of_not_lt hin) + unfold ofFn.go + simp [hin, this] +termination_by n - i + +@[simp] theorem size_ofFn (f : Fin n → α) : (ofFn f).size = n := by simp [ofFn] + +theorem getElem_ofFn_go (f : Fin n → α) (i) {acc k} + (hki : k < n) (hin : i ≤ n) (hi : i = acc.size) + (hacc : ∀ j, ∀ hj : j < acc.size, acc[j] = f ⟨j, Nat.lt_of_lt_of_le hj (hi ▸ hin)⟩) : + haveI : acc.size + (n - acc.size) = n := Nat.add_sub_cancel' (hi ▸ hin) + (ofFn.go f i acc)[k]'(by simp [*]) = f ⟨k, hki⟩ := by + unfold ofFn.go + if hin : i < n then + have : 1 + (n - (i + 1)) = n - i := + Nat.sub_sub .. ▸ Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. ▸ hin)) + simp only [dif_pos hin] + rw [getElem_ofFn_go f (i+1) _ hin (by simp [*]) (fun j hj => ?hacc)] + cases (Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ (by simpa using hj)) with + | inl hj => simp [get_push, hj, hacc j hj] + | inr hj => simp [get_push, *] + else + simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi ▸ hin)))] +termination_by n - i + +@[simp] theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h) : + (ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ := + getElem_ofFn_go _ _ _ (by simp) (by simp) nofun diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index afd71f84f0..f6a82f2e47 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -245,43 +245,6 @@ theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl simp [← show k < _ + 1 ↔ _ from Nat.lt_succ (n := a.size - 1), this] at h rw [List.get?_eq_none.2 ‹_›, List.get?_eq_none.2 (a.data.length_reverse ▸ ‹_›)] -@[simp] theorem size_ofFn_go {n} (f : Fin n → α) (i acc) : - (ofFn.go f i acc).size = acc.size + (n - i) := by - if hin : i < n then - unfold ofFn.go - have : 1 + (n - (i + 1)) = n - i := - Nat.sub_sub .. ▸ Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. ▸ hin)) - rw [dif_pos hin, size_ofFn_go f (i+1), size_push, Nat.add_assoc, this] - else - have : n - i = 0 := Nat.sub_eq_zero_of_le (Nat.le_of_not_lt hin) - unfold ofFn.go - simp [hin, this] -termination_by n - i - -@[simp] theorem size_ofFn (f : Fin n → α) : (ofFn f).size = n := by simp [ofFn] - -theorem getElem_ofFn_go (f : Fin n → α) (i) {acc k} - (hki : k < n) (hin : i ≤ n) (hi : i = acc.size) - (hacc : ∀ j, ∀ hj : j < acc.size, acc[j] = f ⟨j, Nat.lt_of_lt_of_le hj (hi ▸ hin)⟩) : - haveI : acc.size + (n - acc.size) = n := Nat.add_sub_cancel' (hi ▸ hin) - (ofFn.go f i acc)[k]'(by simp [*]) = f ⟨k, hki⟩ := by - unfold ofFn.go - if hin : i < n then - have : 1 + (n - (i + 1)) = n - i := - Nat.sub_sub .. ▸ Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. ▸ hin)) - simp only [dif_pos hin] - rw [getElem_ofFn_go f (i+1) _ hin (by simp [*]) (fun j hj => ?hacc)] - cases (Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ (by simpa using hj)) with - | inl hj => simp [get_push, hj, hacc j hj] - | inr hj => simp [get_push, *] - else - simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi ▸ hin)))] -termination_by n - i - -@[simp] theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h) : - (ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ := - getElem_ofFn_go _ _ _ (by simp) (by simp) nofun - theorem forIn_eq_data_forIn [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : forIn as b f = forIn as.data b f := by diff --git a/Std/Data/ByteArray.lean b/Std/Data/ByteArray.lean index 1a6d6b5df2..dcee0d4948 100644 --- a/Std/Data/ByteArray.lean +++ b/Std/Data/ByteArray.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ +import Std.Data.Array.Init.Lemmas import Std.Data.Array.Lemmas namespace ByteArray diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index f463c64255..244fd5ef3a 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Data.Array.Lemmas +import Std.Data.List.Init.Lemmas +import Std.Data.Array.Init.Lemmas namespace Fin @@ -24,7 +25,7 @@ attribute [norm_cast] val_last @[simp] theorem length_list (n) : (list n).length = n := by simp [list] @[simp] theorem get_list (i : Fin (list n).length) : (list n).get i = i.cast (length_list n) := by - cases i; simp only [list]; rw [←Array.getElem_eq_data_get, getElem_enum, cast_mk] + cases i; simp only [list]; rw [← Array.getElem_eq_data_get, getElem_enum, cast_mk] @[simp] theorem list_zero : list 0 = [] := rfl @@ -55,7 +56,7 @@ 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 foldl_eq_foldl_list (f : α → Fin n → α) (x) : foldl n f x = (list n).foldl f x := by - induction n using Nat.recAux generalizing x with + induction n generalizing x with | zero => rfl | succ n ih => rw [foldl_succ, ih, list_succ, List.foldl_cons, List.foldl_map] @@ -69,7 +70,7 @@ theorem foldr_loop_succ (f : Fin n → α → α) (x) (h : m < n) : 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 using Nat.recAux generalizing x with + induction m generalizing x with | zero => simp [foldr_loop_zero, foldr_loop_succ] | succ m ih => rw [foldr_loop_succ, ih]; rfl @@ -77,6 +78,6 @@ 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_eq_foldr_list (f : Fin n → α → α) (x) : foldr n f x = (list n).foldr f x := by - induction n using Nat.recAux with + induction n with | zero => rfl | succ n ih => rw [foldr_succ, ih, list_succ, List.foldr_cons, List.foldr_map] diff --git a/Std/Data/HashMap/Basic.lean b/Std/Data/HashMap/Basic.lean index 247db447ef..dd45ffd827 100644 --- a/Std/Data/HashMap/Basic.lean +++ b/Std/Data/HashMap/Basic.lean @@ -179,7 +179,7 @@ def erase [BEq α] [Hashable α] (m : Imp α β) (a : α) : Imp α β := let ⟨size, buckets⟩ := m let ⟨i, h⟩ := mkIdx buckets.2 (hash a |>.toUSize) let bkt := buckets.1[i] - bif bkt.contains a then ⟨size - 1, buckets.update i (bkt.erase a) h⟩ else m + bif bkt.contains a then ⟨size - 1, buckets.update i (bkt.erase a) h⟩ else ⟨size, buckets⟩ /-- Map a function over the values in the map. -/ @[inline] def mapVal (f : α → β → γ) (self : Imp α β) : Imp α γ := @@ -262,26 +262,52 @@ instance [BEq α] [Hashable α] : Inhabited (HashMap α β) where instance [BEq α] [Hashable α] : EmptyCollection (HashMap α β) := ⟨mkHashMap⟩ -/-- Make a new empty hash map. -/ +/-- +Make a new empty hash map. +``` +(empty : Std.HashMap Int Int).toList = [] +``` +-/ @[inline] def empty [BEq α] [Hashable α] : HashMap α β := mkHashMap variable {_ : BEq α} {_ : Hashable α} -/-- The number of elements in the hash map. -/ +/-- +The number of elements in the hash map. +``` +(ofList [("one", 1), ("two", 2)]).size = 2 +``` +-/ @[inline] def size (self : HashMap α β) : Nat := self.1.size -/-- Is the map empty? -/ +/-- +Is the map empty? +``` +(empty : Std.HashMap Int Int).isEmpty = true +(ofList [("one", 1), ("two", 2)]).isEmpty = false +``` +-/ @[inline] def isEmpty (self : HashMap α β) : Bool := self.size = 0 /-- Inserts key-value pair `a, b` into the map. If an element equal to `a` is already in the map, it is replaced by `b`. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.insert "three" 3 = {"one" => 1, "two" => 2, "three" => 3} +hashMap.insert "two" 0 = {"one" => 1, "two" => 0} +``` -/ def insert (self : HashMap α β) (a : α) (b : β) : HashMap α β := ⟨self.1.insert a b, self.2.insert⟩ /-- Similar to `insert`, but also returns a boolean flag indicating whether an existing entry has been replaced with `a => b`. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.insert' "three" 3 = ({"one" => 1, "two" => 2, "three" => 3}, false) +hashMap.insert' "two" 0 = ({"one" => 1, "two" => 0}, true) +``` -/ @[inline] def insert' (m : HashMap α β) (a : α) (b : β) : HashMap α β × Bool := let old := m.size @@ -291,43 +317,117 @@ replaced with `a => b`. /-- Removes key `a` from the map. If it does not exist in the map, the map is returned unchanged. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.erase "one" = {"two" => 2} +hashMap.erase "three" = {"one" => 1, "two" => 2} +``` -/ @[inline] def erase (self : HashMap α β) (a : α) : HashMap α β := ⟨self.1.erase a, self.2.erase⟩ /-- Performs an in-place edit of the value, ensuring that the value is used linearly. The function `f` is passed the original key of the entry, along with the value in the map. +``` +(ofList [("one", 1), ("two", 2)]).modify "one" (fun _ v => v + 1) = {"one" => 2, "two" => 2} +(ofList [("one", 1), ("two", 2)]).modify "three" (fun _ v => v + 1) = {"one" => 1, "two" => 2} +``` -/ def modify (self : HashMap α β) (a : α) (f : α → β → β) : HashMap α β := ⟨self.1.modify a f, self.2.modify⟩ -/-- Given a key `a`, returns a key-value pair in the map whose key compares equal to `a`. -/ +/-- +Given a key `a`, returns a key-value pair in the map whose key compares equal to `a`. +Note that the returned key may not be identical to the input, if `==` ignores some part +of the value. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.findEntry? "one" = some ("one", 1) +hashMap.findEntry? "three" = none +``` +-/ @[inline] def findEntry? (self : HashMap α β) (a : α) : Option (α × β) := self.1.findEntry? a -/-- Looks up an element in the map with key `a`. -/ +/-- +Looks up an element in the map with key `a`. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.find? "one" = some 1 +hashMap.find? "three" = none +``` +-/ @[inline] def find? (self : HashMap α β) (a : α) : Option β := self.1.find? a -/-- Looks up an element in the map with key `a`. Returns `b₀` if the element is not found. -/ +/-- +Looks up an element in the map with key `a`. Returns `b₀` if the element is not found. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.findD "one" 0 = 1 +hashMap.findD "three" 0 = 0 +``` +-/ @[inline] def findD (self : HashMap α β) (a : α) (b₀ : β) : β := (self.find? a).getD b₀ -/-- Looks up an element in the map with key `a`. Panics if the element is not found. -/ +/-- +Looks up an element in the map with key `a`. Panics if the element is not found. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.find! "one" = 1 +hashMap.find! "three" => panic! +``` +-/ @[inline] def find! [Inhabited β] (self : HashMap α β) (a : α) : β := (self.find? a).getD (panic! "key is not in the map") instance : GetElem (HashMap α β) α (Option β) fun _ _ => True where getElem m k _ := m.find? k -/-- Returns true if the element `a` is in the map. -/ +/-- +Returns true if the element `a` is in the map. +``` +def hashMap := ofList [("one", 1), ("two", 2)] +hashMap.contains "one" = true +hashMap.contains "three" = false +``` +-/ @[inline] def contains (self : HashMap α β) (a : α) : Bool := self.1.contains a -/-- Folds a monadic function over the elements in the map (in arbitrary order). -/ +/-- +Folds a monadic function over the elements in the map (in arbitrary order). +``` +def sumEven (sum: Nat) (k : String) (v : Nat) : Except String Nat := + if v % 2 == 0 then pure (sum + v) else throw s!"value {v} at key {k} is not even" + +foldM sumEven 0 (ofList [("one", 1), ("three", 3)]) = + Except.error "value 3 at key three is not even" +foldM sumEven 0 (ofList [("two", 2), ("four", 4)]) = Except.ok 6 +``` +-/ @[inline] def foldM [Monad m] (f : δ → α → β → m δ) (init : δ) (self : HashMap α β) : m δ := self.1.foldM f init -/-- Folds a function over the elements in the map (in arbitrary order). -/ +/-- +Folds a function over the elements in the map (in arbitrary order). +``` +fold (fun sum _ v => sum + v) 0 (ofList [("one", 1), ("two", 2)]) = 3 +``` +-/ @[inline] def fold (f : δ → α → β → δ) (init : δ) (self : HashMap α β) : δ := self.1.fold f init -/-- Combines two hashmaps using a monadic function `f` to combine two values at a key. -/ +/-- +Combines two hashmaps using a monadic function `f` to combine two values at a key. +``` +def map1 := ofList [("one", 1), ("two", 2)] +def map2 := ofList [("two", 2), ("three", 3)] +def map3 := ofList [("two", 3), ("three", 3)] +def mergeIfNoConflict? (_ : String) (v₁ v₂ : Nat) : Option Nat := + if v₁ != v₂ then none else some v₁ + + +mergeWithM mergeIfNoConflict? map1 map2 = some {"one" => 1, "two" => 2, "three" => 3} +mergeWithM mergeIfNoConflict? map1 map3 = none +``` +-/ @[specialize] def mergeWithM [Monad m] (f : α → β → β → m β) (self other : HashMap α β) : m (HashMap α β) := other.foldM (init := self) fun m k v₂ => @@ -335,7 +435,14 @@ instance : GetElem (HashMap α β) α (Option β) fun _ _ => True where | none => return m.insert k v₂ | some v₁ => return m.insert k (← f k v₁ v₂) -/-- Combines two hashmaps using function `f` to combine two values at a key. -/ +/-- +Combines two hashmaps using function `f` to combine two values at a key. +``` +mergeWith (fun _ v₁ v₂ => v₁ + v₂ ) + (ofList [("one", 1), ("two", 2)]) (ofList [("two", 2), ("three", 3)]) = + {"one" => 1, "two" => 4, "three" => 3} +``` +-/ @[inline] def mergeWith (f : α → β → β → β) (self other : HashMap α β) : HashMap α β := -- Implementing this function directly, rather than via `mergeWithM`, gives -- us less constrained universes. @@ -344,13 +451,34 @@ instance : GetElem (HashMap α β) α (Option β) fun _ _ => True where | none => map.insert k v₂ | some v₁ => map.insert k $ f k v₁ v₂ -/-- Runs a monadic function over the elements in the map (in arbitrary order). -/ +/-- +Runs a monadic function over the elements in the map (in arbitrary order). +``` +def checkEven (k : String) (v : Nat) : Except String Unit := + if v % 2 == 0 then pure () else throw s!"value {v} at key {k} is not even" + +forM checkEven (ofList [("one", 1), ("three", 3)]) = Except.error "value 3 at key three is not even" +forM checkEven (ofList [("two", 2), ("four", 4)]) = Except.ok () +``` +-/ @[inline] def forM [Monad m] (f : α → β → m PUnit) (self : HashMap α β) : m PUnit := self.1.forM f -/-- Converts the map into a list of key-value pairs. -/ +/-- +Converts the map into a list of key-value pairs. +``` +open List +(ofList [("one", 1), ("two", 2)]).toList ~ [("one", 1), ("two", 2)] +``` +-/ def toList (self : HashMap α β) : List (α × β) := self.fold (init := []) fun r k v => (k, v)::r -/-- Converts the map into an array of key-value pairs. -/ +/-- +Converts the map into an array of key-value pairs. +``` +open List +(ofList [("one", 1), ("two", 2)]).toArray.data ~ #[("one", 1), ("two", 2)].data +``` +-/ def toArray (self : HashMap α β) : Array (α × β) := self.fold (init := #[]) fun r k v => r.push (k, v) @@ -360,11 +488,19 @@ def numBuckets (self : HashMap α β) : Nat := self.1.buckets.1.size /-- Builds a `HashMap` from a list of key-value pairs. Values of duplicated keys are replaced by their respective last occurrences. +``` +ofList [("one", 1), ("one", 2)] = {"one" => 2} +``` -/ def ofList [BEq α] [Hashable α] (l : List (α × β)) : HashMap α β := l.foldl (init := HashMap.empty) fun m (k, v) => m.insert k v -/-- Variant of `ofList` which accepts a function that combines values of duplicated keys. -/ +/-- +Variant of `ofList` which accepts a function that combines values of duplicated keys. +``` +ofListWith [("one", 1), ("one", 2)] (fun v₁ v₂ => v₁ + v₂) = {"one" => 3} +``` +-/ def ofListWith [BEq α] [Hashable α] (l : List (α × β)) (f : β → β → β) : HashMap α β := l.foldl (init := HashMap.empty) fun m p => match m.find? p.1 with diff --git a/Std/Data/List.lean b/Std/Data/List.lean index 4165ebcfe7..137c762db9 100644 --- a/Std/Data/List.lean +++ b/Std/Data/List.lean @@ -1,6 +1,7 @@ import Std.Data.List.Basic import Std.Data.List.Count import Std.Data.List.Init.Attach +import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.List.Pairwise import Std.Data.List.Perm diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index d36dd9a897..01db611d70 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -147,17 +147,17 @@ Constructs the union of two lists, by inserting the elements of `l₁` in revers As a result, `l₂` will always be a suffix, but only the last occurrence of each element in `l₁` will be retained (but order will otherwise be preserved). -/ -@[inline] protected def union [DecidableEq α] (l₁ l₂ : List α) : List α := foldr .insert l₂ l₁ +@[inline] protected def union [BEq α] (l₁ l₂ : List α) : List α := foldr .insert l₂ l₁ -instance [DecidableEq α] : Union (List α) := ⟨List.union⟩ +instance [BEq α] : Union (List α) := ⟨List.union⟩ /-- Constructs the intersection of two lists, by filtering the elements of `l₁` that are in `l₂`. Unlike `bagInter` this does not preserve multiplicity: `[1, 1].inter [1]` is `[1, 1]`. -/ -@[inline] protected def inter [DecidableEq α] (l₁ l₂ : List α) : List α := filter (· ∈ l₂) l₁ +@[inline] protected def inter [BEq α] (l₁ l₂ : List α) : List α := filter (elem · l₂) l₁ -instance [DecidableEq α] : Inter (List α) := ⟨List.inter⟩ +instance [BEq α] : Inter (List α) := ⟨List.inter⟩ /-- `l₁ <+ l₂`, or `Sublist l₁ l₂`, says that `l₁` is a (non-contiguous) subsequence of `l₂`. -/ inductive Sublist {α} : List α → List α → Prop @@ -171,11 +171,11 @@ inductive Sublist {α} : List α → List α → Prop @[inherit_doc] scoped infixl:50 " <+ " => Sublist /-- True if the first list is a potentially non-contiguous sub-sequence of the second list. -/ -def isSublist [DecidableEq α] : List α → List α → Bool +def isSublist [BEq α] : List α → List α → Bool | [], _ => true | _, [] => false | l₁@(hd₁::tl₁), hd₂::tl₂ => - if hd₁ = hd₂ + if hd₁ == hd₂ then tl₁.isSublist tl₂ else l₁.isSublist tl₂ @@ -885,7 +885,7 @@ instance nodupDecidable [DecidableEq α] : ∀ l : List α, Decidable (Nodup l) Defined as `pwFilter (≠)`. eraseDup [1, 0, 2, 2, 1] = [0, 2, 1] -/ -@[inline] def eraseDup [DecidableEq α] : List α → List α := pwFilter (· ≠ ·) +@[inline] def eraseDup [BEq α] : List α → List α := pwFilter (· != ·) /-- `range' start len step` is the list of numbers `[start, start+step, ..., start+(len-1)*step]`. It is intended mainly for proving properties of `range` and `iota`. -/ diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 4458c457dc..6611d032f6 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -116,7 +116,6 @@ theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP apply Nat.le_trans ?_ (Nat.le_add_right _ _) apply ihl hl . simp [ha h] - apply Nat.succ_le_succ apply ihl hl theorem countP_congr (h : ∀ x ∈ l, p x ↔ q x) : countP p l = countP q l := diff --git a/Std/Data/List/Init/Attach.lean b/Std/Data/List/Init/Attach.lean index 63ebca89df..d2b2bf0990 100644 --- a/Std/Data/List/Init/Attach.lean +++ b/Std/Data/List/Init/Attach.lean @@ -6,35 +6,39 @@ Authors: Mario Carneiro namespace List -/-- Partial map. If `f : Π a, p a → β` is a partial function defined on - `a : α` satisfying `p`, then `pmap f l h` is essentially the same as `map f l` - but is defined only when all members of `l` satisfy `p`, using the proof +/-- `O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on + `a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l` + but is defined only when all members of `l` satisfy `P`, using the proof to apply `f`. -/ -@[simp] def pmap {p : α → Prop} (f : ∀ a, p a → β) : ∀ l : List α, (∀ a ∈ l, p a) → List β +@[simp] def pmap {P : α → Prop} (f : ∀ a, P a → β) : ∀ l : List α, (H : ∀ a ∈ l, P a) → List β | [], _ => [] | a :: l, H => f a (forall_mem_cons.1 H).1 :: pmap f l (forall_mem_cons.1 H).2 /-- -Unsafe implementation of `attach`, taking advantage of the fact that the representation of -`List {x // x ∈ l}` is the same as the input `List α`. +Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of +`List {x // P x}` is the same as the input `List α`. (Someday, the compiler might do this optimization automatically, but until then...) -/ -@[inline] private unsafe def attachImpl (l : List α) : List {x // x ∈ l} := unsafeCast l +@[inline] private unsafe def attachWithImpl + (l : List α) (P : α → Prop) (_ : ∀ x ∈ l, P x) : List {x // P x} := unsafeCast l -/-- "Attach" the proof that the elements of `l` are in `l` to produce a new list +/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `l` to produce a new list + with the same elements but in the type `{x // P x}`. -/ +@[implemented_by attachWithImpl] def attachWith + (l : List α) (P : α → Prop) (H : ∀ x ∈ l, P x) : List {x // P x} := pmap Subtype.mk l H + +/-- `O(1)`. "Attach" the proof that the elements of `l` are in `l` to produce a new list with the same elements but in the type `{x // x ∈ l}`. -/ -@[implemented_by attachImpl] def attach (l : List α) : List {x // x ∈ l} := - pmap Subtype.mk l fun _ => id +@[inline] def attach (l : List α) : List {x // x ∈ l} := attachWith l _ fun _ => id /-- Implementation of `pmap` using the zero-copy version of `attach`. -/ -@[inline] private def pmapImpl {p : α → Prop} (f : ∀ a, p a → β) (l : List α) (h : ∀ a ∈ l, p a) : - List β := l.attach.map fun ⟨x, h'⟩ => f x (h _ h') +@[inline] private def pmapImpl {P : α → Prop} (f : ∀ a, P a → β) (l : List α) (H : ∀ a ∈ l, P a) : + List β := (l.attachWith _ H).map fun ⟨x, h'⟩ => f x h' @[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by funext α β p f L h' - let rec go : ∀ L' (hL' : ∀ ⦃x⦄, x ∈ L' → x ∈ L), - pmap f L' (fun _ h => h' _ <| hL' h) = - map (fun ⟨x, hx⟩ => f x (h' _ hx)) (pmap Subtype.mk L' hL') + let rec go : ∀ L' (hL' : ∀ ⦃x⦄, x ∈ L' → p x), + pmap f L' hL' = map (fun ⟨x, hx⟩ => f x hx) (pmap Subtype.mk L' hL') | nil, hL' => rfl | cons _ L', hL' => congrArg _ <| go L' fun _ hx => hL' (.tail _ hx) - exact go L fun _ hx => hx + exact go L h' diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean new file mode 100644 index 0000000000..8770f6c2ee --- /dev/null +++ b/Std/Data/List/Init/Lemmas.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2014 Parikshit Khanna. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro +-/ + +/-! # Bootstrapping properties of Lists -/ + +namespace List + +@[ext] theorem ext : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n) → l₁ = l₂ + | [], [], _ => rfl + | a :: l₁, [], h => nomatch h 0 + | [], a' :: l₂, h => nomatch h 0 + | a :: l₁, a' :: l₂, h => by + have h0 : some a = some a' := h 0 + injection h0 with aa; simp only [aa, ext fun n => h (n+1)] + +theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂) + (h : ∀ n h₁ h₂, get l₁ ⟨n, h₁⟩ = get l₂ ⟨n, h₂⟩) : l₁ = l₂ := + ext fun n => + if h₁ : n < length l₁ then by + rw [get?_eq_get, get?_eq_get, h n h₁ (by rwa [← hl])] + else by + have h₁ := Nat.le_of_not_lt h₁ + rw [get?_len_le h₁, get?_len_le]; rwa [← hl] + +@[simp] theorem get_map (f : α → β) {l n} : get (map f l) n = f (get l ⟨n, length_map l f ▸ n.2⟩) := + Option.some.inj <| by rw [← get?_eq_get, get?_map, get?_eq_get]; rfl + +/-! ### foldl / foldr -/ + +theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) : + (l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by + induction l generalizing init <;> simp [*] + +theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) : + (l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by + induction l generalizing init <;> simp [*] diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 1d1b2a5a71..545fd8f769 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro -/ import Std.Control.ForInStep.Lemmas -import Std.Data.Nat.Basic +import Std.Data.List.Init.Lemmas import Std.Data.List.Basic import Std.Tactic.Init import Std.Tactic.Alias @@ -92,8 +92,11 @@ theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l | .head l => ⟨[], l, rfl⟩ | .tail b h => let ⟨s, t, h'⟩ := append_of_mem h; ⟨b::s, t, by rw [h', cons_append]⟩ -@[simp] theorem elem_iff {_ : DecidableEq α} {a : α} {as : List α} : - elem a as ↔ a ∈ as := ⟨mem_of_elem_eq_true, elem_eq_true_of_mem⟩ +theorem elem_iff [BEq α] [LawfulBEq α] {a : α} {as : List α} : + elem a as = true ↔ a ∈ as := ⟨mem_of_elem_eq_true, elem_eq_true_of_mem⟩ + +@[simp] theorem elem_eq_mem [BEq α] [LawfulBEq α] (a : α) (as : List α) : + elem a as = decide (a ∈ as) := by rw [Bool.eq_iff_iff, elem_iff, decide_eq_true_iff] theorem mem_of_ne_of_mem {a y : α} {l : List α} (h₁ : a ≠ y) (h₂ : a ∈ y :: l) : a ∈ l := Or.elim (mem_cons.mp h₂) (absurd · h₁) (·) @@ -617,13 +620,14 @@ theorem Sublist.eq_of_length_le (s : l₁ <+ l₂) (h : length l₂ ≤ length l | refl => apply Sublist.refl | step => simp [*, replicate, Sublist.cons] -theorem isSublist_iff_sublist [DecidableEq α] {l₁ l₂ : List α} : l₁.isSublist l₂ ↔ l₁ <+ l₂ := by +theorem isSublist_iff_sublist [BEq α] [LawfulBEq α] {l₁ l₂ : List α} : + l₁.isSublist l₂ ↔ l₁ <+ l₂ := by cases l₁ <;> cases l₂ <;> simp [isSublist] case cons.cons hd₁ tl₁ hd₂ tl₂ => if h_eq : hd₁ = hd₂ then simp [h_eq, cons_sublist_cons, isSublist_iff_sublist] else - simp only [h_eq] + simp only [beq_iff_eq, h_eq] constructor · intro h_sub apply Sublist.cons @@ -690,6 +694,11 @@ theorem getLastD_mem_cons : ∀ (l : List α) (a : α), getLastD l a ∈ a::l | [], _ => .head .. | _::_, _ => .tail _ <| getLast_mem _ +@[simp] theorem getLast?_reverse (l : List α) : l.reverse.getLast? = l.head? := by cases l <;> simp + +@[simp] theorem head?_reverse (l : List α) : l.reverse.head? = l.getLast? := by + rw [← getLast?_reverse, reverse_reverse] + /-! ### dropLast -/ /-! NB: `dropLast` is the specification for `Array.pop`, so theorems about `List.dropLast` @@ -774,9 +783,6 @@ theorem get?_inj rw [mem_iff_get?] exact ⟨_, h₂⟩; exact ⟨_ , h₂.symm⟩ -@[simp] theorem get_map (f : α → β) {l n} : get (map f l) n = f (get l ⟨n, length_map l f ▸ n.2⟩) := - Option.some.inj <| by rw [← get?_eq_get, get?_map, get?_eq_get]; rfl - /-- If one has `get l i hi` in a formula and `h : l = l'`, one can not `rw h` in the formula as `hi` gives `i < l.length` and not `i < l'.length`. The theorem `get_of_eq` can be used to make @@ -817,23 +823,6 @@ theorem get_cons_length (x : α) (xs : List α) (n : Nat) (h : n = xs.length) : (x :: xs).get ⟨n, by simp [h]⟩ = (x :: xs).getLast (cons_ne_nil x xs) := by rw [getLast_eq_get]; cases h; rfl -@[ext] theorem ext : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n) → l₁ = l₂ - | [], [], _ => rfl - | a :: l₁, [], h => nomatch h 0 - | [], a' :: l₂, h => nomatch h 0 - | a :: l₁, a' :: l₂, h => by - have h0 : some a = some a' := h 0 - injection h0 with aa; simp only [aa, ext fun n => h (n+1)] - -theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂) - (h : ∀ n h₁ h₂, get l₁ ⟨n, h₁⟩ = get l₂ ⟨n, h₂⟩) : l₁ = l₂ := - ext fun n => - if h₁ : n < length l₁ then by - rw [get?_eq_get, get?_eq_get, h n h₁ (by rwa [← hl])] - else by - have h₁ := Nat.le_of_not_lt h₁ - rw [get?_len_le h₁, get?_len_le]; rwa [← hl] - theorem get!_of_get? [Inhabited α] : ∀ {l : List α} {n}, get? l n = some a → get! l n = a | _a::_, 0, rfl => rfl | _::l, _+1, e => get!_of_get? (l := l) e @@ -935,6 +924,16 @@ theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l. · simp only [get?, take] · simpa only using hn (Nat.lt_of_succ_lt_succ h) +theorem get?_take_eq_none {l : List α} {n m : Nat} (h : n ≤ m) : + (l.take n).get? m = none := + get?_eq_none.mpr <| Nat.le_trans (length_take_le _ _) h + +theorem get?_take_eq_if {l : List α} {n m : Nat} : + (l.take n).get? m = if m < n then l.get? m else none := by + split + · next h => exact get?_take h + · next h => exact get?_take_eq_none (Nat.le_of_not_lt h) + @[simp] theorem nth_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1)).get? n = l.get? n := get?_take (Nat.lt_succ_self n) @@ -1301,6 +1300,18 @@ theorem mem_or_eq_of_mem_set : ∀ {l : List α} {n : Nat} {a b : α}, a ∈ l.s | _ :: _, _+1, _, _, .head .. => .inl (.head ..) | _ :: _, _+1, _, _, .tail _ h => (mem_or_eq_of_mem_set h).imp_left (.tail _) +theorem drop_set_of_lt (a : α) {n m : Nat} (l : List α) (h : n < m) : + (l.set n a).drop m = l.drop m := + List.ext fun i => by rw [get?_drop, get?_drop, get?_set_ne _ _ (by omega)] + +theorem take_set_of_lt (a : α) {n m : Nat} (l : List α) (h : m < n) : + (l.set n a).take m = l.take m := + List.ext fun i => by + rw [get?_take_eq_if, get?_take_eq_if] + split + · next h' => rw [get?_set_ne _ _ (by omega)] + · rfl + /-! ### remove nth -/ theorem length_removeNth : ∀ {l i}, i < length l → length (@removeNth α l i) = length l - 1 @@ -1366,13 +1377,13 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (! /-! ### insert -/ section insert -variable [DecidableEq α] +variable [BEq α] [LawfulBEq α] @[simp] theorem insert_of_mem {l : List α} (h : a ∈ l) : l.insert a = l := by - simp only [List.insert, elem_iff, if_pos h] + simp [List.insert, h] @[simp] theorem insert_of_not_mem {l : List α} (h : a ∉ l) : l.insert a = a :: l := by - simp only [List.insert, elem_iff, if_neg h] + simp [List.insert, h] @[simp] theorem mem_insert_iff {l : List α} : a ∈ l.insert b ↔ a = b ∨ a ∈ l := by if h : b ∈ l then @@ -1502,7 +1513,7 @@ theorem eraseP_map (f : β → α) : ∀ (l : List β), (map f l).eraseP p = map /-! ### erase -/ section erase -variable [BEq α] [LawfulBEq α] +variable [BEq α] @[simp] theorem erase_nil (a : α) : [].erase a = [] := rfl @@ -1511,58 +1522,65 @@ theorem erase_cons (a b : α) (l : List α) : if h : b == a then by simp [List.erase, h] else by simp [List.erase, h, (beq_eq_false_iff_ne _ _).2 h] -@[simp] theorem erase_cons_head (a : α) (l : List α) : (a :: l).erase a = l := by +@[simp] theorem erase_cons_head [LawfulBEq α] (a : α) (l : List α) : (a :: l).erase a = l := by simp [erase_cons] @[simp] theorem erase_cons_tail {a b : α} (l : List α) (h : ¬(b == a)) : (b :: l).erase a = b :: l.erase a := by simp only [erase_cons, if_neg h] -theorem erase_eq_eraseP (a : α) : ∀ l : List α, l.erase a = l.eraseP (a == ·) +theorem erase_eq_eraseP' (a : α) (l : List α) : l.erase a = l.eraseP (· == a) := by + induction l + · simp + · next b t ih => + rw [erase_cons, eraseP_cons, ih] + if h : b == a then simp [h] else simp [h] + +theorem erase_eq_eraseP [LawfulBEq α] (a : α) : ∀ l : List α, l.erase a = l.eraseP (a == ·) | [] => rfl | b :: l => by if h : a = b then simp [h] else simp [h, Ne.symm h, erase_eq_eraseP a l] -theorem Sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a := by - simp [erase_eq_eraseP]; exact Sublist.eraseP h - -theorem erase_of_not_mem {a : α} : ∀ {l : List α}, a ∉ l → l.erase a = l +theorem erase_of_not_mem [LawfulBEq α] {a : α} : ∀ {l : List α}, a ∉ l → l.erase a = l | [], _ => rfl | b :: l, h => by rw [mem_cons, not_or] at h simp only [erase_cons, if_neg, erase_of_not_mem h.2, beq_iff_eq, Ne.symm h.1, not_false_eq_true] -theorem exists_erase_eq {a : α} {l : List α} (h : a ∈ l) : +theorem exists_erase_eq [LawfulBEq α] {a : α} {l : List α} (h : a ∈ l) : ∃ l₁ l₂, a ∉ l₁ ∧ l = l₁ ++ a :: l₂ ∧ l.erase a = l₁ ++ l₂ := by let ⟨_, l₁, l₂, h₁, e, h₂, h₃⟩ := exists_of_eraseP h (beq_self_eq_true _) rw [erase_eq_eraseP]; exact ⟨l₁, l₂, fun h => h₁ _ h (beq_self_eq_true _), eq_of_beq e ▸ h₂, h₃⟩ -@[simp] theorem length_erase_of_mem {a : α} {l : List α} (h : a ∈ l) : +@[simp] theorem length_erase_of_mem [LawfulBEq α] {a : α} {l : List α} (h : a ∈ l) : length (l.erase a) = Nat.pred (length l) := by rw [erase_eq_eraseP]; exact length_eraseP_of_mem h (beq_self_eq_true a) -theorem erase_append_left {l₁ : List α} (l₂) (h : a ∈ l₁) : +theorem erase_append_left [LawfulBEq α] {l₁ : List α} (l₂) (h : a ∈ l₁) : (l₁ ++ l₂).erase a = l₁.erase a ++ l₂ := by simp [erase_eq_eraseP]; exact eraseP_append_left (beq_self_eq_true a) l₂ h -theorem erase_append_right {a : α} {l₁ : List α} (l₂ : List α) (h : a ∉ l₁) : +theorem erase_append_right [LawfulBEq α] {a : α} {l₁ : List α} (l₂ : List α) (h : a ∉ l₁) : (l₁ ++ l₂).erase a = (l₁ ++ l₂.erase a) := by rw [erase_eq_eraseP, erase_eq_eraseP, eraseP_append_right] intros b h' h''; rw [eq_of_beq h''] at h; exact h h' theorem erase_sublist (a : α) (l : List α) : l.erase a <+ l := - erase_eq_eraseP a l ▸ eraseP_sublist l + erase_eq_eraseP' a l ▸ eraseP_sublist l theorem erase_subset (a : α) (l : List α) : l.erase a ⊆ l := (erase_sublist a l).subset -theorem sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a := by - simp only [erase_eq_eraseP]; exact h.eraseP +theorem Sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a := by + simp only [erase_eq_eraseP']; exact h.eraseP +@[deprecated] alias sublist.erase := Sublist.erase theorem mem_of_mem_erase {a b : α} {l : List α} (h : a ∈ l.erase b) : a ∈ l := erase_subset _ _ h -@[simp] theorem mem_erase_of_ne {a b : α} {l : List α} (ab : a ≠ b) : a ∈ l.erase b ↔ a ∈ l := +@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : List α} (ab : a ≠ b) : + a ∈ l.erase b ↔ a ∈ l := erase_eq_eraseP b l ▸ mem_eraseP_of_neg (mt eq_of_beq ab.symm) -theorem erase_comm (a b : α) (l : List α) : (l.erase a).erase b = (l.erase b).erase a := by +theorem erase_comm [LawfulBEq α] (a b : α) (l : List α) : + (l.erase a).erase b = (l.erase b).erase a := by if ab : a == b then rw [eq_of_beq ab] else ?_ if ha : a ∈ l then ?_ else simp only [erase_of_not_mem ha, erase_of_not_mem (mt mem_of_mem_erase ha)] @@ -1978,14 +1996,6 @@ theorem disjoint_of_disjoint_append_right_right (d : Disjoint l (l₁ ++ l₂)) /-! ### foldl / foldr -/ -theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) : - (l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by - induction l generalizing init <;> simp [*] - -theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) : - (l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by - induction l generalizing init <;> simp [*] - theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁) (H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by induction l generalizing init <;> simp [*, H] @@ -1998,25 +2008,25 @@ theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : section union -variable [DecidableEq α] +variable [BEq α] -theorem union_def [DecidableEq α] (l₁ l₂ : List α) : l₁ ∪ l₂ = foldr .insert l₂ l₁ := rfl +theorem union_def [BEq α] (l₁ l₂ : List α) : l₁ ∪ l₂ = foldr .insert l₂ l₁ := rfl @[simp] theorem nil_union (l : List α) : nil ∪ l = l := by simp [List.union_def, foldr] @[simp] theorem cons_union (a : α) (l₁ l₂ : List α) : (a :: l₁) ∪ l₂ = (l₁ ∪ l₂).insert a := by simp [List.union_def, foldr] -@[simp] theorem mem_union_iff {_ : DecidableEq α} {x : α} {l₁ l₂ : List α} : +@[simp] theorem mem_union_iff [LawfulBEq α] {x : α} {l₁ l₂ : List α} : x ∈ l₁ ∪ l₂ ↔ x ∈ l₁ ∨ x ∈ l₂ := by induction l₁ <;> simp [*, or_assoc] end union /-! ### inter -/ -theorem inter_def [DecidableEq α] (l₁ l₂ : List α) : l₁ ∩ l₂ = filter (· ∈ l₂) l₁ := rfl +theorem inter_def [BEq α] (l₁ l₂ : List α) : l₁ ∩ l₂ = filter (elem · l₂) l₁ := rfl -@[simp] theorem mem_inter_iff {_ : DecidableEq α} {x : α} {l₁ l₂ : List α} : +@[simp] theorem mem_inter_iff [BEq α] [LawfulBEq α] {x : α} {l₁ l₂ : List α} : x ∈ l₁ ∩ l₂ ↔ x ∈ l₁ ∧ x ∈ l₂ := by cases l₁ <;> simp [List.inter_def, mem_filter] @@ -2062,8 +2072,8 @@ theorem forIn_eq_bindList [Monad m] [LawfulMonad m] /-! ### diff -/ section Diff --- TODO: theorems about `BEq` -variable [DecidableEq α] +variable [BEq α] +variable [LawfulBEq α] @[simp] theorem diff_nil (l : List α) : l.diff [] = l := rfl diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index 2438d0f0f5..9b74cccaec 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -476,13 +476,10 @@ theorem Perm.diff_right {l₁ l₂ : List α} (t : List α) (h : l₁ ~ l₂) : induction t generalizing l₁ l₂ h with simp only [List.diff] | nil => exact h | cons x t ih => - split <;> rename_i hx - · simp [elem_eq_true_of_mem (h.subset (mem_of_elem_eq_true hx))] - exact ih (h.erase _) - · have : ¬elem x l₂ = true := fun contra => - hx <| elem_eq_true_of_mem <| h.symm.subset <| mem_of_elem_eq_true contra - simp [this] - exact ih h + simp only [elem_eq_mem, decide_eq_true_eq, Perm.mem_iff h] + split + · exact ih (h.erase _) + · exact ih h theorem Perm.diff_left (l : List α) {t₁ t₂ : List α} (h : t₁ ~ t₂) : l.diff t₁ = l.diff t₂ := by induction h generalizing l with try simp [List.diff] @@ -500,21 +497,15 @@ theorem Perm.diff {l₁ l₂ t₁ t₂ : List α} (hl : l₁ ~ l₂) (ht : t₁ theorem Subperm.diff_right {l₁ l₂ : List α} (h : l₁ <+~ l₂) (t : List α) : l₁.diff t <+~ l₂.diff t := by - induction t generalizing l₁ l₂ h with - | nil => simp only [List.diff]; exact h + induction t generalizing l₁ l₂ h with simp [List.diff, elem_eq_mem, *] | cons x t ih => - simp only [List.diff]; split <;> rename_i hx1 - · have : elem x l₂ = true := by - apply elem_eq_true_of_mem - apply h.subset (mem_of_elem_eq_true hx1) - simp [this] - apply ih - apply h.erase - · split <;> rename_i hx2 - · apply ih - have := h.erase x - simpa [erase_of_not_mem (hx1 ∘ elem_eq_true_of_mem)] using this - · apply ih h + split <;> rename_i hx1 + · simp [h.subset hx1] + exact ih (h.erase _) + · split + · rw [← erase_of_not_mem hx1] + exact ih (h.erase _) + · exact ih h theorem erase_cons_subperm_cons_erase (a b : α) (l : List α) : (a :: l).erase b <+~ a :: l.erase b := by diff --git a/Std/Data/RBMap/Alter.lean b/Std/Data/RBMap/Alter.lean index 6e6d99b455..c1119ee434 100644 --- a/Std/Data/RBMap/Alter.lean +++ b/Std/Data/RBMap/Alter.lean @@ -26,20 +26,6 @@ def OnRoot (p : α → Prop) : RBNode α → Prop | nil => True | node _ _ x _ => p x -/-- -Auxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary. --/ -def setRoot (v : α) : RBNode α → RBNode α - | nil => node red nil v nil - | node c a _ b => node c a v b - -/-- -Auxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary. --/ -def delRoot : RBNode α → RBNode α - | nil => nil - | node _ a _ b => a.append b - namespace Path /-- Same as `fill` but taking its arguments in a pair for easier composition with `zoom`. -/ @@ -54,39 +40,6 @@ theorem zoom_fill' (cut : α → Ordering) (t : RBNode α) (path : Path α) : theorem zoom_fill (H : zoom cut t path = (t', path')) : path.fill t = path'.fill t' := (H ▸ zoom_fill' cut t path).symm -theorem zoom_ins {t : RBNode α} {cmp : α → α → Ordering} : - t.zoom (cmp v) path = (t', path') → - path.ins (t.ins cmp v) = path'.ins (t'.setRoot v) := by - unfold RBNode.ins; split <;> simp [zoom] - · intro | rfl, rfl => rfl - all_goals - · split - · exact zoom_ins - · exact zoom_ins - · intro | rfl => rfl - -theorem insertNew_eq_insert (h : zoom (cmp v) t = (nil, path)) : - path.insertNew v = (t.insert cmp v).setBlack := - insert_setBlack .. ▸ (zoom_ins h).symm - -theorem zoom_del {t : RBNode α} : - t.zoom cut path = (t', path') → - path.del (t.del cut) (match t with | node c .. => c | _ => red) = - path'.del t'.delRoot (match t' with | node c .. => c | _ => red) := by - unfold RBNode.del; split <;> simp [zoom] - · intro | rfl, rfl => rfl - · next c a y b => - split - · have IH := @zoom_del (t := a) - match a with - | nil => intro | rfl => rfl - | node black .. | node red .. => apply IH - · have IH := @zoom_del (t := b) - match b with - | nil => intro | rfl => rfl - | node black .. | node red .. => apply IH - · intro | rfl => rfl - variable (c₀ : RBColor) (n₀ : Nat) in /-- The balance invariant for a path. `path.Balanced c₀ n₀ c n` means that `path` is a red-black tree @@ -134,13 +87,6 @@ protected theorem _root_.Std.RBNode.Balanced.zoom : t.Balanced c n → path.Bala · exact hb.zoom (.blackR ha hp) · intro e; cases e; exact ⟨_, _, .black ha hb, hp⟩ -theorem ins_eq_fill {path : Path α} {t : RBNode α} : - path.Balanced c₀ n₀ c n → t.Balanced c n → path.ins t = (path.fill t).setBlack - | .root, h => rfl - | .redL hb H, ha | .redR ha H, hb => by unfold ins; exact ins_eq_fill H (.red ha hb) - | .blackL hb H, ha => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance1_eq ha] - | .blackR ha H, hb => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance2_eq hb] - protected theorem Balanced.ins {path : Path α} (hp : path.Balanced c₀ n₀ c n) (ht : t.RedRed (c = red) n) : ∃ n, (path.ins t).Balanced black n := by @@ -160,21 +106,6 @@ protected theorem Balanced.ins {path : Path α} protected theorem Balanced.insertNew {path : Path α} (H : path.Balanced c n black 0) : ∃ n, (path.insertNew v).Balanced black n := H.ins (.balanced (.red .nil .nil)) -protected theorem Balanced.insert {path : Path α} (hp : path.Balanced c₀ n₀ c n) : - t.Balanced c n → ∃ c n, (path.insert t v).Balanced c n - | .nil => ⟨_, hp.insertNew⟩ - | .red ha hb => ⟨_, _, hp.fill (.red ha hb)⟩ - | .black ha hb => ⟨_, _, hp.fill (.black ha hb)⟩ - -theorem zoom_insert {path : Path α} {t : RBNode α} (ht : t.Balanced c n) - (H : zoom (cmp v) t = (t', path)) : - (path.insert t' v).setBlack = (t.insert cmp v).setBlack := by - have ⟨_, _, ht', hp'⟩ := ht.zoom .root H - cases ht' with simp [insert] - | nil => simp [insertNew_eq_insert H, setBlack_idem] - | red hl hr => rw [← ins_eq_fill hp' (.red hl hr), insert_setBlack]; exact (zoom_ins H).symm - | black hl hr => rw [← ins_eq_fill hp' (.black hl hr), insert_setBlack]; exact (zoom_ins H).symm - protected theorem Balanced.del {path : Path α} (hp : path.Balanced c₀ n₀ c n) (ht : t.DelProp c' n) (hc : c = black → c' ≠ red) : ∃ n, (path.del t c').Balanced black n := by @@ -194,18 +125,6 @@ protected theorem Balanced.del {path : Path α} | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ nofun | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ nofun -/-- Asserts that `p` holds on all elements to the left of the hole. -/ -def AllL (p : α → Prop) : Path α → Prop - | .root => True - | .left _ parent _ _ => parent.AllL p - | .right _ a x parent => a.All p ∧ p x ∧ parent.AllL p - -/-- Asserts that `p` holds on all elements to the right of the hole. -/ -def AllR (p : α → Prop) : Path α → Prop - | .root => True - | .left _ parent x b => parent.AllR p ∧ p x ∧ b.All p - | .right _ _ _ parent => parent.AllR p - /-- The property of a path returned by `t.zoom cut`. Each of the parents visited along the path have the appropriate ordering relation to the cut. @@ -215,15 +134,6 @@ def Zoomed (cut : α → Ordering) : Path α → Prop | .left _ parent x _ => cut x = .lt ∧ parent.Zoomed cut | .right _ _ x parent => cut x = .gt ∧ parent.Zoomed cut -theorem zoom_zoomed₁ (e : zoom cut t path = (t', path')) : t'.OnRoot (cut · = .eq) := - match t, e with - | nil, rfl => trivial - | node .., e => by - revert e; unfold zoom; split - · exact zoom_zoomed₁ - · exact zoom_zoomed₁ - · next H => intro e; cases e; exact H - theorem zoom_zoomed₂ (e : zoom cut t path = (t', path')) (hp : path.Zoomed cut) : path'.Zoomed cut := match t, e with @@ -309,13 +219,6 @@ theorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.Ro (path.insertNew v).Ordered cmp := hp.ins ⟨⟨⟩, ⟨⟩, ⟨⟩, ⟨⟩⟩ ⟨vp, ⟨⟩, ⟨⟩⟩ -theorem Ordered.insert : ∀ {path : Path α} {t : RBNode α}, - path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → path.RootOrdered cmp v → - t.OnRoot (cmpEq cmp v) → (path.insert t v).Ordered cmp - | _, nil, hp, _, _, vp, _ => hp.insertNew vp - | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩, vp, xv => Ordered.fill.2 - ⟨hp, ⟨ax.imp xv.lt_congr_right.2, xb.imp xv.lt_congr_left.2, ha, hb⟩, vp, ap, bp⟩ - 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 @@ -330,11 +233,6 @@ theorem Ordered.del : ∀ {path : Path α} {t : RBNode α} {c}, unfold del; have ⟨xb, bp⟩ := All_and.1 H exact hp.del (ha.balRight ax xb hb) (ap.balRight xp bp) -theorem Ordered.erase : ∀ {path : Path α} {t : RBNode α}, - path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → (path.erase t).Ordered cmp - | _, nil, hp, ht, tp => Ordered.fill.2 ⟨hp, ht, tp⟩ - | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩ => hp.del (ha.append ax xb hb) (ap.append bp) - end Path /-! ## alter -/ diff --git a/Std/Data/RBMap/Basic.lean b/Std/Data/RBMap/Basic.lean index f404c6c5f3..4753a1446b 100644 --- a/Std/Data/RBMap/Basic.lean +++ b/Std/Data/RBMap/Basic.lean @@ -6,6 +6,7 @@ Authors: Leonardo de Moura, Mario Carneiro import Std.Classes.Order import Std.Control.ForInStep.Basic import Std.Tactic.Lint.Misc +import Std.Tactic.Alias /-! # Red-black trees @@ -55,16 +56,19 @@ open RBColor instance : EmptyCollection (RBNode α) := ⟨nil⟩ /-- The minimum element of a tree is the left-most value. -/ -protected def min : RBNode α → Option α +protected def min? : RBNode α → Option α | nil => none | node _ nil v _ => some v - | node _ l _ _ => l.min + | node _ l _ _ => l.min? /-- The maximum element of a tree is the right-most value. -/ -protected def max : RBNode α → Option α +protected def max? : RBNode α → Option α | nil => none | node _ _ v nil => some v - | node _ _ _ r => r.max + | node _ _ _ r => r.max? + +@[deprecated] protected alias min := RBNode.min? +@[deprecated] protected alias max := RBNode.max? /-- Fold a function in tree order along the nodes. `v₀` is used at `nil` nodes and @@ -263,8 +267,8 @@ def isOrdered (cmp : α → α → Ordering) /-- The second half of Okasaki's `balance`, concerning red-red sequences in the right child. -/ @[inline] def balance2 : RBNode α → α → RBNode α → RBNode α - | a, x, node red (node red b y c) z d - | a, x, node red b y (node red c z d) => node red (node black a x b) y (node black c z d) + | a, x, node red b y (node red c z d) + | a, x, node red (node red b y c) z d => node red (node black a x b) y (node black c z d) | a, x, b => node black a x b /-- Returns `red` if the node is red, otherwise `black`. (Nil nodes are treated as `black`.) -/ @@ -280,11 +284,16 @@ Returns `black` if the node is black, otherwise `red`. | node c .. => c | _ => red -/-- Change the color of the root to `black`. -/ +/-- Changes the color of the root to `black`. -/ def setBlack : RBNode α → RBNode α | nil => nil | node _ l v r => node black l v r +/-- `O(n)`. Reverses the ordering of the tree without any rebalancing. -/ +@[simp] def reverse : RBNode α → RBNode α + | nil => nil + | node c l v r => node c r.reverse v l.reverse + section Insert /-- @@ -646,10 +655,13 @@ instance : ToStream (RBSet α cmp) (RBNode.Stream α) := ⟨fun x => x.1.toStrea @[inline] def toList (t : RBSet α cmp) : List α := t.1.toList /-- `O(log n)`. Returns the entry `a` such that `a ≤ k` for all keys in the RBSet. -/ -@[inline] protected def min (t : RBSet α cmp) : Option α := t.1.min +@[inline] protected def min? (t : RBSet α cmp) : Option α := t.1.min? /-- `O(log n)`. Returns the entry `a` such that `a ≥ k` for all keys in the RBSet. -/ -@[inline] protected def max (t : RBSet α cmp) : Option α := t.1.max +@[inline] protected def max? (t : RBSet α cmp) : Option α := t.1.max? + +@[deprecated] protected alias min := RBSet.min? +@[deprecated] protected alias max := RBSet.max? instance [Repr α] : Repr (RBSet α cmp) where reprPrec m prec := Repr.addAppParen ("RBSet.ofList " ++ repr m.toList) prec @@ -751,10 +763,10 @@ instance [BEq α] : BEq (RBSet α cmp) where def size (m : RBSet α cmp) : Nat := m.1.size /-- `O(log n)`. Returns the minimum element of the tree, or panics if the tree is empty. -/ -@[inline] def min! [Inhabited α] (t : RBSet α cmp) : α := t.min.getD (panic! "tree is empty") +@[inline] def min! [Inhabited α] (t : RBSet α cmp) : α := t.min?.getD (panic! "tree is empty") /-- `O(log n)`. Returns the maximum element of the tree, or panics if the tree is empty. -/ -@[inline] def max! [Inhabited α] (t : RBSet α cmp) : α := t.max.getD (panic! "tree is empty") +@[inline] def max! [Inhabited α] (t : RBSet α cmp) : α := t.max?.getD (panic! "tree is empty") /-- `O(log n)`. Attempts to find the value with key `k : α` in `t` and panics if there is no such key. @@ -890,7 +902,7 @@ variable {α : Type u} {β : Type v} {σ : Type w} {cmp : α → α → Ordering /-- `O(n)`. Run monadic function `f` on each element of the tree (in increasing order). -/ @[inline] def forM [Monad m] (f : α → β → m PUnit) (t : RBMap α β cmp) : m PUnit := - t.foldlM (fun _ k v => f k v) ⟨⟩ + t.1.forM (fun (a, b) => f a b) instance : ForIn m (RBMap α β cmp) (α × β) := inferInstanceAs (ForIn _ (RBSet ..) _) @@ -1002,10 +1014,13 @@ instance : Stream (Values.Stream α β) β := ⟨Values.Stream.next?⟩ @[inline] def toList : RBMap α β cmp → List (α × β) := RBSet.toList /-- `O(log n)`. Returns the key-value pair `(a, b)` such that `a ≤ k` for all keys in the RBMap. -/ -@[inline] protected def min : RBMap α β cmp → Option (α × β) := RBSet.min +@[inline] protected def min? : RBMap α β cmp → Option (α × β) := RBSet.min? /-- `O(log n)`. Returns the key-value pair `(a, b)` such that `a ≥ k` for all keys in the RBMap. -/ -@[inline] protected def max : RBMap α β cmp → Option (α × β) := RBSet.max +@[inline] protected def max? : RBMap α β cmp → Option (α × β) := RBSet.max? + +@[deprecated] protected alias min := RBMap.min? +@[deprecated] protected alias max := RBMap.max? instance [Repr α] [Repr β] : Repr (RBMap α β cmp) where reprPrec m prec := Repr.addAppParen ("RBMap.ofList " ++ repr m.toList) prec diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index 64e26eb4a7..24ca552fd0 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -92,6 +92,15 @@ theorem WF.depth_bound {t : RBNode α} (h : t.WF cmp) : t.depth ≤ 2 * (t.size end depth +@[simp] theorem min?_reverse (t : RBNode α) : t.reverse.min? = t.max? := by + unfold RBNode.max?; split <;> simp [RBNode.min?] + unfold RBNode.min?; rw [min?.match_1.eq_3] + · apply min?_reverse + · simpa [reverse_eq_iff] + +@[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_node {y c a x b} : y ∈ (.node c a x b : RBNode α) ↔ y = x ∨ y ∈ a ∨ y ∈ b := by simp [(·∈·), EMem] @@ -366,15 +375,39 @@ theorem foldr_cons (t : RBNode α) (l) : t.foldr (·::·) l = t.toList ++ l := b @[simp] theorem toList_node : (.node c a x b : RBNode α).toList = a.toList ++ x :: b.toList := by rw [toList, foldr, foldr_cons]; rfl +@[simp] theorem toList_reverse (t : RBNode α) : t.reverse.toList = t.toList.reverse := by + induction t <;> simp [*] + @[simp] theorem mem_toList {t : RBNode α} : x ∈ t.toList ↔ x ∈ t := by induction t <;> simp [*, or_left_comm] +@[simp] theorem mem_reverse {t : RBNode α} : a ∈ t.reverse ↔ a ∈ t := by rw [← mem_toList]; simp + +theorem min?_eq_toList_head? {t : RBNode α} : t.min? = t.toList.head? := by + induction t with + | nil => rfl + | node _ l _ _ ih => + cases l <;> simp [RBNode.min?, ih] + next ll _ _ => cases toList ll <;> rfl + +theorem max?_eq_toList_getLast? {t : RBNode α} : t.max? = t.toList.getLast? := by + rw [← min?_reverse, min?_eq_toList_head?]; simp + theorem foldr_eq_foldr_toList {t : RBNode α} : t.foldr f init = t.toList.foldr f init := by induction t generalizing init <;> simp [*] theorem foldl_eq_foldl_toList {t : RBNode α} : t.foldl f init = t.toList.foldl f init := by induction t generalizing init <;> simp [*] +theorem foldl_reverse {α β : Type _} {t : RBNode α} {f : β → α → β} {init : β} : + t.reverse.foldl f init = t.foldr (flip f) init := by + simp (config := {unfoldPartialApp := true}) + [foldr_eq_foldr_toList, foldl_eq_foldl_toList, flip] + +theorem foldr_reverse {α β : Type _} {t : RBNode α} {f : α → β → β} {init : β} : + t.reverse.foldr f init = t.foldl (flip f) init := + foldl_reverse.symm.trans (by simp; rfl) + theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {t : RBNode α} : t.forM (m := m) f = t.toList.forM f := by induction t <;> simp [*] @@ -466,6 +499,27 @@ theorem Ordered.toList_sorted {t : RBNode α} : t.Ordered cmp → t.toList.Pairw theorem size_eq {t : RBNode α} : t.size = t.toList.length := by induction t <;> simp [*, size]; rfl +@[simp] theorem reverse_size (t : RBNode α) : t.reverse.size = t.size := by simp [size_eq] + +@[simp] theorem find?_reverse (t : RBNode α) (cut : α → Ordering) : + t.reverse.find? cut = t.find? (cut · |>.swap) := by + induction t <;> simp [*, find?] + cases cut _ <;> simp [Ordering.swap] + +/-- +Auxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary. +-/ +def setRoot (v : α) : RBNode α → RBNode α + | nil => node red nil v nil + | node c a _ b => node c a v b + +/-- +Auxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary. +-/ +def delRoot : RBNode α → RBNode α + | nil => nil + | node _ a _ b => a.append b + namespace Path attribute [simp] RootOrdered Ordered @@ -515,6 +569,15 @@ theorem ordered_iff {p : Path α} : fun ⟨⟨hL, ⟨hl, lx⟩, Ll, Lx⟩, hR, LR, lR, xR⟩ => ⟨⟨hL, hR, LR⟩, lx, ⟨Lx, xR⟩, ⟨fun _ ha _ hb => Ll _ hb _ ha, lR⟩, hl⟩⟩ +theorem zoom_zoomed₁ (e : zoom cut t path = (t', path')) : t'.OnRoot (cut · = .eq) := + match t, e with + | nil, rfl => trivial + | node .., e => by + revert e; unfold zoom; split + · exact zoom_zoomed₁ + · exact zoom_zoomed₁ + · next H => intro e; cases e; exact H + @[simp] theorem fill_toList {p : Path α} : (p.fill t).toList = p.withList t.toList := by induction p generalizing t <;> simp [*] @@ -533,6 +596,85 @@ theorem insert_toList {p : Path α} : (p.insert t v).toList = p.withList (t.setRoot v).toList := by simp [insert]; split <;> simp [setRoot] +protected theorem Balanced.insert {path : Path α} (hp : path.Balanced c₀ n₀ c n) : + t.Balanced c n → ∃ c n, (path.insert t v).Balanced c n + | .nil => ⟨_, hp.insertNew⟩ + | .red ha hb => ⟨_, _, hp.fill (.red ha hb)⟩ + | .black ha hb => ⟨_, _, hp.fill (.black ha hb)⟩ + +theorem Ordered.insert : ∀ {path : Path α} {t : RBNode α}, + path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → path.RootOrdered cmp v → + t.OnRoot (cmpEq cmp v) → (path.insert t v).Ordered cmp + | _, nil, hp, _, _, vp, _ => hp.insertNew vp + | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩, vp, xv => Ordered.fill.2 + ⟨hp, ⟨ax.imp xv.lt_congr_right.2, xb.imp xv.lt_congr_left.2, ha, hb⟩, vp, ap, bp⟩ + +theorem Ordered.erase : ∀ {path : Path α} {t : RBNode α}, + path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → (path.erase t).Ordered cmp + | _, nil, hp, ht, tp => Ordered.fill.2 ⟨hp, ht, tp⟩ + | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩ => hp.del (ha.append ax xb hb) (ap.append bp) + +theorem zoom_ins {t : RBNode α} {cmp : α → α → Ordering} : + t.zoom (cmp v) path = (t', path') → + path.ins (t.ins cmp v) = path'.ins (t'.setRoot v) := by + unfold RBNode.ins; split <;> simp [zoom] + · intro | rfl, rfl => rfl + all_goals + · split + · exact zoom_ins + · exact zoom_ins + · intro | rfl => rfl + +theorem insertNew_eq_insert (h : zoom (cmp v) t = (nil, path)) : + path.insertNew v = (t.insert cmp v).setBlack := + insert_setBlack .. ▸ (zoom_ins h).symm + +theorem ins_eq_fill {path : Path α} {t : RBNode α} : + path.Balanced c₀ n₀ c n → t.Balanced c n → path.ins t = (path.fill t).setBlack + | .root, h => rfl + | .redL hb H, ha | .redR ha H, hb => by unfold ins; exact ins_eq_fill H (.red ha hb) + | .blackL hb H, ha => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance1_eq ha] + | .blackR ha H, hb => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance2_eq hb] + +theorem zoom_insert {path : Path α} {t : RBNode α} (ht : t.Balanced c n) + (H : zoom (cmp v) t = (t', path)) : + (path.insert t' v).setBlack = (t.insert cmp v).setBlack := by + have ⟨_, _, ht', hp'⟩ := ht.zoom .root H + cases ht' with simp [insert] + | nil => simp [insertNew_eq_insert H, setBlack_idem] + | red hl hr => rw [← ins_eq_fill hp' (.red hl hr), insert_setBlack]; exact (zoom_ins H).symm + | black hl hr => rw [← ins_eq_fill hp' (.black hl hr), insert_setBlack]; exact (zoom_ins H).symm + +theorem zoom_del {t : RBNode α} : + t.zoom cut path = (t', path') → + path.del (t.del cut) (match t with | node c .. => c | _ => red) = + path'.del t'.delRoot (match t' with | node c .. => c | _ => red) := by + unfold RBNode.del; split <;> simp [zoom] + · intro | rfl, rfl => rfl + · next c a y b => + split + · have IH := @zoom_del (t := a) + match a with + | nil => intro | rfl => rfl + | node black .. | node red .. => apply IH + · have IH := @zoom_del (t := b) + match b with + | nil => intro | rfl => rfl + | node black .. | node red .. => apply IH + · intro | rfl => rfl + +/-- Asserts that `p` holds on all elements to the left of the hole. -/ +def AllL (p : α → Prop) : Path α → Prop + | .root => True + | .left _ parent _ _ => parent.AllL p + | .right _ a x parent => a.All p ∧ p x ∧ parent.AllL p + +/-- Asserts that `p` holds on all elements to the right of the hole. -/ +def AllR (p : α → Prop) : Path α → Prop + | .root => True + | .left _ parent x b => parent.AllR p ∧ p x ∧ b.All p + | .right _ _ _ parent => parent.AllR p + end Path theorem insert_toList_zoom {t : RBNode α} (ht : Balanced t c n) diff --git a/Std/Data/RBMap/WF.lean b/Std/Data/RBMap/WF.lean index ddc72ea38f..0e00e65465 100644 --- a/Std/Data/RBMap/WF.lean +++ b/Std/Data/RBMap/WF.lean @@ -27,6 +27,9 @@ theorem All.trivial (H : ∀ {x : α}, p x) : ∀ {t : RBNode α}, t.All p theorem All_and {t : RBNode α} : t.All (fun a => p a ∧ q a) ↔ t.All p ∧ t.All q := by induction t <;> simp [*, and_assoc, and_left_comm] +protected theorem cmpLT.flip (h₁ : cmpLT cmp x y) : cmpLT (flip cmp) y x := + ⟨have : TransCmp cmp := inferInstanceAs (TransCmp (flip (flip cmp))); h₁.1⟩ + theorem cmpLT.trans (h₁ : cmpLT cmp x y) (h₂ : cmpLT cmp y z) : cmpLT cmp x z := ⟨TransCmp.lt_trans h₁.1 h₂.1⟩ @@ -42,6 +45,36 @@ theorem cmpEq.lt_congr_left (H : cmpEq cmp x y) : cmpLT cmp x z ↔ cmpLT cmp y theorem cmpEq.lt_congr_right (H : cmpEq cmp y z) : cmpLT cmp x y ↔ cmpLT cmp x z := ⟨fun ⟨h⟩ => ⟨TransCmp.cmp_congr_right H.1 ▸ h⟩, fun ⟨h⟩ => ⟨TransCmp.cmp_congr_right H.1 ▸ h⟩⟩ +@[simp] theorem reverse_reverse (t : RBNode α) : t.reverse.reverse = t := by + induction t <;> simp [*] + +theorem reverse_eq_iff {t t' : RBNode α} : t.reverse = t' ↔ t = t'.reverse := by + constructor <;> rintro rfl <;> simp + +@[simp] theorem reverse_balance1 (l : RBNode α) (v : α) (r : RBNode α) : + (balance1 l v r).reverse = balance2 r.reverse v l.reverse := by + unfold balance1 balance2; split <;> simp + · rw [balance2.match_1.eq_2]; simp [reverse_eq_iff]; intros; solve_by_elim + · rw [balance2.match_1.eq_3] <;> (simp [reverse_eq_iff]; intros; solve_by_elim) + +@[simp] theorem reverse_balance2 (l : RBNode α) (v : α) (r : RBNode α) : + (balance2 l v r).reverse = balance1 r.reverse v l.reverse := by + refine Eq.trans ?_ (reverse_reverse _); rw [reverse_balance1]; simp + +@[simp] theorem All.reverse {t : RBNode α} : t.reverse.All p ↔ t.All p := by + induction t <;> simp [*, and_comm] + +/-- The `reverse` function reverses the ordering invariants. -/ +protected theorem Ordered.reverse : ∀ {t : RBNode α}, t.Ordered cmp → t.reverse.Ordered (flip cmp) + | .nil, _ => ⟨⟩ + | .node .., ⟨lv, vr, hl, hr⟩ => + ⟨(All.reverse.2 vr).imp cmpLT.flip, (All.reverse.2 lv).imp cmpLT.flip, hr.reverse, hl.reverse⟩ + +protected theorem Balanced.reverse {t : RBNode α} : t.Balanced c n → t.reverse.Balanced c n + | .nil => .nil + | .black hl hr => .black hr.reverse hl.reverse + | .red hl hr => .red hr.reverse hl.reverse + /-- The `balance1` function preserves the ordering invariants. -/ protected theorem Ordered.balance1 {l : RBNode α} {v : α} {r : RBNode α} (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·)) @@ -63,19 +96,17 @@ protected theorem Ordered.balance1 {l : RBNode α} {v : α} {r : RBNode α} protected theorem Ordered.balance2 {l : RBNode α} {v : α} {r : RBNode α} (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·)) (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balance2 l v r).Ordered cmp := by - unfold balance2; split - · next b y c z d => - have ⟨_, ⟨vy, vb, _⟩, _⟩ := vr; have ⟨⟨yz, _, cz⟩, zd, ⟨by_, yc, hy, hz⟩, hd⟩ := hr - exact ⟨⟨vy, vy.trans_r lv, by_⟩, ⟨yz, yc, yz.trans_l zd⟩, ⟨lv, vb, hl, hy⟩, cz, zd, hz, hd⟩ - · next a x b y c _ => - have ⟨vx, va, _⟩ := vr; have ⟨ax, xy, ha, hy⟩ := hr - exact ⟨⟨vx, vx.trans_r lv, ax⟩, xy, ⟨lv, va, hl, ha⟩, hy⟩ - · exact ⟨lv, vr, hl, hr⟩ + rw [← reverse_reverse (balance2 ..), reverse_balance2] + exact .reverse <| hr.reverse.balance1 + ((All.reverse.2 vr).imp cmpLT.flip) ((All.reverse.2 lv).imp cmpLT.flip) hl.reverse @[simp] theorem balance2_All {l : RBNode α} {v : α} {r : RBNode α} : (balance2 l v r).All p ↔ p v ∧ l.All p ∧ r.All p := by unfold balance2; split <;> simp [and_assoc, and_left_comm] +@[simp] theorem reverse_setBlack {t : RBNode α} : (setBlack t).reverse = setBlack t.reverse := by + unfold setBlack; split <;> simp + protected theorem Ordered.setBlack {t : RBNode α} : (setBlack t).Ordered cmp ↔ t.Ordered cmp := by unfold setBlack; split <;> simp [Ordered] @@ -85,9 +116,10 @@ protected theorem Balanced.setBlack : t.Balanced c n → ∃ n', (setBlack t).Ba theorem setBlack_idem {t : RBNode α} : t.setBlack.setBlack = t.setBlack := by cases t <;> rfl -theorem insert_setBlack {t : RBNode α} : - (t.insert cmp v).setBlack = (t.ins cmp v).setBlack := by - unfold insert; split <;> simp [setBlack_idem] +@[simp] theorem reverse_ins [inst : @OrientedCmp α cmp] {t : RBNode α} : + (ins cmp x t).reverse = ins (flip cmp) x t.reverse := by + induction t <;> [skip; (rename_i c a y b iha ihb; cases c)] <;> simp [ins, flip] + <;> rw [← inst.symm x y] <;> split <;> simp [*, Ordering.swap, iha, ihb] protected theorem All.ins {x : α} {t : RBNode α} (h₁ : p x) (h₂ : t.All p) : (ins cmp x t).All p := by @@ -112,6 +144,17 @@ protected theorem Ordered.ins : ∀ {t : RBNode α}, t.Ordered cmp → (ins cmp ay.imp fun ⟨h'⟩ => ⟨(TransCmp.cmp_congr_right h).trans h'⟩, yb.imp fun ⟨h'⟩ => ⟨(TransCmp.cmp_congr_left h).trans h'⟩, ha, hb⟩) +@[simp] theorem isRed_reverse {t : RBNode α} : t.reverse.isRed = t.isRed := by + cases t <;> simp [isRed] + +@[simp] theorem reverse_insert [inst : @OrientedCmp α cmp] {t : RBNode α} : + (insert cmp t x).reverse = insert (flip cmp) t.reverse x := by + simp [insert] <;> split <;> simp + +theorem insert_setBlack {t : RBNode α} : + (t.insert cmp v).setBlack = (t.ins cmp v).setBlack := by + unfold insert; split <;> simp [setBlack_idem] + /-- The `insert` function preserves the ordering invariants. -/ protected theorem Ordered.insert (h : t.Ordered cmp) : (insert cmp t v).Ordered cmp := by unfold RBNode.insert; split <;> simp [Ordered.setBlack, h.ins (x := v)] @@ -145,6 +188,10 @@ protected theorem RedRed.imp (h : p → q) : RedRed p t n → RedRed q t n | .balanced h => .balanced h | .redred hp ha hb => .redred (h hp) ha hb +protected theorem RedRed.reverse : RedRed p t n → RedRed p t.reverse n + | .balanced h => .balanced h.reverse + | .redred hp ha hb => .redred hp hb.reverse ha.reverse + /-- If `t` has the red-red invariant, then setting the root to black yields a balanced tree. -/ protected theorem RedRed.setBlack : t.RedRed p n → ∃ n', (setBlack t).Balanced black n' | .balanced h => h.setBlack @@ -164,15 +211,8 @@ protected theorem RedRed.balance1 {l : RBNode α} {v : α} {r : RBNode α} /-- The `balance2` function repairs the balance invariant when the second argument is red-red. -/ protected theorem RedRed.balance2 {l : RBNode α} {v : α} {r : RBNode α} - (hl : l.Balanced c n) (hr : r.RedRed p n) : ∃ c, (balance2 l v r).Balanced c (n + 1) := by - unfold balance2; split - · have .redred _ (.red ha hb) hc := hr; exact ⟨_, .red (.black hl ha) (.black hb hc)⟩ - · have .redred _ ha (.red hb hc) := hr; exact ⟨_, .red (.black hl ha) (.black hb hc)⟩ - · next H1 H2 => match hr with - | .balanced hr => exact ⟨_, .black hl hr⟩ - | .redred _ (c₁ := black) (c₂ := black) ha hb => exact ⟨_, .black hl (.red ha hb)⟩ - | .redred _ (c₁ := red) (.red ..) _ => cases H1 _ _ _ _ _ rfl - | .redred _ (c₂ := red) _ (.red ..) => cases H2 _ _ _ _ _ rfl + (hl : l.Balanced c n) (hr : r.RedRed p n) : ∃ c, (balance2 l v r).Balanced c (n + 1) := + (hr.reverse.balance1 hl.reverse (v := v)).imp fun _ h => by simpa using h.reverse /-- The `balance1` function does nothing if the first argument is already balanced. -/ theorem balance1_eq {l : RBNode α} {v : α} {r : RBNode α} @@ -181,8 +221,8 @@ theorem balance1_eq {l : RBNode α} {v : α} {r : RBNode α} /-- The `balance2` function does nothing if the second argument is already balanced. -/ theorem balance2_eq {l : RBNode α} {v : α} {r : RBNode α} - (hr : r.Balanced c n) : balance2 l v r = node black l v r := by - unfold balance2; split <;> first | rfl | nomatch hr + (hr : r.Balanced c n) : balance2 l v r = node black l v r := + (reverse_reverse _).symm.trans <| by simp [balance1_eq hr.reverse] /-! ## insert -/ @@ -225,6 +265,9 @@ theorem Balanced.insert {t : RBNode α} (h : t.Balanced c n) : | _, .balanced h => split <;> [exact ⟨_, h.setBlack⟩; exact ⟨_, _, h⟩] | _, .redred _ ha hb => have .node red .. := t; exact ⟨_, _, .black ha hb⟩ +@[simp] theorem reverse_setRed {t : RBNode α} : (setRed t).reverse = setRed t.reverse := by + unfold setRed; split <;> simp + protected theorem All.setRed {t : RBNode α} (h : t.All p) : (setRed t).All p := by unfold setRed; split <;> simp_all @@ -232,6 +275,18 @@ protected theorem All.setRed {t : RBNode α} (h : t.All p) : (setRed t).All p := protected theorem Ordered.setRed {t : RBNode α} : (setRed t).Ordered cmp ↔ t.Ordered cmp := by unfold setRed; split <;> simp [Ordered] +@[simp] theorem reverse_balLeft (l : RBNode α) (v : α) (r : RBNode α) : + (balLeft l v r).reverse = balRight r.reverse v l.reverse := by + unfold balLeft balRight; split + · simp + · rw [balLeft.match_2.eq_2 _ _ _ _ (by simp [reverse_eq_iff]; intros; solve_by_elim)] + split <;> simp + rw [balRight.match_1.eq_3] <;> (simp [reverse_eq_iff]; intros; solve_by_elim) + +@[simp] theorem reverse_balRight (l : RBNode α) (v : α) (r : RBNode α) : + (balRight l v r).reverse = balLeft r.reverse v l.reverse := by + rw [← reverse_reverse (balLeft ..)]; simp + protected theorem All.balLeft (hl : l.All p) (hv : p v) (hr : r.All p) : (balLeft l v r).All p := by unfold balLeft; split <;> (try simp_all); split <;> simp_all [All.setRed] @@ -267,38 +322,24 @@ protected theorem Balanced.balLeft (hl : l.RedRed True n) (hr : r.Balanced cr (n let ⟨c, h⟩ := RedRed.balance2 hb (.redred trivial hc hd); .redred rfl (.black hl ha) h protected theorem All.balRight - (hl : l.All p) (hv : p v) (hr : r.All p) : (balRight l v r).All p := by - unfold balRight; split <;> (try simp_all); split <;> simp_all [All.setRed] + (hl : l.All p) (hv : p v) (hr : r.All p) : (balRight l v r).All p := + All.reverse.1 <| reverse_balRight .. ▸ (All.reverse.2 hr).balLeft hv (All.reverse.2 hl) /-- The `balRight` function preserves the ordering invariants. -/ protected theorem Ordered.balRight {l : RBNode α} {v : α} {r : RBNode α} (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·)) (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balRight l v r).Ordered cmp := by - unfold balRight; split - · exact ⟨lv, vr, hl, hr⟩ - split - · exact hl.balance1 lv vr hr - · have ⟨yv, _, cv⟩ := lv.2.2; have ⟨ax, ⟨xy, xb, _⟩, ha, by_, yc, hb, hc⟩ := hl - exact ⟨balance1_All.2 ⟨xy, (xy.trans_r ax).setRed, by_⟩, ⟨yv, yc, yv.trans_l vr⟩, - (Ordered.setRed.2 ha).balance1 ax.setRed xb hb, cv, vr, hc, hr⟩ - · exact ⟨lv, vr, hl, hr⟩ + rw [← reverse_reverse (balRight ..), reverse_balRight] + exact .reverse <| hr.reverse.balLeft + ((All.reverse.2 vr).imp cmpLT.flip) ((All.reverse.2 lv).imp cmpLT.flip) hl.reverse /-- The balancing properties of the `balRight` function. -/ protected theorem Balanced.balRight (hl : l.Balanced cl (n + 1)) (hr : r.RedRed True n) : (balRight l v r).RedRed (cl = red) (n + 1) := by - unfold balRight; split - · next b y c => exact - let ⟨cb, cc, hb, hc⟩ := hr.of_red - match cl with - | red => .redred rfl hl (.black hb hc) - | black => .balanced (.red hl (.black hb hc)) - · next H => exact match hr with - | .redred .. => nomatch H _ _ _ rfl - | .balanced hr => match hl with - | .black hb hc => - let ⟨c, h⟩ := RedRed.balance1 (.redred trivial hb hc) hr; .balanced h - | .red (.black ha hb) (.black hc hd) => - let ⟨c, h⟩ := RedRed.balance1 (.redred trivial ha hb) hc; .redred rfl h (.black hd hr) + rw [← reverse_reverse (balRight ..), reverse_balRight] + exact .reverse <| hl.reverse.balLeft hr.reverse + +-- note: reverse_append is false! protected theorem All.append (hl : l.All p) (hr : r.All p) : (append l r).All p := by unfold append; split <;> try simp [*] diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index b1994dde0d..0bd703baa7 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -32,6 +32,12 @@ theorem ext_iff {s₁ s₂ : String} : s₁ = s₂ ↔ s₁.data = s₂.data := rw [push, mk_length, List.length_append, List.length_singleton, Nat.succ.injEq] rfl +@[simp] theorem length_pushn (c : Char) (n : Nat) : (pushn s c n).length = s.length + n := by + unfold pushn; induction n <;> simp [Nat.repeat, Nat.add_assoc, *] + +@[simp] theorem length_append (s t : String) : (s ++ t).length = s.length + t.length := by + simp only [length, append, List.length_append] + @[simp] theorem data_push (s : String) (c : Char) : (s.push c).1 = s.1 ++ [c] := rfl @[simp] theorem data_append (s t : String) : (s ++ t).1 = s.1 ++ t.1 := rfl diff --git a/Std/Data/Sum/Lemmas.lean b/Std/Data/Sum/Lemmas.lean index f7766d2985..80d4fb4230 100644 --- a/Std/Data/Sum/Lemmas.lean +++ b/Std/Data/Sum/Lemmas.lean @@ -5,6 +5,7 @@ Authors: Mario Carneiro, Yury G. Kudryashov -/ import Std.Data.Sum.Basic +import Std.Logic /-! # Disjoint union of types @@ -112,6 +113,10 @@ theorem comp_elim (f : γ → δ) (g : α → γ) (h : β → γ) : 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 : β → β') : diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index d94c11ae26..a2f422f1a4 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -13,14 +13,11 @@ Authors: François G. Dorais theorem UInt8.toNat_lt (x : UInt8) : x.toNat < 2 ^ 8 := x.val.isLt -@[simp] theorem UInt8.toUInt16_toNat (x : UInt8) : x.toUInt16.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt16_toNat (x : UInt8) : x.toUInt16.toNat = x.toNat := rfl -@[simp] theorem UInt8.toUInt32_toNat (x : UInt8) : x.toUInt32.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt32_toNat (x : UInt8) : x.toUInt32.toNat = x.toNat := rfl -@[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt16 -/ @@ -33,11 +30,9 @@ theorem UInt16.toNat_lt (x : UInt16) : x.toNat < 2 ^ 16 := x.val.isLt @[simp] theorem UInt16.toUInt8_toNat (x : UInt16) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl -@[simp] theorem UInt16.toUInt32_toNat (x : UInt16) : x.toUInt32.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt16.toUInt32_toNat (x : UInt16) : x.toUInt32.toNat = x.toNat := rfl -@[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt32 -/ @@ -52,8 +47,7 @@ theorem UInt32.toNat_lt (x : UInt32) : x.toNat < 2 ^ 32 := x.val.isLt @[simp] theorem UInt32.toUInt16_toNat (x : UInt32) : x.toUInt16.toNat = x.toNat % 2 ^ 16 := rfl -@[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt64 -/ @@ -97,5 +91,4 @@ theorem USize.toNat_lt (x : USize) : x.toNat < 2 ^ System.Platform.numBits := by @[simp] theorem USize.toUInt64_toNat (x : USize) : x.toUInt64.toNat = x.toNat := by simp only [USize.toUInt64, UInt64.toNat]; rfl -@[simp] theorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt USize.le_size) +@[simp] theorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := rfl diff --git a/Std/Lean/PersistentHashMap.lean b/Std/Lean/PersistentHashMap.lean index 4122f193b4..5054e15758 100644 --- a/Std/Lean/PersistentHashMap.lean +++ b/Std/Lean/PersistentHashMap.lean @@ -19,12 +19,6 @@ def insert' (m : PersistentHashMap α β) (a : α) (b : β) : PersistentHashMap let m := m.insert a b (m, m.size == oldSize) -/-- -Turns a `PersistentHashMap` into an array of key-value pairs. --/ -def toArray (m : PersistentHashMap α β) : Array (α × β) := - m.foldl (init := Array.mkEmpty m.size) fun xs k v => xs.push (k, v) - /-- Builds a `PersistentHashMap` from a list of key-value pairs. Values of duplicated keys are replaced by their respective last occurrences. diff --git a/Std/Logic.lean b/Std/Logic.lean index 1069b48c75..c11432896d 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -56,6 +56,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 _ +theorem Function.funext_iff {β : α → Sort u} {f₁ f₂ : ∀ x : α, β x} : f₁ = f₂ ↔ ∀ a, f₁ a = f₂ a := + ⟨congrFun, funext⟩ + theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} : f x ≠ f y → x ≠ y := mt <| congrArg _ diff --git a/Std/Tactic/Classical.lean b/Std/Tactic/Classical.lean index 3bd386c858..cf05a4d59f 100644 --- a/Std/Tactic/Classical.lean +++ b/Std/Tactic/Classical.lean @@ -8,7 +8,7 @@ import Lean.Elab.ElabRules /-! # `classical` and `classical!` tactics -/ namespace Std.Tactic -open Lean Meta +open Lean Meta Elab.Tactic /-- `classical!` adds a proof of `Classical.propDecidable` as a local variable, which makes it @@ -24,6 +24,19 @@ Consider using `classical` instead if you want to use the decidable instance whe macro (name := classical!) "classical!" : tactic => `(tactic| have em := Classical.propDecidable) +/-- +`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 tacs` runs `tacs` in a scope where `Classical.propDecidable` is a low priority local instance. It differs from `classical!` in that `classical!` uses a local variable, @@ -45,7 +58,4 @@ 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 - modifyEnv Meta.instanceExtension.pushScope - Meta.addInstance ``Classical.propDecidable .local 10 - try Elab.Tactic.evalTactic tacs - finally modifyEnv Meta.instanceExtension.popScope + classical <| Elab.Tactic.evalTactic tacs diff --git a/Std/Tactic/FalseOrByContra.lean b/Std/Tactic/FalseOrByContra.lean deleted file mode 100644 index 8a3a8d0763..0000000000 --- a/Std/Tactic/FalseOrByContra.lean +++ /dev/null @@ -1,65 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.Elab.Tactic.Basic -import Std.Lean.Meta.Basic -import Lean.Meta.Tactic.Util - -/-! -# `false_or_by_contra` tactic - -Changes the goal to `False`, retaining as much information as possible: - -If the goal is `False`, do nothing. -If the goal is an implication or a function type, introduce the argument. -(If the goal is `x ≠ y`, introduce `x = y`.) -Otherwise, for a goal `P`, replace it with `¬ ¬ P` and introduce `¬ P`. --/ - -open Lean - -/-- -Changes the goal to `False`, retaining as much information as possible: - -If the goal is `False`, do nothing. -If the goal is an implication or a function type, introduce the argument and restart. -(In particular, if the goal is `x ≠ y`, introduce `x = y`.) -Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P` -(attempt to find a `Decidable` instance, but otherwise falling back to working classically) -and introduce `¬ P`. -For a non-propositional goal use `False.elim`. --/ -syntax (name := false_or_by_contra) "false_or_by_contra" : tactic - -open Meta Elab Tactic - -@[inherit_doc false_or_by_contra] -partial def falseOrByContra (g : MVarId) (useClassical : Option Bool := none) : MetaM MVarId := do - let ty ← whnfR (← g.getType) - match ty with - | .const ``False _ => pure g - | .forallE _ _ _ _ - | .app (.const ``Not _) _ => falseOrByContra (← g.intro1).2 - | _ => - let gs ← if ← isProp ty then - match useClassical with - | some true => some <$> g.applyConst ``Classical.byContradiction - | some false => - try some <$> g.applyConst ``Decidable.byContradiction - catch _ => pure none - | none => - try some <$> g.applyConst ``Decidable.byContradiction - catch _ => some <$> g.applyConst ``Classical.byContradiction - else - pure none - if let some gs := gs then - let [g] := gs | panic! "expected one subgoal" - pure (← g.intro1).2 - else - let [g] ← g.applyConst ``False.elim | panic! "expected one sugoal" - pure g - -@[inherit_doc falseOrByContra] -elab "false_or_by_contra" : tactic => liftMetaTactic1 (falseOrByContra ·) diff --git a/Std/Tactic/PrintPrefix.lean b/Std/Tactic/PrintPrefix.lean index 29fa51d834..b342b38b12 100644 --- a/Std/Tactic/PrintPrefix.lean +++ b/Std/Tactic/PrintPrefix.lean @@ -5,9 +5,11 @@ Authors: Shing Tak Lam, Daniel Selsam, Mario Carneiro -/ import Std.Lean.Name import Std.Lean.Util.EnvSearch +import Std.Lean.Delaborator import Lean.Elab.Tactic.Config -namespace Lean.Elab.Command +namespace Std.Tactic +open Lean Elab Command /-- Options to control `#print prefix` command and `getMatchingConstants`. @@ -29,35 +31,6 @@ structure PrintPrefixConfig where /-- Function elaborating `Config`. -/ declare_config_elab elabPrintPrefixConfig PrintPrefixConfig -/-- -The command `#print prefix foo` will print all definitions that start with -the namespace `foo`. - -For example, the command below will print out definitions in the `List` namespace: - -```lean -#print prefix List -``` - -`#print prefix` can be controlled by flags in `PrintPrefixConfig`. These provide -options for filtering names and formatting. For example, -`#print prefix` by default excludes internal names, but this can be controlled -via config: -```lean -#print prefix (config:={internals:=true}) List -``` - -By default, `#print prefix` prints the type after each name. This can be controlled -by setting `showTypes` to `false`: -```lean -#print prefix (config:={showTypes:=false}) List -``` - -The complete set of flags can be seen in the documentation -for `Lean.Elab.Command.PrintPrefixConfig`. --/ -syntax (name := printPrefix) "#print" "prefix" (Lean.Parser.Tactic.config)? ident : command - /-- `reverseName name` reverses the components of a name. -/ @@ -88,12 +61,9 @@ private def matchName (opts : PrintPrefixConfig) let (root, post) := takeNameSuffix (nameCnt - preCnt) name if root ≠ pre then return false if !opts.internals && post.isInternalDetail then return false + if opts.propositions != opts.propositionsOnly then return opts.propositions let isProp := (Expr.isProp <$> Lean.Meta.inferType cinfo.type) <|> pure false - if opts.propositions then do - if opts.propositionsOnly && !(←isProp) then return false - else do - if opts.propositionsOnly || (←isProp) then return false - pure true + pure <| opts.propositionsOnly == (← isProp) private def lexNameLt : Name -> Name -> Bool | _, .anonymous => false @@ -103,32 +73,53 @@ private def lexNameLt : Name -> Name -> Bool | .str _ _, .num _ _ => false | .str p m, .str q n => m < n || m == n && lexNameLt p q -private def appendMatchingConstants (msg : String) (opts : PrintPrefixConfig) (pre : Name) - : MetaM String := do +private def matchingConstants (opts : PrintPrefixConfig) (pre : Name) + : MetaM (Array MessageData) := do let cinfos ← getMatchingConstants (matchName opts pre) opts.imported let cinfos := cinfos.qsort fun p q => lexNameLt (reverseName p.name) (reverseName q.name) - let mut msg := msg - let ppInfo cinfo := - if opts.showTypes then do - pure s!"{cinfo.name} : {← Meta.ppExpr cinfo.type}\n" - else - pure s!"{cinfo.name}\n" - for cinfo in cinfos do - msg := msg ++ (← ppInfo cinfo) - pure msg + cinfos.mapM fun cinfo => do + if opts.showTypes then + pure <| .ofPPFormat { pp := fun + | some ctx => ctx.runMetaM <| + withOptions (pp.tagAppFns.set · true) <| PrettyPrinter.ppSignature cinfo.name + | none => return f!"{cinfo.name}" -- should never happen + } ++ "\n" + else + pure m!"{ppConst (← mkConstWithLevelParams cinfo.name)}\n" /-- -Implementation for #print prefix +The command `#print prefix foo` will print all definitions that start with +the namespace `foo`. + +For example, the command below will print out definitions in the `List` namespace: + +```lean +#print prefix List +``` + +`#print prefix` can be controlled by flags in `PrintPrefixConfig`. These provide +options for filtering names and formatting. For example, +`#print prefix` by default excludes internal names, but this can be controlled +via config: +```lean +#print prefix (config := {internals := true}) List +``` + +By default, `#print prefix` prints the type after each name. This can be controlled +by setting `showTypes` to `false`: +```lean +#print prefix (config := {showTypes := false}) List +``` + +The complete set of flags can be seen in the documentation +for `Lean.Elab.Command.PrintPrefixConfig`. -/ -@[command_elab printPrefix] def elabPrintPrefix : CommandElab -| `(#print prefix%$tk $[$cfg:config]? $name:ident) => do +elab (name := printPrefix) "#print" tk:"prefix" + cfg:(Lean.Parser.Tactic.config)? name:ident : command => liftTermElabM do let nameId := name.getId - liftTermElabM do - let opts ← elabPrintPrefixConfig (mkOptionalNode cfg) - let mut msg ← appendMatchingConstants "" opts nameId - if msg.isEmpty then - if let [name] ← resolveGlobalConst name then - msg ← appendMatchingConstants msg opts name - if !msg.isEmpty then - logInfoAt tk msg -| _ => throwUnsupportedSyntax + 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 "") diff --git a/Std/Tactic/ShowUnused.lean b/Std/Tactic/ShowUnused.lean new file mode 100644 index 0000000000..9efc6b7673 --- /dev/null +++ b/Std/Tactic/ShowUnused.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2024 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import Lean.Util.FoldConsts +import Lean.Linter.UnusedVariables +import Std.Lean.Delaborator + +/-! +# The `#show_unused` command + +`#show_unused decl1 decl2 ..` will highlight every theorem or definition in the current file +not involved in the definition of declarations `decl1`, `decl2`, etc. The result is shown +both in the message on `#show_unused`, as well as on the declarations themselves. +-/ + +namespace Std.Tactic.ShowUnused +open Lean Elab Command + +variable (env : Environment) in +private partial def visit (n : Name) : StateM NameSet Unit := do + if (← get).contains n then + modify (·.erase n) + let rec visitExpr (e : Expr) : StateM NameSet Unit := e.getUsedConstants.forM visit + match env.find? n with + | some (ConstantInfo.axiomInfo v) => visitExpr v.type + | some (ConstantInfo.defnInfo v) => visitExpr v.type *> visitExpr v.value + | some (ConstantInfo.thmInfo v) => visitExpr v.type *> visitExpr v.value + | some (ConstantInfo.opaqueInfo v) => visitExpr v.type *> visitExpr v.value + | some (ConstantInfo.quotInfo _) => pure () + | some (ConstantInfo.ctorInfo v) => visitExpr v.type + | some (ConstantInfo.recInfo v) => visitExpr v.type + | some (ConstantInfo.inductInfo v) => visitExpr v.type *> v.ctors.forM visit + | none => pure () + +/-- +`#show_unused decl1 decl2 ..` will highlight every theorem or definition in the current file +not involved in the definition of declarations `decl1`, `decl2`, etc. The result is shown +both in the message on `#show_unused`, as well as on the declarations themselves. +``` +def foo := 1 +def baz := 2 +def bar := foo +#show_unused bar -- highlights `baz` +``` +-/ +elab tk:"#show_unused" ids:(ppSpace colGt ident)* : command => do + let ns ← ids.mapM fun s => liftCoreM <| realizeGlobalConstNoOverloadWithInfo s + let env ← getEnv + let decls := env.constants.map₂.foldl (fun m n _ => m.insert n) {} + let mut unused := #[] + let fileMap ← getFileMap + for c in ((ns.forM (visit env)).run decls).2 do + if let some { selectionRange := range, .. } := declRangeExt.find? env c then + unused := unused.push (c, { + start := fileMap.ofPosition range.pos + stop := fileMap.ofPosition range.endPos + }) + unused := unused.qsort (·.2.start < ·.2.start) + let pos := fileMap.toPosition <| (tk.getPos? <|> (← getRef).getPos?).getD 0 + let pfx := m!"#show_unused (line {pos.line}) says:\n" + let post := m!" is not used transitively by \ + {← ns.mapM (Lean.ppConst <$> mkConstWithLevelParams ·)}" + for (c, range) in unused do + logWarningAt (Syntax.ofRange range) <| + .tagged Linter.linter.unusedVariables.name <| + m!"{pfx}{Lean.ppConst (← mkConstWithLevelParams c)}{post}" + if unused.isEmpty then + logInfoAt tk "No unused definitions" + else + logWarningAt tk <| m!"unused definitions in this file:\n" ++ + m!"\n".joinSep (← unused.toList.mapM (toMessageData <$> mkConstWithLevelParams ·.1)) diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 39fad08cfc..cfb0476a57 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -85,7 +85,7 @@ elab_rules : tactic throw e if let some new := new then for (_, stx, usedSimps) in new do - let usedSimps := usedSimps.foldl (fun s usedSimps => usedSimps.fold .insert s) {} + let usedSimps := usedSimps.foldl (fun s usedSimps => usedSimps.foldl .insert s) {} let stx' ← mkSimpCallStx stx usedSimps TryThis.addSuggestion stx[0] stx' (origSpan? := stx) diff --git a/lean-toolchain b/lean-toolchain index 4610193327..b96d89db4d 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-01 +leanprover/lean4:nightly-2024-04-22 diff --git a/test/case.lean b/test/case.lean index ab0b664218..2c0c5ff552 100644 --- a/test/case.lean +++ b/test/case.lean @@ -183,11 +183,14 @@ example : True ∧ ∀ x : Nat, x = x := by -- Test focusing by full match, suffix match, and prefix match /-- -warning: unused variable `x` [linter.unusedVariables] +warning: unused variable `x` +note: this linter can be disabled with `set_option linter.unusedVariables false` --- -warning: unused variable `y` [linter.unusedVariables] +warning: unused variable `y` +note: this linter can be disabled with `set_option linter.unusedVariables false` --- -warning: unused variable `z` [linter.unusedVariables] +warning: unused variable `z` +note: this linter can be disabled with `set_option linter.unusedVariables false` -/ #guard_msgs in example : True := by diff --git a/test/false_or_by_contra.lean b/test/false_or_by_contra.lean deleted file mode 100644 index 5d3e4669e3..0000000000 --- a/test/false_or_by_contra.lean +++ /dev/null @@ -1,53 +0,0 @@ -import Std.Tactic.FalseOrByContra - -example (w : False) : False := by - false_or_by_contra - guard_target = False - exact w - -example : False → Nat := by - false_or_by_contra <;> rename_i h - guard_target = False - guard_hyp h : False - simp_all - -example {P : Prop} (p : P) : Nat → Nat → P := by - false_or_by_contra <;> rename_i a b h - guard_target = False - guard_hyp a : Nat - guard_hyp b : Nat - guard_hyp h : ¬ P - simp_all - -example {P : Prop} : False → P := by - false_or_by_contra <;> rename_i h w - guard_target = False - guard_hyp h : False - guard_hyp w : ¬ P - simp_all - -example (_ : False) : x ≠ y := by - false_or_by_contra <;> rename_i h - guard_hyp h : x = y - guard_target = False - simp_all - -example (_ : False) : ¬ P := by - false_or_by_contra <;> rename_i h - guard_hyp h : P - guard_target = False - simp_all - -example {P : Prop} (_ : False) : P := by - false_or_by_contra <;> rename_i h - guard_hyp h : ¬ P - guard_target = False - simp_all - --- It doesn't make sense to use contradiction if the goal is a Type (rather than a Prop). -example {P : Type} (_ : False) : P := by - false_or_by_contra - fail_if_success - have : ¬ P := by assumption - guard_target = False - simp_all diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 6ff9720bbf..bab7b9db86 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -19,7 +19,7 @@ elab "check_indep" : tactic => do pure () /-- warning: ?w : Nat is not independent of: -/ -#guard_msgs(warning) in +#guard_msgs(warning, drop info) in example : ∃ (n : Nat), ∀(x : Fin n), x.val = 0 := by apply Exists.intro intro x @@ -32,7 +32,7 @@ example : ∃ (n : Nat), ∀(x : Fin n), x.val = 0 := by -- This is a tricker one, where the dependency is via a hypothesis. /-- warning: ?w : Nat is not independent of: -/ -#guard_msgs(warning) in +#guard_msgs(warning, drop info) in example : ∃ (n : Nat), ∀(x : Fin n) (y : Nat), x.val = y → y = 0 := by apply Exists.intro intro x y p diff --git a/test/lintTC.lean b/test/lintTC.lean index deee02378c..74d8f861b1 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -5,7 +5,10 @@ open Std.Tactic.Lint namespace A -/-- warning: unused variable `β` [linter.unusedVariables] -/ +/-- +warning: unused variable `β` +note: this linter can be disabled with `set_option linter.unusedVariables false` +-/ #guard_msgs in local instance impossible {α β : Type} [Inhabited α] : Nonempty α := ⟨default⟩ diff --git a/test/lint_unreachableTactic.lean b/test/lint_unreachableTactic.lean index 86938a12f9..ec10da4a3a 100644 --- a/test/lint_unreachableTactic.lean +++ b/test/lint_unreachableTactic.lean @@ -1,6 +1,9 @@ import Std.Linter.UnreachableTactic -/-- warning: this tactic is never executed [linter.unreachableTactic] -/ +/-- +warning: this tactic is never executed +note: this linter can be disabled with `set_option linter.unreachableTactic false` +-/ #guard_msgs in example : 1 = 1 := by rfl <;> simp diff --git a/test/print_prefix.lean b/test/print_prefix.lean index a506e926c6..6677469882 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -3,19 +3,18 @@ import Std.Tactic.PrintPrefix inductive TEmpty : Type /-- info: TEmpty : Type -TEmpty.casesOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t -TEmpty.noConfusion : {P : Sort u} → {v1 v2 : TEmpty} → v1 = v2 → TEmpty.noConfusionType P v1 v2 -TEmpty.noConfusionType : Sort u → TEmpty → TEmpty → Sort u -TEmpty.rec : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t -TEmpty.recOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t +TEmpty.casesOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t +TEmpty.noConfusion.{u} {P : Sort u} {v1 v2 : TEmpty} (h12 : v1 = v2) : TEmpty.noConfusionType P v1 v2 +TEmpty.noConfusionType.{u} (P : Sort u) (v1 v2 : TEmpty) : Sort u +TEmpty.rec.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t +TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t -/ #guard_msgs in #print prefix TEmpty -- Test type that probably won't change much. -/-- --/ +/-- info: -/ #guard_msgs in -#print prefix (config:={imported:=false}) Empty +#print prefix (config := {imported := false}) Empty namespace EmptyPrefixTest @@ -35,9 +34,7 @@ def foo (_l:List String) : Int := 0 end Prefix.Test -/-- -info: Prefix.Test.foo : List String → Int --/ +/-- info: Prefix.Test.foo (_l : List String) : Int -/ #guard_msgs in #print prefix Prefix.Test @@ -50,44 +47,52 @@ structure TestStruct where /-- info: TestStruct : Type -TestStruct.bar : TestStruct → Int -TestStruct.casesOn : {motive : TestStruct → Sort u} → (t : TestStruct) → ((foo bar : Int) → motive { foo := foo, bar := bar }) → motive t -TestStruct.foo : TestStruct → Int -TestStruct.mk : Int → Int → TestStruct -TestStruct.mk.inj : ∀ {foo bar 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 foo_1 bar_1 : Int), - ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) -TestStruct.mk.sizeOf_spec : ∀ (foo bar : Int), sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar -TestStruct.noConfusion : {P : Sort u} → {v1 v2 : TestStruct} → v1 = v2 → TestStruct.noConfusionType P v1 v2 -TestStruct.noConfusionType : Sort u → TestStruct → TestStruct → Sort u -TestStruct.rec : {motive : TestStruct → Sort u} → ((foo bar : Int) → motive { foo := foo, bar := bar }) → (t : TestStruct) → motive t -TestStruct.recOn : {motive : TestStruct → Sort u} → (t : TestStruct) → ((foo bar : Int) → motive { foo := foo, bar := bar }) → motive t +TestStruct.bar (self : TestStruct) : Int +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.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 +TestStruct.rec.{u} {motive : TestStruct → Sort u} (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) + (t : TestStruct) : motive t +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 TestStruct /-- info: TestStruct : Type -TestStruct.bar : TestStruct → Int -TestStruct.casesOn : {motive : TestStruct → Sort u} → (t : TestStruct) → ((foo bar : Int) → motive { foo := foo, bar := bar }) → motive t -TestStruct.foo : TestStruct → Int -TestStruct.mk : Int → Int → TestStruct -TestStruct.noConfusion : {P : Sort u} → {v1 v2 : TestStruct} → v1 = v2 → TestStruct.noConfusionType P v1 v2 -TestStruct.noConfusionType : Sort u → TestStruct → TestStruct → Sort u -TestStruct.rec : {motive : TestStruct → Sort u} → ((foo bar : Int) → motive { foo := foo, bar := bar }) → (t : TestStruct) → motive t -TestStruct.recOn : {motive : TestStruct → Sort u} → (t : TestStruct) → ((foo bar : Int) → motive { foo := foo, bar := bar }) → motive t +TestStruct.bar (self : TestStruct) : Int +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.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 +TestStruct.rec.{u} {motive : TestStruct → Sort u} (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) + (t : TestStruct) : motive t +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 (config := {propositions := false}) TestStruct /-- -info: TestStruct.mk.inj : ∀ {foo bar 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 foo_1 bar_1 : Int), - ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) -TestStruct.mk.sizeOf_spec : ∀ (foo bar : Int), sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar +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) +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 (config := {propositionsOnly := true}) TestStruct /-- info: TestStruct @@ -104,7 +109,7 @@ TestStruct.rec TestStruct.recOn -/ #guard_msgs in -#print prefix (config:={showTypes:=false}) TestStruct +#print prefix (config := {showTypes := false}) TestStruct /-- Artificial test function to show #print prefix filters out internals @@ -118,50 +123,51 @@ def testMatchProof : (n : Nat) → Fin n → Unit | _, ⟨0, _⟩ => () | Nat.succ as, ⟨Nat.succ i, h⟩ => testMatchProof as ⟨i, Nat.le_of_succ_le_succ h⟩ -/-- -info: testMatchProof : (n : Nat) → Fin n → Unit --/ +/-- info: testMatchProof (n : Nat) : Fin n → Unit -/ #guard_msgs in #print prefix testMatchProof /-- -info: testMatchProof : (n : Nat) → Fin n → Unit -testMatchProof._cstage1 : (n : Nat) → Fin n → Unit +info: testMatchProof (n : Nat) : Fin n → Unit +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 : (motive : (x : Nat) → Fin x → Sort u_1) → +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 : (motive : (x : Nat) → Fin x → Sort u_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.proof_1 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as -testMatchProof.proof_2 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as +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 (config := {internals := true}) testMatchProof private inductive TestInd where | foo : TestInd | bar : TestInd /-- -info: _private.test.print_prefix.0.TestInd : Type -_private.test.print_prefix.0.TestInd.bar : TestInd -_private.test.print_prefix.0.TestInd.bar.sizeOf_spec : sizeOf TestInd.bar = 1 -_private.test.print_prefix.0.TestInd.casesOn : {motive : TestInd → Sort u} → (t : TestInd) → motive TestInd.foo → motive TestInd.bar → motive t -_private.test.print_prefix.0.TestInd.foo : TestInd -_private.test.print_prefix.0.TestInd.foo.sizeOf_spec : sizeOf TestInd.foo = 1 -_private.test.print_prefix.0.TestInd.noConfusion : {P : Sort v✝} → {x y : TestInd} → x = y → TestInd.noConfusionType P x y -_private.test.print_prefix.0.TestInd.noConfusionType : Sort v✝ → TestInd → TestInd → Sort v✝ -_private.test.print_prefix.0.TestInd.rec : {motive : TestInd → Sort u} → motive TestInd.foo → motive TestInd.bar → (t : TestInd) → motive t -_private.test.print_prefix.0.TestInd.recOn : {motive : TestInd → Sort u} → (t : TestInd) → motive TestInd.foo → motive TestInd.bar → motive t -_private.test.print_prefix.0.TestInd.toCtorIdx : TestInd → Nat +info: TestInd : Type +TestInd.bar : TestInd +TestInd.bar.sizeOf_spec : sizeOf TestInd.bar = 1 +TestInd.casesOn.{u} {motive : TestInd → Sort u} (t : TestInd) (foo : motive TestInd.foo) (bar : motive TestInd.bar) : + motive t +TestInd.foo : TestInd +TestInd.foo.sizeOf_spec : sizeOf TestInd.foo = 1 +TestInd.noConfusion.{v✝} {P : Sort v✝} {x y : TestInd} (h : x = y) : TestInd.noConfusionType P x y +TestInd.noConfusionType.{v✝} (P : Sort v✝) (x y : TestInd) : Sort v✝ +TestInd.rec.{u} {motive : TestInd → Sort u} (foo : motive TestInd.foo) (bar : motive TestInd.bar) (t : TestInd) : + motive t +TestInd.recOn.{u} {motive : TestInd → Sort u} (t : TestInd) (foo : motive TestInd.foo) (bar : motive TestInd.bar) : + motive t +TestInd.toCtorIdx : TestInd → Nat -/ #guard_msgs in #print prefix TestInd diff --git a/test/show_unused.lean b/test/show_unused.lean new file mode 100644 index 0000000000..0d05ced062 --- /dev/null +++ b/test/show_unused.lean @@ -0,0 +1,14 @@ +import Std.Tactic.ShowUnused + +def foo := 1 +def baz := 2 +def bar := foo + +/-- +warning: #show_unused (line 14) says: +baz is not used transitively by [bar] +--- +warning: unused definitions in this file: +baz +-/ +#guard_msgs in #show_unused bar diff --git a/test/simpa.lean b/test/simpa.lean index 0c2d7c6aea..9528b26382 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -14,12 +14,18 @@ def foo (n : α) := [n] section unnecessarySimpa -/-- warning: try 'simp' instead of 'simpa' [linter.unnecessarySimpa] -/ +/-- +warning: try 'simp' instead of 'simpa' +note: this linter can be disabled with `set_option linter.unnecessarySimpa false` +-/ #guard_msgs in example : foo n = [n] := by simpa only [foo] -/-- warning: try 'simp at h' instead of 'simpa using h' [linter.unnecessarySimpa] -/ +/-- +warning: try 'simp at h' instead of 'simpa using h' +note: this linter can be disabled with `set_option linter.unnecessarySimpa false` +-/ #guard_msgs in example (h : foo n ≠ [n]) : False := by simpa [foo] using h From 4cc72031342ffd83bf8d5ce296d6ab605b4cf1ce Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 23 Apr 2024 11:01:49 +1000 Subject: [PATCH 8/8] fix test --- test/print_prefix.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 6677469882..625ba47b2e 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -12,7 +12,6 @@ TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t #guard_msgs in #print prefix TEmpty -- Test type that probably won't change much. -/-- info: -/ #guard_msgs in #print prefix (config := {imported := false}) Empty