feat: refine pattern selection and fix test

This PR adds the `[grind intro]` attribute. It instructs `grind` to mark
the introduction rules of an inductive predicate as E-matching theorems.

src/Init/Control/Lawful.lean

@@ -6,3 +6,4 @@ Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
 prelude
 import Init.Control.Lawful.Basic
 import Init.Control.Lawful.Instances
+import Init.Control.Lawful.Lemmas

src/Init/Control/Lawful/Lemmas.lean

@@ -0,0 +1,33 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Control.Lawful.Basic
+import Init.RCases
+import Init.ByCases
+
+-- Mapping by a function with a left inverse is injective.
+theorem map_inj_of_left_inverse [Applicative m] [LawfulApplicative m] {f : α → β}
+    (w : ∃ g : β → α, ∀ x, g (f x) = x) {x y : m α}
+    (h : f <$> x = f <$> y) : x = y := by
+  rcases w with ⟨g, w⟩
+  replace h := congrArg (g <$> ·) h
+  simpa [w] using h
+
+-- Mapping by an injective function is injective, as long as the domain is nonempty.
+theorem map_inj_of_inj [Applicative m] [LawfulApplicative m] [Nonempty α] {f : α → β}
+    (w : ∀ x y, f x = f y → x = y) {x y : m α}
+    (h : f <$> x = f <$> y) : x = y := by
+  apply map_inj_of_left_inverse ?_ h
+  let ⟨a⟩ := ‹Nonempty α›
+  refine ⟨?_, ?_⟩
+  · intro b
+    by_cases p : ∃ a, f a = b
+    · exact Exists.choose p
+    · exact a
+  · intro b
+    simp only [exists_apply_eq_apply, ↓reduceDIte]
+    apply w
+    apply Exists.choose_spec (p := fun a => f a = f b)

src/Init/Data/Array.lean

@@ -23,3 +23,6 @@ import Init.Data.Array.FinRange
 import Init.Data.Array.Perm
 import Init.Data.Array.Find
 import Init.Data.Array.Lex
+import Init.Data.Array.Range
+import Init.Data.Array.Erase
+import Init.Data.Array.Zip

src/Init/Data/Array/Attach.lean

@@ -291,6 +291,20 @@ theorem foldr_pmap (l : Array α) {P : α → Prop} (f : (a : α) → P a → β
     (l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
   rw [pmap_eq_map_attach, foldr_map]
 
+@[simp] theorem foldl_attachWith
+    (l : Array α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : β → { x // q x} → β} {b} (w : stop = l.size) :
+    (l.attachWith q H).foldl f b 0 stop = l.attach.foldl (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by
+  subst w
+  rcases l with ⟨l⟩
+  simp [List.foldl_attachWith, List.foldl_map]
+
+@[simp] theorem foldr_attachWith
+    (l : Array α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : { x // q x} → β → β} {b} (w : start = l.size) :
+    (l.attachWith q H).foldr f b start 0 = l.attach.foldr (fun a acc => f ⟨a.1, H _ a.2⟩ acc) b := by
+  subst w
+  rcases l with ⟨l⟩
+  simp [List.foldr_attachWith, List.foldr_map]
+
 /--
 If we fold over `l.attach` with a function that ignores the membership predicate,
 we get the same results as folding over `l` directly.
@@ -571,7 +585,7 @@ and simplifies these to the function directly taking the value.
 -/
 theorem foldl_subtype {p : α → Prop} {l : Array { x // p x }}
     {f : β → { x // p x } → β} {g : β → α → β} {x : β}
-    {hf : ∀ b x h, f b ⟨x, h⟩ = g b x} :
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) :
     l.foldl f x = l.unattach.foldl g x := by
   cases l
   simp only [List.foldl_toArray', List.unattach_toArray]
@@ -581,7 +595,7 @@ theorem foldl_subtype {p : α → Prop} {l : Array { x // p x }}
 /-- Variant of `foldl_subtype` with side condition to check `stop = l.size`. -/
 @[simp] theorem foldl_subtype' {p : α → Prop} {l : Array { x // p x }}
     {f : β → { x // p x } → β} {g : β → α → β} {x : β}
-    {hf : ∀ b x h, f b ⟨x, h⟩ = g b x} (h : stop = l.size) :
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) (h : stop = l.size) :
     l.foldl f x 0 stop = l.unattach.foldl g x := by
   subst h
   rwa [foldl_subtype]
@@ -592,7 +606,7 @@ and simplifies these to the function directly taking the value.
 -/
 theorem foldr_subtype {p : α → Prop} {l : Array { x // p x }}
     {f : { x // p x } → β → β} {g : α → β → β} {x : β}
-    {hf : ∀ x h b, f ⟨x, h⟩ b = g x b} :
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) :
     l.foldr f x = l.unattach.foldr g x := by
   cases l
   simp only [List.foldr_toArray', List.unattach_toArray]
@@ -602,7 +616,7 @@ theorem foldr_subtype {p : α → Prop} {l : Array { x // p x }}
 /-- Variant of `foldr_subtype` with side condition to check `stop = l.size`. -/
 @[simp] theorem foldr_subtype' {p : α → Prop} {l : Array { x // p x }}
     {f : { x // p x } → β → β} {g : α → β → β} {x : β}
-    {hf : ∀ x h b, f ⟨x, h⟩ b = g x b} (h : start = l.size) :
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) (h : start = l.size) :
     l.foldr f x start 0 = l.unattach.foldr g x := by
   subst h
   rwa [foldr_subtype]
@@ -612,7 +626,7 @@ This lemma identifies maps over arrays of subtypes, where the function only depe
 and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem map_subtype {p : α → Prop} {l : Array { x // p x }}
-    {f : { x // p x } → β} {g : α → β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → β} {g : α → β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     l.map f = l.unattach.map g := by
   cases l
   simp only [List.map_toArray, List.unattach_toArray]
@@ -620,7 +634,7 @@ and simplifies these to the function directly taking the value.
   simp [hf]
 
 @[simp] theorem filterMap_subtype {p : α → Prop} {l : Array { x // p x }}
-    {f : { x // p x } → Option β} {g : α → Option β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → Option β} {g : α → Option β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     l.filterMap f = l.unattach.filterMap g := by
   cases l
   simp only [size_toArray, List.filterMap_toArray', List.unattach_toArray, List.length_unattach,
@@ -629,7 +643,7 @@ and simplifies these to the function directly taking the value.
   simp [hf]
 
 @[simp] theorem unattach_filter {p : α → Prop} {l : Array { x // p x }}
-    {f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → Bool} {g : α → Bool} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     (l.filter f).unattach = l.unattach.filter g := by
   cases l
   simp [hf]

src/Init/Data/Array/Basic.lean

@@ -244,6 +244,10 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
 def range (n : Nat) : Array Nat :=
   ofFn fun (i : Fin n) => i
 
+/-- The array `#[start, start + step, ..., start + step * (size - 1)]`. -/
+def range' (start size : Nat) (step : Nat := 1) : Array Nat :=
+  ofFn fun (i : Fin size) => start + step * i
+
 @[inline] protected def singleton (v : α) : Array α := #[v]
 
 def back! [Inhabited α] (a : Array α) : α :=
@@ -270,14 +274,22 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
     have : Inhabited (α × Array α) := ⟨(v, a)⟩
     panic! ("index " ++ toString i ++ " out of bounds")
 
-/-- `take a n` returns the first `n` elements of `a`. -/
-def take (a : Array α) (n : Nat) : Array α :=
+/-- `shrink a n` returns the first `n` elements of `a`, implemented by repeatedly popping the last element. -/
+def shrink (a : Array α) (n : Nat) : Array α :=
   let rec loop
     | 0,   a => a
     | n+1, a => loop n a.pop
   loop (a.size - n) a
 
-@[deprecated take (since := "2024-10-22")] abbrev shrink := @take
+/-- `take a n` returns the first `n` elements of `a`, implemented by copying the first `n` elements. -/
+abbrev take (a : Array α) (n : Nat) : Array α := extract a 0 n
+
+@[simp] theorem take_eq_extract (a : Array α) (n : Nat) : a.take n = a.extract 0 n := rfl
+
+/-- `drop a n` removes the first `n` elements of `a`, implemented by copying the remaining elements. -/
+abbrev drop (a : Array α) (n : Nat) : Array α := extract a n a.size
+
+@[simp] theorem drop_eq_extract (a : Array α) (n : Nat) : a.drop n = a.extract n a.size := rfl
 
 @[inline]
 unsafe def modifyMUnsafe [Monad m] (a : Array α) (i : Nat) (f : α → m α) : m (Array α) := do
@@ -345,6 +357,9 @@ instance : ForIn' m (Array α) α inferInstance where
 
 -- No separate `ForIn` instance is required because it can be derived from `ForIn'`.
 
+-- We simplify `Array.forIn'` to `forIn'`.
+@[simp] theorem forIn'_eq_forIn' [Monad m] : @Array.forIn' α β m _ = forIn' := rfl
+
 /-- See comment at `forIn'Unsafe` -/
 @[inline]
 unsafe def foldlMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : β → α → m β) (init : β) (as : Array α) (start := 0) (stop := as.size) : m β :=
@@ -452,7 +467,7 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
 
 @[deprecated mapM (since := "2024-11-11")] abbrev sequenceMap := @mapM
 
-/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
+/-- Variant of `mapIdxM` which receives the index `i` along with the bound `i < as.size`. -/
 @[inline]
 def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
     (as : Array α) (f : (i : Nat) → α → (h : i < as.size) → m β) : m (Array β) :=
@@ -464,13 +479,25 @@ def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
         rw [← inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
         apply Nat.le_add_right
       have : i + (j + 1) = as.size := by rw [← inv, Nat.add_comm j 1, Nat.add_assoc]
-      map i (j+1) this (bs.push (← f j (as.get j j_lt) j_lt))
+      map i (j+1) this (bs.push (← f j as[j] j_lt))
   map as.size 0 rfl (mkEmpty as.size)
 
 @[inline]
 def mapIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : Nat → α → m β) (as : Array α) : m (Array β) :=
   as.mapFinIdxM fun i a _ => f i a
 
+@[inline]
+def firstM {α : Type u} {m : Type v → Type w} [Alternative m] (f : α → m β) (as : Array α) : m β :=
+  go 0
+where
+  go (i : Nat) : m β :=
+    if hlt : i < as.size then
+      f as[i] <|> go (i+1)
+    else
+      failure
+  termination_by as.size - i
+  decreasing_by exact Nat.sub_succ_lt_self as.size i hlt
+
 @[inline]
 def findSomeM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → m (Option β)) (as : Array α) : m (Option β) := do
   for a in as do
@@ -561,9 +588,16 @@ def findRevM? {α : Type} {m : Type → Type w} [Monad m] (p : α → m Bool) (a
   as.findSomeRevM? fun a => return if (← p a) then some a else none
 
 @[inline]
-def forM {α : Type u} {m : Type v → Type w} [Monad m] (f : α → m PUnit) (as : Array α) (start := 0) (stop := as.size) : m PUnit :=
+protected def forM {α : Type u} {m : Type v → Type w} [Monad m] (f : α → m PUnit) (as : Array α) (start := 0) (stop := as.size) : m PUnit :=
   as.foldlM (fun _ => f) ⟨⟩ start stop
 
+instance : ForM m (Array α) α where
+  forM xs f := Array.forM f xs
+
+-- We simplify `Array.forM` to `forM`.
+@[simp] theorem forM_eq_forM [Monad m] (f : α → m PUnit) :
+    Array.forM f as 0 as.size = forM as f := rfl
+
 @[inline]
 def forRevM {α : Type u} {m : Type v → Type w} [Monad m] (f : α → m PUnit) (as : Array α) (start := as.size) (stop := 0) : m PUnit :=
   as.foldrM (fun a _ => f a) ⟨⟩ start stop
@@ -595,6 +629,9 @@ def count {α : Type u} [BEq α] (a : α) (as : Array α) : Nat :=
 def map {α : Type u} {β : Type v} (f : α → β) (as : Array α) : Array β :=
   Id.run <| as.mapM f
 
+instance : Functor Array where
+  map := map
+
 /-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
 @[inline]
 def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : (i : Nat) → α → (h : i < as.size) → β) : Array β :=
@@ -606,7 +643,7 @@ def mapIdx {α : Type u} {β : Type v} (f : Nat → α → β) (as : Array α) :
 
 /-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
 def zipIdx (arr : Array α) (start := 0) : Array (α × Nat) :=
-  arr.mapIdx fun i a => (a, i + start)
+  arr.mapIdx fun i a => (a, start + i)
 
 @[deprecated zipIdx (since := "2025-01-21")] abbrev zipWithIndex := @zipIdx
 
@@ -656,18 +693,51 @@ def findFinIdx? {α : Type u} (p : α → Bool) (as : Array α) : Option (Fin as
     decreasing_by simp_wf; decreasing_trivial_pre_omega
   loop 0
 
+theorem findIdx?_loop_eq_map_findFinIdx?_loop_val {xs : Array α} {p : α → Bool} {j} :
+    findIdx?.loop p xs j = (findFinIdx?.loop p xs j).map (·.val) := by
+  unfold findIdx?.loop
+  unfold findFinIdx?.loop
+  split <;> rename_i h
+  case isTrue =>
+    split
+    case isTrue => simp
+    case isFalse =>
+      have : xs.size - (j + 1) < xs.size - j := Nat.sub_succ_lt_self xs.size j h
+      rw [findIdx?_loop_eq_map_findFinIdx?_loop_val (j := j + 1)]
+  case isFalse => simp
+termination_by xs.size - j
+
+theorem findIdx?_eq_map_findFinIdx?_val {xs : Array α} {p : α → Bool} :
+    xs.findIdx? p = (xs.findFinIdx? p).map (·.val) := by
+  simp [findIdx?, findFinIdx?, findIdx?_loop_eq_map_findFinIdx?_loop_val]
+
+@[inline]
+def findIdx (p : α → Bool) (as : Array α) : Nat := (as.findIdx? p).getD as.size
+
 @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
-def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
+def idxOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
   if h : i < a.size then
     if a[i] == v then some ⟨i, h⟩
-    else indexOfAux a v (i+1)
+    else idxOfAux a v (i+1)
   else none
 decreasing_by simp_wf; decreasing_trivial_pre_omega
 
-def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
-  indexOfAux a v 0
+@[deprecated idxOfAux (since := "2025-01-29")]
+abbrev indexOfAux := @idxOfAux
 
-@[deprecated indexOf? (since := "2024-11-20")]
+def finIdxOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
+  idxOfAux a v 0
+
+@[deprecated "`Array.indexOf?` has been deprecated, use `idxOf?` or `finIdxOf?` instead." (since := "2025-01-29")]
+abbrev indexOf? := @finIdxOf?
+
+/-- Returns the index of the first element equal to `a`, or the length of the array otherwise. -/
+def idxOf [BEq α] (a : α) : Array α → Nat := findIdx (· == a)
+
+def idxOf? [BEq α] (a : Array α) (v : α) : Option Nat :=
+  (a.finIdxOf? v).map (·.val)
+
+@[deprecated idxOf? (since := "2024-11-20")]
 def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
   a.findIdx? fun a => a == v
 
@@ -732,6 +802,24 @@ def flatMap (f : α → Array β) (as : Array α) : Array β :=
 @[inline] def flatten (as : Array (Array α)) : Array α :=
   as.foldl (init := empty) fun r a => r ++ a
 
+def reverse (as : Array α) : Array α :=
+  if h : as.size ≤ 1 then
+    as
+  else
+    loop as 0 ⟨as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h ▸ by decide) h)⟩
+where
+  termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
+    rw [Nat.sub_sub, Nat.add_comm]
+    exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
+  loop (as : Array α) (i : Nat) (j : Fin as.size) :=
+    if h : i < j then
+      have := termination h
+      let as := as.swap i j (Nat.lt_trans h j.2)
+      have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
+      loop as (i+1) ⟨j-1, this⟩
+    else
+      as
+
 @[inline]
 def filter (p : α → Bool) (as : Array α) (start := 0) (stop := as.size) : Array α :=
   as.foldl (init := #[]) (start := start) (stop := stop) fun r a =>
@@ -742,6 +830,11 @@ def filterM {α : Type} [Monad m] (p : α → m Bool) (as : Array α) (start :=
   as.foldlM (init := #[]) (start := start) (stop := stop) fun r a => do
     if (← p a) then return r.push a else return r
 
+@[inline]
+def filterRevM {α : Type} [Monad m] (p : α → m Bool) (as : Array α) (start := as.size) (stop := 0) : m (Array α) :=
+  reverse <$> as.foldrM (init := #[]) (start := start) (stop := stop) fun a r => do
+    if (← p a) then return r.push a else return r
+
 @[specialize]
 def filterMapM [Monad m] (f : α → m (Option β)) (as : Array α) (start := 0) (stop := as.size) : m (Array β) :=
   as.foldlM (init := #[]) (start := start) (stop := stop) fun bs a => do
@@ -773,24 +866,6 @@ def partition (p : α → Bool) (as : Array α) : Array α × Array α := Id.run
       cs := cs.push a
   return (bs, cs)
 
-def reverse (as : Array α) : Array α :=
-  if h : as.size ≤ 1 then
-    as
-  else
-    loop as 0 ⟨as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h ▸ by decide) h)⟩
-where
-  termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
-    rw [Nat.sub_sub, Nat.add_comm]
-    exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
-  loop (as : Array α) (i : Nat) (j : Fin as.size) :=
-    if h : i < j then
-      have := termination h
-      let as := as.swap i j (Nat.lt_trans h j.2)
-      have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
-      loop as (i+1) ⟨j-1, this⟩
-    else
-      as
-
 @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
 def popWhile (p : α → Bool) (as : Array α) : Array α :=
   if h : as.size > 0 then
@@ -861,7 +936,7 @@ def eraseIdx! (a : Array α) (i : Nat) : Array α :=
 This function takes worst case O(n) time because
 it has to backshift all later elements. -/
 def erase [BEq α] (as : Array α) (a : α) : Array α :=
-  match as.indexOf? a with
+  match as.finIdxOf? a with
   | none   => as
   | some i => as.eraseIdx i
 
@@ -870,9 +945,9 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
 This function takes worst case O(n) time because
 it has to backshift all later elements. -/
 def eraseP (as : Array α) (p : α → Bool) : Array α :=
-  match as.findIdx? p with
+  match as.findFinIdx? p with
   | none   => as
-  | some i => as.eraseIdxIfInBounds i
+  | some i => as.eraseIdx i
 
 /-- Insert element `a` at position `i`. -/
 @[inline] def insertIdx (as : Array α) (i : Nat) (a : α) (_ : i ≤ as.size := by get_elem_tactic) : Array α :=
@@ -941,13 +1016,13 @@ def zipWithAux (as : Array α) (bs : Array β) (f : α → β → γ) (i : Nat)
     cs
 decreasing_by simp_wf; decreasing_trivial_pre_omega
 
-@[inline] def zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : Array γ :=
+@[inline] def zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : Array γ :=
   zipWithAux as bs f 0 #[]
 
 def zip (as : Array α) (bs : Array β) : Array (α × β) :=
-  zipWith as bs Prod.mk
+  zipWith Prod.mk as bs
 
-def zipWithAll (as : Array α) (bs : Array β) (f : Option α → Option β → γ) : Array γ :=
+def zipWithAll (f : Option α → Option β → γ) (as : Array α) (bs : Array β) : Array γ :=
   go as bs 0 #[]
 where go (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) :=
   if i < max as.size bs.size then

src/Init/Data/Array/DecidableEq.lean

@@ -11,7 +11,7 @@ import Init.ByCases
 
 namespace Array
 
-theorem rel_of_isEqvAux
+private theorem rel_of_isEqvAux
     {r : α → α → Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i ≤ a.size)
     (heqv : Array.isEqvAux a b hsz r i hi)
     {j : Nat} (hj : j < i) : r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz ▸ hi))) := by
@@ -27,7 +27,7 @@ theorem rel_of_isEqvAux
       subst hj'
       exact heqv.left
 
-theorem isEqvAux_of_rel {r : α → α → Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i ≤ a.size)
+private theorem isEqvAux_of_rel {r : α → α → Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i ≤ a.size)
     (w : ∀ j, (hj : j < i) → r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz ▸ hi)))) : Array.isEqvAux a b hsz r i hi := by
   induction i with
   | zero => simp [Array.isEqvAux]
@@ -35,7 +35,8 @@ theorem isEqvAux_of_rel {r : α → α → Bool} {a b : Array α} (hsz : a.size
     simp only [isEqvAux, Bool.and_eq_true]
     exact ⟨w i (Nat.lt_add_one i), ih _ fun j hj => w j (Nat.lt_add_right 1 hj)⟩
 
-theorem rel_of_isEqv {r : α → α → Bool} {a b : Array α} :
+-- This is private as the forward direction of `isEqv_iff_rel` may be used.
+private theorem rel_of_isEqv {r : α → α → Bool} {a b : Array α} :
     Array.isEqv a b r → ∃ h : a.size = b.size, ∀ (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h ▸ h')) := by
   simp only [isEqv]
   split <;> rename_i h
@@ -69,7 +70,7 @@ theorem eq_of_isEqv [DecidableEq α] (a b : Array α) (h : Array.isEqv a b (fun
   have ⟨h, h'⟩ := rel_of_isEqv h
   exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
 
-theorem isEqvAux_self (r : α → α → Bool) (hr : ∀ a, r a a) (a : Array α) (i : Nat) (h : i ≤ a.size) :
+private theorem isEqvAux_self (r : α → α → Bool) (hr : ∀ a, r a a) (a : Array α) (i : Nat) (h : i ≤ a.size) :
     Array.isEqvAux a a rfl r i h = true := by
   induction i with
   | zero => simp [Array.isEqvAux]

src/Init/Data/Array/Erase.lean

@@ -0,0 +1,400 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Lemmas
+import Init.Data.List.Nat.Erase
+import Init.Data.List.Nat.Basic
+
+/-!
+# Lemmas about `Array.eraseP`, `Array.erase`, and `Array.eraseIdx`.
+-/
+
+namespace Array
+
+open Nat
+
+/-! ### eraseP -/
+
+@[simp] theorem eraseP_empty : #[].eraseP p = #[] := rfl
+
+theorem eraseP_of_forall_mem_not {l : Array α} (h : ∀ a, a ∈ l → ¬p a) : l.eraseP p = l := by
+  cases l
+  simp_all [List.eraseP_of_forall_not]
+
+theorem eraseP_of_forall_getElem_not {l : Array α} (h : ∀ i, (h : i < l.size) → ¬p l[i]) : l.eraseP p = l :=
+  eraseP_of_forall_mem_not fun a m => by
+    rw [mem_iff_getElem] at m
+    obtain ⟨i, w, rfl⟩ := m
+    exact h i w
+
+@[simp] theorem eraseP_eq_empty_iff {xs : Array α} {p : α → Bool} : xs.eraseP p = #[] ↔ xs = #[] ∨ ∃ x, p x ∧ xs = #[x] := by
+  cases xs
+  simp
+
+theorem eraseP_ne_empty_iff {xs : Array α} {p : α → Bool} : xs.eraseP p ≠ #[] ↔ xs ≠ #[] ∧ ∀ x, p x → xs ≠ #[x] := by
+  simp
+
+theorem exists_of_eraseP {l : Array α} {a} (hm : a ∈ l) (hp : p a) :
+    ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁.push a ++ l₂ ∧ l.eraseP p = l₁ ++ l₂ := by
+  rcases l with ⟨l⟩
+  obtain ⟨a, l₁, l₂, h₁, h₂, rfl, h₃⟩ := List.exists_of_eraseP (by simpa using hm) (hp)
+  refine ⟨a, ⟨l₁⟩, ⟨l₂⟩, by simpa using h₁, h₂, by simp, by simpa using h₃⟩
+
+theorem exists_or_eq_self_of_eraseP (p) (l : Array α) :
+    l.eraseP p = l ∨
+    ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁.push a ++ l₂ ∧ l.eraseP p = l₁ ++ l₂ :=
+  if h : ∃ a ∈ l, p a then
+    let ⟨_, ha, pa⟩ := h
+    .inr (exists_of_eraseP ha pa)
+  else
+    .inl (eraseP_of_forall_mem_not (h ⟨·, ·, ·⟩))
+
+@[simp] theorem size_eraseP_of_mem {l : Array α} (al : a ∈ l) (pa : p a) :
+    (l.eraseP p).size = l.size - 1 := by
+  let ⟨_, l₁, l₂, _, _, e₁, e₂⟩ := exists_of_eraseP al pa
+  rw [e₂]; simp [size_append, e₁]; omega
+
+theorem size_eraseP {l : Array α} : (l.eraseP p).size = if l.any p then l.size - 1 else l.size := by
+  split <;> rename_i h
+  · simp only [any_eq_true] at h
+    obtain ⟨i, h, w⟩ := h
+    simp [size_eraseP_of_mem (l := l) (by simp) w]
+  · simp only [any_eq_true] at h
+    rw [eraseP_of_forall_getElem_not]
+    simp_all
+
+theorem size_eraseP_le (l : Array α) : (l.eraseP p).size ≤ l.size := by
+  rcases l with ⟨l⟩
+  simpa using List.length_eraseP_le l
+
+theorem le_size_eraseP (l : Array α) : l.size - 1 ≤ (l.eraseP p).size := by
+  rcases l with ⟨l⟩
+  simpa using List.le_length_eraseP l
+
+theorem mem_of_mem_eraseP {l : Array α} : a ∈ l.eraseP p → a ∈ l := by
+  rcases l with ⟨l⟩
+  simpa using List.mem_of_mem_eraseP
+
+@[simp] theorem mem_eraseP_of_neg {l : Array α} (pa : ¬p a) : a ∈ l.eraseP p ↔ a ∈ l := by
+  rcases l with ⟨l⟩
+  simpa using List.mem_eraseP_of_neg pa
+
+@[simp] theorem eraseP_eq_self_iff {p} {l : Array α} : l.eraseP p = l ↔ ∀ a ∈ l, ¬ p a := by
+  rcases l with ⟨l⟩
+  simp
+
+theorem eraseP_map (f : β → α) (l : Array β) : (map f l).eraseP p = map f (l.eraseP (p ∘ f)) := by
+  rcases l with ⟨l⟩
+  simpa using List.eraseP_map f l
+
+theorem eraseP_filterMap (f : α → Option β) (l : Array α) :
+    (filterMap f l).eraseP p = filterMap f (l.eraseP (fun x => match f x with | some y => p y | none => false)) := by
+  rcases l with ⟨l⟩
+  simpa using List.eraseP_filterMap f l
+
+theorem eraseP_filter (f : α → Bool) (l : Array α) :
+    (filter f l).eraseP p = filter f (l.eraseP (fun x => p x && f x)) := by
+  rcases l with ⟨l⟩
+  simpa using List.eraseP_filter f l
+
+theorem eraseP_append_left {a : α} (pa : p a) {l₁ : Array α} l₂ (h : a ∈ l₁) :
+    (l₁ ++ l₂).eraseP p = l₁.eraseP p ++ l₂ := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simpa using List.eraseP_append_left pa l₂ (by simpa using h)
+
+theorem eraseP_append_right {l₁ : Array α} l₂ (h : ∀ b ∈ l₁, ¬p b) :
+    (l₁ ++ l₂).eraseP p = l₁ ++ l₂.eraseP p := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simpa using List.eraseP_append_right l₂ (by simpa using h)
+
+theorem eraseP_append (l₁ l₂ : Array α) :
+    (l₁ ++ l₂).eraseP p = if l₁.any p then l₁.eraseP p ++ l₂ else l₁ ++ l₂.eraseP p := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simp only [List.append_toArray, List.eraseP_toArray, List.eraseP_append l₁ l₂, List.any_toArray']
+  split <;> simp
+
+theorem eraseP_mkArray (n : Nat) (a : α) (p : α → Bool) :
+    (mkArray n a).eraseP p = if p a then mkArray (n - 1) a else mkArray n a := by
+  simp only [← List.toArray_replicate, List.eraseP_toArray, List.eraseP_replicate]
+  split <;> simp
+
+@[simp] theorem eraseP_mkArray_of_pos {n : Nat} {a : α} (h : p a) :
+    (mkArray n a).eraseP p = mkArray (n - 1) a := by
+  simp only [← List.toArray_replicate, List.eraseP_toArray]
+  simp [h]
+
+@[simp] theorem eraseP_mkArray_of_neg {n : Nat} {a : α} (h : ¬p a) :
+    (mkArray n a).eraseP p = mkArray n a := by
+  simp only [← List.toArray_replicate, List.eraseP_toArray]
+  simp [h]
+
+theorem eraseP_eq_iff {p} {l : Array α} :
+    l.eraseP p = l' ↔
+      ((∀ a ∈ l, ¬ p a) ∧ l = l') ∨
+        ∃ a l₁ l₂, (∀ b ∈ l₁, ¬ p b) ∧ p a ∧ l = l₁.push a ++ l₂ ∧ l' = l₁ ++ l₂ := by
+  rcases l with ⟨l⟩
+  rcases l' with ⟨l'⟩
+  simp [List.eraseP_eq_iff]
+  constructor
+  · rintro (h | ⟨a, l₁, h₁, h₂, ⟨x, rfl, rfl⟩⟩)
+    · exact Or.inl h
+    · exact Or.inr ⟨a, ⟨l₁⟩, by simpa using h₁, h₂, ⟨⟨x⟩, by simp⟩⟩
+  · rintro (h | ⟨a, ⟨l₁⟩, h₁, h₂, ⟨⟨x⟩, rfl, rfl⟩⟩)
+    · exact Or.inl h
+    · exact Or.inr ⟨a, l₁, by simpa using h₁, h₂, ⟨x, by simp⟩⟩
+
+theorem eraseP_comm {l : Array α} (h : ∀ a ∈ l, ¬ p a ∨ ¬ q a) :
+    (l.eraseP p).eraseP q = (l.eraseP q).eraseP p := by
+  rcases l with ⟨l⟩
+  simpa using List.eraseP_comm (by simpa using h)
+
+/-! ### erase -/
+
+section erase
+variable [BEq α]
+
+theorem erase_of_not_mem [LawfulBEq α] {a : α} {l : Array α} (h : a ∉ l) : l.erase a = l := by
+  rcases l with ⟨l⟩
+  simp [List.erase_of_not_mem (by simpa using h)]
+
+theorem erase_eq_eraseP' (a : α) (l : Array α) : l.erase a = l.eraseP (· == a) := by
+  rcases l with ⟨l⟩
+  simp [List.erase_eq_eraseP']
+
+theorem erase_eq_eraseP [LawfulBEq α] (a : α) (l : Array α) : l.erase a = l.eraseP (a == ·) := by
+  rcases l with ⟨l⟩
+  simp [List.erase_eq_eraseP]
+
+@[simp] theorem erase_eq_empty_iff [LawfulBEq α] {xs : Array α} {a : α} :
+    xs.erase a = #[] ↔ xs = #[] ∨ xs = #[a] := by
+  rcases xs with ⟨xs⟩
+  simp [List.erase_eq_nil_iff]
+
+theorem erase_ne_empty_iff [LawfulBEq α] {xs : Array α} {a : α} :
+    xs.erase a ≠ #[] ↔ xs ≠ #[] ∧ xs ≠ #[a] := by
+  rcases xs with ⟨xs⟩
+  simp [List.erase_ne_nil_iff]
+
+theorem exists_erase_eq [LawfulBEq α] {a : α} {l : Array α} (h : a ∈ l) :
+    ∃ l₁ l₂, a ∉ l₁ ∧ l = l₁.push 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 size_erase_of_mem [LawfulBEq α] {a : α} {l : Array α} (h : a ∈ l) :
+    (l.erase a).size = l.size - 1 := by
+  rw [erase_eq_eraseP]; exact size_eraseP_of_mem h (beq_self_eq_true a)
+
+theorem size_erase [LawfulBEq α] (a : α) (l : Array α) :
+    (l.erase a).size = if a ∈ l then l.size - 1 else l.size := by
+  rw [erase_eq_eraseP, size_eraseP]
+  congr
+  simp [mem_iff_getElem, eq_comm (a := a)]
+
+theorem size_erase_le (a : α) (l : Array α) : (l.erase a).size ≤ l.size := by
+  rcases l with ⟨l⟩
+  simpa using List.length_erase_le a l
+
+theorem le_size_erase [LawfulBEq α] (a : α) (l : Array α) : l.size - 1 ≤ (l.erase a).size := by
+  rcases l with ⟨l⟩
+  simpa using List.le_length_erase a l
+
+theorem mem_of_mem_erase {a b : α} {l : Array α} (h : a ∈ l.erase b) : a ∈ l := by
+  rcases l with ⟨l⟩
+  simpa using List.mem_of_mem_erase (by simpa using h)
+
+@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : Array α} (ab : a ≠ b) :
+    a ∈ l.erase b ↔ a ∈ l :=
+  erase_eq_eraseP b l ▸ mem_eraseP_of_neg (mt eq_of_beq ab.symm)
+
+@[simp] theorem erase_eq_self_iff [LawfulBEq α] {l : Array α} : l.erase a = l ↔ a ∉ l := by
+  rw [erase_eq_eraseP', eraseP_eq_self_iff]
+  simp [forall_mem_ne']
+
+theorem erase_filter [LawfulBEq α] (f : α → Bool) (l : Array α) :
+    (filter f l).erase a = filter f (l.erase a) := by
+  rcases l with ⟨l⟩
+  simpa using List.erase_filter f l
+
+theorem erase_append_left [LawfulBEq α] {l₁ : Array α} (l₂) (h : a ∈ l₁) :
+    (l₁ ++ l₂).erase a = l₁.erase a ++ l₂ := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simpa using List.erase_append_left l₂ (by simpa using h)
+
+theorem erase_append_right [LawfulBEq α] {a : α} {l₁ : Array α} (l₂ : Array α) (h : a ∉ l₁) :
+    (l₁ ++ l₂).erase a = (l₁ ++ l₂.erase a) := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simpa using List.erase_append_right l₂ (by simpa using h)
+
+theorem erase_append [LawfulBEq α] {a : α} {l₁ l₂ : Array α} :
+    (l₁ ++ l₂).erase a = if a ∈ l₁ then l₁.erase a ++ l₂ else l₁ ++ l₂.erase a := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simp only [List.append_toArray, List.erase_toArray, List.erase_append, mem_toArray]
+  split <;> simp
+
+theorem erase_mkArray [LawfulBEq α] (n : Nat) (a b : α) :
+    (mkArray n a).erase b = if b == a then mkArray (n - 1) a else mkArray n a := by
+  simp only [← List.toArray_replicate, List.erase_toArray]
+  simp only [List.erase_replicate, beq_iff_eq, List.toArray_replicate]
+  split <;> simp
+
+theorem erase_comm [LawfulBEq α] (a b : α) (l : Array α) :
+    (l.erase a).erase b = (l.erase b).erase a := by
+  rcases l with ⟨l⟩
+  simpa using List.erase_comm a b l
+
+theorem erase_eq_iff [LawfulBEq α] {a : α} {l : Array α} :
+    l.erase a = l' ↔
+      (a ∉ l ∧ l = l') ∨
+        ∃ l₁ l₂, a ∉ l₁ ∧ l = l₁.push a ++ l₂ ∧ l' = l₁ ++ l₂ := by
+  rw [erase_eq_eraseP', eraseP_eq_iff]
+  simp only [beq_iff_eq, forall_mem_ne', exists_and_left]
+  constructor
+  · rintro (⟨h, rfl⟩ | ⟨a', l', h, rfl, x, rfl, rfl⟩)
+    · left; simp_all
+    · right; refine ⟨l', h, x, by simp⟩
+  · rintro (⟨h, rfl⟩ | ⟨l₁, h, x, rfl, rfl⟩)
+    · left; simp_all
+    · right; refine ⟨a, l₁, h, rfl, x, by simp⟩
+
+@[simp] theorem erase_mkArray_self [LawfulBEq α] {a : α} :
+    (mkArray n a).erase a = mkArray (n - 1) a := by
+  simp only [← List.toArray_replicate, List.erase_toArray]
+  simp [List.erase_replicate]
+
+@[simp] theorem erase_mkArray_ne [LawfulBEq α] {a b : α} (h : !b == a) :
+    (mkArray n a).erase b = mkArray n a := by
+  rw [erase_of_not_mem]
+  simp_all
+
+end erase
+
+/-! ### eraseIdx -/
+
+theorem eraseIdx_eq_take_drop_succ (l : Array α) (i : Nat) (h) : l.eraseIdx i = l.take i ++ l.drop (i + 1) := by
+  rcases l with ⟨l⟩
+  simp only [size_toArray] at h
+  simp only [List.eraseIdx_toArray, List.eraseIdx_eq_take_drop_succ, take_eq_extract,
+    List.extract_toArray, List.extract_eq_drop_take, Nat.sub_zero, List.drop_zero, drop_eq_extract,
+    size_toArray, List.append_toArray, mk.injEq, List.append_cancel_left_eq]
+  rw [List.take_of_length_le]
+  simp
+
+theorem getElem?_eraseIdx (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) :
+    (l.eraseIdx i)[j]? = if j < i then l[j]? else l[j + 1]? := by
+  rcases l with ⟨l⟩
+  simp [List.getElem?_eraseIdx]
+
+theorem getElem?_eraseIdx_of_lt (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : j < i) :
+    (l.eraseIdx i)[j]? = l[j]? := by
+  rw [getElem?_eraseIdx]
+  simp [h']
+
+theorem getElem?_eraseIdx_of_ge (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : i ≤ j) :
+    (l.eraseIdx i)[j]? = l[j + 1]? := by
+  rw [getElem?_eraseIdx]
+  simp only [dite_eq_ite, ite_eq_right_iff]
+  intro h'
+  omega
+
+theorem getElem_eraseIdx (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : j < (l.eraseIdx i).size) :
+    (l.eraseIdx i)[j] = if h'' : j < i then
+        l[j]
+      else
+        l[j + 1]'(by rw [size_eraseIdx] at h'; omega) := by
+  apply Option.some.inj
+  rw [← getElem?_eq_getElem, getElem?_eraseIdx]
+  split <;> simp
+
+@[simp] theorem eraseIdx_eq_empty_iff {l : Array α} {i : Nat} {h} : eraseIdx l i = #[] ↔ l.size = 1 ∧ i = 0 := by
+  rcases l with ⟨l⟩
+  simp only [List.eraseIdx_toArray, mk.injEq, List.eraseIdx_eq_nil_iff, size_toArray,
+    or_iff_right_iff_imp]
+  rintro rfl
+  simp_all
+
+theorem eraseIdx_ne_empty_iff {l : Array α} {i : Nat} {h} : eraseIdx l i ≠ #[] ↔ 2 ≤ l.size := by
+  rcases l with ⟨_ | ⟨a, (_ | ⟨b, l⟩)⟩⟩
+  · simp
+  · simp at h
+    simp [h]
+  · simp
+
+theorem mem_of_mem_eraseIdx {l : Array α} {i : Nat} {h} {a : α} (h : a ∈ l.eraseIdx i) : a ∈ l := by
+  rcases l with ⟨l⟩
+  simpa using List.mem_of_mem_eraseIdx (by simpa using h)
+
+theorem eraseIdx_append_of_lt_size {l : Array α} {k : Nat} (hk : k < l.size) (l' : Array α) (h) :
+    eraseIdx (l ++ l') k = eraseIdx l k ++ l' := by
+  rcases l with ⟨l⟩
+  rcases l' with ⟨l'⟩
+  simp at hk
+  simp [List.eraseIdx_append_of_lt_length, *]
+
+theorem eraseIdx_append_of_length_le {l : Array α} {k : Nat} (hk : l.size ≤ k) (l' : Array α) (h) :
+    eraseIdx (l ++ l') k = l ++ eraseIdx l' (k - l.size) (by simp at h; omega) := by
+  rcases l with ⟨l⟩
+  rcases l' with ⟨l'⟩
+  simp at hk
+  simp [List.eraseIdx_append_of_length_le, *]
+
+theorem eraseIdx_mkArray {n : Nat} {a : α} {k : Nat} {h} :
+    (mkArray n a).eraseIdx k = mkArray (n - 1) a := by
+  simp at h
+  simp only [← List.toArray_replicate, List.eraseIdx_toArray]
+  simp [List.eraseIdx_replicate, h]
+
+theorem mem_eraseIdx_iff_getElem {x : α} {l} {k} {h} : x ∈ eraseIdx l k h ↔ ∃ i w, i ≠ k ∧ l[i]'w = x := by
+  rcases l with ⟨l⟩
+  simp [List.mem_eraseIdx_iff_getElem, *]
+
+theorem mem_eraseIdx_iff_getElem? {x : α} {l} {k} {h} : x ∈ eraseIdx l k h ↔ ∃ i ≠ k, l[i]? = some x := by
+  rcases l with ⟨l⟩
+  simp [List.mem_eraseIdx_iff_getElem?, *]
+
+theorem erase_eq_eraseIdx_of_idxOf [BEq α] [LawfulBEq α] (l : Array α) (a : α) (i : Nat) (w : l.idxOf a = i) (h : i < l.size) :
+    l.erase a = l.eraseIdx i := by
+  rcases l with ⟨l⟩
+  simp at w
+  simp [List.erase_eq_eraseIdx_of_idxOf, *]
+
+theorem getElem_eraseIdx_of_lt (l : Array α) (i : Nat) (w : i < l.size) (j : Nat) (h : j < (l.eraseIdx i).size) (h' : j < i) :
+    (l.eraseIdx i)[j] = l[j] := by
+  rcases l with ⟨l⟩
+  simp [List.getElem_eraseIdx_of_lt, *]
+
+theorem getElem_eraseIdx_of_ge (l : Array α) (i : Nat) (w : i < l.size) (j : Nat) (h : j < (l.eraseIdx i).size) (h' : i ≤ j) :
+    (l.eraseIdx i)[j] = l[j + 1]'(by simp at h; omega) := by
+  rcases l with ⟨l⟩
+  simp [List.getElem_eraseIdx_of_ge, *]
+
+theorem eraseIdx_set_eq {l : Array α} {i : Nat} {a : α} {h : i < l.size} :
+    (l.set i a).eraseIdx i (by simp; omega) = l.eraseIdx i := by
+  rcases l with ⟨l⟩
+  simp [List.eraseIdx_set_eq, *]
+
+theorem eraseIdx_set_lt {l : Array α} {i : Nat} {w : i < l.size} {j : Nat} {a : α} (h : j < i) :
+    (l.set i a).eraseIdx j (by simp; omega) = (l.eraseIdx j).set (i - 1) a (by simp; omega) := by
+  rcases l with ⟨l⟩
+  simp [List.eraseIdx_set_lt, *]
+
+theorem eraseIdx_set_gt {l : Array α} {i : Nat} {j : Nat} {a : α} (h : i < j) {w : j < l.size} :
+    (l.set i a).eraseIdx j (by simp; omega) = (l.eraseIdx j).set i a (by simp; omega) := by
+  rcases l with ⟨l⟩
+  simp [List.eraseIdx_set_gt, *]
+
+@[simp] theorem set_getElem_succ_eraseIdx_succ
+    {l : Array α} {i : Nat} (h : i + 1 < l.size) :
+    (l.eraseIdx (i + 1)).set i l[i + 1] (by simp; omega) = l.eraseIdx i := by
+  rcases l with ⟨l⟩
+  simp [List.set_getElem_succ_eraseIdx_succ, *]
+
+end Array

src/Init/Data/Array/Lemmas.lean

@@ -397,6 +397,10 @@ theorem getElem_of_mem {a} {l : Array α} (h : a ∈ l) : ∃ (i : Nat) (h : i <
 theorem getElem?_of_mem {a} {l : Array α} (h : a ∈ l) : ∃ i : Nat, l[i]? = some a :=
   let ⟨n, _, e⟩ := getElem_of_mem h; ⟨n, e ▸ getElem?_eq_getElem _⟩
 
+theorem mem_of_getElem {l : Array α} {i : Nat} {h} {a : α} (e : l[i] = a) : a ∈ l := by
+  subst e
+  simp
+
 theorem mem_of_getElem? {l : Array α} {i : Nat} {a : α} (e : l[i]? = some a) : a ∈ l :=
   let ⟨_, e⟩ := getElem?_eq_some_iff.1 e; e ▸ getElem_mem ..
 
@@ -836,9 +840,6 @@ theorem mem_or_eq_of_mem_set
   cases as
   simpa using List.mem_or_eq_of_mem_set (by simpa using h)
 
-@[simp] theorem toList_set (a : Array α) (i x h) :
-    (a.set i x).toList = a.toList.set i x := rfl
-
 /-! ### setIfInBounds -/
 
 @[simp] theorem set!_eq_setIfInBounds : @set! = @setIfInBounds := rfl
@@ -1002,7 +1003,7 @@ private theorem beq_of_beq_singleton [BEq α] {a b : α} : #[a] == #[b] → a ==
   · intro h
     constructor
     · intro a b h
-      obtain ⟨hs, hi⟩ := rel_of_isEqv h
+      obtain ⟨hs, hi⟩ := isEqv_iff_rel.mp h
       ext i h₁ h₂
       · exact hs
       · simpa using hi _ h₁
@@ -2283,10 +2284,6 @@ theorem flatMap_mkArray {β} (f : α → Array β) : (mkArray n a).flatMap f = (
 
 /-! ### Preliminaries about `swap` needed for `reverse`. -/
 
-theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
-    a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
-  simp [swap]
-
 theorem getElem?_swap (a : Array α) (i j : Nat) (hi hj) (k : Nat) : (a.swap i j hi hj)[k]? =
     if j = k then some a[i] else if i = k then some a[j] else a[k]? := by
   simp [swap_def, getElem?_set]
@@ -2568,8 +2565,14 @@ theorem getElem?_extract {as : Array α} {start stop : Nat} :
     · omega
   · rfl
 
+@[congr] theorem extract_congr {as bs : Array α}
+    (w : as = bs) (h : start = start') (h' : stop = stop') :
+    as.extract start stop = bs.extract start' stop' := by
+  subst w h h'
+  rfl
+
 @[simp] theorem toList_extract (as : Array α) (start stop : Nat) :
-    (as.extract start stop).toList = (as.toList.drop start).take (stop - start) := by
+    (as.extract start stop).toList = as.toList.extract start stop := by
   apply List.ext_getElem
   · simp only [length_toList, size_extract, List.length_take, List.length_drop]
     omega
@@ -2598,7 +2601,7 @@ theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : a
   extract_empty_of_size_le_start _ (Nat.zero_le _)
 
 @[simp] theorem _root_.List.extract_toArray (l : List α) (start stop : Nat) :
-    l.toArray.extract start stop = ((l.drop start).take (stop - start)).toArray := by
+    l.toArray.extract start stop = (l.extract start stop).toArray := by
   apply ext'
   simp
 
@@ -3303,9 +3306,6 @@ theorem get_set (a : Array α) (i : Nat) (hi : i < a.size) (j : Nat) (hj : j < a
     (h : i ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
   simp only [set, ← getElem_toList, List.getElem_set_ne h]
 
-@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
-    (a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
-
 @[simp] theorem swapAt_def (a : Array α) (i : Nat) (v : α) (hi) :
     a.swapAt i v hi = (a[i], a.set i v) := rfl
 
@@ -3360,45 +3360,65 @@ theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rf
 @[deprecated size_swapIfInBounds (since := "2024-11-24")] abbrev size_swap! := @size_swapIfInBounds
 
 @[simp] theorem size_range {n : Nat} : (range n).size = n := by
-  induction n <;> simp [range]
+  simp [range]
 
 @[simp] theorem toList_range (n : Nat) : (range n).toList = List.range n := by
   apply List.ext_getElem <;> simp [range]
 
 @[simp]
-theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
+theorem getElem_range {n : Nat} {i : Nat} (h : i < (Array.range n).size) : (Array.range n)[i] = i := by
   simp [← getElem_toList]
 
+theorem getElem?_range {n : Nat} {i : Nat} : (Array.range n)[i]? = if i < n then some i else none := by
+  simp [getElem?_def, getElem_range]
 
+@[simp] theorem size_range' {start size step} : (range' start size step).size = size := by
+  simp [range']
 
+@[simp] theorem toList_range' {start size step} :
+     (range' start size step).toList = List.range' start size step := by
+  apply List.ext_getElem <;> simp [range']
 
-/-! ### take -/
+@[simp]
+theorem getElem_range' {start size step : Nat} {i : Nat}
+    (h : i < (Array.range' start size step).size) :
+    (Array.range' start size step)[i] = start + step * i := by
+  simp [← getElem_toList]
 
-@[simp] theorem size_take_loop (a : Array α) (n : Nat) : (take.loop n a).size = a.size - n := by
+theorem getElem?_range' {start size step : Nat} {i : Nat} :
+    (Array.range' start size step)[i]? = if i < size then some (start + step * i) else none := by
+  simp [getElem?_def, getElem_range']
+
+/-! ### shrink -/
+
+@[simp] theorem size_shrink_loop (a : Array α) (n : Nat) : (shrink.loop n a).size = a.size - n := by
   induction n generalizing a with
-  | zero => simp [take.loop]
+  | zero => simp [shrink.loop]
   | succ n ih =>
-    simp [take.loop, ih]
+    simp [shrink.loop, ih]
     omega
 
-@[simp] theorem getElem_take_loop (a : Array α) (n : Nat) (i : Nat) (h : i < (take.loop n a).size) :
-    (take.loop n a)[i] = a[i]'(by simp at h; omega) := by
+@[simp] theorem getElem_shrink_loop (a : Array α) (n : Nat) (i : Nat) (h : i < (shrink.loop n a).size) :
+    (shrink.loop n a)[i] = a[i]'(by simp at h; omega) := by
   induction n generalizing a i with
-  | zero => simp [take.loop]
+  | zero => simp [shrink.loop]
   | succ n ih =>
-    simp [take.loop, ih]
+    simp [shrink.loop, ih]
 
-@[simp] theorem size_take (a : Array α) (n : Nat) : (a.take n).size = min n a.size  := by
-  simp [take]
+@[simp] theorem size_shrink (a : Array α) (n : Nat) : (a.shrink n).size = min n a.size  := by
+  simp [shrink]
   omega
 
-@[simp] theorem getElem_take (a : Array α) (n : Nat) (i : Nat) (h : i < (a.take n).size) :
-    (a.take n)[i] = a[i]'(by simp at h; omega) := by
-  simp [take]
+@[simp] theorem getElem_shrink (a : Array α) (n : Nat) (i : Nat) (h : i < (a.shrink n).size) :
+    (a.shrink n)[i] = a[i]'(by simp at h; omega) := by
+  simp [shrink]
 
-@[simp] theorem toList_take (a : Array α) (n : Nat) : (a.take n).toList = a.toList.take n := by
+@[simp] theorem toList_shrink (a : Array α) (n : Nat) : (a.shrink n).toList = a.toList.take n := by
   apply List.ext_getElem <;> simp
 
+@[simp] theorem shrink_eq_take (a : Array α) (n : Nat) : a.shrink n = a.take n := by
+  ext <;> simp
+
 /-! ### forIn -/
 
 @[simp] theorem forIn_toList [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) :
@@ -3549,23 +3569,23 @@ theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size)
 /-! ### zipWith -/
 
 @[simp] theorem toList_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) :
-    (Array.zipWith as bs f).toList = List.zipWith f as.toList bs.toList := by
+    (zipWith f as bs).toList = List.zipWith f as.toList bs.toList := by
   cases as
   cases bs
   simp
 
 @[simp] theorem toList_zip (as : Array α) (bs : Array β) :
-    (Array.zip as bs).toList = List.zip as.toList bs.toList := by
+    (zip as bs).toList = List.zip as.toList bs.toList := by
   simp [zip, toList_zipWith, List.zip]
 
 @[simp] theorem toList_zipWithAll (f : Option α → Option β → γ) (as : Array α) (bs : Array β) :
-    (Array.zipWithAll as bs f).toList = List.zipWithAll f as.toList bs.toList := by
+    (zipWithAll f as bs).toList = List.zipWithAll f as.toList bs.toList := by
   cases as
   cases bs
   simp
 
 @[simp] theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) :
-    (as.zipWith bs f).size = min as.size bs.size := by
+    (zipWith f as bs).size = min as.size bs.size := by
   rw [size_eq_length_toList, toList_zipWith, List.length_zipWith]
 
 @[simp] theorem size_zip (as : Array α) (bs : Array β) :
@@ -3573,8 +3593,8 @@ theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size)
   as.size_zipWith bs Prod.mk
 
 @[simp] theorem getElem_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) (i : Nat)
-    (hi : i < (as.zipWith bs f).size) :
-    (as.zipWith bs f)[i] = f (as[i]'(by simp at hi; omega)) (bs[i]'(by simp at hi; omega)) := by
+    (hi : i < (zipWith f as bs).size) :
+    (zipWith f as bs)[i] = f (as[i]'(by simp at hi; omega)) (bs[i]'(by simp at hi; omega)) := by
   cases as
   cases bs
   simp
@@ -3635,11 +3655,6 @@ theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
 theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
     l.toArray.uset i a h = (l.set i.toNat a).toArray := by simp
 
-@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
-    l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
-  apply ext'
-  simp
-
 @[simp] theorem modify_toArray (f : α → α) (l : List α) :
     l.toArray.modify i f = (l.modify f i).toArray := by
   apply ext'
@@ -3654,34 +3669,14 @@ theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray
   apply ext'
   simp
 
+@[simp] theorem toArray_range' (start size step : Nat) :
+    (range' start size step).toArray = Array.range' start size step := by
+  apply ext'
+  simp
+
 @[simp] theorem toArray_ofFn (f : Fin n → α) : (ofFn f).toArray = Array.ofFn f := by
   ext <;> simp
 
-@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
-    l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
-  rw [Array.eraseIdx]
-  split <;> rename_i h'
-  · rw [eraseIdx_toArray]
-    simp only [swap_toArray, Fin.getElem_fin, toList_toArray, mk.injEq]
-    rw [eraseIdx_set_gt (by simp), eraseIdx_set_eq]
-    simp
-  · simp at h h'
-    have t : i = l.length - 1 := by omega
-    simp [t]
-termination_by l.length - i
-decreasing_by
-  rename_i h
-  simp at h
-  simp
-  omega
-
-@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
-    l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
-  rw [Array.eraseIdxIfInBounds]
-  split
-  · simp
-  · simp_all [eraseIdx_eq_self.2]
-
 end List
 
 namespace Array
@@ -3795,6 +3790,27 @@ namespace List
     as.toArray.unzip = Prod.map List.toArray List.toArray as.unzip := by
   ext1 <;> simp
 
+@[simp] theorem firstM_toArray [Alternative m] (as : List α) (f : α → m β) :
+    as.toArray.firstM f = as.firstM f := by
+  unfold Array.firstM
+  suffices ∀ i, i ≤ as.length → firstM.go f as.toArray (as.length - i) = firstM f (as.drop (as.length - i)) by
+    specialize this as.length
+    simpa
+  intro i
+  induction i with
+  | zero => simp [firstM.go]
+  | succ i ih =>
+    unfold firstM.go
+    split <;> rename_i h
+    · rw [drop_eq_getElem_cons h]
+      intro h'
+      specialize ih (by omega)
+      have : as.length - (i + 1) + 1 = as.length - i := by omega
+      simp_all [ih]
+    · simp only [size_toArray, Nat.not_lt] at h
+      have : as.length = 0 := by omega
+      simp_all
+
 end List
 
 namespace Array

src/Init/Data/Array/MapIdx.lean

@@ -120,7 +120,7 @@ namespace Array
 /-! ### zipIdx -/
 
 @[simp] theorem getElem_zipIdx (a : Array α) (k : Nat) (i : Nat) (h : i < (a.zipIdx k).size) :
-    (a.zipIdx k)[i] = (a[i]'(by simp_all), i + k) := by
+    (a.zipIdx k)[i] = (a[i]'(by simp_all), k + i) := by
   simp [zipIdx]
 
 @[deprecated getElem_zipIdx (since := "2025-01-21")]

src/Init/Data/Array/Monadic.lean

@@ -20,6 +20,12 @@ open Nat
 
 /-! ### mapM -/
 
+@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : Array α} :
+    (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simp
+
 theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α → m β) (l : Array α) :
     mapM f l = l.foldlM (fun acc a => return (acc.push (← f a))) #[] := by
   rcases l with ⟨l⟩
@@ -37,58 +43,85 @@ theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α → m β) (l : Arr
 
 /-! ### foldlM and foldrM -/
 
-theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : Array β₁) (init : α) :
-    (l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
+theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : Array β₁) (init : α) (w : stop = l.size) :
+    (l.map f).foldlM g init 0 stop = l.foldlM (fun x y => g x (f y)) init 0 stop := by
+  subst w
   cases l
-  rw [List.map_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldlM_map]
 
 theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : Array β₁)
-    (init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
+    (init : α) (w : start = l.size) :
+    (l.map f).foldrM g init start 0 = l.foldrM (fun x y => g (f x) y) init start 0 := by
+  subst w
   cases l
-  rw [List.map_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldrM_map]
 
-theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : γ → β → m γ) (l : Array α) (init : γ) :
-    (l.filterMap f).foldlM g init =
+theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : γ → β → m γ)
+    (l : Array α) (init : γ) (w : stop = (l.filterMap f).size) :
+    (l.filterMap f).foldlM g init 0 stop =
       l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
+  subst w
   cases l
-  rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldlM_filterMap]
   rfl
 
-theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : β → γ → m γ) (l : Array α) (init : γ) :
-    (l.filterMap f).foldrM g init =
+theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : β → γ → m γ)
+    (l : Array α) (init : γ) (w : start = (l.filterMap f).size) :
+    (l.filterMap f).foldrM g init start 0 =
       l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
+  subst w
   cases l
-  rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldrM_filterMap]
   rfl
 
-theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : β → α → m β) (l : Array α) (init : β) :
-    (l.filter p).foldlM g init =
+theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : β → α → m β)
+    (l : Array α) (init : β) (w : stop = (l.filter p).size) :
+    (l.filter p).foldlM g init 0 stop =
       l.foldlM (fun x y => if p y then g x y else pure x) init := by
+  subst w
   cases l
-  rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldlM_filter]
 
-theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β → m β) (l : Array α) (init : β) :
-    (l.filter p).foldrM g init =
+theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β → m β)
+    (l : Array α) (init : β) (w : start = (l.filter p).size) :
+    (l.filter p).foldrM g init start 0 =
       l.foldrM (fun x y => if p x then g x y else pure y) init := by
+  subst w
   cases l
-  rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldrM_filter]
 
+@[simp] theorem foldlM_attachWith [Monad m]
+    (l : Array α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : β → { x // q x} → m β} {b} (w : stop = l.size):
+    (l.attachWith q H).foldlM f b 0 stop =
+      l.attach.foldlM (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by
+  subst w
+  rcases l with ⟨l⟩
+  simp [List.foldlM_map]
+
+@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
+    (l : Array α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : { x // q x} → β → m β} {b} (w : start = l.size):
+    (l.attachWith q H).foldrM f b start 0 =
+      l.attach.foldrM (fun a acc => f ⟨a.1, H _ a.2⟩ acc) b := by
+  subst w
+  rcases l with ⟨l⟩
+  simp [List.foldrM_map]
+
 /-! ### forM -/
 
 @[congr] theorem forM_congr [Monad m] {as bs : Array α} (w : as = bs)
     {f : α → m PUnit} :
-    forM f as = forM f bs := by
+    forM as f = forM bs f := by
   cases as <;> cases bs
   simp_all
 
+@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ l₂ : Array α) (f : α → m PUnit) :
+    forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simp
+
 @[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Array α) (g : α → β) (f : β → m PUnit) :
-    (l.map g).forM f = l.forM (fun a => f (g a)) := by
+    forM (l.map g) f = forM l (fun a => f (g a)) := by
   cases l
   simp
 
@@ -115,9 +148,7 @@ theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
         | .yield b => f a m b
         | .done b => pure (.done b)) (ForInStep.yield init) := by
   cases l
-  rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
-  simp only [List.forIn'_toArray, List.forIn'_eq_foldlM, List.attachWith_mem_toArray, size_toArray,
-    List.length_map, List.length_attach, List.foldlM_toArray', List.foldlM_map]
+  simp [List.forIn'_eq_foldlM, List.foldlM_map]
   congr
 
 /-- We can express a for loop over an array which always yields as a fold. -/
@@ -126,7 +157,6 @@ theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
     forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
       l.attach.foldlM (fun b ⟨a, m⟩ => g a m b <$> f a m b) init := by
   cases l
-  rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldlM_map]
 
 theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
@@ -191,4 +221,59 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   cases l
   simp
 
+/-! ### Recognizing higher order functions using a function that only depends on the value. -/
+
+/--
+This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem foldlM_subtype [Monad m] {p : α → Prop} {l : Array { x // p x }}
+    {f : β → { x // p x } → m β} {g : β → α → m β} {x : β}
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) (w : stop = l.size) :
+    l.foldlM f x 0 stop = l.unattach.foldlM g x 0 stop := by
+  subst w
+  rcases l with ⟨l⟩
+  simp
+  rw [List.foldlM_subtype hf]
+
+/--
+This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem foldrM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
+    {f : { x // p x } → β → m β} {g : α → β → m β} {x : β}
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) (w : start = l.size) :
+    l.foldrM f x start 0 = l.unattach.foldrM g x start 0:= by
+  subst w
+  rcases l with ⟨l⟩
+  simp
+  rw [List.foldrM_subtype hf]
+
+/--
+This lemma identifies monadic maps over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem mapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
+    {f : { x // p x } → m β} {g : α → m β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+    l.mapM f = l.unattach.mapM g := by
+  rcases l with ⟨l⟩
+  simp
+  rw [List.mapM_subtype hf]
+
+-- Without `filterMapM_toArray` relating `filterMapM` on `List` and `Array` we can't prove this yet:
+-- @[simp] theorem filterMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
+--     {f : { x // p x } → m (Option β)} {g : α → m (Option β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+--     l.filterMapM f = l.unattach.filterMapM g := by
+--   rcases l with ⟨l⟩
+--   simp
+--   rw [List.filterMapM_subtype hf]
+
+-- Without `flatMapM_toArray` relating `flatMapM` on `List` and `Array` we can't prove this yet:
+-- @[simp] theorem flatMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
+--     {f : { x // p x } → m (Array β)} {g : α → m (Array β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+--     (l.flatMapM f) = l.unattach.flatMapM g := by
+--   rcases l with ⟨l⟩
+--   simp
+--   rw [List.flatMapM_subtype hf]
+
 end Array

src/Init/Data/Array/OfFn.lean

@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Lemmas
+import Init.Data.List.OfFn
+
+/-!
+# Theorems about `Array.ofFn`
+-/
+
+namespace Array
+
+@[simp]
+theorem ofFn_eq_empty_iff {f : Fin n → α} : ofFn f = #[] ↔ n = 0 := by
+  rw [← Array.toList_inj]
+  simp
+
+@[simp 500]
+theorem mem_ofFn {n} (f : Fin n → α) (a : α) : a ∈ ofFn f ↔ ∃ i, f i = a := by
+  constructor
+  · intro w
+    obtain ⟨i, h, rfl⟩ := getElem_of_mem w
+    exact ⟨⟨i, by simpa using h⟩, by simp⟩
+  · rintro ⟨i, rfl⟩
+    apply mem_of_getElem (i := i) <;> simp
+
+end Array

src/Init/Data/Array/Range.lean

@@ -0,0 +1,297 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Lemmas
+import Init.Data.Array.OfFn
+import Init.Data.Array.MapIdx
+import Init.Data.Array.Zip
+import Init.Data.List.Nat.Range
+
+/-!
+# Lemmas about `Array.range'`, `Array.range`, and `Array.zipIdx`
+
+-/
+
+namespace Array
+
+open Nat
+
+/-! ## Ranges and enumeration -/
+
+/-! ### range' -/
+
+theorem range'_succ (s n step) : range' s (n + 1) step = #[s] ++ range' (s + step) n step := by
+  rw [← toList_inj]
+  simp [List.range'_succ]
+
+@[simp] theorem range'_eq_empty_iff : range' s n step = #[] ↔ n = 0 := by
+  rw [← size_eq_zero, size_range']
+
+theorem range'_ne_empty_iff (s : Nat) {n step : Nat} : range' s n step ≠ #[] ↔ n ≠ 0 := by
+  cases n <;> simp
+
+@[simp] theorem range'_zero : range' s 0 step = #[] := by
+  simp
+
+@[simp] theorem range'_one {s step : Nat} : range' s 1 step = #[s] := rfl
+
+@[simp] theorem range'_inj : range' s n = range' s' n' ↔ n = n' ∧ (n = 0 ∨ s = s') := by
+  rw [← toList_inj]
+  simp [List.range'_inj]
+
+theorem mem_range' {n} : m ∈ range' s n step ↔ ∃ i < n, m = s + step * i := by
+  simp [range']
+  constructor
+  · rintro ⟨⟨i, w⟩, h, h'⟩
+    exact ⟨i, w, by simp_all⟩
+  · rintro ⟨i, w, h'⟩
+    exact ⟨⟨i, w⟩, by simp_all⟩
+
+theorem pop_range' : (range' s n step).pop = range' s (n - 1) step := by
+  ext <;> simp
+
+theorem map_add_range' (a) (s n step) : map (a + ·) (range' s n step) = range' (a + s) n step := by
+  ext <;> simp <;> omega
+
+theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1) := by
+  ext <;> simp <;> omega
+
+theorem range'_append (s m n step : Nat) :
+    range' s m step ++ range' (s + step * m) n step = range' s (m + n) step := by
+  ext i h₁ h₂
+  · simp
+  · simp only [size_append, size_range'] at h₁ h₂
+    simp only [getElem_append, size_range', getElem_range', Nat.mul_sub_left_distrib, dite_eq_ite,
+      ite_eq_left_iff, Nat.not_lt]
+    intro h
+    have : step * m ≤ step * i := by exact mul_le_mul_left step h
+    omega
+
+@[simp] theorem range'_append_1 (s m n : Nat) :
+    range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
+
+theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ #[s + step * n] := by
+  exact (range'_append s n 1 step).symm
+
+theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ #[s + n] := by
+  simp [range'_concat]
+
+@[simp] theorem mem_range'_1 : m ∈ range' s n ↔ s ≤ m ∧ m < s + n := by
+  simp [mem_range']; exact ⟨
+    fun ⟨i, h, e⟩ => e ▸ ⟨Nat.le_add_right .., Nat.add_lt_add_left h _⟩,
+    fun ⟨h₁, h₂⟩ => ⟨m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm⟩⟩
+
+theorem map_sub_range' (a s n : Nat) (h : a ≤ s) :
+    map (· - a) (range' s n step) = range' (s - a) n step := by
+  conv => lhs; rw [← Nat.add_sub_cancel' h]
+  rw [← map_add_range', map_map, (?_ : _∘_ = _), map_id]
+  funext x; apply Nat.add_sub_cancel_left
+
+@[simp] theorem range'_eq_singleton_iff {s n a : Nat} : range' s n = #[a] ↔ s = a ∧ n = 1 := by
+  rw [← toList_inj]
+  simp
+
+theorem range'_eq_append_iff : range' s n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs = range' s k ∧ ys = range' (s + k) (n - k) := by
+  simp [← toList_inj, List.range'_eq_append_iff]
+
+@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat → Bool} :
+    (range' s n).find? p = some i ↔ p i ∧ i ∈ range' s n ∧ ∀ j, s ≤ j → j < i → !p j := by
+  rw [← List.toArray_range']
+  simp only [List.find?_toArray, mem_toArray]
+  simp [List.find?_range'_eq_some]
+
+@[simp] theorem find?_range'_eq_none {s n : Nat} {p : Nat → Bool} :
+    (range' s n).find? p = none ↔ ∀ i, s ≤ i → i < s + n → !p i := by
+  rw [← List.toArray_range']
+  simp only [List.find?_toArray]
+  simp
+
+theorem erase_range' :
+    (range' s n).erase i =
+      range' s (min n (i - s)) ++ range' (max s (i + 1)) (min s (i + 1) + n - (i + 1)) := by
+  simp only [← List.toArray_range', List.erase_toArray]
+  simp [List.erase_range']
+
+/-! ### range -/
+
+theorem range_eq_range' (n : Nat) : range n = range' 0 n := by
+  simp [range, range']
+
+theorem range_succ_eq_map (n : Nat) : range (n + 1) = #[0] ++ map succ (range n) := by
+  ext i h₁ h₂
+  · simp
+    omega
+  · simp only [getElem_range, getElem_append, size_toArray, List.length_cons, List.length_nil,
+      Nat.zero_add, lt_one_iff, List.getElem_toArray, List.getElem_singleton, getElem_map,
+      succ_eq_add_one, dite_eq_ite]
+    split <;> omega
+
+theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) := by
+  rw [range_eq_range', map_add_range']; rfl
+
+@[simp] theorem range_eq_empty_iff {n : Nat} : range n = #[] ↔ n = 0 := by
+  rw [← size_eq_zero, size_range]
+
+theorem range_ne_empty_iff {n : Nat} : range n ≠ #[] ↔ n ≠ 0 := by
+  cases n <;> simp
+
+theorem range_succ (n : Nat) : range (succ n) = range n ++ #[n] := by
+  ext i h₁ h₂
+  · simp
+  · simp only [succ_eq_add_one, size_range] at h₁
+    simp only [succ_eq_add_one, getElem_range, append_singleton, getElem_push, size_range,
+      dite_eq_ite]
+    split <;> omega
+
+theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·) := by
+  rw [← range'_eq_map_range]
+  simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm
+
+theorem reverse_range' (s n : Nat) : reverse (range' s n) = map (s + n - 1 - ·) (range n) := by
+  simp [← toList_inj, List.reverse_range']
+
+@[simp]
+theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by
+  simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add]
+
+theorem not_mem_range_self {n : Nat} : n ∉ range n := by simp
+
+theorem self_mem_range_succ (n : Nat) : n ∈ range (n + 1) := by simp
+
+@[simp] theorem take_range (m n : Nat) : take (range n) m = range (min m n) := by
+  ext <;> simp
+
+@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
+    (range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
+  simp [range_eq_range']
+
+@[simp] theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
+    (range n).find? p = none ↔ ∀ i, i < n → !p i := by
+  simp only [← List.toArray_range, List.find?_toArray, List.find?_range_eq_none]
+
+theorem erase_range : (range n).erase i = range (min n i) ++ range' (i + 1) (n - (i + 1)) := by
+  simp [range_eq_range', erase_range']
+
+
+/-! ### zipIdx -/
+
+@[simp]
+theorem zipIdx_eq_empty_iff {l : Array α} {n : Nat} : l.zipIdx n = #[] ↔ l = #[] := by
+  cases l
+  simp
+
+@[simp]
+theorem getElem?_zipIdx (l : Array α) (n m) : (zipIdx l n)[m]? = l[m]?.map fun a => (a, n + m) := by
+  simp [getElem?_def]
+
+theorem map_snd_add_zipIdx_eq_zipIdx (l : Array α) (n k : Nat) :
+    map (Prod.map id (· + n)) (zipIdx l k) = zipIdx l (n + k) :=
+  ext_getElem? fun i ↦ by simp [(· ∘ ·), Nat.add_comm, Nat.add_left_comm]; rfl
+
+@[simp]
+theorem zipIdx_map_snd (n) (l : Array α) : map Prod.snd (zipIdx l n) = range' n l.size := by
+  cases l
+  simp
+
+@[simp]
+theorem zipIdx_map_fst (n) (l : Array α) : map Prod.fst (zipIdx l n) = l := by
+  cases l
+  simp
+
+theorem zipIdx_eq_zip_range' (l : Array α) {n : Nat} : l.zipIdx n = l.zip (range' n l.size) := by
+  simp [zip_of_prod (zipIdx_map_fst _ _) (zipIdx_map_snd _ _)]
+
+@[simp]
+theorem unzip_zipIdx_eq_prod (l : Array α) {n : Nat} :
+    (l.zipIdx n).unzip = (l, range' n l.size) := by
+  simp only [zipIdx_eq_zip_range', unzip_zip, size_range']
+
+/-- Replace `zipIdx` with a starting index `n+1` with `zipIdx` starting from `n`,
+followed by a `map` increasing the indices by one. -/
+theorem zipIdx_succ (l : Array α) (n : Nat) :
+    l.zipIdx (n + 1) = (l.zipIdx n).map (fun ⟨a, i⟩ => (a, i + 1)) := by
+  cases l
+  simp [List.zipIdx_succ]
+
+/-- Replace `zipIdx` with a starting index with `zipIdx` starting from 0,
+followed by a `map` increasing the indices. -/
+theorem zipIdx_eq_map_add (l : Array α) (n : Nat) :
+    l.zipIdx n = l.zipIdx.map (fun ⟨a, i⟩ => (a, n + i)) := by
+  cases l
+  simp only [zipIdx_toArray, List.map_toArray, mk.injEq]
+  rw [List.zipIdx_eq_map_add]
+
+@[simp]
+theorem zipIdx_singleton (x : α) (k : Nat) : zipIdx #[x] k = #[(x, k)] :=
+  rfl
+
+theorem mk_add_mem_zipIdx_iff_getElem? {k i : Nat} {x : α} {l : Array α} :
+    (x, k + i) ∈ zipIdx l k ↔ l[i]? = some x := by
+  simp [mem_iff_getElem?, and_left_comm]
+
+theorem le_snd_of_mem_zipIdx {x : α × Nat} {k : Nat} {l : Array α} (h : x ∈ zipIdx l k) :
+    k ≤ x.2 :=
+  (mk_mem_zipIdx_iff_le_and_getElem?_sub.1 h).1
+
+theorem snd_lt_add_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x ∈ zipIdx l k) :
+    x.2 < k + l.size := by
+  rcases mem_iff_getElem.1 h with ⟨i, h', rfl⟩
+  simpa using h'
+
+theorem snd_lt_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x ∈ l.zipIdx k) : x.2 < l.size + k := by
+  simpa [Nat.add_comm] using snd_lt_add_of_mem_zipIdx h
+
+theorem map_zipIdx (f : α → β) (l : Array α) (k : Nat) :
+    map (Prod.map f id) (zipIdx l k) = zipIdx (l.map f) k := by
+  cases l
+  simp [List.map_zipIdx]
+
+theorem fst_mem_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x ∈ zipIdx l k) : x.1 ∈ l :=
+  zipIdx_map_fst k l ▸ mem_map_of_mem _ h
+
+theorem fst_eq_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x ∈ zipIdx l k) :
+    x.1 = l[x.2 - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) := by
+  cases l
+  exact List.fst_eq_of_mem_zipIdx (by simpa using h)
+
+theorem mem_zipIdx {x : α} {i : Nat} {xs : Array α} {k : Nat} (h : (x, i) ∈ xs.zipIdx k) :
+    k ≤ i ∧ i < k + xs.size ∧
+      x = xs[i - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
+  ⟨le_snd_of_mem_zipIdx h, snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h⟩
+
+/-- Variant of `mem_zipIdx` specialized at `k = 0`. -/
+theorem mem_zipIdx' {x : α} {i : Nat} {xs : Array α} (h : (x, i) ∈ xs.zipIdx) :
+    i < xs.size ∧ x = xs[i]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
+  ⟨by simpa using snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h⟩
+
+theorem zipIdx_map (l : Array α) (k : Nat) (f : α → β) :
+    zipIdx (l.map f) k = (zipIdx l k).map (Prod.map f id) := by
+  cases l
+  simp [List.zipIdx_map]
+
+theorem zipIdx_append (xs ys : Array α) (k : Nat) :
+    zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + xs.size) := by
+  cases xs
+  cases ys
+  simp [List.zipIdx_append]
+
+theorem zipIdx_eq_append_iff {l : Array α} {k : Nat} :
+    zipIdx l k = l₁ ++ l₂ ↔
+      ∃ l₁' l₂', l = l₁' ++ l₂' ∧ l₁ = zipIdx l₁' k ∧ l₂ = zipIdx l₂' (k + l₁'.size) := by
+  rcases l with ⟨l⟩
+  rcases l₁ with ⟨l₁⟩
+  rcases l₂ with ⟨l₂⟩
+  simp only [zipIdx_toArray, List.append_toArray, mk.injEq, List.zipIdx_eq_append_iff,
+    toArray_eq_append_iff]
+  constructor
+  · rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
+    exact ⟨⟨l₁'⟩, ⟨l₂'⟩, by simp⟩
+  · rintro ⟨⟨l₁'⟩, ⟨l₂'⟩, rfl, h⟩
+    simp only [zipIdx_toArray, mk.injEq, size_toArray] at h
+    obtain ⟨rfl, rfl⟩ := h
+    exact ⟨l₁', l₂', by simp⟩
+
+end Array

src/Init/Data/Array/Zip.lean

@@ -0,0 +1,363 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.TakeDrop
+import Init.Data.List.Zip
+
+/-!
+# Lemmas about `Array.zip`, `Array.zipWith`, `Array.zipWithAll`, and `Array.unzip`.
+-/
+
+namespace Array
+
+open Nat
+
+/-! ## Zippers -/
+
+/-! ### zipWith -/
+
+theorem zipWith_comm (f : α → β → γ) (la : Array α) (lb : Array β) :
+    zipWith f la lb = zipWith (fun b a => f a b) lb la := by
+  cases la
+  cases lb
+  simpa using List.zipWith_comm _ _ _
+
+theorem zipWith_comm_of_comm (f : α → α → β) (comm : ∀ x y : α, f x y = f y x) (l l' : Array α) :
+    zipWith f l l' = zipWith f l' l := by
+  rw [zipWith_comm]
+  simp only [comm]
+
+@[simp]
+theorem zipWith_self (f : α → α → δ) (l : Array α) : zipWith f l l = l.map fun a => f a a := by
+  cases l
+  simp
+
+/--
+See also `getElem?_zipWith'` for a variant
+using `Option.map` and `Option.bind` rather than a `match`.
+-/
+theorem getElem?_zipWith {f : α → β → γ} {i : Nat} :
+    (zipWith f as bs)[i]? = match as[i]?, bs[i]? with
+      | some a, some b => some (f a b) | _, _ => none := by
+  cases as
+  cases bs
+  simp [List.getElem?_zipWith]
+  rfl
+
+/-- Variant of `getElem?_zipWith` using `Option.map` and `Option.bind` rather than a `match`. -/
+theorem getElem?_zipWith' {f : α → β → γ} {i : Nat} :
+    (zipWith f l₁ l₂)[i]? = (l₁[i]?.map f).bind fun g => l₂[i]?.map g := by
+  cases l₁
+  cases l₂
+  simp [List.getElem?_zipWith']
+
+theorem getElem?_zipWith_eq_some {f : α → β → γ} {l₁ : Array α} {l₂ : Array β} {z : γ} {i : Nat} :
+    (zipWith f l₁ l₂)[i]? = some z ↔
+      ∃ x y, l₁[i]? = some x ∧ l₂[i]? = some y ∧ f x y = z := by
+  cases l₁
+  cases l₂
+  simp [List.getElem?_zipWith_eq_some]
+
+theorem getElem?_zip_eq_some {l₁ : Array α} {l₂ : Array β} {z : α × β} {i : Nat} :
+    (zip l₁ l₂)[i]? = some z ↔ l₁[i]? = some z.1 ∧ l₂[i]? = some z.2 := by
+  cases z
+  rw [zip, getElem?_zipWith_eq_some]; constructor
+  · rintro ⟨x, y, h₀, h₁, h₂⟩
+    simpa [h₀, h₁] using h₂
+  · rintro ⟨h₀, h₁⟩
+    exact ⟨_, _, h₀, h₁, rfl⟩
+
+@[simp]
+theorem zipWith_map {μ} (f : γ → δ → μ) (g : α → γ) (h : β → δ) (l₁ : Array α) (l₂ : Array β) :
+    zipWith f (l₁.map g) (l₂.map h) = zipWith (fun a b => f (g a) (h b)) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWith_map]
+
+theorem zipWith_map_left (l₁ : Array α) (l₂ : Array β) (f : α → α') (g : α' → β → γ) :
+    zipWith g (l₁.map f) l₂ = zipWith (fun a b => g (f a) b) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWith_map_left]
+
+theorem zipWith_map_right (l₁ : Array α) (l₂ : Array β) (f : β → β') (g : α → β' → γ) :
+    zipWith g l₁ (l₂.map f) = zipWith (fun a b => g a (f b)) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWith_map_right]
+
+theorem zipWith_foldr_eq_zip_foldr {f : α → β → γ} (i : δ):
+    (zipWith f l₁ l₂).foldr g i = (zip l₁ l₂).foldr (fun p r => g (f p.1 p.2) r) i := by
+  cases l₁
+  cases l₂
+  simp [List.zipWith_foldr_eq_zip_foldr]
+
+theorem zipWith_foldl_eq_zip_foldl {f : α → β → γ} (i : δ):
+    (zipWith f l₁ l₂).foldl g i = (zip l₁ l₂).foldl (fun r p => g r (f p.1 p.2)) i := by
+  cases l₁
+  cases l₂
+  simp [List.zipWith_foldl_eq_zip_foldl]
+
+@[simp]
+theorem zipWith_eq_empty_iff {f : α → β → γ} {l l'} : zipWith f l l' = #[] ↔ l = #[] ∨ l' = #[] := by
+  cases l <;> cases l' <;> simp
+
+theorem map_zipWith {δ : Type _} (f : α → β) (g : γ → δ → α) (l : Array γ) (l' : Array δ) :
+    map f (zipWith g l l') = zipWith (fun x y => f (g x y)) l l' := by
+  cases l
+  cases l'
+  simp [List.map_zipWith]
+
+theorem take_zipWith : (zipWith f l l').take n = zipWith f (l.take n) (l'.take n) := by
+  cases l
+  cases l'
+  simp [List.take_zipWith]
+
+theorem extract_zipWith : (zipWith f l l').extract m n = zipWith f (l.extract m n) (l'.extract m n) := by
+  cases l
+  cases l'
+  simp [List.drop_zipWith, List.take_zipWith]
+
+theorem zipWith_append (f : α → β → γ) (l la : Array α) (l' lb : Array β)
+    (h : l.size = l'.size) :
+    zipWith f (l ++ la) (l' ++ lb) = zipWith f l l' ++ zipWith f la lb := by
+  cases l
+  cases l'
+  cases la
+  cases lb
+  simp at h
+  simp [List.zipWith_append, h]
+
+theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : Array α} {l₂ : Array β} :
+    zipWith f l₁ l₂ = l₁' ++ l₂' ↔
+      ∃ w x y z, w.size = y.size ∧ l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zipWith f w y ∧ l₂' = zipWith f x z := by
+  cases l₁
+  cases l₂
+  cases l₁'
+  cases l₂'
+  simp only [List.zipWith_toArray, List.append_toArray, mk.injEq, List.zipWith_eq_append_iff,
+    toArray_eq_append_iff]
+  constructor
+  · rintro ⟨w, x, y, z, h, rfl, rfl, rfl, rfl⟩
+    exact ⟨w.toArray, x.toArray, y.toArray, z.toArray, by simp [h]⟩
+  · rintro ⟨⟨w⟩, ⟨x⟩, ⟨y⟩, ⟨z⟩, h, rfl, rfl, h₁, h₂⟩
+    exact ⟨w, x, y, z, by simp_all⟩
+
+@[simp] theorem zipWith_mkArray {a : α} {b : β} {m n : Nat} :
+    zipWith f (mkArray m a) (mkArray n b) = mkArray (min m n) (f a b) := by
+  simp [← List.toArray_replicate]
+
+theorem map_uncurry_zip_eq_zipWith (f : α → β → γ) (l : Array α) (l' : Array β) :
+    map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
+  cases l
+  cases l'
+  simp [List.map_uncurry_zip_eq_zipWith]
+
+theorem map_zip_eq_zipWith (f : α × β → γ) (l : Array α) (l' : Array β) :
+    map f (l.zip l') = zipWith (Function.curry f) l l' := by
+  cases l
+  cases l'
+  simp [List.map_zip_eq_zipWith]
+
+theorem lt_size_left_of_zipWith {f : α → β → γ} {i : Nat} {l : Array α} {l' : Array β}
+    (h : i < (zipWith f l l').size) : i < l.size := by rw [size_zipWith] at h; omega
+
+theorem lt_size_right_of_zipWith {f : α → β → γ} {i : Nat} {l : Array α} {l' : Array β}
+    (h : i < (zipWith f l l').size) : i < l'.size := by rw [size_zipWith] at h; omega
+
+theorem zipWith_eq_zipWith_take_min (l₁ : Array α) (l₂ : Array β) :
+    zipWith f l₁ l₂ = zipWith f (l₁.take (min l₁.size l₂.size)) (l₂.take (min l₁.size l₂.size)) := by
+  cases l₁
+  cases l₂
+  simp
+  rw [List.zipWith_eq_zipWith_take_min]
+
+theorem reverse_zipWith (h : l.size = l'.size) :
+    (zipWith f l l').reverse = zipWith f l.reverse l'.reverse := by
+  cases l
+  cases l'
+  simp [List.reverse_zipWith (by simpa using h)]
+
+/-! ### zip -/
+
+theorem lt_size_left_of_zip {i : Nat} {l : Array α} {l' : Array β} (h : i < (zip l l').size) :
+    i < l.size :=
+  lt_size_left_of_zipWith h
+
+theorem lt_size_right_of_zip {i : Nat} {l : Array α} {l' : Array β} (h : i < (zip l l').size) :
+    i < l'.size :=
+  lt_size_right_of_zipWith h
+
+@[simp]
+theorem getElem_zip {l : Array α} {l' : Array β} {i : Nat} {h : i < (zip l l').size} :
+    (zip l l')[i] =
+      (l[i]'(lt_size_left_of_zip h), l'[i]'(lt_size_right_of_zip h)) :=
+  getElem_zipWith (hi := by simpa using h)
+
+theorem zip_eq_zipWith (l₁ : Array α) (l₂ : Array β) : zip l₁ l₂ = zipWith Prod.mk l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zip_eq_zipWith]
+
+theorem zip_map (f : α → γ) (g : β → δ) (l₁ : Array α) (l₂ : Array β) :
+    zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g) := by
+  cases l₁
+  cases l₂
+  simp [List.zip_map]
+
+theorem zip_map_left (f : α → γ) (l₁ : Array α) (l₂ : Array β) :
+    zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]
+
+theorem zip_map_right (f : β → γ) (l₁ : Array α) (l₂ : Array β) :
+    zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [← zip_map, map_id]
+
+theorem zip_append {l₁ r₁ : Array α} {l₂ r₂ : Array β} (_h : l₁.size = l₂.size) :
+    zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂ := by
+  cases l₁
+  cases l₂
+  cases r₁
+  cases r₂
+  simp_all [List.zip_append]
+
+theorem zip_map' (f : α → β) (g : α → γ) (l : Array α) :
+    zip (l.map f) (l.map g) = l.map fun a => (f a, g a) := by
+  cases l
+  simp [List.zip_map']
+
+theorem of_mem_zip {a b} {l₁ : Array α} {l₂ : Array β} : (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂ := by
+  cases l₁
+  cases l₂
+  simpa using List.of_mem_zip
+
+theorem map_fst_zip (l₁ : Array α) (l₂ : Array β) (h : l₁.size ≤ l₂.size) :
+    map Prod.fst (zip l₁ l₂) = l₁ := by
+  cases l₁
+  cases l₂
+  simp_all [List.map_fst_zip]
+
+theorem map_snd_zip (l₁ : Array α) (l₂ : Array β) (h : l₂.size ≤ l₁.size) :
+    map Prod.snd (zip l₁ l₂) = l₂ := by
+  cases l₁
+  cases l₂
+  simp_all [List.map_snd_zip]
+
+theorem map_prod_left_eq_zip {l : Array α} (f : α → β) :
+    (l.map fun x => (x, f x)) = l.zip (l.map f) := by
+  rw [← zip_map']
+  congr
+  simp
+
+theorem map_prod_right_eq_zip {l : Array α} (f : α → β) :
+    (l.map fun x => (f x, x)) = (l.map f).zip l := by
+  rw [← zip_map']
+  congr
+  simp
+
+@[simp] theorem zip_eq_empty_iff {l₁ : Array α} {l₂ : Array β} :
+    zip l₁ l₂ = #[] ↔ l₁ = #[] ∨ l₂ = #[] := by
+  cases l₁
+  cases l₂
+  simp [List.zip_eq_nil_iff]
+
+theorem zip_eq_append_iff {l₁ : Array α} {l₂ : Array β} :
+    zip l₁ l₂ = l₁' ++ l₂' ↔
+      ∃ w x y z, w.size = y.size ∧ l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zip w y ∧ l₂' = zip x z := by
+  simp [zip_eq_zipWith, zipWith_eq_append_iff]
+
+@[simp] theorem zip_mkArray {a : α} {b : β} {m n : Nat} :
+    zip (mkArray m a) (mkArray n b) = mkArray (min m n) (a, b) := by
+  simp [← List.toArray_replicate]
+
+theorem zip_eq_zip_take_min (l₁ : Array α) (l₂ : Array β) :
+    zip l₁ l₂ = zip (l₁.take (min l₁.size l₂.size)) (l₂.take (min l₁.size l₂.size)) := by
+  cases l₁
+  cases l₂
+  simp only [List.zip_toArray, size_toArray, List.take_toArray, mk.injEq]
+  rw [List.zip_eq_zip_take_min]
+
+
+/-! ### zipWithAll -/
+
+theorem getElem?_zipWithAll {f : Option α → Option β → γ} {i : Nat} :
+    (zipWithAll f as bs)[i]? = match as[i]?, bs[i]? with
+      | none, none => .none | a?, b? => some (f a? b?) := by
+  cases as
+  cases bs
+  simp [List.getElem?_zipWithAll]
+  rfl
+
+theorem zipWithAll_map {μ} (f : Option γ → Option δ → μ) (g : α → γ) (h : β → δ) (l₁ : Array α) (l₂ : Array β) :
+    zipWithAll f (l₁.map g) (l₂.map h) = zipWithAll (fun a b => f (g <$> a) (h <$> b)) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWithAll_map]
+
+theorem zipWithAll_map_left (l₁ : Array α) (l₂ : Array β) (f : α → α') (g : Option α' → Option β → γ) :
+    zipWithAll g (l₁.map f) l₂ = zipWithAll (fun a b => g (f <$> a) b) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWithAll_map_left]
+
+theorem zipWithAll_map_right (l₁ : Array α) (l₂ : Array β) (f : β → β') (g : Option α → Option β' → γ) :
+    zipWithAll g l₁ (l₂.map f) = zipWithAll (fun a b => g a (f <$> b)) l₁ l₂ := by
+  cases l₁
+  cases l₂
+  simp [List.zipWithAll_map_right]
+
+theorem map_zipWithAll {δ : Type _} (f : α → β) (g : Option γ → Option δ → α) (l : Array γ) (l' : Array δ) :
+    map f (zipWithAll g l l') = zipWithAll (fun x y => f (g x y)) l l' := by
+  cases l
+  cases l'
+  simp [List.map_zipWithAll]
+
+
+@[simp] theorem zipWithAll_replicate {a : α} {b : β} {n : Nat} :
+    zipWithAll f (mkArray n a) (mkArray n b) = mkArray n (f a b) := by
+  simp [← List.toArray_replicate]
+
+/-! ### unzip -/
+
+@[simp] theorem unzip_fst : (unzip l).fst = l.map Prod.fst := by
+  induction l <;> simp_all
+
+@[simp] theorem unzip_snd : (unzip l).snd = l.map Prod.snd := by
+  induction l <;> simp_all
+
+theorem unzip_eq_map (l : Array (α × β)) : unzip l = (l.map Prod.fst, l.map Prod.snd) := by
+  cases l
+  simp [List.unzip_eq_map]
+
+theorem zip_unzip (l : Array (α × β)) : zip (unzip l).1 (unzip l).2 = l := by
+  cases l
+  simp only [List.unzip_toArray, Prod.map_fst, Prod.map_snd, List.zip_toArray, List.zip_unzip]
+
+theorem unzip_zip_left {l₁ : Array α} {l₂ : Array β} (h : l₁.size ≤ l₂.size) :
+    (unzip (zip l₁ l₂)).1 = l₁ := by
+  cases l₁
+  cases l₂
+  simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, Prod.map_fst,
+    List.unzip_zip_left]
+
+theorem unzip_zip_right {l₁ : Array α} {l₂ : Array β} (h : l₂.size ≤ l₁.size) :
+    (unzip (zip l₁ l₂)).2 = l₂ := by
+  cases l₁
+  cases l₂
+  simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, Prod.map_snd,
+    List.unzip_zip_right]
+
+theorem unzip_zip {l₁ : Array α} {l₂ : Array β} (h : l₁.size = l₂.size) :
+    unzip (zip l₁ l₂) = (l₁, l₂) := by
+  cases l₁
+  cases l₂
+  simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, List.unzip_zip, Prod.map_apply]
+
+theorem zip_of_prod {l : Array α} {l' : Array β} {lp : Array (α × β)} (hl : lp.map Prod.fst = l)
+    (hr : lp.map Prod.snd = l') : lp = l.zip l' := by
+  rw [← hl, ← hr, ← zip_unzip lp, ← unzip_fst, ← unzip_snd, zip_unzip, zip_unzip]
+
+@[simp] theorem unzip_mkArray {n : Nat} {a : α} {b : β} :
+    unzip (mkArray n (a, b)) = (mkArray n a, mkArray n b) := by
+  ext1 <;> simp

src/Init/Data/BitVec/Lemmas.lean

@@ -430,6 +430,9 @@ theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat
     simp only [Nat.add_sub_cancel]
     exact p
 
+theorem msb_eq_getMsbD_zero (x : BitVec w) : x.msb = x.getMsbD 0 := by
+  cases w <;> simp [getMsbD_eq_getLsbD, msb_eq_getLsbD_last]
+
 /-! ### cast -/
 
 @[simp, bv_toNat] theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
@@ -934,6 +937,19 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· ||| · ) (0#n) where
   ext i h
   simp [h]
 
+@[simp]
+theorem or_eq_zero_iff {x y : BitVec w} : (x ||| y) = 0#w ↔ x = 0#w ∧ y = 0#w := by
+  constructor
+  · intro h
+    constructor
+    all_goals
+    · ext i ih
+      have := BitVec.eq_of_getLsbD_eq_iff.mp h i ih
+      simp only [getLsbD_or, getLsbD_zero, Bool.or_eq_false_iff] at this
+      simp [this]
+  · intro h
+    simp [h]
+
 theorem extractLsb'_or {x y : BitVec w} {start len : Nat} :
    (x ||| y).extractLsb' start len = (x.extractLsb' start len) ||| (y.extractLsb' start len) := by
   ext i hi
@@ -1017,6 +1033,20 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· &&& · ) (allOnes n) wher
   ext i h
   simp [h]
 
+@[simp]
+theorem and_eq_allOnes_iff {x y : BitVec w} :
+    x &&& y = allOnes w ↔ x = allOnes w ∧ y = allOnes w := by
+  constructor
+  · intro h
+    constructor
+    all_goals
+    · ext i ih
+      have := BitVec.eq_of_getLsbD_eq_iff.mp h i ih
+      simp only [getLsbD_and, getLsbD_allOnes, ih, decide_true, Bool.and_eq_true] at this
+      simp [this, ih]
+  · intro h
+    simp [h]
+
 theorem extractLsb'_and {x y : BitVec w} {start len : Nat} :
    (x &&& y).extractLsb' start len = (x.extractLsb' start len) &&& (y.extractLsb' start len) := by
   ext i hi
@@ -1092,6 +1122,31 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· ^^^ · ) (0#n) where
   ext i
   simp
 
+@[simp]
+theorem xor_left_inj {x y : BitVec w} (z : BitVec w) : (x ^^^ z = y ^^^ z) ↔ x = y := by
+  constructor
+  · intro h
+    ext i ih
+    have := BitVec.eq_of_getLsbD_eq_iff.mp h i
+    simp only [getLsbD_xor, Bool.xor_left_inj] at this
+    exact this ih
+  · intro h
+    rw [h]
+
+@[simp]
+theorem xor_right_inj {x y : BitVec w} (z : BitVec w) : (z ^^^ x = z ^^^ y) ↔ x = y := by
+  rw [xor_comm z x, xor_comm z y]
+  exact xor_left_inj _
+
+@[simp]
+theorem xor_eq_zero_iff {x y : BitVec w} : (x ^^^ y = 0#w) ↔ x = y := by
+  constructor
+  · intro h
+    apply (xor_left_inj y).mp
+    rwa [xor_self]
+  · intro h
+    simp [h]
+
 theorem extractLsb'_xor {x y : BitVec w} {start len : Nat} :
    (x ^^^ y).extractLsb' start len = (x.extractLsb' start len) ^^^ (y.extractLsb' start len) := by
   ext i hi
@@ -1193,6 +1248,10 @@ theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
   ext i h
   simp [h]
 
+@[simp]
+protected theorem not_inj {x y : BitVec w} : ~~~x = ~~~y ↔ x = y :=
+  ⟨fun h => by rw [← @not_not w x, ← @not_not w y, h], congrArg _⟩
+
 @[simp] theorem and_not_self (x : BitVec n) : x &&& ~~~x = 0 := by
    ext i
    simp_all
@@ -2347,6 +2406,20 @@ theorem toNat_shiftConcat_lt_of_lt {x : BitVec w} {b : Bool} {k : Nat}
   have := Bool.toNat_lt b
   omega
 
+theorem getElem_shiftConcat {x : BitVec w} {b : Bool} (h : i < w) :
+    (x.shiftConcat b)[i] = if i = 0 then b else x[i-1] := by
+  rw [← getLsbD_eq_getElem, getLsbD_shiftConcat, getLsbD_eq_getElem, decide_eq_true h, Bool.true_and]
+
+@[simp]
+theorem getElem_shiftConcat_zero {x : BitVec w} (b : Bool) (h : 0 < w) :
+    (x.shiftConcat b)[0] = b := by
+  simp [getElem_shiftConcat]
+
+@[simp]
+theorem getElem_shiftConcat_succ {x : BitVec w} {b : Bool} (h : i + 1 < w) :
+    (x.shiftConcat b)[i+1] = x[i] := by
+  simp [getElem_shiftConcat]
+
 /-! ### add -/
 
 theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl
@@ -2515,6 +2588,10 @@ theorem neg_neg {x : BitVec w} : - - x = x := by
   · simp [h]
   · simp [bv_toNat, h]
 
+@[simp]
+protected theorem neg_inj {x y : BitVec w} : -x = -y ↔ x = y :=
+  ⟨fun h => by rw [← @neg_neg w x, ← @neg_neg w y, h], congrArg _⟩
+
 theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x ≠ y ↔ x ≠ -y := by
   constructor
   all_goals
@@ -2557,6 +2634,49 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
         show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
       omega
 
+/- ### add/sub injectivity -/
+
+@[simp]
+protected theorem add_left_inj {x y : BitVec w} (z : BitVec w) : (x + z = y + z) ↔ x = y := by
+  apply Iff.intro
+  · intro p
+    rw [← add_sub_cancel x z, ← add_sub_cancel y z, p]
+  · exact congrArg (· + z)
+
+@[simp]
+protected theorem add_right_inj {x y : BitVec w} (z : BitVec w) : (z + x = z + y) ↔ x = y := by
+  simp [BitVec.add_comm z]
+
+@[simp]
+protected theorem sub_left_inj {x y : BitVec w} (z : BitVec w) : (x - z = y - z) ↔ x = y := by
+  simp [sub_toAdd]
+
+@[simp]
+protected theorem sub_right_inj {x y : BitVec w} (z : BitVec w) : (z - x = z - y) ↔ x = y := by
+  simp [sub_toAdd]
+
+/-! ### add self -/
+
+@[simp]
+protected theorem add_left_eq_self {x y : BitVec w} : x + y = y ↔ x = 0#w := by
+  conv => lhs; rhs; rw [← BitVec.zero_add y]
+  exact BitVec.add_left_inj y
+
+@[simp]
+protected theorem add_right_eq_self {x y : BitVec w} : x + y = x ↔ y = 0#w := by
+  rw [BitVec.add_comm]
+  exact BitVec.add_left_eq_self
+
+@[simp]
+protected theorem self_eq_add_right {x y : BitVec w} : x = x + y ↔ y = 0#w := by
+  rw [Eq.comm]
+  exact BitVec.add_right_eq_self
+
+@[simp]
+protected theorem self_eq_add_left {x y : BitVec w} : x = y + x ↔ y = 0#w := by
+  rw [BitVec.add_comm]
+  exact BitVec.self_eq_add_right
+
 /-! ### fill -/
 
 @[simp]
@@ -2671,6 +2791,17 @@ theorem mul_eq_and {a b : BitVec 1} : a * b = a &&& b := by
   have hb : b = 0 ∨ b = 1 := eq_zero_or_eq_one _
   rcases ha with h | h <;> (rcases hb with h' | h' <;> (simp [h, h']))
 
+@[simp] protected theorem neg_mul (x y : BitVec w) : -x * y = -(x * y) := by
+  apply eq_of_toInt_eq
+  simp [toInt_neg]
+
+@[simp] protected theorem mul_neg (x y : BitVec w) : x * -y = -(x * y) := by
+  rw [BitVec.mul_comm, BitVec.neg_mul, BitVec.mul_comm]
+
+protected theorem neg_mul_neg (x y : BitVec w) : -x * -y = x * y := by simp
+
+protected theorem neg_mul_comm (x y : BitVec w) : -x * y = x * -y := by simp
+
 /-! ### le and lt -/
 
 @[bv_toNat] theorem le_def {x y : BitVec n} :

src/Init/Data/Int.lean

@@ -13,3 +13,4 @@ import Init.Data.Int.Lemmas
 import Init.Data.Int.LemmasAux
 import Init.Data.Int.Order
 import Init.Data.Int.Pow
+import Init.Data.Int.Cooper

src/Init/Data/Int/Cooper.lean

@@ -0,0 +1,259 @@
+/-
+Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Int.DivModLemmas
+import Init.Data.Int.Gcd
+
+/-!
+## Cooper resolution: small solutions to boundedness and divisibility constraints.
+-/
+
+namespace Int
+
+def add_of_le {a b : Int} (h : a ≤ b) : { c : Nat // b = a + c } :=
+  ⟨(b - a).toNat, by rw [Int.toNat_of_nonneg (Int.sub_nonneg_of_le h), ← Int.add_sub_assoc,
+    Int.add_comm, Int.add_sub_cancel]⟩
+
+theorem dvd_of_mul_dvd {a b c : Int} (w : a * b ∣ a * c) (h : 0 < a) : b ∣ c := by
+  obtain ⟨z, w⟩ := w
+  refine ⟨z, ?_⟩
+  replace w := congrArg (· / a) w
+  dsimp at w
+  rwa [Int.mul_ediv_cancel_left _ (Int.ne_of_gt h), Int.mul_assoc,
+    Int.mul_ediv_cancel_left _ (Int.ne_of_gt h)] at w
+
+/--
+Given a solution `x` to a divisibility constraint `a ∣ b * x + c`,
+then `x % d` is another solution as long as `(a / gcd a b) | d`.
+
+See `dvd_emod_add_of_dvd_add` for the specialization with `b = 1`.
+-/
+theorem dvd_mul_emod_add_of_dvd_mul_add {a b c d x : Int}
+    (w : a ∣ b * x + c) (h : (a / gcd a b) ∣ d) :
+    a ∣ b * (x % d) + c := by
+  obtain ⟨p, w⟩ := w
+  obtain ⟨q, rfl⟩ := h
+  rw [Int.emod_def, Int.mul_sub, Int.sub_eq_add_neg, Int.add_right_comm, w,
+    Int.dvd_add_right (Int.dvd_mul_right _ _), ← Int.mul_assoc, ← Int.mul_assoc, Int.dvd_neg,
+    ← Int.mul_ediv_assoc b gcd_dvd_left, Int.mul_comm b a, Int.mul_ediv_assoc a gcd_dvd_right,
+    Int.mul_assoc, Int.mul_assoc]
+  apply Int.dvd_mul_right
+
+/--
+Given a solution `x` to a divisibility constraint `a ∣ x + c`,
+then `x % d` is another solution as long as `a | d`.
+
+See `dvd_mul_emod_add_of_dvd_mul_add` for a more general version allowing a coefficient with `x`.
+-/
+theorem dvd_emod_add_of_dvd_add {a c d x : Int} (w : a ∣ x + c) (h : a ∣ d) : a ∣ (x % d) + c := by
+  rw [← Int.one_mul x] at w
+  rw [← Int.one_mul (x % d)]
+  apply dvd_mul_emod_add_of_dvd_mul_add w (by simpa)
+
+/-!
+There is an integer solution for `x` to the system
+```
+p ≤ a * x
+    b * x ≤ q
+d | c * x + s
+```
+(here `a`, `b`, `d` are positive integers, `c` and `s` are integers,
+and `p` and `q` are integers which it may be helpful to think of as evaluations of linear forms),
+if and only if there is an integer solution for `k` to the system
+```
+0 ≤ k < lcm a (a * d / gcd (a * d) c)
+b * k + b * p ≤ a * q
+    a | k + p
+a * d | c * k + c * p + a * s
+```
+Note in the new system that `k` has explicit lower and upper bounds
+(i.e. without a coefficient for `k`, and in terms of `a`, `c`, and `d` only).
+
+This is a statement of "Cooper resolution" with a divisibility constraint,
+as formulated in
+"Cutting to the Chase: Solving Linear Integer Arithmetic" by Dejan Jovanović and Leonardo de Moura,
+DOI 10.1007/s10817-013-9281-x
+
+See `cooper_resolution_left` for a simpler version without the divisibility constraint.
+
+This formulation is "biased" towards the lower bound, so it is called "left Cooper resolution".
+See `cooper_resolution_dvd_right` for the version biased towards the upper bound.
+-/
+
+namespace Cooper
+
+def resolve_left (a c d p x : Int) : Int := (a * x - p) % (lcm a (a * d / gcd (a * d) c))
+
+/-- When `p ≤ a * x`, we can realize `resolve_left` as a natural number. -/
+def resolve_left' (a c d p x : Int) (h₁ : p ≤ a * x) : Nat := (add_of_le h₁).1 % (lcm a (a * d / gcd (a * d) c))
+
+@[simp] theorem resolve_left_eq (a c d p x : Int) (h₁ : p ≤ a * x) :
+    resolve_left a c d p x = resolve_left' a c d p x h₁ := by
+  simp only [resolve_left, resolve_left', add_of_le, ofNat_emod, ofNat_toNat]
+  rw [Int.max_eq_left]
+  omega
+
+/-- `resolve_left` is nonnegative when `p ≤ a * x`. -/
+theorem le_zero_resolve_left (a c d p x : Int) (h₁ : p ≤ a * x) :
+    0 ≤ resolve_left a c d p x := by
+  simpa [h₁] using Int.ofNat_nonneg _
+
+/-- `resolve_left` is bounded above by `lcm a (a * d / gcd (a * d) c)`. -/
+theorem resolve_left_lt_lcm (a c d p x : Int) (a_pos : 0 < a) (d_pos : 0 < d) (h₁ : p ≤ a * x) :
+    resolve_left a c d p x < lcm a (a * d / gcd (a * d) c) := by
+  simp only [h₁, resolve_left_eq, resolve_left', add_of_le, Int.ofNat_lt]
+  exact Nat.mod_lt _ (Nat.pos_of_ne_zero (lcm_ne_zero (Int.ne_of_gt a_pos)
+    (Int.ne_of_gt (Int.ediv_pos_of_pos_of_dvd (Int.mul_pos a_pos d_pos) (Int.ofNat_nonneg _)
+      gcd_dvd_left))))
+
+theorem resolve_left_ineq (a c d p x : Int) (a_pos : 0 < a) (b_pos : 0 < b)
+    (h₁ : p ≤ a * x) (h₂ : b * x ≤ q) :
+    b * resolve_left a c d p x + b * p ≤ a * q := by
+  simp only [h₁, resolve_left_eq, resolve_left']
+  obtain ⟨k', w⟩ := add_of_le h₁
+  replace h₂ : a * b * x ≤ a * q :=
+    Int.mul_assoc _ _ _ ▸ Int.mul_le_mul_of_nonneg_left h₂ (Int.le_of_lt a_pos)
+  rw [Int.mul_right_comm, w, Int.add_mul, Int.mul_comm p b, Int.mul_comm _ b] at h₂
+  rw [Int.add_comm]
+  calc
+    _ ≤ _ := Int.add_le_add_left (Int.mul_le_mul_of_nonneg_left
+                (Int.ofNat_le.mpr <| Nat.mod_le _ _) (Int.le_of_lt b_pos)) _
+    _ ≤ _ := h₂
+
+theorem resolve_left_dvd₁ (a c d p x : Int) (h₁ : p ≤ a * x) :
+    a ∣ resolve_left a c d p x + p := by
+  simp only [h₁, resolve_left_eq, resolve_left']
+  obtain ⟨k', w⟩ := add_of_le h₁
+  exact Int.ofNat_emod _ _ ▸ dvd_emod_add_of_dvd_add (x := k') ⟨x, by rw [w, Int.add_comm]⟩ dvd_lcm_left
+
+theorem resolve_left_dvd₂ (a c d p x : Int)
+    (h₁ : p ≤ a * x) (h₃ : d ∣ c * x + s) :
+    a * d ∣ c * resolve_left a c d p x + c * p + a * s := by
+  simp only [h₁, resolve_left_eq, resolve_left']
+  obtain ⟨k', w⟩ := add_of_le h₁
+  simp only [Int.add_assoc, ofNat_emod]
+  apply dvd_mul_emod_add_of_dvd_mul_add
+  · obtain ⟨z, r⟩ := h₃
+    refine ⟨z, ?_⟩
+    rw [Int.mul_assoc, ← r, Int.mul_add, Int.mul_comm c x, ← Int.mul_assoc, w, Int.add_mul,
+      Int.mul_comm c, Int.mul_comm c, ← Int.add_assoc, Int.add_comm (p * c)]
+  · exact Int.dvd_lcm_right
+
+def resolve_left_inv (a p k : Int) : Int := (k + p) / a
+
+theorem le_mul_resolve_left_inv (a p k : Int)
+    (h₁ : 0 ≤ k) (h₄ : a ∣ k + p) :
+    p ≤ a * resolve_left_inv a p k := by
+  simp only [resolve_left_inv]
+  rw [Int.mul_ediv_cancel' h₄]
+  apply Int.le_add_of_nonneg_left h₁
+
+theorem mul_resolve_left_inv_le (a p k : Int) (a_pos : 0 < a)
+    (h₃ : b * k + b * p ≤ a * q) (h₄ : a ∣ k + p) :
+    b * resolve_left_inv a p k ≤ q := by
+  suffices h : a * (b * ((k + p) / a)) ≤ a * q from le_of_mul_le_mul_left h a_pos
+  rw [Int.mul_left_comm a b, Int.mul_ediv_cancel' h₄, Int.mul_add]
+  exact h₃
+
+theorem resolve_left_inv_dvd (a c d p k : Int) (a_pos : 0 < a)
+    (h₄ : a ∣ k + p) (h₅ : a * d ∣ c * k + c * p + a * s) :
+    d ∣ c * resolve_left_inv a p k + s := by
+  suffices h : a * d ∣ a * ((c * ((k + p) / a)) + s) from dvd_of_mul_dvd h a_pos
+  rw [Int.mul_add, Int.mul_left_comm, Int.mul_ediv_cancel' h₄, Int.mul_add]
+  exact h₅
+
+end Cooper
+
+open Cooper
+
+/--
+Left Cooper resolution of an upper and lower bound with divisibility constraint.
+-/
+theorem cooper_resolution_dvd_left
+    {a b c d s p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) (d_pos : 0 < d) :
+    (∃ x, p ≤ a * x ∧ b * x ≤ q ∧ d ∣ c * x + s) ↔
+    (∃ k : Int, 0 ≤ k ∧ k < lcm a (a * d / gcd (a * d) c) ∧
+      b * k + b * p ≤ a * q ∧
+      a ∣ k + p ∧
+      a * d ∣ c * k + c * p + a * s) := by
+  constructor
+  · rintro ⟨x, h₁, h₂, h₃⟩
+    exact ⟨resolve_left a c d p x,
+      le_zero_resolve_left a c d p x h₁,
+      resolve_left_lt_lcm a c d p x a_pos d_pos h₁,
+      resolve_left_ineq a c d p x a_pos b_pos h₁ h₂,
+      resolve_left_dvd₁ a c d p x h₁,
+      resolve_left_dvd₂ a c d p x h₁ h₃⟩
+  · rintro ⟨k, h₁, h₂, h₃, h₄, h₅⟩
+    exact ⟨resolve_left_inv a p k,
+      le_mul_resolve_left_inv a p k h₁ h₄,
+      mul_resolve_left_inv_le a p k a_pos h₃ h₄,
+      resolve_left_inv_dvd a c d p k a_pos h₄ h₅⟩
+
+/--
+Right Cooper resolution of an upper and lower bound with divisibility constraint.
+-/
+theorem cooper_resolution_dvd_right
+    {a b c d s p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) (d_pos : 0 < d) :
+    (∃ x, p ≤ a * x ∧ b * x ≤ q ∧ d ∣ c * x + s) ↔
+    (∃ k : Int, 0 ≤ k ∧ k < lcm b (b * d / gcd (b * d) c) ∧
+      a * k + b * p ≤ a * q ∧
+      b ∣ k - q ∧
+      b * d ∣ (- c) * k + c * q + b * s) := by
+  have this : ∀ x y z : Int, x + -y ≤ -z ↔ x + z ≤ y := by omega
+  suffices h :
+    (∃ x, p ≤ a * x ∧ b * x ≤ q ∧ d ∣ c * x + s) ↔
+    (∃ k : Int, 0 ≤ k ∧ k < lcm b (b * d / gcd (b * d) (-c)) ∧
+      a * k + a * (-q) ≤ b * (-p) ∧
+      b ∣ k + (-q) ∧
+      b * d ∣ (- c) * k + (-c) * (-q) + b * s) by
+    simp only [gcd_neg, Int.neg_mul_neg] at h
+    simp only [Int.mul_neg, this] at h
+    exact h
+  constructor
+  · rintro ⟨x, lower, upper, dvd⟩
+    have h : (∃ x, -q ≤ b * x ∧ a * x ≤ -p ∧ d ∣ -c * x + s) :=
+      ⟨-x, Int.mul_neg _ _ ▸ Int.neg_le_neg upper, Int.mul_neg _ _ ▸ Int.neg_le_neg lower,
+        by rwa [Int.neg_mul_neg _ _]⟩
+    replace h := (cooper_resolution_dvd_left b_pos a_pos d_pos).mp h
+    exact h
+  · intro h
+    obtain ⟨x, lower, upper, dvd⟩ := (cooper_resolution_dvd_left b_pos a_pos d_pos).mpr h
+    refine ⟨-x, ?_, ?_, ?_⟩
+    · exact Int.mul_neg _ _ ▸ Int.le_neg_of_le_neg upper
+    · exact Int.mul_neg _ _ ▸ Int.neg_le_of_neg_le lower
+    · exact Int.mul_neg _ _ ▸ Int.neg_mul _ _ ▸ dvd
+
+/--
+Left Cooper resolution of an upper and lower bound.
+-/
+theorem cooper_resolution_left
+    {a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
+    (∃ x, p ≤ a * x ∧ b * x ≤ q) ↔
+    (∃ k : Int, 0 ≤ k ∧ k < a ∧ b * k + b * p ≤ a * q ∧ a ∣ k + p) := by
+  have h := cooper_resolution_dvd_left
+    a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
+  simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
+    Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt a_pos), Int.one_dvd, and_true,
+    and_self] at h
+  exact h
+
+/--
+Right Cooper resolution of an upper and lower bound.
+-/
+theorem cooper_resolution_right
+    {a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
+    (∃ x, p ≤ a * x ∧ b * x ≤ q) ↔
+    (∃ k : Int, 0 ≤ k ∧ k < b ∧ a * k + b * p ≤ a * q ∧ b ∣ k - q) := by
+  have h := cooper_resolution_dvd_right
+    a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
+  have : ∀ k : Int, (b ∣ -k + q) ↔ (b ∣ k - q) := by
+    intro k
+    rw [← Int.dvd_neg, Int.neg_add, Int.neg_neg, Int.sub_eq_add_neg]
+  simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
+    Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt b_pos), Int.one_dvd, and_true,
+    and_self, ← Int.neg_eq_neg_one_mul, this] at h
+  exact h

src/Init/Data/Int/DivModLemmas.lean

@@ -1176,35 +1176,29 @@ theorem emod_mul_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n * y) n = Int.bmo
 
 @[simp]
 theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n := by
-  rw [bmod_def x n]
-  split
-  next p =>
-    simp only [emod_add_bmod_congr]
-  next p =>
-    rw [Int.sub_eq_add_neg, Int.add_right_comm, ←Int.sub_eq_add_neg]
-    simp
+  have := (@bmod_add_mul_cancel (Int.bmod x n + y) n (bdiv x n)).symm
+  rwa [Int.add_right_comm, bmod_add_bdiv] at this
 
 @[simp]
-theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n := by
-  rw [Int.bmod_def x n]
-  split
-  next p =>
-    simp only [emod_sub_bmod_congr]
-  next p =>
-    rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, ←Int.sub_eq_add_neg, ← Int.sub_eq_add_neg]
-    simp [emod_sub_bmod_congr]
+theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n :=
+  @bmod_add_bmod_congr x n (-y)
+
+theorem add_bmod_eq_add_bmod_right (i : Int)
+    (H : bmod x n = bmod y n) : bmod (x + i) n = bmod (y + i) n := by
+  rw [← bmod_add_bmod_congr, ← @bmod_add_bmod_congr y, H]
+
+theorem bmod_add_cancel_right (i : Int) : bmod (x + i) n = bmod (y + i) n ↔ bmod x n = bmod y n :=
+  ⟨fun H => by
+    have := add_bmod_eq_add_bmod_right (-i) H
+    rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this,
+  fun H => by rw [← bmod_add_bmod_congr, H, bmod_add_bmod_congr]⟩
 
 @[simp] theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
   rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
 
 @[simp] theorem sub_bmod_bmod : Int.bmod (x - Int.bmod y n) n = Int.bmod (x - y) n := by
-  rw [Int.bmod_def y n]
-  split
-  next p =>
-    simp [sub_emod_bmod_congr]
-  next p =>
-    rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, ← Int.add_assoc, ← Int.sub_eq_add_neg]
-    simp [sub_emod_bmod_congr]
+  apply (bmod_add_cancel_right (bmod y n)).mp
+  rw [Int.sub_add_cancel, add_bmod_bmod, Int.sub_add_cancel]
 
 @[simp]
 theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
@@ -1348,3 +1342,8 @@ theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1
           all_goals decide
     · exact ofNat_nonneg x
     · exact succ_ofNat_pos (x + 1)
+
+@[simp]
+theorem bmod_neg_bmod : bmod (-(bmod x n)) n = bmod (-x) n := by
+  apply (bmod_add_cancel_right x).mp
+  rw [Int.add_left_neg, ← add_bmod_bmod, Int.add_left_neg]

src/Init/Data/List/Attach.lean

@@ -361,6 +361,20 @@ theorem foldr_pmap (l : List α) {P : α → Prop} (f : (a : α) → P a → β)
     (l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
   rw [pmap_eq_map_attach, foldr_map]
 
+@[simp] theorem foldl_attachWith
+    (l : List α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : β → { x // q x} → β} {b} :
+    (l.attachWith q H).foldl f b = l.attach.foldl (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by
+  induction l generalizing b with
+  | nil => simp
+  | cons a l ih => simp [ih, foldl_map]
+
+@[simp] theorem foldr_attachWith
+    (l : List α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : { x // q x} → β → β} {b} :
+    (l.attachWith q H).foldr f b = l.attach.foldr (fun a acc => f ⟨a.1, H _ a.2⟩ acc) b := by
+  induction l generalizing b with
+  | nil => simp
+  | cons a l ih => simp [ih, foldr_map]
+
 /--
 If we fold over `l.attach` with a function that ignores the membership predicate,
 we get the same results as folding over `l` directly.
@@ -676,7 +690,7 @@ and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem foldl_subtype {p : α → Prop} {l : List { x // p x }}
     {f : β → { x // p x } → β} {g : β → α → β} {x : β}
-    {hf : ∀ b x h, f b ⟨x, h⟩ = g b x} :
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) :
     l.foldl f x = l.unattach.foldl g x := by
   unfold unattach
   induction l generalizing x with
@@ -689,7 +703,7 @@ and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem foldr_subtype {p : α → Prop} {l : List { x // p x }}
     {f : { x // p x } → β → β} {g : α → β → β} {x : β}
-    {hf : ∀ x h b, f ⟨x, h⟩ b = g x b} :
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) :
     l.foldr f x = l.unattach.foldr g x := by
   unfold unattach
   induction l generalizing x with
@@ -701,7 +715,7 @@ This lemma identifies maps over lists of subtypes, where the function only depen
 and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem map_subtype {p : α → Prop} {l : List { x // p x }}
-    {f : { x // p x } → β} {g : α → β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → β} {g : α → β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     l.map f = l.unattach.map g := by
   unfold unattach
   induction l with
@@ -709,7 +723,7 @@ and simplifies these to the function directly taking the value.
   | cons a l ih => simp [ih, hf]
 
 @[simp] theorem filterMap_subtype {p : α → Prop} {l : List { x // p x }}
-    {f : { x // p x } → Option β} {g : α → Option β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → Option β} {g : α → Option β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     l.filterMap f = l.unattach.filterMap g := by
   unfold unattach
   induction l with
@@ -717,7 +731,7 @@ and simplifies these to the function directly taking the value.
   | cons a l ih => simp [ih, hf, filterMap_cons]
 
 @[simp] theorem flatMap_subtype {p : α → Prop} {l : List { x // p x }}
-    {f : { x // p x } → List β} {g : α → List β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → List β} {g : α → List β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     (l.flatMap f) = l.unattach.flatMap g := by
   unfold unattach
   induction l with
@@ -726,6 +740,8 @@ and simplifies these to the function directly taking the value.
 
 @[deprecated flatMap_subtype (since := "2024-10-16")] abbrev bind_subtype := @flatMap_subtype
 
+/-! ### Simp lemmas pushing `unattach` inwards. -/
+
 @[simp] theorem unattach_filter {p : α → Prop} {l : List { x // p x }}
     {f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
     (l.filter f).unattach = l.unattach.filter g := by
@@ -735,8 +751,6 @@ and simplifies these to the function directly taking the value.
     simp only [filter_cons, hf, unattach_cons]
     split <;> simp [ih]
 
-/-! ### Simp lemmas pushing `unattach` inwards. -/
-
 @[simp] theorem unattach_reverse {p : α → Prop} {l : List { x // p x }} :
     l.reverse.unattach = l.unattach.reverse := by
   simp [unattach, -map_subtype]

src/Init/Data/List/Basic.lean

@@ -823,6 +823,17 @@ theorem drop_eq_nil_of_le {as : List α} {i : Nat} (h : as.length ≤ i) : as.dr
   | _::_,  0   => simp at h
   | _::as, i+1 => simp only [length_cons] at h; exact @drop_eq_nil_of_le as i (Nat.le_of_succ_le_succ h)
 
+/-! ### extract -/
+
+/-- `extract l start stop` returns the slice of `l` from indices `start` to `stop` (exclusive). -/
+-- This is only an abbreviation for the operation in terms of `drop` and `take`.
+-- We do not prove properties of extract itself.
+abbrev extract (l : List α) (start : Nat := 0) (stop : Nat := l.length) : List α :=
+  (l.drop start).take (stop - start)
+
+@[simp] theorem extract_eq_drop_take (l : List α) (start stop : Nat) :
+    l.extract start stop = (l.drop start).take (stop - start) := rfl
+
 /-! ### takeWhile -/
 
 /--
@@ -1266,24 +1277,61 @@ theorem findSome?_cons {f : α → Option β} :
 
 @[simp] theorem findIdx_nil {α : Type _} (p : α → Bool) : [].findIdx p = 0 := rfl
 
-/-! ### indexOf -/
+/-! ### idxOf -/
 
 /-- Returns the index of the first element equal to `a`, or the length of the list otherwise. -/
-def indexOf [BEq α] (a : α) : List α → Nat := findIdx (· == a)
+def idxOf [BEq α] (a : α) : List α → Nat := findIdx (· == a)
 
-@[simp] theorem indexOf_nil [BEq α] : ([] : List α).indexOf x = 0 := rfl
+/-- Returns the index of the first element equal to `a`, or the length of the list otherwise. -/
+@[deprecated idxOf (since := "2025-01-29")] abbrev indexOf := @idxOf
+
+@[simp] theorem idxOf_nil [BEq α] : ([] : List α).idxOf x = 0 := rfl
+
+@[deprecated idxOf_nil (since := "2025-01-29")]
+theorem indexOf_nil [BEq α] : ([] : List α).idxOf x = 0 := rfl
 
 /-! ### findIdx? -/
 
 /-- Return the index of the first occurrence of an element satisfying `p`. -/
-def findIdx? (p : α → Bool) : List α → (start : Nat := 0) → Option Nat
-| [], _ => none
-| a :: l, i => if p a then some i else findIdx? p l (i + 1)
+def findIdx? (p : α → Bool) (l : List α) : Option Nat :=
+  go l 0
+where
+  go : List α → Nat → Option Nat
+  | [], _ => none
+  | a :: l, i => if p a then some i else go l (i + 1)
 
-/-! ### indexOf? -/
+/-! ### idxOf? -/
 
 /-- Return the index of the first occurrence of `a` in the list. -/
-@[inline] def indexOf? [BEq α] (a : α) : List α → Option Nat := findIdx? (· == a)
+@[inline] def idxOf? [BEq α] (a : α) : List α → Option Nat := findIdx? (· == a)
+
+/-- Return the index of the first occurrence of `a` in the list. -/
+@[deprecated idxOf? (since := "2025-01-29")]
+abbrev indexOf? := @idxOf?
+
+/-! ### findFinIdx? -/
+
+/-- Return the index of the first occurrence of an element satisfying `p`, as a `Fin l.length`,
+or `none` if no such element is found. -/
+@[inline] def findFinIdx? (p : α → Bool) (l : List α) : Option (Fin l.length) :=
+  go l 0 (by simp)
+where
+  go : (l' : List α) → (i : Nat) → (h : l'.length + i = l.length) → Option (Fin l.length)
+  | [], _, _ => none
+  | a :: l, i, h =>
+    if p a then
+      some ⟨i, by
+        simp only [Nat.add_comm _ i, ← Nat.add_assoc] at h
+        exact Nat.lt_of_add_right_lt (Nat.lt_of_succ_le (Nat.le_of_eq h))⟩
+    else
+      go l (i + 1) (by simp at h; simpa [← Nat.add_assoc, Nat.add_right_comm] using h)
+
+/-! ### finIdxOf? -/
+
+/-- Return the index of the first occurrence of `a`, as a `Fin l.length`,
+or `none` if no such element is found. -/
+@[inline] def finIdxOf? [BEq α] (a : α) : (l : List α) → Option (Fin l.length) :=
+  findFinIdx? (· == a)
 
 /-! ### countP -/
 

src/Init/Data/List/Control.lean

@@ -98,6 +98,7 @@ def forA {m : Type u → Type v} [Applicative m] {α : Type w} (as : List α) (f
   | []      => pure ⟨⟩
   | a :: as => f a *> forA as f
 
+
 @[specialize]
 def filterAuxM {m : Type → Type v} [Monad m] {α : Type} (f : α → m Bool) : List α → List α → m (List α)
   | [],     acc => pure acc
@@ -136,6 +137,19 @@ def filterMapM {m : Type u → Type v} [Monad m] {α β : Type u} (f : α → m
       | some b => loop as (b::bs)
   loop as []
 
+/--
+Applies the monadic function `f` on every element `x` in the list, left-to-right, and returns the
+concatenation of the results.
+-/
+@[inline]
+def flatMapM {m : Type u → Type v} [Monad m] {α : Type w} {β : Type u} (f : α → m (List β)) (as : List α) : m (List β) :=
+  let rec @[specialize] loop
+    | [],     bs => pure bs.reverse.flatten
+    | a :: as, bs => do
+      let bs' ← f a
+      loop as (bs' :: bs)
+  loop as []
+
 /--
 Folds a monadic function over a list from left to right:
 ```
@@ -270,6 +284,7 @@ instance : ForIn' m (List α) α inferInstance where
 
 -- No separate `ForIn` instance is required because it can be derived from `ForIn'`.
 
+-- We simplify `List.forIn'` to `forIn'`.
 @[simp] theorem forIn'_eq_forIn' [Monad m] : @List.forIn' α β m _ = forIn' := rfl
 
 @[simp] theorem forIn'_nil [Monad m] (f : (a : α) → a ∈ [] → β → m (ForInStep β)) (b : β) : forIn' [] b f = pure b :=
@@ -281,6 +296,9 @@ instance : ForIn' m (List α) α inferInstance where
 instance : ForM m (List α) α where
   forM := List.forM
 
+-- We simplify `List.forM` to `forM`.
+@[simp] theorem forM_eq_forM [Monad m] : @List.forM m _ α = forM := rfl
+
 @[simp] theorem forM_nil  [Monad m] (f : α → m PUnit) : forM [] f = pure ⟨⟩ :=
   rfl
 @[simp] theorem forM_cons [Monad m] (f : α → m PUnit) (a : α) (as : List α) : forM (a::as) f = f a >>= fun _ => forM as f :=

src/Init/Data/List/Erase.lean

@@ -9,7 +9,7 @@ import Init.Data.List.Pairwise
 import Init.Data.List.Find
 
 /-!
-# Lemmas about `List.eraseP` and `List.erase`.
+# Lemmas about `List.eraseP`, `List.erase`, and `List.eraseIdx`.
 -/
 
 namespace List
@@ -34,7 +34,7 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
   | nil => rfl
   | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2]
 
-@[simp] theorem eraseP_eq_nil {xs : List α} {p : α → Bool} : xs.eraseP p = [] ↔ xs = [] ∨ ∃ x, p x ∧ xs = [x] := by
+@[simp] theorem eraseP_eq_nil_iff {xs : List α} {p : α → Bool} : xs.eraseP p = [] ↔ xs = [] ∨ ∃ x, p x ∧ xs = [x] := by
   induction xs with
   | nil => simp
   | cons x xs ih =>
@@ -50,9 +50,15 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
       rintro x h' rfl
       simp_all
 
-theorem eraseP_ne_nil {xs : List α} {p : α → Bool} : xs.eraseP p ≠ [] ↔ xs ≠ [] ∧ ∀ x, p x → xs ≠ [x] := by
+@[deprecated eraseP_eq_nil_iff (since := "2025-01-30")]
+abbrev eraseP_eq_nil := @eraseP_eq_nil_iff
+
+theorem eraseP_ne_nil_iff {xs : List α} {p : α → Bool} : xs.eraseP p ≠ [] ↔ xs ≠ [] ∧ ∀ x, p x → xs ≠ [x] := by
   simp
 
+@[deprecated eraseP_ne_nil_iff (since := "2025-01-30")]
+abbrev eraseP_ne_nil := @eraseP_ne_nil_iff
+
 theorem exists_of_eraseP : ∀ {l : List α} {a} (_ : a ∈ l) (_ : p a),
     ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.eraseP p = l₁ ++ l₂
   | b :: l, _, al, pa =>
@@ -191,6 +197,14 @@ theorem eraseP_replicate (n : Nat) (a : α) (p : α → Bool) :
     simp only [replicate_succ, eraseP_cons]
     split <;> simp [*]
 
+@[simp] theorem eraseP_replicate_of_pos {n : Nat} {a : α} (h : p a) :
+    (replicate n a).eraseP p = replicate (n - 1) a := by
+  cases n <;> simp [replicate_succ, h]
+
+@[simp] theorem eraseP_replicate_of_neg {n : Nat} {a : α} (h : ¬p a) :
+    (replicate n a).eraseP p = replicate n a := by
+  rw [eraseP_of_forall_not (by simp_all)]
+
 protected theorem IsPrefix.eraseP (h : l₁ <+: l₂) : l₁.eraseP p <+: l₂.eraseP p := by
   rw [IsPrefix] at h
   obtain ⟨t, rfl⟩ := h
@@ -237,14 +251,6 @@ theorem eraseP_eq_iff {p} {l : List α} :
         subst p
         simp_all
 
-@[simp] theorem eraseP_replicate_of_pos {n : Nat} {a : α} (h : p a) :
-    (replicate n a).eraseP p = replicate (n - 1) a := by
-  cases n <;> simp [replicate_succ, h]
-
-@[simp] theorem eraseP_replicate_of_neg {n : Nat} {a : α} (h : ¬p a) :
-    (replicate n a).eraseP p = replicate n a := by
-  rw [eraseP_of_forall_not (by simp_all)]
-
 theorem Pairwise.eraseP (q) : Pairwise p l → Pairwise p (l.eraseP q) :=
   Pairwise.sublist <| eraseP_sublist _
 
@@ -271,7 +277,22 @@ theorem head_eraseP_mem (xs : List α) (p : α → Bool) (h) : (xs.eraseP p).hea
 theorem getLast_eraseP_mem (xs : List α) (p : α → Bool) (h) : (xs.eraseP p).getLast h ∈ xs :=
   (eraseP_sublist xs).getLast_mem h
 
+theorem eraseP_eq_eraseIdx {xs : List α} {p : α → Bool} :
+    xs.eraseP p = match xs.findIdx? p with
+    | none => xs
+    | some i => xs.eraseIdx i := by
+  induction xs with
+  | nil => rfl
+  | cons x xs ih =>
+    rw [eraseP_cons, findIdx?_cons]
+    by_cases h : p x
+    · simp [h]
+    · simp only [h]
+      rw [ih]
+      split <;> simp [*]
+
 /-! ### erase -/
+
 section erase
 variable [BEq α]
 
@@ -299,16 +320,22 @@ theorem erase_eq_eraseP [LawfulBEq α] (a : α) : ∀ l : List α,  l.erase a =
   | b :: l => by
     if h : a = b then simp [h] else simp [h, Ne.symm h, erase_eq_eraseP a l]
 
-@[simp] theorem erase_eq_nil [LawfulBEq α] {xs : List α} {a : α} :
+@[simp] theorem erase_eq_nil_iff [LawfulBEq α] {xs : List α} {a : α} :
     xs.erase a = [] ↔ xs = [] ∨ xs = [a] := by
   rw [erase_eq_eraseP]
   simp
 
-theorem erase_ne_nil [LawfulBEq α] {xs : List α} {a : α} :
+@[deprecated erase_eq_nil_iff (since := "2025-01-30")]
+abbrev erase_eq_nil := @erase_eq_nil_iff
+
+theorem erase_ne_nil_iff [LawfulBEq α] {xs : List α} {a : α} :
     xs.erase a ≠ [] ↔ xs ≠ [] ∧ xs ≠ [a] := by
   rw [erase_eq_eraseP]
   simp
 
+@[deprecated erase_ne_nil_iff (since := "2025-01-30")]
+abbrev erase_ne_nil := @erase_ne_nil_iff
+
 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 _)
@@ -457,6 +484,19 @@ theorem head_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).head h ∈ xs
 theorem getLast_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).getLast h ∈ xs :=
   (erase_sublist a xs).getLast_mem h
 
+theorem erase_eq_eraseIdx (l : List α) (a : α) :
+    l.erase a = match l.idxOf? a with
+    | none => l
+    | some i => l.eraseIdx i := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    rw [erase_cons, idxOf?_cons]
+    split
+    · simp
+    · simp [ih]
+      split <;> simp [*]
+
 end erase
 
 /-! ### eraseIdx -/
@@ -488,18 +528,24 @@ theorem eraseIdx_eq_take_drop_succ :
 
 -- See `Init.Data.List.Nat.Erase` for `getElem?_eraseIdx` and `getElem_eraseIdx`.
 
-@[simp] theorem eraseIdx_eq_nil {l : List α} {i : Nat} : eraseIdx l i = [] ↔ l = [] ∨ (length l = 1 ∧ i = 0) := by
+@[simp] theorem eraseIdx_eq_nil_iff {l : List α} {i : Nat} : eraseIdx l i = [] ↔ l = [] ∨ (length l = 1 ∧ i = 0) := by
   match l, i with
   | [], _
   | a::l, 0
   | a::l, i + 1 => simp [Nat.succ_inj']
 
-theorem eraseIdx_ne_nil {l : List α} {i : Nat} : eraseIdx l i ≠ [] ↔ 2 ≤ l.length ∨ (l.length = 1 ∧ i ≠ 0) := by
+@[deprecated eraseIdx_eq_nil_iff (since := "2025-01-30")]
+abbrev eraseIdx_eq_nil := @eraseIdx_eq_nil_iff
+
+theorem eraseIdx_ne_nil_iff {l : List α} {i : Nat} : eraseIdx l i ≠ [] ↔ 2 ≤ l.length ∨ (l.length = 1 ∧ i ≠ 0) := by
   match l with
   | []
   | [a]
   | a::b::l => simp [Nat.succ_inj']
 
+@[deprecated eraseIdx_ne_nil_iff (since := "2025-01-30")]
+abbrev eraseIdx_ne_nil := @eraseIdx_ne_nil_iff
+
 theorem eraseIdx_sublist : ∀ (l : List α) (k : Nat), eraseIdx l k <+ l
   | [], _ => by simp
   | a::l, 0 => by simp
@@ -573,7 +619,8 @@ protected theorem IsPrefix.eraseIdx {l l' : List α} (h : l <+: l') (k : Nat) :
 -- See also `mem_eraseIdx_iff_getElem` and `mem_eraseIdx_iff_getElem?` in
 -- `Init/Data/List/Nat/Basic.lean`.
 
-theorem erase_eq_eraseIdx [BEq α] [LawfulBEq α] (l : List α) (a : α) (i : Nat) (w : l.indexOf a = i) :
+theorem erase_eq_eraseIdx_of_idxOf [BEq α] [LawfulBEq α]
+    (l : List α) (a : α) (i : Nat) (w : l.idxOf a = i) :
     l.erase a = l.eraseIdx i := by
   subst w
   rw [erase_eq_iff]
@@ -581,11 +628,14 @@ theorem erase_eq_eraseIdx [BEq α] [LawfulBEq α] (l : List α) (a : α) (i : Na
   · right
     obtain ⟨as, bs, rfl, h'⟩ := eq_append_cons_of_mem h
     refine ⟨as, bs, h', by simp, ?_⟩
-    rw [indexOf_append, if_neg h', indexOf_cons_self, eraseIdx_append_of_length_le] <;>
+    rw [idxOf_append, if_neg h', idxOf_cons_self, eraseIdx_append_of_length_le] <;>
       simp
   · left
     refine ⟨h, ?_⟩
     rw [eq_comm, eraseIdx_eq_self]
-    exact Nat.le_of_eq (indexOf_eq_length h).symm
+    exact Nat.le_of_eq (idxOf_eq_length h).symm
+
+@[deprecated erase_eq_eraseIdx_of_idxOf (since := "2025-01-29")]
+abbrev erase_eq_eraseIdx_of_indexOf := @erase_eq_eraseIdx_of_idxOf
 
 end List

src/Init/Data/List/Find.lean

@@ -641,29 +641,36 @@ theorem findIdx_le_findIdx {l : List α} {p q : α → Bool} (h : ∀ x ∈ l, p
 
 /-! ### findIdx? -/
 
-@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl
+@[local simp] private theorem findIdx?_go_nil {p : α → Bool} {i : Nat} :
+    findIdx?.go p [] i = none := rfl
 
-@[simp] theorem findIdx?_cons :
-    (x :: xs).findIdx? p i = if p x then some i else findIdx? p xs (i + 1) := rfl
+@[local simp] private theorem findIdx?_go_cons :
+    findIdx?.go p (x :: xs) i = if p x then some i else findIdx?.go p xs (i + 1) := rfl
 
-theorem findIdx?_succ :
-    (xs : List α).findIdx? p (i+1) = (xs.findIdx? p i).map fun i => i + 1 := by
+private theorem findIdx?_go_succ {p : α → Bool} {xs : List α} {i : Nat} :
+    findIdx?.go p xs (i+1) = (findIdx?.go p xs i).map fun i => i + 1 := by
   induction xs generalizing i with simp
   | cons _ _ _ => split <;> simp_all
 
-@[simp] theorem findIdx?_start_succ :
-    (xs : List α).findIdx? p (i+1) = (xs.findIdx? p 0).map fun k => k + (i + 1) := by
+private theorem findIdx?_go_eq {p : α → Bool} {xs : List α} {i : Nat} :
+    findIdx?.go p xs (i+1) = (findIdx?.go p xs 0).map fun k => k + (i + 1) := by
   induction xs generalizing i with
   | nil => simp
   | cons _ _ _ =>
-    simp only [findIdx?_succ, findIdx?_cons, Nat.zero_add]
+    simp only [findIdx?_go_succ, findIdx?_go_cons, Nat.zero_add]
     split
     · simp_all
-    · simp_all only [findIdx?_succ, Bool.not_eq_true, Option.map_map, Nat.zero_add]
+    · simp_all only [findIdx?_go_succ, Bool.not_eq_true, Option.map_map, Nat.zero_add]
       congr
       ext
       simp only [Nat.add_comm i, Function.comp_apply, Nat.add_assoc]
 
+@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p = none := rfl
+
+@[simp] theorem findIdx?_cons :
+    (x :: xs).findIdx? p = if p x then some 0 else (xs.findIdx? p).map fun i => i + 1 := by
+  simp [findIdx?, findIdx?_go_eq]
+
 @[simp]
 theorem findIdx?_eq_none_iff {xs : List α} {p : α → Bool} :
     xs.findIdx? p = none ↔ ∀ x, x ∈ xs → p x = false := by
@@ -731,7 +738,7 @@ theorem findIdx?_eq_some_iff_getElem {xs : List α} {p : α → Bool} {i : Nat}
   induction xs generalizing i with
   | nil => simp
   | cons x xs ih =>
-    simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ]
+    simp only [findIdx?_cons, Nat.zero_add]
     split
     · simp only [Option.some.injEq, Bool.not_eq_true, length_cons]
       cases i with
@@ -762,7 +769,7 @@ theorem findIdx?_of_eq_some {xs : List α} {p : α → Bool} (w : xs.findIdx? p
   induction xs generalizing i with
   | nil => simp_all
   | cons x xs ih =>
-    simp_all only [findIdx?_cons, Nat.zero_add, findIdx?_succ]
+    simp_all only [findIdx?_cons, Nat.zero_add]
     split at w <;> cases i <;> simp_all [succ_inj']
 
 theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p = none) :
@@ -771,7 +778,7 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
   induction xs generalizing i with
   | nil => simp_all
   | cons x xs ih =>
-    simp_all only [Bool.not_eq_true, findIdx?_cons, Nat.zero_add, findIdx?_succ]
+    simp_all only [Bool.not_eq_true, findIdx?_cons, Nat.zero_add]
     cases i with
     | zero =>
       split at w <;> simp_all
@@ -784,7 +791,7 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
   induction l with
   | nil => simp
   | cons x xs ih =>
-    simp only [map_cons, findIdx?]
+    simp only [map_cons, findIdx?_cons]
     split <;> simp_all
 
 @[simp] theorem findIdx?_append :
@@ -801,25 +808,20 @@ theorem findIdx?_flatten {l : List (List α)} {p : α → Bool} :
   induction l with
   | nil => simp
   | cons xs l ih =>
-    simp only [flatten, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
-      findIdx?_succ]
-    split
-    · simp only [Option.map_some', take_zero, sum_nil, length_cons, zero_lt_succ,
-        getElem?_eq_getElem, getElem_cons_zero, Option.getD_some, Nat.zero_add]
-      rw [Option.or_of_isSome (by simpa [findIdx?_isSome])]
-      rw [findIdx?_eq_some_of_exists ‹_›]
-    · simp_all only [map_take, not_exists, not_and, Bool.not_eq_true, Option.map_map]
-      rw [Option.or_of_isNone (by simpa [findIdx?_isNone])]
-      congr 1
-      ext i
-      simp [Nat.add_comm, Nat.add_assoc]
+    rw [flatten_cons, findIdx?_append, ih, findIdx?_cons]
+    split <;> rename_i h
+    · simp only [any_eq_true] at h
+      rw [Option.or_of_isSome (by simp_all [findIdx?_isSome])]
+      simp_all [findIdx?_eq_some_of_exists]
+    · rw [Option.or_of_isNone (by simp_all [findIdx?_isNone])]
+      simp [Function.comp_def, Nat.add_comm, Nat.add_assoc]
 
 @[simp] theorem findIdx?_replicate :
     (replicate n a).findIdx? p = if 0 < n ∧ p a then some 0 else none := by
   cases n with
   | zero => simp
   | succ n =>
-    simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, zero_lt_succ, true_and]
+    simp only [replicate, findIdx?_cons, Nat.zero_add, zero_lt_succ, true_and]
     split <;> simp_all
 
 theorem findIdx?_eq_findSome?_zipIdx {xs : List α} {p : α → Bool} :
@@ -827,7 +829,7 @@ theorem findIdx?_eq_findSome?_zipIdx {xs : List α} {p : α → Bool} :
   induction xs with
   | nil => simp
   | cons x xs ih =>
-    simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ, zipIdx]
+    simp only [findIdx?_cons, Nat.zero_add, zipIdx]
     split
     · simp_all
     · simp_all only [zipIdx_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone, reduceCtorEq]
@@ -839,7 +841,7 @@ theorem findIdx?_eq_fst_find?_zipIdx {xs : List α} {p : α → Bool} :
   induction xs with
   | nil => simp
   | cons x xs ih =>
-    simp only [findIdx?_cons, Nat.zero_add, findIdx?_start_succ, zipIdx_cons]
+    simp only [findIdx?_cons, Nat.zero_add, zipIdx_cons]
     split
     · simp_all
     · rw [ih, ← map_snd_add_zipIdx_eq_zipIdx (n := 1) (k := 0)]
@@ -884,59 +886,107 @@ theorem IsInfix.findIdx?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l
     List.findIdx? p l₂ = none → List.findIdx? p l₁ = none :=
   h.sublist.findIdx?_eq_none
 
-/-! ### indexOf
+theorem findIdx_eq_getD_findIdx? {xs : List α} {p : α → Bool} :
+    xs.findIdx p = (xs.findIdx? p).getD xs.length := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findIdx_cons, findIdx?_cons]
+    split <;> simp_all [ih]
 
-The verification API for `indexOf` is still incomplete.
+/-! ### findFinIdx? -/
+
+theorem findIdx?_go_eq_map_findFinIdx?_go_val {xs : List α} {p : α → Bool} {i : Nat} {h} :
+    List.findIdx?.go p xs i =
+      (List.findFinIdx?.go p l xs i h).map (·.val) := by
+  unfold findIdx?.go
+  unfold findFinIdx?.go
+  split <;> rename_i a xs
+  · simp_all
+  · simp only
+    split
+    · simp
+    · rw [findIdx?_go_eq_map_findFinIdx?_go_val]
+
+theorem findIdx?_eq_map_findFinIdx?_val {xs : List α} {p : α → Bool} :
+    xs.findIdx? p = (xs.findFinIdx? p).map (·.val) := by
+  simp [findIdx?, findFinIdx?]
+  rw [findIdx?_go_eq_map_findFinIdx?_go_val]
+
+/-! ### idxOf
+
+The verification API for `idxOf` is still incomplete.
 The lemmas below should be made consistent with those for `findIdx` (and proved using them).
 -/
 
-theorem indexOf_cons [BEq α] :
-    (x :: xs : List α).indexOf y = bif x == y then 0 else xs.indexOf y + 1 := by
-  dsimp [indexOf]
+theorem idxOf_cons [BEq α] :
+    (x :: xs : List α).idxOf y = bif x == y then 0 else xs.idxOf y + 1 := by
+  dsimp [idxOf]
   simp [findIdx_cons]
 
-@[simp] theorem indexOf_cons_self [BEq α] [ReflBEq α] {l : List α} : (a :: l).indexOf a = 0 := by
-  simp [indexOf_cons]
+@[deprecated idxOf_cons (since := "2025-01-29")]
+abbrev indexOf_cons := @idxOf_cons
 
-theorem indexOf_append [BEq α] [LawfulBEq α] {l₁ l₂ : List α} {a : α} :
-    (l₁ ++ l₂).indexOf a = if a ∈ l₁ then l₁.indexOf a else l₂.indexOf a + l₁.length := by
-  rw [indexOf, findIdx_append]
+@[simp] theorem idxOf_cons_self [BEq α] [ReflBEq α] {l : List α} : (a :: l).idxOf a = 0 := by
+  simp [idxOf_cons]
+
+@[deprecated idxOf_cons_self (since := "2025-01-29")]
+abbrev indexOf_cons_self := @idxOf_cons_self
+
+theorem idxOf_append [BEq α] [LawfulBEq α] {l₁ l₂ : List α} {a : α} :
+    (l₁ ++ l₂).idxOf a = if a ∈ l₁ then l₁.idxOf a else l₂.idxOf a + l₁.length := by
+  rw [idxOf, findIdx_append]
   split <;> rename_i h
   · rw [if_pos]
     simpa using h
   · rw [if_neg]
     simpa using h
 
-theorem indexOf_eq_length [BEq α] [LawfulBEq α] {l : List α} (h : a ∉ l) : l.indexOf a = l.length := by
+@[deprecated idxOf_append (since := "2025-01-29")]
+abbrev indexOf_append := @idxOf_append
+
+theorem idxOf_eq_length [BEq α] [LawfulBEq α] {l : List α} (h : a ∉ l) : l.idxOf a = l.length := by
   induction l with
   | nil => rfl
   | cons x xs ih =>
     simp only [mem_cons, not_or] at h
-    simp only [indexOf_cons, cond_eq_if, beq_iff_eq]
+    simp only [idxOf_cons, cond_eq_if, beq_iff_eq]
     split <;> simp_all
 
-theorem indexOf_lt_length [BEq α] [LawfulBEq α] {l : List α} (h : a ∈ l) : l.indexOf a < l.length := by
+@[deprecated idxOf_eq_length (since := "2025-01-29")]
+abbrev indexOf_eq_length := @idxOf_eq_length
+
+theorem idxOf_lt_length [BEq α] [LawfulBEq α] {l : List α} (h : a ∈ l) : l.idxOf a < l.length := by
   induction l with
   | nil => simp at h
   | cons x xs ih =>
     simp only [mem_cons] at h
     obtain rfl | h := h
     · simp
-    · simp only [indexOf_cons, cond_eq_if, beq_iff_eq, length_cons]
+    · simp only [idxOf_cons, cond_eq_if, beq_iff_eq, length_cons]
       specialize ih h
       split
       · exact zero_lt_succ xs.length
       · exact Nat.add_lt_add_right ih 1
 
-/-! ### indexOf?
+@[deprecated idxOf_lt_length (since := "2025-01-29")]
+abbrev indexOf_lt_length := @idxOf_lt_length
 
-The verification API for `indexOf?` is still incomplete.
+/-! ### idxOf?
+
+The verification API for `idxOf?` is still incomplete.
 The lemmas below should be made consistent with those for `findIdx?` (and proved using them).
 -/
 
-@[simp] theorem indexOf?_eq_none_iff [BEq α] [LawfulBEq α] {l : List α} {a : α} :
-    l.indexOf? a = none ↔ a ∉ l := by
-  simp only [indexOf?, findIdx?_eq_none_iff, beq_eq_false_iff_ne, ne_eq]
+@[simp] theorem idxOf?_nil [BEq α] : ([] : List α).idxOf? a = none := rfl
+
+theorem idxOf?_cons [BEq α] (a : α) (xs : List α) (b : α) :
+    (a :: xs).idxOf? b = if a == b then some 0 else (xs.idxOf? b).map (· + 1) := by
+  simp [idxOf?]
+
+@[simp] theorem idxOf?_eq_none_iff [BEq α] [LawfulBEq α] {l : List α} {a : α} :
+    l.idxOf? a = none ↔ a ∉ l := by
+  simp only [idxOf?, findIdx?_eq_none_iff, beq_eq_false_iff_ne, ne_eq]
   constructor
   · intro w h
     specialize w _ h
@@ -944,6 +994,15 @@ The lemmas below should be made consistent with those for `findIdx?` (and proved
   · rintro w x h rfl
     contradiction
 
+@[deprecated idxOf?_eq_none_iff (since := "2025-01-29")]
+abbrev indexOf?_eq_none_iff := @idxOf?_eq_none_iff
+
+/-! ### finIdxOf? -/
+
+theorem idxOf?_eq_map_finIdxOf?_val [BEq α] {xs : List α} {a : α} :
+    xs.idxOf? a = (xs.finIdxOf? a).map (·.val) := by
+  simp [idxOf?, finIdxOf?, findIdx?_eq_map_findFinIdx?_val]
+
 /-! ### lookup -/
 
 section lookup

src/Init/Data/List/Lemmas.lean

@@ -436,6 +436,10 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ i : Nat, l[i]? = s
   let ⟨n, _, e⟩ := getElem_of_mem h
   exact ⟨n, e ▸ getElem?_eq_getElem _⟩
 
+theorem mem_of_getElem {l : List α} {i : Nat} {h} {a : α} (e : l[i] = a) : a ∈ l := by
+  subst e
+  simp
+
 theorem mem_of_getElem? {l : List α} {i : Nat} {a : α} (e : l[i]? = some a) : a ∈ l :=
   let ⟨_, e⟩ := getElem?_eq_some_iff.1 e; e ▸ getElem_mem ..
 

src/Init/Data/List/MapIdx.lean

@@ -15,17 +15,15 @@ namespace List
 
 /-! ## Operations using indexes -/
 
-/-! ### mapIdx -/
-
 /--
-Given a list `as = [a₀, a₁, ...]` function `f : Fin as.length → α → β`, returns the list
-`[f 0 a₀, f 1 a₁, ...]`.
+Given a list `as = [a₀, a₁, ...]` and a function `f : (i : Nat) → α → (h : i < as.length) → β`, returns the list
+`[f 0 a₀ ⋯, f 1 a₁ ⋯, ...]`.
 -/
 @[inline] def mapFinIdx (as : List α) (f : (i : Nat) → α → (h : i < as.length) → β) : List β :=
   go as #[] (by simp)
 where
   /-- Auxiliary for `mapFinIdx`:
-  `mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
+  `mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀ ⋯, f 1 a₁ ⋯, ...]` -/
   @[specialize] go : (bs : List α) → (acc : Array β) → bs.length + acc.size = as.length → List β
   | [], acc, h => acc.toList
   | a :: as, acc, h =>
@@ -42,6 +40,31 @@ Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁,
   | [], acc => acc.toList
   | a :: as, acc => go as (acc.push (f acc.size a))
 
+/--
+Given a list `as = [a₀, a₁, ...]` and a monadic function `f : (i : Nat) → α → (h : i < as.length) → m β`,
+returns the list `[f 0 a₀ ⋯, f 1 a₁ ⋯, ...]`.
+-/
+@[inline] def mapFinIdxM [Monad m] (as : List α) (f : (i : Nat) → α → (h : i < as.length) → m β) : m (List β) :=
+  go as #[] (by simp)
+where
+  /-- Auxiliary for `mapFinIdxM`:
+  `mapFinIdxM.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀ ⋯, f 1 a₁ ⋯, ...]` -/
+  @[specialize] go : (bs : List α) → (acc : Array β) → bs.length + acc.size = as.length → m (List β)
+  | [], acc, h => pure acc.toList
+  | a :: as, acc, h => do
+    go as (acc.push (← f acc.size a (by simp at h; omega))) (by simp at h ⊢; omega)
+
+/--
+Given a monadic function `f : Nat → α → m β` and `as : List α`, `as = [a₀, a₁, ...]`,
+returns the list `[f 0 a₀, f 1 a₁, ...]`.
+-/
+@[inline] def mapIdxM [Monad m] (f : Nat → α → m β) (as : List α) : m (List β) := go as #[] where
+  /-- Auxiliary for `mapIdxM`:
+  `mapIdxM.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/
+  @[specialize] go : List α → Array β → m (List β)
+  | [], acc => pure acc.toList
+  | a :: as, acc => do go as (acc.push (← f acc.size a))
+
 /-! ### mapFinIdx -/
 
 @[congr] theorem mapFinIdx_congr {xs ys : List α} (w : xs = ys)

src/Init/Data/List/Monadic.lean

@@ -28,7 +28,11 @@ attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM?
 
 /-! ### mapM -/
 
-/-- Alternate (non-tail-recursive) form of mapM for proofs. -/
+/-- Alternate (non-tail-recursive) form of mapM for proofs.
+
+Note that we can not have this as the main definition and replace it using a `@[csimp]` lemma,
+because they are only equal when `m` is a `LawfulMonad`.
+-/
 def mapM' [Monad m] (f : α → m β) : List α → m (List β)
   | [] => pure []
   | a :: l => return (← f a) :: (← l.mapM' f)
@@ -76,6 +80,63 @@ theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α → m β)
       reverse_cons, reverse_nil, nil_append, singleton_append]
     simp [bind_pure_comp]
 
+/-! ### filterMapM -/
+
+@[simp] theorem filterMapM_nil [Monad m] (f : α → m (Option β)) : [].filterMapM f = pure [] := rfl
+
+theorem filterMapM_loop_eq [Monad m] [LawfulMonad m]
+    (f : α → m (Option β)) (l : List α) (acc : List β) :
+    filterMapM.loop f l acc = (acc.reverse ++ ·) <$> filterMapM.loop f l [] := by
+  induction l generalizing acc with
+  | nil => simp [filterMapM.loop]
+  | cons a l ih =>
+    simp only [filterMapM.loop, _root_.map_bind]
+    congr
+    funext b?
+    split <;> rename_i b
+    · apply ih
+    · rw [ih, ih [b]]
+      simp
+
+@[simp] theorem filterMapM_cons [Monad m] [LawfulMonad m] (f : α → m (Option β)) :
+    (a :: l).filterMapM f = do
+      match (← f a) with
+      | none => filterMapM f l
+      | some b => return (b :: (← filterMapM f l)) := by
+  conv => lhs; unfold filterMapM; unfold filterMapM.loop
+  congr
+  funext b?
+  split <;> rename_i b
+  · simp [filterMapM]
+  · simp only [bind_pure_comp]
+    rw [filterMapM_loop_eq, filterMapM]
+    simp
+
+/-! ### flatMapM -/
+
+@[simp] theorem flatMapM_nil [Monad m] (f : α → m (List β)) : [].flatMapM f = pure [] := rfl
+
+theorem flatMapM_loop_eq [Monad m] [LawfulMonad m] (f : α → m (List β)) (l : List α) (acc : List (List β)) :
+    flatMapM.loop f l acc = (acc.reverse.flatten ++ ·) <$> flatMapM.loop f l [] := by
+  induction l generalizing acc with
+  | nil => simp [flatMapM.loop]
+  | cons a l ih =>
+    simp only [flatMapM.loop, append_nil, _root_.map_bind]
+    congr
+    funext bs
+    rw [ih, ih [bs]]
+    simp
+
+@[simp] theorem flatMapM_cons [Monad m] [LawfulMonad m] (f : α → m (List β)) :
+    (a :: l).flatMapM f = do
+      let bs ← f a
+      return (bs ++ (← l.flatMapM f)) := by
+  conv => lhs; unfold flatMapM; unfold flatMapM.loop
+  congr
+  funext bs
+  rw [flatMapM_loop_eq, flatMapM]
+  simp
+
 /-! ### foldlM and foldrM -/
 
 theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : List β₁) (init : α) :
@@ -122,24 +183,36 @@ theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β
     simp only [filter_cons, foldrM_cons]
     split <;> simp [ih]
 
+@[simp] theorem foldlM_attachWith [Monad m]
+    (l : List α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : β → { x // q x} → m β} {b} :
+    (l.attachWith q H).foldlM f b = l.attach.foldlM (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by
+  induction l generalizing b with
+  | nil => simp
+  | cons a l ih => simp [ih, foldlM_map]
+
+@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
+    (l : List α) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : { x // q x} → β → m β} {b} :
+    (l.attachWith q H).foldrM f b = l.attach.foldrM (fun a acc => f ⟨a.1, H _ a.2⟩ acc) b := by
+  induction l generalizing b with
+  | nil => simp
+  | cons a l ih => simp [ih, foldrM_map]
+
 /-! ### forM -/
 
--- We currently use `List.forM` as the simp normal form, rather that `ForM.forM`.
--- (This should probably be revisited.)
--- As such we need to replace `List.forM_nil` and `List.forM_cons`:
+@[deprecated forM_nil (since := "2025-01-31")]
+theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
 
-@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
-
-@[simp] theorem forM_cons' [Monad m] :
+@[deprecated forM_cons (since := "2025-01-31")]
+theorem forM_cons' [Monad m] :
     (a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) :=
   List.forM_cons _ _ _
 
 @[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ l₂ : List α) (f : α → m PUnit) :
-    (l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
+    forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
   induction l₁ <;> simp [*]
 
 @[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : List α) (g : α → β) (f : β → m PUnit) :
-    (l.map g).forM f = l.forM (fun a => f (g a)) := by
+    forM (l.map g) f = forM l (fun a => f (g a)) := by
   induction l <;> simp [*]
 
 /-! ### forIn' -/
@@ -334,4 +407,65 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
     funext b
     split <;> simp_all
 
+/-! ### Recognizing higher order functions using a function that only depends on the value. -/
+
+/--
+This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem foldlM_subtype [Monad m] {p : α → Prop} {l : List { x // p x }}
+    {f : β → { x // p x } → m β} {g : β → α → m β} {x : β}
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) :
+    l.foldlM f x = l.unattach.foldlM g x := by
+  unfold unattach
+  induction l generalizing x with
+  | nil => simp
+  | cons a l ih => simp [ih, hf]
+
+/--
+This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem foldrM_subtype [Monad m] [LawfulMonad m]{p : α → Prop} {l : List { x // p x }}
+    {f : { x // p x } → β → m β} {g : α → β → m β} {x : β}
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) :
+    l.foldrM f x = l.unattach.foldrM g x := by
+  unfold unattach
+  induction l generalizing x with
+  | nil => simp
+  | cons a l ih =>
+    simp [ih, hf, foldrM_cons]
+    congr
+    funext b
+    simp [hf]
+
+/--
+This lemma identifies monadic maps over lists of subtypes, where the function only depends on the value, not the proposition,
+and simplifies these to the function directly taking the value.
+-/
+@[simp] theorem mapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : List { x // p x }}
+    {f : { x // p x } → m β} {g : α → m β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+    l.mapM f = l.unattach.mapM g := by
+  unfold unattach
+  simp [← List.mapM'_eq_mapM]
+  induction l with
+  | nil => simp
+  | cons a l ih => simp [ih, hf]
+
+@[simp] theorem filterMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : List { x // p x }}
+    {f : { x // p x } → m (Option β)} {g : α → m (Option β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+    l.filterMapM f = l.unattach.filterMapM g := by
+  unfold unattach
+  induction l with
+  | nil => simp
+  | cons a l ih => simp [ih, hf, filterMapM_cons]
+
+@[simp] theorem flatMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : List { x // p x }}
+    {f : { x // p x } → m (List β)} {g : α → m (List β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
+    (l.flatMapM f) = l.unattach.flatMapM g := by
+  unfold unattach
+  induction l with
+  | nil => simp
+  | cons a l ih => simp [ih, hf]
+
 end List

src/Init/Data/List/Nat/Erase.lean

@@ -65,6 +65,11 @@ theorem getElem_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : j < (l.era
   rw [getElem_eraseIdx, dif_neg]
   omega
 
+theorem eraseIdx_eq_dropLast (l : List α) (i : Nat) (h : i + 1 = l.length) :
+    l.eraseIdx i = l.dropLast := by
+  simp [eraseIdx_eq_take_drop_succ, h]
+  rw [take_eq_dropLast h]
+
 theorem eraseIdx_set_eq {l : List α} {i : Nat} {a : α} :
     (l.set i a).eraseIdx i = l.eraseIdx i := by
   apply ext_getElem

src/Init/Data/List/Nat/Range.lean

@@ -77,12 +77,15 @@ theorem map_sub_range' (a s n : Nat) (h : a ≤ s) :
   rw [← map_add_range', map_map, (?_ : _∘_ = _), map_id]
   funext x; apply Nat.add_sub_cancel_left
 
-@[simp] theorem range'_eq_singleton {s n a : Nat} : range' s n = [a] ↔ s = a ∧ n = 1 := by
+@[simp] theorem range'_eq_singleton_iff {s n a : Nat} : range' s n = [a] ↔ s = a ∧ n = 1 := by
   rw [range'_eq_cons_iff]
-  simp only [nil_eq, range'_eq_nil, and_congr_right_iff]
+  simp only [nil_eq, range'_eq_nil_iff, and_congr_right_iff]
   rintro rfl
   omega
 
+@[deprecated range'_eq_singleton_iff (since := "2025-01-29")]
+abbrev range'_eq_singleton := @range'_eq_singleton_iff
+
 theorem range'_eq_append_iff : range' s n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs = range' s k ∧ ys = range' (s + k) (n - k) := by
   induction n generalizing s xs ys with
   | zero => simp
@@ -174,7 +177,7 @@ theorem pairwise_lt_range (n : Nat) : Pairwise (· < ·) (range n) := by
 theorem pairwise_le_range (n : Nat) : Pairwise (· ≤ ·) (range n) :=
   Pairwise.imp Nat.le_of_lt (pairwise_lt_range _)
 
-theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
+@[simp] theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
   apply List.ext_getElem
   · simp
   · simp +contextual [getElem_take, Nat.lt_min]

src/Init/Data/List/Nat/TakeDrop.lean

@@ -171,6 +171,20 @@ theorem dropLast_take {n : Nat} {l : List α} (h : n < l.length) :
 
 @[deprecated map_eq_append_iff (since := "2024-09-05")] abbrev map_eq_append_split := @map_eq_append_iff
 
+theorem take_eq_dropLast {l : List α} {i : Nat} (h : i + 1 = l.length) :
+    l.take i = l.dropLast := by
+  induction l generalizing i with
+  | nil => simp
+  | cons a as ih =>
+    cases i
+    · simp_all
+    · cases as with
+      | nil => simp_all
+      | cons b bs =>
+        simp only [take_succ_cons, dropLast_cons₂]
+        rw [ih]
+        simpa using h
+
 theorem take_prefix_take_left (l : List α) {m n : Nat} (h : m ≤ n) : take m l <+: take n l := by
   rw [isPrefix_iff]
   intro i w

src/Init/Data/List/OfFn.lean

@@ -68,6 +68,15 @@ theorem ofFn_succ {n} (f : Fin (n + 1) → α) : ofFn f = f 0 :: ofFn fun i => f
 theorem ofFn_eq_nil_iff {f : Fin n → α} : ofFn f = [] ↔ n = 0 := by
   cases n <;> simp only [ofFn_zero, ofFn_succ, eq_self_iff_true, Nat.succ_ne_zero, reduceCtorEq]
 
+@[simp 500]
+theorem mem_ofFn {n} (f : Fin n → α) (a : α) : a ∈ ofFn f ↔ ∃ i, f i = a := by
+  constructor
+  · intro w
+    obtain ⟨i, h, rfl⟩ := getElem_of_mem w
+    exact ⟨⟨i, by simpa using h⟩, by simp⟩
+  · rintro ⟨i, rfl⟩
+    apply mem_of_getElem (i := i) <;> simp
+
 theorem head_ofFn {n} (f : Fin n → α) (h : ofFn f ≠ []) :
     (ofFn f).head h = f ⟨0, Nat.pos_of_ne_zero (mt ofFn_eq_nil_iff.2 h)⟩ := by
   rw [← getElem_zero (length_ofFn _ ▸ Nat.pos_of_ne_zero (mt ofFn_eq_nil_iff.2 h)),

src/Init/Data/List/Range.lean

@@ -8,7 +8,7 @@ import Init.Data.List.Pairwise
 import Init.Data.List.Zip
 
 /-!
-# Lemmas about `List.range` and `List.enum`
+# Lemmas about `List.range` and `List.zipIdx`
 
 Most of the results are deferred to `Data.Init.List.Nat.Range`, where more results about
 natural arithmetic are available.
@@ -29,12 +29,16 @@ theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step)
   | 0 => rfl
   | _ + 1 => congrArg succ (length_range' _ _ _)
 
-@[simp] theorem range'_eq_nil : range' s n step = [] ↔ n = 0 := by
+@[simp] theorem range'_eq_nil_iff : range' s n step = [] ↔ n = 0 := by
   rw [← length_eq_zero, length_range']
 
-theorem range'_ne_nil (s : Nat) {n : Nat} : range' s n ≠ [] ↔ n ≠ 0 := by
+@[deprecated range'_eq_nil_iff (since := "2025-01-29")] abbrev range'_eq_nil := @range'_eq_nil_iff
+
+theorem range'_ne_nil_iff (s : Nat) {n step : Nat} : range' s n step ≠ [] ↔ n ≠ 0 := by
   cases n <;> simp
 
+@[deprecated range'_ne_nil_iff (since := "2025-01-29")] abbrev range'_ne_nil := @range'_ne_nil_iff
+
 @[simp] theorem range'_zero : range' s 0 step = [] := by
   simp
 
@@ -94,18 +98,18 @@ theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1
   · simp [Nat.add_right_comm]
 
 theorem range'_append : ∀ s m n step : Nat,
-    range' s m step ++ range' (s + step * m) n step = range' s (n + m) step
-  | _, 0, _, _ => rfl
+    range' s m step ++ range' (s + step * m) n step = range' s (m + n) step
+  | _, 0, _, _ => by simp
   | s, m + 1, n, step => by
     simpa [range', Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
       using range'_append (s + step) m n step
 
 @[simp] theorem range'_append_1 (s m n : Nat) :
-    range' s m ++ range' (s + m) n = range' s (n + m) := by simpa using range'_append s m n 1
+    range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
 
 theorem range'_sublist_right {s m n : Nat} : range' s m step <+ range' s n step ↔ m ≤ n :=
   ⟨fun h => by simpa only [length_range'] using h.length_le,
-   fun h => by rw [← Nat.sub_add_cancel h, ← range'_append]; apply sublist_append_left⟩
+   fun h => by rw [← add_sub_of_le h, ← range'_append]; apply sublist_append_left⟩
 
 theorem range'_subset_right {s m n : Nat} (step0 : 0 < step) :
     range' s m step ⊆ range' s n step ↔ m ≤ n := by
@@ -117,7 +121,7 @@ theorem range'_subset_right_1 {s m n : Nat} : range' s m ⊆ range' s n ↔ m
   range'_subset_right (by decide)
 
 theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ [s + step * n] := by
-  rw [Nat.add_comm n 1]; exact (range'_append s n 1 step).symm
+  exact (range'_append s n 1 step).symm
 
 theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ [s + n] := by
   simp [range'_concat]

src/Init/Data/List/ToArray.lean

@@ -13,6 +13,21 @@ import Init.Data.Array.Lex.Basic
 
 We prefer to pull `List.toArray` outwards past `Array` operations.
 -/
+
+namespace Array
+
+@[simp] theorem toList_set (a : Array α) (i x h) :
+    (a.set i x).toList = a.toList.set i x := rfl
+
+theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
+    a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
+  simp [swap]
+
+@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
+    (a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
+
+end Array
+
 namespace List
 
 open Array
@@ -125,9 +140,10 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
   simp only [size_toArray, foldlM_toArray']
   induction l <;> simp_all
 
+@[simp]
 theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
-    (l.toArray.forM f) = l.forM f := by
-  simp
+    (forM l.toArray f) = l.forM f :=
+  forM_toArray' l f rfl
 
 /-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
 @[simp] theorem foldr_toArray' (f : α → β → β) (init : β) (l : List α)
@@ -297,7 +313,7 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
     simp [zipWith_cons_cons, zipWithAux_toArray_succ', zipWithAux_toArray_zero, push_append_toArray]
 
 @[simp] theorem zipWith_toArray (as : List α) (bs : List β) (f : α → β → γ) :
-    Array.zipWith as.toArray bs.toArray f = (List.zipWith f as bs).toArray := by
+    Array.zipWith f as.toArray bs.toArray = (List.zipWith f as bs).toArray := by
   rw [Array.zipWith]
   simp [zipWithAux_toArray_zero]
 
@@ -340,7 +356,7 @@ theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α → O
   decreasing_by simp_wf; decreasing_trivial_pre_omega
 
 @[simp] theorem zipWithAll_toArray (f : Option α → Option β → γ) (as : List α) (bs : List β) :
-    Array.zipWithAll as.toArray bs.toArray f = (List.zipWithAll f as bs).toArray := by
+    Array.zipWithAll f as.toArray bs.toArray = (List.zipWithAll f as bs).toArray := by
   simp [Array.zipWithAll, zipWithAll_go_toArray]
 
 @[simp] theorem toArray_appendList (l₁ l₂ : List α) :
@@ -417,4 +433,123 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
     apply ext'
     simp [ih, flatMap_toArray_cons]
 
+@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
+    l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
+  apply ext'
+  simp
+
+@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
+    l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
+  rw [Array.eraseIdx]
+  split <;> rename_i h'
+  · rw [eraseIdx_toArray]
+    simp only [swap_toArray, Fin.getElem_fin, toList_toArray, mk.injEq]
+    rw [eraseIdx_set_gt (by simp), eraseIdx_set_eq]
+    simp
+  · simp at h h'
+    have t : i = l.length - 1 := by omega
+    simp [t]
+termination_by l.length - i
+decreasing_by
+  rename_i h
+  simp at h
+  simp
+  omega
+
+@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
+    l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
+  rw [Array.eraseIdxIfInBounds]
+  split
+  · simp
+  · simp_all [eraseIdx_eq_self.2]
+
+@[simp] theorem findIdx?_toArray {as : List α} {p : α → Bool} :
+    as.toArray.findIdx? p = as.findIdx? p := by
+  unfold Array.findIdx?
+  suffices ∀ i, i ≤ as.length →
+      Array.findIdx?.loop p as.toArray (as.length - i) =
+        (findIdx? p (as.drop  (as.length - i))).map fun j => j +  (as.length - i) by
+    specialize this as.length
+    simpa
+  intro i
+  induction i with
+  | zero => simp [findIdx?.loop]
+  | succ i ih =>
+    unfold findIdx?.loop
+    simp only [size_toArray, getElem_toArray]
+    split <;> rename_i h
+    · rw [drop_eq_getElem_cons h]
+      rw [findIdx?_cons]
+      split <;> rename_i h'
+      · simp
+      · intro w
+        have : as.length - (i + 1) + 1 = as.length - i := by omega
+        specialize ih (by omega)
+        simp only [Option.map_map, this, ih]
+        congr
+        ext
+        simp
+        omega
+    · have : as.length = 0 := by omega
+      simp_all
+
+@[simp] theorem findFinIdx?_toArray {as : List α} {p : α → Bool} :
+    as.toArray.findFinIdx? p = as.findFinIdx? p := by
+  have h := findIdx?_toArray (as := as) (p := p)
+  rw [findIdx?_eq_map_findFinIdx?_val, Array.findIdx?_eq_map_findFinIdx?_val] at h
+  rwa [Option.map_inj_right] at h
+  rintro ⟨x, hx⟩ ⟨y, hy⟩ rfl
+  simp
+
+theorem findFinIdx?_go_beq_eq_idxOfAux_toArray [BEq α]
+    {xs as : List α} {a : α} {i : Nat} {h} (w : as = xs.drop i) :
+    findFinIdx?.go (fun x => x == a) xs as i h =
+      xs.toArray.idxOfAux a i := by
+  unfold findFinIdx?.go
+  unfold idxOfAux
+  split <;> rename_i b as
+  · simp at h
+    simp [h]
+  · simp at h
+    rw [dif_pos (by simp; omega)]
+    simp only [getElem_toArray]
+    erw [getElem_drop' (j := 0)]
+    simp only [← w, getElem_cons_zero]
+    have : xs.length - (i + 1) < xs.length - i := by omega
+    rw [findFinIdx?_go_beq_eq_idxOfAux_toArray]
+    rw [← drop_drop, ← w]
+    simp
+termination_by xs.length - i
+
+@[simp] theorem finIdxOf?_toArray [BEq α] {as : List α} {a : α} :
+    as.toArray.finIdxOf? a = as.finIdxOf? a := by
+  unfold Array.finIdxOf?
+  unfold finIdxOf?
+  unfold findFinIdx?
+  rw [findFinIdx?_go_beq_eq_idxOfAux_toArray]
+  simp
+
+@[simp] theorem findIdx_toArray [BEq α] {as : List α} {p : α → Bool} :
+    as.toArray.findIdx p = as.findIdx p := by
+  rw [Array.findIdx, findIdx?_toArray, findIdx_eq_getD_findIdx?]
+
+@[simp] theorem idxOf?_toArray [BEq α] {as : List α} {a : α} :
+    as.toArray.idxOf? a = as.idxOf? a := by
+  rw [Array.idxOf?, finIdxOf?_toArray, idxOf?_eq_map_finIdxOf?_val]
+
+@[simp] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
+    as.toArray.idxOf a = as.idxOf a := by
+  rw [Array.idxOf, findIdx_toArray, idxOf]
+
+@[simp] theorem eraseP_toArray {as : List α} {p : α → Bool} :
+    as.toArray.eraseP p = (as.eraseP p).toArray := by
+  rw [Array.eraseP, List.eraseP_eq_eraseIdx, findFinIdx?_toArray]
+  split <;> simp [*, findIdx?_eq_map_findFinIdx?_val]
+
+@[simp] theorem erase_toArray [BEq α] {as : List α} {a : α} :
+    as.toArray.erase a = (as.erase a).toArray := by
+  rw [Array.erase, finIdxOf?_toArray, List.erase_eq_eraseIdx]
+  rw [idxOf?_eq_map_finIdxOf?_val]
+  split <;> simp_all
+
 end List

src/Init/Data/List/Zip.lean

@@ -31,16 +31,18 @@ theorem zipWith_comm_of_comm (f : α → α → β) (comm : ∀ x y : α, f x y
   simp only [comm]
 
 @[simp]
-theorem zipWith_same (f : α → α → δ) : ∀ l : List α, zipWith f l l = l.map fun a => f a a
+theorem zipWith_self (f : α → α → δ) : ∀ l : List α, zipWith f l l = l.map fun a => f a a
   | [] => rfl
-  | _ :: xs => congrArg _ (zipWith_same f xs)
+  | _ :: xs => congrArg _ (zipWith_self f xs)
+
+@[deprecated zipWith_self (since := "2025-01-29")] abbrev zipWith_same := @zipWith_self
 
 /--
 See also `getElem?_zipWith'` for a variant
 using `Option.map` and `Option.bind` rather than a `match`.
 -/
 theorem getElem?_zipWith {f : α → β → γ} {i : Nat} :
-    (List.zipWith f as bs)[i]? = match as[i]?, bs[i]? with
+    (zipWith f as bs)[i]? = match as[i]?, bs[i]? with
       | some a, some b => some (f a b) | _, _ => none := by
   induction as generalizing bs i with
   | nil => cases bs with
@@ -257,8 +259,7 @@ theorem zip_map (f : α → γ) (g : β → δ) :
     ∀ (l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
   | [], _ => rfl
   | _, [] => by simp only [map, zip_nil_right]
-  | _ :: _, _ :: _ => by
-    simp only [map, zip_cons_cons, zip_map, Prod.map]; try constructor -- TODO: remove try constructor after update stage0
+  | _ :: _, _ :: _ => by simp only [map, zip_cons_cons, zip_map, Prod.map]
 
 theorem zip_map_left (f : α → γ) (l₁ : List α) (l₂ : List β) :
     zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]

src/Init/Data/Option/Attach.lean

@@ -224,17 +224,17 @@ This lemma identifies maps over lists of subtypes, where the function only depen
 and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem map_subtype {p : α → Prop} {o : Option { x // p x }}
-    {f : { x // p x } → β} {g : α → β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → β} {g : α → β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     o.map f = o.unattach.map g := by
   cases o <;> simp [hf]
 
 @[simp] theorem bind_subtype {p : α → Prop} {o : Option { x // p x }}
-    {f : { x // p x } → Option β} {g : α → Option β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → Option β} {g : α → Option β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     (o.bind f) = o.unattach.bind g := by
   cases o <;> simp [hf]
 
 @[simp] theorem unattach_filter {p : α → Prop} {o : Option { x // p x }}
-    {f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → Bool} {g : α → Bool} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     (o.filter f).unattach = o.unattach.filter g := by
   cases o
   · simp

src/Init/Data/Ord.lean

@@ -10,12 +10,10 @@ import Init.Data.Array.Basic
 
 inductive Ordering where
   | lt | eq | gt
-deriving Inhabited, BEq
+deriving Inhabited, DecidableEq
 
 namespace Ordering
 
-deriving instance DecidableEq for Ordering
-
 /-- Swaps less and greater ordering results -/
 def swap : Ordering → Ordering
   | .lt => .gt
@@ -86,6 +84,181 @@ def isGE : Ordering → Bool
   | lt => false
   | _ => true
 
+section Lemmas
+
+@[simp]
+theorem isLT_lt : lt.isLT := rfl
+
+@[simp]
+theorem isLE_lt : lt.isLE := rfl
+
+@[simp]
+theorem isEq_lt : lt.isEq = false := rfl
+
+@[simp]
+theorem isNe_lt : lt.isNe = true := rfl
+
+@[simp]
+theorem isGE_lt : lt.isGE = false := rfl
+
+@[simp]
+theorem isGT_lt : lt.isGT = false := rfl
+
+@[simp]
+theorem isLT_eq : eq.isLT = false := rfl
+
+@[simp]
+theorem isLE_eq : eq.isLE := rfl
+
+@[simp]
+theorem isEq_eq : eq.isEq := rfl
+
+@[simp]
+theorem isNe_eq : eq.isNe = false := rfl
+
+@[simp]
+theorem isGE_eq : eq.isGE := rfl
+
+@[simp]
+theorem isGT_eq : eq.isGT = false := rfl
+
+@[simp]
+theorem isLT_gt : gt.isLT = false := rfl
+
+@[simp]
+theorem isLE_gt : gt.isLE = false := rfl
+
+@[simp]
+theorem isEq_gt : gt.isEq = false := rfl
+
+@[simp]
+theorem isNe_gt : gt.isNe = true := rfl
+
+@[simp]
+theorem isGE_gt : gt.isGE := rfl
+
+@[simp]
+theorem isGT_gt : gt.isGT := rfl
+
+@[simp]
+theorem swap_lt : lt.swap = .gt := rfl
+
+@[simp]
+theorem swap_eq : eq.swap = .eq := rfl
+
+@[simp]
+theorem swap_gt : gt.swap = .lt := rfl
+
+theorem eq_eq_of_isLE_of_isLE_swap {o : Ordering} : o.isLE → o.swap.isLE → o = .eq := by
+  cases o <;> simp
+
+theorem eq_eq_of_isGE_of_isGE_swap {o : Ordering} : o.isGE → o.swap.isGE → o = .eq := by
+  cases o <;> simp
+
+theorem eq_eq_of_isLE_of_isGE {o : Ordering} : o.isLE → o.isGE → o = .eq := by
+  cases o <;> simp
+
+theorem eq_swap_iff_eq_eq {o : Ordering} : o = o.swap ↔ o = .eq := by
+  cases o <;> simp
+
+theorem eq_eq_of_eq_swap {o : Ordering} : o = o.swap → o = .eq :=
+  eq_swap_iff_eq_eq.mp
+
+@[simp]
+theorem isLE_eq_false {o : Ordering} : o.isLE = false ↔ o = .gt := by
+  cases o <;> simp
+
+@[simp]
+theorem isGE_eq_false {o : Ordering} : o.isGE = false ↔ o = .lt := by
+  cases o <;> simp
+
+@[simp]
+theorem swap_eq_gt {o : Ordering} : o.swap = .gt ↔ o = .lt := by
+  cases o <;> simp
+
+@[simp]
+theorem swap_eq_lt {o : Ordering} : o.swap = .lt ↔ o = .gt := by
+  cases o <;> simp
+
+@[simp]
+theorem swap_eq_eq {o : Ordering} : o.swap = .eq ↔ o = .eq := by
+  cases o <;> simp
+
+@[simp]
+theorem isLT_swap {o : Ordering} : o.swap.isLT = o.isGT := by
+  cases o <;> simp
+
+@[simp]
+theorem isLE_swap {o : Ordering} : o.swap.isLE = o.isGE := by
+  cases o <;> simp
+
+@[simp]
+theorem isEq_swap {o : Ordering} : o.swap.isEq = o.isEq := by
+  cases o <;> simp
+
+@[simp]
+theorem isNe_swap {o : Ordering} : o.swap.isNe = o.isNe := by
+  cases o <;> simp
+
+@[simp]
+theorem isGE_swap {o : Ordering} : o.swap.isGE = o.isLE := by
+  cases o <;> simp
+
+@[simp]
+theorem isGT_swap {o : Ordering} : o.swap.isGT = o.isLT := by
+  cases o <;> simp
+
+theorem isLT_iff_eq_lt {o : Ordering} : o.isLT ↔ o = .lt := by
+  cases o <;> simp
+
+theorem isLE_iff_eq_lt_or_eq_eq {o : Ordering} : o.isLE ↔ o = .lt ∨ o = .eq := by
+  cases o <;> simp
+
+theorem isLE_of_eq_lt {o : Ordering} : o = .lt → o.isLE := by
+  rintro rfl; rfl
+
+theorem isLE_of_eq_eq {o : Ordering} : o = .eq → o.isLE := by
+  rintro rfl; rfl
+
+theorem isEq_iff_eq_eq {o : Ordering} : o.isEq ↔ o = .eq := by
+  cases o <;> simp
+
+theorem isNe_iff_ne_eq {o : Ordering} : o.isNe ↔ o ≠ .eq := by
+  cases o <;> simp
+
+theorem isGE_iff_eq_gt_or_eq_eq {o : Ordering} : o.isGE ↔ o = .gt ∨ o = .eq := by
+  cases o <;> simp
+
+theorem isGE_of_eq_gt {o : Ordering} : o = .gt → o.isGE := by
+  rintro rfl; rfl
+
+theorem isGE_of_eq_eq {o : Ordering} : o = .eq → o.isGE := by
+  rintro rfl; rfl
+
+theorem isGT_iff_eq_gt {o : Ordering} : o.isGT ↔ o = .gt := by
+  cases o <;> simp
+
+@[simp]
+theorem swap_swap {o : Ordering} : o.swap.swap = o := by
+  cases o <;> simp
+
+@[simp] theorem swap_inj {o₁ o₂ : Ordering} : o₁.swap = o₂.swap ↔ o₁ = o₂ :=
+  ⟨fun h => by simpa using congrArg swap h, congrArg _⟩
+
+theorem swap_then (o₁ o₂ : Ordering) : (o₁.then o₂).swap = o₁.swap.then o₂.swap := by
+  cases o₁ <;> rfl
+
+theorem then_eq_lt {o₁ o₂ : Ordering} : o₁.then o₂ = lt ↔ o₁ = lt ∨ o₁ = eq ∧ o₂ = lt := by
+  cases o₁ <;> cases o₂ <;> decide
+
+theorem then_eq_eq {o₁ o₂ : Ordering} : o₁.then o₂ = eq ↔ o₁ = eq ∧ o₂ = eq := by
+  cases o₁ <;> simp [«then»]
+
+theorem then_eq_gt {o₁ o₂ : Ordering} : o₁.then o₂ = gt ↔ o₁ = gt ∨ o₁ = eq ∧ o₂ = gt := by
+  cases o₁ <;> cases o₂ <;> decide
+
+end Lemmas
+
 end Ordering
 
 /--

src/Init/Data/Vector.lean

@@ -9,3 +9,9 @@ import Init.Data.Vector.Lemmas
 import Init.Data.Vector.Lex
 import Init.Data.Vector.MapIdx
 import Init.Data.Vector.Count
+import Init.Data.Vector.DecidableEq
+import Init.Data.Vector.Zip
+import Init.Data.Vector.OfFn
+import Init.Data.Vector.Range
+import Init.Data.Vector.Erase
+import Init.Data.Vector.Monadic

src/Init/Data/Vector/Attach.lean

@@ -494,7 +494,7 @@ and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem foldl_subtype {p : α → Prop} {l : Vector { x // p x } n}
     {f : β → { x // p x } → β} {g : β → α → β} {x : β}
-    {hf : ∀ b x h, f b ⟨x, h⟩ = g b x} :
+    (hf : ∀ b x h, f b ⟨x, h⟩ = g b x) :
     l.foldl f x = l.unattach.foldl g x := by
   rcases l with ⟨l, rfl⟩
   simp [Array.foldl_subtype (hf := hf)]
@@ -505,7 +505,7 @@ and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem foldr_subtype {p : α → Prop} {l : Vector { x // p x } n}
     {f : { x // p x } → β → β} {g : α → β → β} {x : β}
-    {hf : ∀ x h b, f ⟨x, h⟩ b = g x b} :
+    (hf : ∀ x h b, f ⟨x, h⟩ b = g x b) :
     l.foldr f x = l.unattach.foldr g x := by
   rcases l with ⟨l, rfl⟩
   simp [Array.foldr_subtype (hf := hf)]
@@ -515,7 +515,7 @@ This lemma identifies maps over arrays of subtypes, where the function only depe
 and simplifies these to the function directly taking the value.
 -/
 @[simp] theorem map_subtype {p : α → Prop} {l : Vector { x // p x } n}
-    {f : { x // p x } → β} {g : α → β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
+    {f : { x // p x } → β} {g : α → β} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
     l.map f = l.unattach.map g := by
   rcases l with ⟨l, rfl⟩
   simp [Array.map_subtype (hf := hf)]

src/Init/Data/Vector/Basic.lean

@@ -8,6 +8,7 @@ prelude
 import Init.Data.Array.Lemmas
 import Init.Data.Array.MapIdx
 import Init.Data.Range
+import Init.Data.Stream
 
 /-!
 # Vectors
@@ -55,6 +56,9 @@ def elimAsList {motive : Vector α n → Sort u}
 /-- Makes a vector of size `n` with all cells containing `v`. -/
 @[inline] def mkVector (n) (v : α) : Vector α n := ⟨mkArray n v, by simp⟩
 
+instance : Nonempty (Vector α 0) := ⟨#v[]⟩
+instance [Nonempty α] : Nonempty (Vector α n) := ⟨mkVector _ Classical.ofNonempty⟩
+
 /-- Returns a vector of size `1` with element `v`. -/
 @[inline] def singleton (v : α) : Vector α 1 := ⟨#[v], rfl⟩
 
@@ -162,9 +166,36 @@ instance : HAppend (Vector α n) (Vector α m) (Vector α (n + m)) where
 Extracts the slice of a vector from indices `start` to `stop` (exclusive). If `start ≥ stop`, the
 result is empty. If `stop` is greater than the size of the vector, the size is used instead.
 -/
-@[inline] def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) :=
+@[inline] def extract (v : Vector α n) (start : Nat := 0) (stop : Nat := n) : Vector α (min stop n - start) :=
   ⟨v.toArray.extract start stop, by simp⟩
 
+/--
+Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the
+vector then the vector is returned unchanged.
+-/
+@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) :=
+  ⟨v.toArray.take m, by simp⟩
+
+@[simp] theorem take_eq_extract (v : Vector α n) (m : Nat) : v.take m = v.extract 0 m := rfl
+
+/--
+Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the
+vector then the empty vector is returned.
+-/
+@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) :=
+  ⟨v.toArray.drop m, by simp⟩
+
+@[simp] theorem drop_eq_cast_extract (v : Vector α n) (m : Nat) :
+    v.drop m = (v.extract m n).cast (by simp) := by
+  simp [drop, extract, Vector.cast]
+
+/-- Shrinks a vector to the first `m` elements, by repeatedly popping the last element. -/
+@[inline] def shrink (v : Vector α n) (m : Nat) : Vector α (min m n) :=
+  ⟨v.toArray.shrink m, by simp⟩
+
+@[simp] theorem shrink_eq_take (v : Vector α n) (m : Nat) : v.shrink m = v.take m := by
+  simp [shrink, take]
+
 /-- Maps elements of a vector using the function `f`. -/
 @[inline] def map (f : α → β) (v : Vector α n) : Vector β n :=
   ⟨v.toArray.map f, by simp⟩
@@ -178,6 +209,50 @@ which also receives the index of the element, and the fact that the index is les
 @[inline] def mapFinIdx (v : Vector α n) (f : (i : Nat) → α → (h : i < n) → β) : Vector β n :=
   ⟨v.toArray.mapFinIdx (fun i a h => f i a (by simpa [v.size_toArray] using h)), by simp⟩
 
+/-- Map a monadic function over a vector. -/
+@[inline] def mapM [Monad m] (f : α → m β) (v : Vector α n) : m (Vector β n) := do
+  go 0 (Nat.zero_le n) #v[]
+where
+  go (i : Nat) (h : i ≤ n) (r : Vector β i) : m (Vector β n) := do
+    if h' : i < n then
+      go (i+1) (by omega) (r.push (← f v[i]))
+    else
+      return r.cast (by omega)
+
+@[inline] protected def forM [Monad m] (v : Vector α n) (f : α → m PUnit) : m PUnit :=
+  v.toArray.forM f
+
+@[inline] def flatMapM [Monad m] (v : Vector α n) (f : α → m (Vector β k)) : m (Vector β (n * k)) := do
+  go 0 (Nat.zero_le n) (#v[].cast (by omega))
+where
+  go (i : Nat) (h : i ≤ n) (r : Vector β (i * k)) : m (Vector β (n * k)) := do
+    if h' : i < n then
+      go (i+1) (by omega) ((r ++ (← f v[i])).cast (Nat.succ_mul i k).symm)
+    else
+      return r.cast (by congr; omega)
+
+/-- Variant of `mapIdxM` which receives the index `i` along with the bound `i < n. -/
+@[inline]
+def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
+    (as : Vector α n) (f : (i : Nat) → α → (h : i < n) → m β) : m (Vector β n) :=
+  let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = n) (bs : Vector β (n - i)) : m (Vector β n) := do
+    match i, inv with
+    | 0,    _  => pure bs
+    | i+1, inv =>
+      have j_lt : j < n := by
+        rw [← inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
+        apply Nat.le_add_right
+      have : i + (j + 1) = n := by rw [← inv, Nat.add_comm j 1, Nat.add_assoc]
+      map i (j+1) this ((bs.push (← f j as[j] j_lt)).cast (by omega))
+  map n 0 rfl (#v[].cast (by simp))
+
+@[inline]
+def mapIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : Nat → α → m β) (as : Vector α n) : m (Vector β n) :=
+  as.mapFinIdxM fun i a _ => f i a
+
+@[inline] def firstM {α : Type u} {m : Type v → Type w} [Alternative m] (f : α → m β) (as : Vector α n) : m β :=
+  as.toArray.firstM f
+
 @[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
   ⟨(v.toArray.map Vector.toArray).flatten,
     by rcases v; simp_all [Function.comp_def, Array.map_const']⟩
@@ -191,9 +266,15 @@ which also receives the index of the element, and the fact that the index is les
 @[deprecated zipIdx (since := "2025-01-21")]
 abbrev zipWithIndex := @zipIdx
 
+@[inline] def zip (v : Vector α n) (w : Vector β n) : Vector (α × β) n :=
+  ⟨v.toArray.zip w.toArray, by simp⟩
+
 /-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
-@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α → β → φ) : Vector φ n :=
-  ⟨Array.zipWith a.toArray b.toArray f, by simp⟩
+@[inline] def zipWith (f : α → β → φ) (a : Vector α n) (b : Vector β n) : Vector φ n :=
+  ⟨Array.zipWith f a.toArray b.toArray, by simp⟩
+
+@[inline] def unzip (v : Vector (α × β) n) : Vector α n × Vector β n :=
+  ⟨⟨v.toArray.unzip.1, by simp⟩, ⟨v.toArray.unzip.2, by simp⟩⟩
 
 /-- The vector of length `n` whose `i`-th element is `f i`. -/
 @[inline] def ofFn (f : Fin n → α) : Vector α n :=
@@ -237,22 +318,12 @@ This will perform the update destructively provided that the vector has a refere
   let a := v.toArray.swapAt! i x
   ⟨a.fst, a.snd, by simp [a]⟩
 
-/-- The vector `#v[0,1,2,...,n-1]`. -/
+/-- The vector `#v[0, 1, 2, ..., n-1]`. -/
 @[inline] def range (n : Nat) : Vector Nat n := ⟨Array.range n, by simp⟩
 
-/--
-Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the
-vector then the vector is returned unchanged.
--/
-@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) :=
-  ⟨v.toArray.take m, by simp⟩
-
-/--
-Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the
-vector then the empty vector is returned.
--/
-@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) :=
-  ⟨v.toArray.extract m v.size, by simp⟩
+/-- The vector `#v[start, start + step, start + 2 * step, ..., start + (size - 1) * step]`. -/
+@[inline] def range' (start size : Nat) (step : Nat := 1) : Vector Nat size :=
+  ⟨Array.range' start size step, by simp⟩
 
 /--
 Compares two vectors of the same size using a given boolean relation `r`. `isEqv v w r` returns
@@ -292,8 +363,26 @@ instance [BEq α] : BEq (Vector α n) where
 Finds the first index of a given value in a vector using `==` for comparison. Returns `none` if the
 no element of the index matches the given value.
 -/
-@[inline] def indexOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) :=
-  (v.toArray.indexOf? x).map (Fin.cast v.size_toArray)
+@[inline] def finIdxOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) :=
+  (v.toArray.finIdxOf? x).map (Fin.cast v.size_toArray)
+
+@[deprecated finIdxOf? (since := "2025-01-29")]
+abbrev indexOf? := @finIdxOf?
+
+/-- Finds the first index of a given value in a vector using a predicate. Returns `none` if the
+no element of the index matches the given value. -/
+@[inline] def findFinIdx? (v : Vector α n) (p : α → Bool) : Option (Fin n) :=
+  (v.toArray.findFinIdx? p).map (Fin.cast v.size_toArray)
+
+/--
+Note that the universe level is contrained to `Type` here,
+to avoid having to have the predicate live in `p : α → m (ULift Bool)`.
+-/
+@[inline] def findM? {α : Type} {m : Type → Type} [Monad m] (f : α → m Bool) (as : Vector α n) : m (Option α) :=
+  as.toArray.findM? f
+
+@[inline] def findSomeM? [Monad m] (f : α → m (Option β)) (as : Vector α n) : m (Option β) :=
+  as.toArray.findSomeM? f
 
 /-- Returns `true` when `v` is a prefix of the vector `w`. -/
 @[inline] def isPrefixOf [BEq α] (v : Vector α m) (w : Vector α n) : Bool :=
@@ -323,6 +412,28 @@ no element of the index matches the given value.
 @[inline] def count [BEq α] (a : α) (v : Vector α n) : Nat :=
   v.toArray.count a
 
+/-! ### ForIn instance -/
+
+@[simp] theorem mem_toArray_iff (a : α) (v : Vector α n) : a ∈ v.toArray ↔ a ∈ v :=
+  ⟨fun h => ⟨h⟩, fun ⟨h⟩ => h⟩
+
+instance : ForIn' m (Vector α n) α inferInstance where
+  forIn' v b f := Array.forIn' v.toArray b (fun a h b => f a (by simpa using h) b)
+
+/-! ### ForM instance -/
+
+instance : ForM m (Vector α n) α where
+  forM := Vector.forM
+
+-- We simplify `Vector.forM` to `forM`.
+@[simp] theorem forM_eq_forM [Monad m] (f : α → m PUnit) :
+    Vector.forM v f = forM v f := rfl
+
+/-! ### ToStream instance -/
+
+instance : ToStream (Vector α n) (Subarray α) where
+  toStream v := v.toArray[:n]
+
 /-! ### Lexicographic ordering -/
 
 instance instLT [LT α] : LT (Vector α n) := ⟨fun v w => v.toArray < w.toArray⟩

src/Init/Data/Vector/Count.lean

@@ -71,7 +71,7 @@ theorem countP_le_size {l : Vector α n} : countP p l ≤ n := by
 
 theorem countP_mkVector (p : α → Bool) (a : α) (n : Nat) :
     countP p (mkVector n a) = if p a then n else 0 := by
-  simp only [mkVector_eq_toVector_mkArray, countP_cast, countP_mk]
+  simp only [mkVector_eq_mk_mkArray, countP_cast, countP_mk]
   simp [Array.countP_mkArray]
 
 theorem boole_getElem_le_countP (p : α → Bool) (l : Vector α n) (i : Nat) (h : i < n) :
@@ -213,11 +213,11 @@ theorem count_eq_size {l : Vector α n} : count a l = l.size ↔ ∀ b ∈ l, a
   simp [Array.count_eq_size]
 
 @[simp] theorem count_mkVector_self (a : α) (n : Nat) : count a (mkVector n a) = n := by
-  simp only [mkVector_eq_toVector_mkArray, count_cast, count_mk]
+  simp only [mkVector_eq_mk_mkArray, count_cast, count_mk]
   simp
 
 theorem count_mkVector (a b : α) (n : Nat) : count a (mkVector n b) = if b == a then n else 0 := by
-  simp only [mkVector_eq_toVector_mkArray, count_cast, count_mk]
+  simp only [mkVector_eq_mk_mkArray, count_cast, count_mk]
   simp [Array.count_mkArray]
 
 theorem count_le_count_map [DecidableEq β] (l : Vector α n) (f : α → β) (x : α) :

src/Init/Data/Vector/DecidableEq.lean

@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.DecidableEq
+import Init.Data.Vector.Lemmas
+
+namespace Vector
+
+theorem isEqv_iff_rel {a b : Vector α n} {r} :
+    Vector.isEqv a b r ↔ ∀ (i : Nat) (h' : i < n), r a[i] b[i] := by
+  rcases a with ⟨a, rfl⟩
+  rcases b with ⟨b, h⟩
+  simp [Array.isEqv_iff_rel, h]
+
+theorem isEqv_eq_decide (a b : Vector α n) (r) :
+    Vector.isEqv a b r = decide (∀ (i : Nat) (h' : i < n), r a[i] b[i]) := by
+  rcases a with ⟨a, rfl⟩
+  rcases b with ⟨b, h⟩
+  simp [Array.isEqv_eq_decide, h]
+
+@[simp] theorem isEqv_toArray [BEq α] (a b : Vector α n) : (a.toArray.isEqv b.toArray r) = (a.isEqv b r) := by
+  simp [isEqv_eq_decide, Array.isEqv_eq_decide]
+
+theorem eq_of_isEqv [DecidableEq α] (a b : Vector α n) (h : Vector.isEqv a b (fun x y => x = y)) : a = b := by
+  rcases a with ⟨a, rfl⟩
+  rcases b with ⟨b, h⟩
+  rw [← Vector.toArray_inj]
+  apply Array.eq_of_isEqv
+  simp_all
+
+theorem isEqv_self_beq [BEq α] [ReflBEq α] (a : Vector α n) : Vector.isEqv a a (· == ·) = true := by
+  rcases a with ⟨a, rfl⟩
+  simp [Array.isEqv_self_beq]
+
+theorem isEqv_self [DecidableEq α] (a : Vector α n) : Vector.isEqv a a (· = ·) = true := by
+  rcases a with ⟨a, rfl⟩
+  simp [Array.isEqv_self]
+
+instance [DecidableEq α] : DecidableEq (Vector α n) :=
+  fun a b =>
+    match h:isEqv a b (fun a b => a = b) with
+    | true  => isTrue (eq_of_isEqv a b h)
+    | false => isFalse fun h' => by subst h'; rw [isEqv_self] at h; contradiction
+
+theorem beq_eq_decide [BEq α] (a b : Vector α n) :
+    (a == b) = decide (∀ (i : Nat) (h' : i < n), a[i] == b[i]) := by
+  simp [BEq.beq, isEqv_eq_decide]
+
+@[simp] theorem beq_toArray [BEq α] (a b : Vector α n) : (a.toArray == b.toArray) = (a == b) := by
+  simp [beq_eq_decide, Array.beq_eq_decide]
+
+@[simp] theorem beq_toList [BEq α] (a b : Vector α n) : (a.toList == b.toList) = (a == b) := by
+  simp [beq_eq_decide, List.beq_eq_decide]
+
+end Vector

src/Init/Data/Vector/Erase.lean

@@ -0,0 +1,113 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Vector.Lemmas
+import Init.Data.Array.Erase
+
+/-!
+# Lemmas about `Vector.eraseIdx`.
+-/
+
+namespace Vector
+
+open Nat
+
+/-! ### eraseIdx -/
+
+theorem eraseIdx_eq_take_drop_succ (l : Vector α n) (i : Nat) (h) :
+    l.eraseIdx i = (l.take i ++ l.drop (i + 1)).cast (by omega) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.eraseIdx_eq_take_drop_succ, *]
+
+theorem getElem?_eraseIdx (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) :
+    (l.eraseIdx i)[j]? = if j < i then l[j]? else l[j + 1]? := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.getElem?_eraseIdx]
+
+theorem getElem?_eraseIdx_of_lt (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : j < i) :
+    (l.eraseIdx i)[j]? = l[j]? := by
+  rw [getElem?_eraseIdx]
+  simp [h']
+
+theorem getElem?_eraseIdx_of_ge (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : i ≤ j) :
+    (l.eraseIdx i)[j]? = l[j + 1]? := by
+  rw [getElem?_eraseIdx]
+  simp only [dite_eq_ite, ite_eq_right_iff]
+  intro h'
+  omega
+
+theorem getElem_eraseIdx (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : j < n - 1) :
+    (l.eraseIdx i)[j] = if h'' : j < i then l[j] else l[j + 1] := by
+  apply Option.some.inj
+  rw [← getElem?_eq_getElem, getElem?_eraseIdx]
+  split <;> simp
+
+theorem mem_of_mem_eraseIdx {l : Vector α n} {i : Nat} {h} {a : α} (h : a ∈ l.eraseIdx i) : a ∈ l := by
+  rcases l with ⟨l, rfl⟩
+  simpa using Array.mem_of_mem_eraseIdx (by simpa using h)
+
+theorem eraseIdx_append_of_lt_size {l : Vector α n} {k : Nat} (hk : k < n) (l' : Vector α n) (h) :
+    eraseIdx (l ++ l') k = (eraseIdx l k ++ l').cast (by omega) := by
+  rcases l with ⟨l⟩
+  rcases l' with ⟨l'⟩
+  simp [Array.eraseIdx_append_of_lt_size, *]
+
+theorem eraseIdx_append_of_length_le {l : Vector α n} {k : Nat} (hk : n ≤ k) (l' : Vector α n) (h) :
+    eraseIdx (l ++ l') k = (l ++ eraseIdx l' (k - n)).cast (by omega) := by
+  rcases l with ⟨l⟩
+  rcases l' with ⟨l'⟩
+  simp [Array.eraseIdx_append_of_length_le, *]
+
+theorem eraseIdx_cast {l : Vector α n} {k : Nat} (h : k < m) :
+    eraseIdx (l.cast w) k h = (eraseIdx l k).cast (by omega) := by
+  rcases l with ⟨l, rfl⟩
+  simp
+
+theorem eraseIdx_mkVector {n : Nat} {a : α} {k : Nat} {h} :
+    (mkVector n a).eraseIdx k = mkVector (n - 1) a := by
+  rw [mkVector_eq_mk_mkArray, eraseIdx_mk]
+  simp [Array.eraseIdx_mkArray, *]
+
+theorem mem_eraseIdx_iff_getElem {x : α} {l : Vector α n} {k} {h} : x ∈ eraseIdx l k h ↔ ∃ i w, i ≠ k ∧ l[i]'w = x := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.mem_eraseIdx_iff_getElem, *]
+
+theorem mem_eraseIdx_iff_getElem? {x : α} {l : Vector α n} {k} {h} : x ∈ eraseIdx l k h ↔ ∃ i ≠ k, l[i]? = some x := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.mem_eraseIdx_iff_getElem?, *]
+
+theorem getElem_eraseIdx_of_lt (l : Vector α n) (i : Nat) (w : i < n) (j : Nat) (h : j < n - 1) (h' : j < i) :
+    (l.eraseIdx i)[j] = l[j] := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.getElem_eraseIdx_of_lt, *]
+
+theorem getElem_eraseIdx_of_ge (l : Vector α n) (i : Nat) (w : i < n) (j : Nat) (h : j < n - 1) (h' : i ≤ j) :
+    (l.eraseIdx i)[j] = l[j + 1] := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.getElem_eraseIdx_of_ge, *]
+
+theorem eraseIdx_set_eq {l : Vector α n} {i : Nat} {a : α} {h : i < n} :
+    (l.set i a).eraseIdx i = l.eraseIdx i := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.eraseIdx_set_eq, *]
+
+theorem eraseIdx_set_lt {l : Vector α n} {i : Nat} {w : i < n} {j : Nat} {a : α} (h : j < i) :
+    (l.set i a).eraseIdx j = (l.eraseIdx j).set (i - 1) a := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.eraseIdx_set_lt, *]
+
+theorem eraseIdx_set_gt {l : Vector α n} {i : Nat} {j : Nat} {a : α} (h : i < j) {w : j < n} :
+    (l.set i a).eraseIdx j = (l.eraseIdx j).set i a := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.eraseIdx_set_gt, *]
+
+@[simp] theorem set_getElem_succ_eraseIdx_succ
+    {l : Vector α n} {i : Nat} (h : i + 1 < n) :
+    (l.eraseIdx (i + 1)).set i l[i + 1] = l.eraseIdx i := by
+  rcases l with ⟨l, rfl⟩
+  simp [List.set_getElem_succ_eraseIdx_succ, *]
+
+end Vector

src/Init/Data/Vector/Lemmas.lean

@@ -101,8 +101,17 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
 @[simp] theorem extract_mk (a : Array α) (h : a.size = n) (start stop) :
     (Vector.mk a h).extract start stop = Vector.mk (a.extract start stop) (by simp [h]) := rfl
 
-@[simp] theorem indexOf?_mk [BEq α] (a : Array α) (h : a.size = n) (x : α) :
-    (Vector.mk a h).indexOf? x = (a.indexOf? x).map (Fin.cast h) := rfl
+@[simp] theorem finIdxOf?_mk [BEq α] (a : Array α) (h : a.size = n) (x : α) :
+    (Vector.mk a h).finIdxOf? x = (a.finIdxOf? x).map (Fin.cast h) := rfl
+
+@[deprecated finIdxOf?_mk (since := "2025-01-29")]
+abbrev indexOf?_mk := @finIdxOf?_mk
+
+@[simp] theorem findM?_mk [Monad m] (a : Array α) (h : a.size = n) (f : α → m Bool) :
+    (Vector.mk a h).findM? f = a.findM? f := rfl
+
+@[simp] theorem findSomeM?_mk [Monad m] (a : Array α) (h : a.size = n) (f : α → m (Option β)) :
+    (Vector.mk a h).findSomeM? f = a.findSomeM? f := rfl
 
 @[simp] theorem mk_isEqv_mk (r : α → α → Bool) (a b : Array α) (ha : a.size = n) (hb : b.size = n) :
     Vector.isEqv (Vector.mk a ha) (Vector.mk b hb) r = Array.isEqv a b r := by
@@ -121,6 +130,25 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
     (Vector.mk a h).mapFinIdx f =
       Vector.mk (a.mapFinIdx fun i a h' => f i a (by simpa [h] using h')) (by simp [h]) := rfl
 
+@[simp] theorem forM_mk [Monad m] (f : α → m PUnit) (a : Array α) (h : a.size = n) :
+    forM (Vector.mk a h) f = forM a f := rfl
+
+@[simp] theorem forIn'_mk [Monad m]
+    (xs : Array α) (h : xs.size = n) (b : β)
+    (f : (a : α) → a ∈ Vector.mk xs h → β → m (ForInStep β)) :
+    forIn' (Vector.mk xs h) b f = forIn' xs b (fun a m b => f a (by simpa using m) b) := rfl
+
+@[simp] theorem forIn_mk [Monad m]
+    (xs : Array α) (h : xs.size = n) (b : β) (f : (a : α) → β → m (ForInStep β)) :
+    forIn (Vector.mk xs h) b f = forIn xs b f := rfl
+
+@[simp] theorem flatMap_mk (f : α → Vector β m) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).flatMap f =
+      Vector.mk (a.flatMap (fun a => (f a).toArray)) (by simp [h, Array.map_const']) := rfl
+
+@[simp] theorem firstM_mk [Alternative m] (f : α → m β) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).firstM f = a.firstM f := rfl
+
 @[simp] theorem reverse_mk (a : Array α) (h : a.size = n) :
     (Vector.mk a h).reverse = Vector.mk a.reverse (by simp [h]) := rfl
 
@@ -158,8 +186,14 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
 abbrev zipWithIndex_mk := @zipIdx_mk
 
 @[simp] theorem mk_zipWith_mk (f : α → β → γ) (a : Array α) (b : Array β)
-      (ha : a.size = n) (hb : b.size = n) : zipWith (Vector.mk a ha) (Vector.mk b hb) f =
-        Vector.mk (Array.zipWith a b f) (by simp [ha, hb]) := rfl
+      (ha : a.size = n) (hb : b.size = n) : zipWith f (Vector.mk a ha) (Vector.mk b hb) =
+        Vector.mk (Array.zipWith f a b) (by simp [ha, hb]) := rfl
+
+@[simp] theorem mk_zip_mk (a : Array α) (b : Array β) (ha : a.size = n) (hb : b.size = n) :
+    zip (Vector.mk a ha) (Vector.mk b hb) = Vector.mk (Array.zip a b) (by simp [ha, hb]) := rfl
+
+@[simp] theorem unzip_mk (a : Array (α × β)) (h : a.size = n) :
+    (Vector.mk a h).unzip = (Vector.mk a.unzip.1 (by simp_all), Vector.mk a.unzip.2 (by simp_all)) := rfl
 
 @[simp] theorem anyM_mk [Monad m] (p : α → m Bool) (a : Array α) (h : a.size = n) :
     (Vector.mk a h).anyM p = a.anyM p := rfl
@@ -234,6 +268,26 @@ abbrev zipWithIndex_mk := @zipIdx_mk
       v.toArray.mapFinIdx (fun i a h => f i a (by simpa [v.size_toArray] using h)) :=
   rfl
 
+theorem toArray_mapM_go [Monad m] [LawfulMonad m] (f : α → m β) (v : Vector α n) (i h r) :
+    toArray <$> mapM.go f v i h r = Array.mapM.map f v.toArray i r.toArray := by
+  unfold mapM.go
+  unfold Array.mapM.map
+  simp only [v.size_toArray, getElem_toArray]
+  split
+  · simp only [map_bind]
+    congr
+    funext b
+    rw [toArray_mapM_go]
+    rfl
+  · simp
+
+@[simp] theorem toArray_mapM [Monad m] [LawfulMonad m] (f : α → m β) (a : Vector α n) :
+    toArray <$> a.mapM f = a.toArray.mapM f := by
+  rcases a with ⟨a, rfl⟩
+  unfold mapM
+  rw [toArray_mapM_go]
+  rfl
+
 @[simp] theorem toArray_ofFn (f : Fin n → α) : (Vector.ofFn f).toArray = Array.ofFn f := rfl
 
 @[simp] theorem toArray_pop (a : Vector α n) : a.pop.toArray = a.toArray.pop := rfl
@@ -280,7 +334,7 @@ abbrev zipWithIndex_mk := @zipIdx_mk
     (a.zipIdx k).toArray = a.toArray.zipIdx k := rfl
 
 @[simp] theorem toArray_zipWith (f : α → β → γ) (a : Vector α n) (b : Vector β n) :
-    (Vector.zipWith a b f).toArray = Array.zipWith a.toArray b.toArray f := rfl
+    (Vector.zipWith f a b).toArray = Array.zipWith f a.toArray b.toArray := rfl
 
 @[simp] theorem anyM_toArray [Monad m] (p : α → m Bool) (v : Vector α n) :
     v.toArray.anyM p = v.anyM p := by
@@ -336,9 +390,6 @@ protected theorem ext {a b : Vector α n} (h : (i : Nat) → (_ : i < n) → a[i
   rcases v with ⟨v, h⟩
   exact ⟨by rintro rfl; simp_all, by rintro rfl; simpa using h⟩
 
-@[simp] theorem mem_toArray_iff (a : α) (v : Vector α n) : a ∈ v.toArray ↔ a ∈ v :=
-  ⟨fun h => ⟨h⟩, fun ⟨h⟩ => h⟩
-
 /-! ### toList -/
 
 theorem toArray_toList (a : Vector α n) : a.toArray.toList = a.toList := rfl
@@ -420,7 +471,7 @@ theorem toList_swap (a : Vector α n) (i j) (hi hj) :
   simp [List.take_of_length_le]
 
 @[simp] theorem toList_zipWith (f : α → β → γ) (a : Vector α n) (b : Vector β n) :
-    (Vector.zipWith a b f).toArray = Array.zipWith a.toArray b.toArray f := rfl
+    (Vector.zipWith f a b).toArray = Array.zipWith f a.toArray b.toArray := rfl
 
 @[simp] theorem anyM_toList [Monad m] (p : α → m Bool) (v : Vector α n) :
     v.toList.anyM p = v.anyM p := by
@@ -567,11 +618,11 @@ theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
 @[simp] theorem mkVector_inj : mkVector n a = mkVector n b ↔ n = 0 ∨ a = b := by
   simp [← toArray_inj, toArray_mkVector, Array.mkArray_inj]
 
-@[simp] theorem _root_.Array.toVector_mkArray (a : α) (n : Nat) :
-    (Array.mkArray n a).toVector = (mkVector n a).cast (by simp) := rfl
+@[simp] theorem _root_.Array.mk_mkArray (a : α) (n : Nat) (h : (mkArray n a).size = m) :
+    mk (Array.mkArray n a) h = (mkVector n a).cast (by simpa using h) := rfl
 
-theorem mkVector_eq_toVector_mkArray (a : α) (n : Nat) :
-    mkVector n a = (Array.mkArray n a).toVector.cast (by simp) := by
+theorem mkVector_eq_mk_mkArray (a : α) (n : Nat) :
+    mkVector n a = mk (mkArray n a) (by simp) := by
   simp
 
 /-! ## L[i] and L[i]? -/
@@ -779,6 +830,10 @@ theorem getElem_of_mem {a} {l : Vector α n} (h : a ∈ l) : ∃ (i : Nat) (h :
 theorem getElem?_of_mem {a} {l : Vector α n} (h : a ∈ l) : ∃ i : Nat, l[i]? = some a :=
   let ⟨n, _, e⟩ := getElem_of_mem h; ⟨n, e ▸ getElem?_eq_getElem _⟩
 
+theorem mem_of_getElem {l : Vector α n} {i : Nat} {h} {a : α} (e : l[i] = a) : a ∈ l := by
+  subst e
+  simp
+
 theorem mem_of_getElem? {l : Vector α n} {i : Nat} {a : α} (e : l[i]? = some a) : a ∈ l :=
   let ⟨_, e⟩ := getElem?_eq_some_iff.1 e; e ▸ getElem_mem ..
 
@@ -1134,7 +1189,7 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
       constructor
       · rintro ⟨a, ha⟩ ⟨b, hb⟩ h
         simp at h
-        obtain ⟨hs, hi⟩ := Array.rel_of_isEqv h
+        obtain ⟨hs, hi⟩ := Array.isEqv_iff_rel.mp h
         ext i h
         · simpa using hi _ (by omega)
       · rintro ⟨a, ha⟩
@@ -1655,11 +1710,6 @@ theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
 
 /-! ### flatMap -/
 
-@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α → Vector β n) :
-    (mk l h).flatMap f =
-      mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
-  simp [flatMap]
-
 @[simp] theorem flatMap_toArray (l : Vector α n) (f : α → Vector β m) :
     l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
   rcases l with ⟨l, rfl⟩
@@ -1749,6 +1799,7 @@ theorem mkVector_succ' : mkVector (n + 1) a = (#v[a] ++ mkVector n a).cast (by o
 
 @[simp] theorem mem_mkVector {a b : α} {n} : b ∈ mkVector n a ↔ n ≠ 0 ∧ b = a := by
   unfold mkVector
+  simp only [mem_mk]
   simp
 
 theorem eq_of_mem_mkVector {a b : α} {n} (h : b ∈ mkVector n a) : b = a := (mem_mkVector.1 h).2
@@ -1758,7 +1809,8 @@ theorem forall_mem_mkVector {p : α → Prop} {a : α} {n} :
   cases n <;> simp [mem_mkVector]
 
 @[simp] theorem getElem_mkVector (a : α) (n i : Nat) (h : i < n) : (mkVector n a)[i] = a := by
-  simp [mkVector]
+  rw [mkVector_eq_mk_mkArray, getElem_mk]
+  simp
 
 theorem getElem?_mkVector (a : α) (n i : Nat) : (mkVector n a)[i]? = if i < n then some a else none := by
   simp [getElem?_def]
@@ -2139,10 +2191,6 @@ theorem foldr_rel {l : Array α} {f g : α → β → β} {a b : β} (r : β →
 
 /-! Content below this point has not yet been aligned with `List` and `Array`. -/
 
-@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
-    (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
-  simp [ofFn]
-
 @[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
   rcases v with ⟨data, rfl⟩
   simp
@@ -2170,7 +2218,7 @@ defeq issues in the implicit size argument.
 /-! ### zipWith -/
 
 @[simp] theorem getElem_zipWith (f : α → β → γ) (a : Vector α n) (b : Vector β n) (i : Nat)
-    (hi : i < n) : (zipWith a b f)[i] = f a[i] b[i] := by
+    (hi : i < n) : (zipWith f a b)[i] = f a[i] b[i] := by
   cases a
   cases b
   simp

src/Init/Data/Vector/MapIdx.lean

@@ -59,7 +59,7 @@ namespace Vector
   simp
 
 @[simp] theorem getElem_zipIdx (a : Vector α n) (i : Nat) (h : i < n) :
-    (a.zipIdx k)[i] = (a[i]'(by simp_all), i + k) := by
+    (a.zipIdx k)[i] = (a[i]'(by simp_all), k + i) := by
   rcases a with ⟨a, rfl⟩
   simp
 

src/Init/Data/Vector/Monadic.lean

@@ -0,0 +1,217 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Vector.Lemmas
+import Init.Data.Vector.Attach
+import Init.Data.Array.Monadic
+import Init.Control.Lawful.Lemmas
+
+/-!
+# Lemmas about `Vector.forIn'` and `Vector.forIn`.
+-/
+
+namespace Vector
+
+open Nat
+
+/-! ## Monadic operations -/
+
+theorem map_toArray_inj [Monad m] [LawfulMonad m] [Nonempty α]
+    {v₁ : m (Vector α n)} {v₂ : m (Vector α n)} (w : toArray <$> v₁ = toArray <$> v₂) :
+    v₁ = v₂ := by
+  apply map_inj_of_inj ?_ w
+  simp
+
+/-! ### mapM -/
+
+@[congr] theorem mapM_congr [Monad m] {as bs : Vector α n} (w : as = bs)
+    {f : α → m β} :
+    as.mapM f = bs.mapM f := by
+  subst w
+  simp
+
+@[simp] theorem mapM_mk_empty [Monad m] (f : α → m β)  :
+    (mk #[] rfl).mapM f = pure #v[] := by
+  unfold mapM
+  unfold mapM.go
+  simp
+
+-- The `[Nonempty β]` hypothesis should be avoidable by unfolding `mapM` directly.
+@[simp] theorem mapM_append [Monad m] [LawfulMonad m] [Nonempty β]
+    (f : α → m β) {l₁ : Vector α n} {l₂ : Vector α n'} :
+    (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by
+  apply map_toArray_inj
+  suffices toArray <$> (l₁ ++ l₂).mapM f = (return (← toArray <$> l₁.mapM f) ++ (← toArray <$> l₂.mapM f)) by
+    rw [this]
+    simp only [bind_pure_comp, Functor.map_map, bind_map_left, map_bind, toArray_append]
+  simp
+
+/-! ### foldlM and foldrM -/
+
+theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : Vector β₁ n) (init : α) :
+    (l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldlM_map]
+
+theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : Vector β₁ n)
+    (init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldrM_map]
+
+theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : γ → β → m γ) (l : Vector α n) (init : γ) :
+    (l.filterMap f).foldlM g init =
+      l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldlM_filterMap]
+  rfl
+
+theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α → Option β) (g : β → γ → m γ) (l : Vector α n) (init : γ) :
+    (l.filterMap f).foldrM g init =
+      l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldrM_filterMap]
+  rfl
+
+theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : β → α → m β) (l : Vector α n) (init : β) :
+    (l.filter p).foldlM g init =
+      l.foldlM (fun x y => if p y then g x y else pure x) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldlM_filter]
+
+theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β → m β) (l : Vector α n) (init : β) :
+    (l.filter p).foldrM g init =
+      l.foldrM (fun x y => if p x then g x y else pure y) init := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldrM_filter]
+
+@[simp] theorem foldlM_attachWith [Monad m]
+    (l : Vector α n) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : β → { x // q x} → m β} {b} :
+    (l.attachWith q H).foldlM f b = l.attach.foldlM (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldlM_map]
+
+@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
+    (l : Vector α n) {q : α → Prop} (H : ∀ a, a ∈ l → q a) {f : { x // q x} → β → m β} {b} :
+    (l.attachWith q H).foldrM f b = l.attach.foldrM (fun a acc => f ⟨a.1, H _ a.2⟩ acc) b := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.foldrM_map]
+
+/-! ### forM -/
+
+@[congr] theorem forM_congr [Monad m] {as bs : Vector α n} (w : as = bs)
+    {f : α → m PUnit} :
+    forM as f = forM bs f := by
+  cases as <;> cases bs
+  simp_all
+
+@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ : Vector α n) (l₂ : Vector α n') (f : α → m PUnit) :
+    forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, rfl⟩
+  simp
+
+@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Vector α n) (g : α → β) (f : β → m PUnit) :
+    forM (l.map g) f = forM l (fun a => f (g a)) := by
+  cases l
+  simp
+
+/-! ### forIn' -/
+
+@[congr] theorem forIn'_congr [Monad m] {as bs : Vector α n} (w : as = bs)
+    {b b' : β} (hb : b = b')
+    {f : (a' : α) → a' ∈ as → β → m (ForInStep β)}
+    {g : (a' : α) → a' ∈ bs → β → m (ForInStep β)}
+    (h : ∀ a m b, f a (by simpa [w] using m) b = g a m b) :
+    forIn' as b f = forIn' bs b' g := by
+  cases as <;> cases bs
+  simp only [eq_mk, mem_mk, forIn'_mk] at w h ⊢
+  exact Array.forIn'_congr w hb h
+
+/--
+We can express a for loop over a vector as a fold,
+in which whenever we reach `.done b` we keep that value through the rest of the fold.
+-/
+theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
+    (l : Vector α n) (f : (a : α) → a ∈ l → β → m (ForInStep β)) (init : β) :
+    forIn' l init f = ForInStep.value <$>
+      l.attach.foldlM (fun b ⟨a, m⟩ => match b with
+        | .yield b => f a m b
+        | .done b => pure (.done b)) (ForInStep.yield init) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.forIn'_eq_foldlM]
+  rfl
+
+/-- We can express a for loop over a vector which always yields as a fold. -/
+@[simp] theorem forIn'_yield_eq_foldlM [Monad m] [LawfulMonad m]
+    (l : Vector α n) (f : (a : α) → a ∈ l → β → m γ) (g : (a : α) → a ∈ l → β → γ → β) (init : β) :
+    forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
+      l.attach.foldlM (fun b ⟨a, m⟩ => g a m b <$> f a m b) init := by
+  rcases l with ⟨l, rfl⟩
+  simp
+
+theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
+    (l : Vector α n) (f : (a : α) → a ∈ l → β → β) (init : β) :
+    forIn' l init (fun a m b => pure (.yield (f a m b))) =
+      pure (f := m) (l.attach.foldl (fun b ⟨a, h⟩ => f a h b) init) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.forIn'_pure_yield_eq_foldl, Array.foldl_map]
+
+@[simp] theorem forIn'_yield_eq_foldl
+    (l : Vector α n) (f : (a : α) → a ∈ l → β → β) (init : β) :
+    forIn' (m := Id) l init (fun a m b => .yield (f a m b)) =
+      l.attach.foldl (fun b ⟨a, h⟩ => f a h b) init := by
+  cases l
+  simp [List.foldl_map]
+
+@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
+    (l : Vector α n) (g : α → β) (f : (b : β) → b ∈ l.map g → γ → m (ForInStep γ)) :
+    forIn' (l.map g) init f = forIn' l init fun a h y => f (g a) (mem_map_of_mem g h) y := by
+  cases l
+  simp
+
+/--
+We can express a for loop over a vector as a fold,
+in which whenever we reach `.done b` we keep that value through the rest of the fold.
+-/
+theorem forIn_eq_foldlM [Monad m] [LawfulMonad m]
+    (f : α → β → m (ForInStep β)) (init : β) (l : Vector α n) :
+    forIn l init f = ForInStep.value <$>
+      l.foldlM (fun b a => match b with
+        | .yield b => f a b
+        | .done b => pure (.done b)) (ForInStep.yield init) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.forIn_eq_foldlM]
+  rfl
+
+/-- We can express a for loop over a vector which always yields as a fold. -/
+@[simp] theorem forIn_yield_eq_foldlM [Monad m] [LawfulMonad m]
+    (l : Vector α n) (f : α → β → m γ) (g : α → β → γ → β) (init : β) :
+    forIn l init (fun a b => (fun c => .yield (g a b c)) <$> f a b) =
+      l.foldlM (fun b a => g a b <$> f a b) init := by
+  cases l
+  simp
+
+theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
+    (l : Vector α n) (f : α → β → β) (init : β) :
+    forIn l init (fun a b => pure (.yield (f a b))) =
+      pure (f := m) (l.foldl (fun b a => f a b) init) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.forIn_pure_yield_eq_foldl, Array.foldl_map]
+
+@[simp] theorem forIn_yield_eq_foldl
+    (l : Vector α n) (f : α → β → β) (init : β) :
+    forIn (m := Id) l init (fun a b => .yield (f a b)) =
+      l.foldl (fun b a => f a b) init := by
+  cases l
+  simp
+
+@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
+    (l : Vector α n) (g : α → β) (f : β → γ → m (ForInStep γ)) :
+    forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
+  cases l
+  simp
+
+end Vector

src/Init/Data/Vector/OfFn.lean

@@ -0,0 +1,37 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Vector.Lemmas
+import Init.Data.Array.OfFn
+
+/-!
+# Theorems about `Vector.ofFn`
+-/
+
+namespace Vector
+
+@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
+    (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
+  simp [ofFn]
+
+theorem getElem?_ofFn (f : Fin n → α) (i : Nat) :
+    (ofFn f)[i]? = if h : i < n then some (f ⟨i, h⟩) else none := by
+  simp [getElem?_def]
+
+@[simp 500]
+theorem mem_ofFn {n} (f : Fin n → α) (a : α) : a ∈ ofFn f ↔ ∃ i, f i = a := by
+  constructor
+  · intro w
+    obtain ⟨i, h, rfl⟩ := getElem_of_mem w
+    exact ⟨⟨i, by simpa using h⟩, by simp⟩
+  · rintro ⟨i, rfl⟩
+    apply mem_of_getElem (i := i) <;> simp
+
+theorem back_ofFn {n} [NeZero n](f : Fin n → α) :
+    (ofFn f).back = f ⟨n - 1, by have := NeZero.ne n; omega⟩ := by
+  simp [back]
+
+end Vector

src/Init/Data/Vector/Range.lean

@@ -0,0 +1,271 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Vector.Lemmas
+import Init.Data.Vector.Zip
+import Init.Data.Vector.MapIdx
+import Init.Data.Array.Range
+
+/-!
+# Lemmas about `Vector.range'`, `Vector.range`, and `Vector.zipIdx`
+
+-/
+
+namespace Vector
+
+open Nat
+
+/-! ## Ranges and enumeration -/
+
+/-! ### range' -/
+
+@[simp] theorem toArray_range' (start size step) :
+    (range' start size step).toArray = Array.range' start size step := by
+  rfl
+
+theorem range'_eq_mk_range' (start size step) :
+    range' start size step = Vector.mk (Array.range' start size step) (by simp) := by
+  rfl
+
+@[simp] theorem getElem_range' (start size step i) (h : i < size) :
+   (range' start size step)[i] = start + step * i := by
+  simp [range', h]
+
+@[simp] theorem getElem?_range' (start size step i) :
+   (range' start size step)[i]? = if i < size then some (start + step * i) else none := by
+  simp [getElem?_def, range']
+
+theorem range'_succ (s n step) :
+    range' s (n + 1) step = (#v[s] ++ range' (s + step) n step).cast (by omega) := by
+  rw [← toArray_inj]
+  simp [Array.range'_succ]
+
+theorem range'_zero : range' s 0 step = #v[] := by
+  simp
+
+@[simp] theorem range'_one {s step : Nat} : range' s 1 step = #v[s] := rfl
+
+@[simp] theorem range'_inj : range' s n = range' s' n ↔ (n = 0 ∨ s = s') := by
+  rw [← toArray_inj]
+  simp [List.range'_inj]
+
+theorem mem_range' {n} : m ∈ range' s n step ↔ ∃ i < n, m = s + step * i := by
+  simp [range', Array.mem_range']
+
+theorem pop_range' : (range' s n step).pop = range' s (n - 1) step := by
+  ext <;> simp
+
+theorem map_add_range' (a) (s n step) : map (a + ·) (range' s n step) = range' (a + s) n step := by
+  ext <;> simp <;> omega
+
+theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1) := by
+  ext <;> simp <;> omega
+
+theorem range'_append (s m n step : Nat) :
+    range' s m step ++ range' (s + step * m) n step = range' s (m + n) step := by
+  rw [← toArray_inj]
+  simp [Array.range'_append]
+
+@[simp] theorem range'_append_1 (s m n : Nat) :
+    range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
+
+theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ #v[s + step * n] := by
+  exact (range'_append s n 1 step).symm
+
+theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ #v[s + n] := by
+  simp [range'_concat]
+
+@[simp] theorem mem_range'_1 : m ∈ range' s n ↔ s ≤ m ∧ m < s + n := by
+  simp [mem_range']; exact ⟨
+    fun ⟨i, h, e⟩ => e ▸ ⟨Nat.le_add_right .., Nat.add_lt_add_left h _⟩,
+    fun ⟨h₁, h₂⟩ => ⟨m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm⟩⟩
+
+theorem map_sub_range' (a s n : Nat) (h : a ≤ s) :
+    map (· - a) (range' s n step) = range' (s - a) n step := by
+  conv => lhs; rw [← Nat.add_sub_cancel' h]
+  rw [← map_add_range', map_map, (?_ : _∘_ = _), map_id]
+  funext x; apply Nat.add_sub_cancel_left
+
+theorem range'_eq_append_iff : range' s (n + m) = xs ++ ys ↔ xs = range' s n ∧ ys = range' (s + n) m := by
+  simp only [← toArray_inj, toArray_range', toArray_append, Array.range'_eq_append_iff]
+  constructor
+  · rintro ⟨k, hk, h₁, h₂⟩
+    have w : k = n := by
+      replace h₁ := congrArg Array.size h₁
+      simp_all
+    subst w
+    simp_all
+    omega
+  · rintro ⟨h₁, h₂⟩
+    exact ⟨n, by omega, by simp_all; omega⟩
+
+@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat → Bool} :
+    (range' s n).find? p = some i ↔ p i ∧ i ∈ range' s n ∧ ∀ j, s ≤ j → j < i → !p j := by
+  simp [range'_eq_mk_range']
+
+@[simp] theorem find?_range'_eq_none {s n : Nat} {p : Nat → Bool} :
+    (range' s n).find? p = none ↔ ∀ i, s ≤ i → i < s + n → !p i := by
+  simp [range'_eq_mk_range']
+
+/-! ### range -/
+
+theorem range_eq_range' (n : Nat) : range n = range' 0 n := by
+  simp [range, range', Array.range_eq_range']
+
+theorem range_succ_eq_map (n : Nat) : range (n + 1) =
+    (#v[0] ++ map succ (range n)).cast (by omega) := by
+  rw [← toArray_inj]
+  simp [Array.range_succ_eq_map]
+
+theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) := by
+  rw [range_eq_range', map_add_range']; rfl
+
+theorem range_succ (n : Nat) : range (succ n) = range n ++ #v[n] := by
+  rw [← toArray_inj]
+  simp [Array.range_succ]
+
+theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·) := by
+  rw [← range'_eq_map_range]
+  simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm
+
+theorem reverse_range' (s n : Nat) : reverse (range' s n) = map (s + n - 1 - ·) (range n) := by
+  simp [← toList_inj, List.reverse_range']
+
+@[simp]
+theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by
+  simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add]
+
+theorem not_mem_range_self {n : Nat} : n ∉ range n := by simp
+
+theorem self_mem_range_succ (n : Nat) : n ∈ range (n + 1) := by simp
+
+@[simp] theorem take_range (m n : Nat) : take (range n) m = range (min m n) := by
+  ext <;> simp
+  erw [getElem_extract] -- Why is an `erw` needed here? This should be by simp!
+  simp
+
+@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
+    (range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
+  simp [range_eq_range']
+
+@[simp] theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
+    (range n).find? p = none ↔ ∀ i, i < n → !p i := by
+  simp [range_eq_range']
+
+/-! ### zipIdx -/
+
+@[simp]
+theorem getElem?_zipIdx (l : Vector α n) (n m) : (zipIdx l n)[m]? = l[m]?.map fun a => (a, n + m) := by
+  simp [getElem?_def]
+
+theorem map_snd_add_zipIdx_eq_zipIdx (l : Vector α n) (m k : Nat) :
+    map (Prod.map id (· + m)) (zipIdx l k) = zipIdx l (m + k) := by
+  ext <;> simp <;> omega
+
+@[simp]
+theorem zipIdx_map_snd (m) (l : Vector α n) : map Prod.snd (zipIdx l m) = range' m n := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.zipIdx_map_snd]
+
+@[simp]
+theorem zipIdx_map_fst (m) (l : Vector α n) : map Prod.fst (zipIdx l m) = l := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.zipIdx_map_fst]
+
+theorem zipIdx_eq_zip_range' (l : Vector α n) : l.zipIdx m = l.zip (range' m n) := by
+  simp [zip_of_prod (zipIdx_map_fst _ _) (zipIdx_map_snd _ _)]
+
+@[simp]
+theorem unzip_zipIdx_eq_prod (l : Vector α n) {m : Nat} :
+    (l.zipIdx m).unzip = (l, range' m n) := by
+  simp only [zipIdx_eq_zip_range', unzip_zip]
+
+/-- Replace `zipIdx` with a starting index `m+1` with `zipIdx` starting from `m`,
+followed by a `map` increasing the indices by one. -/
+theorem zipIdx_succ (l : Vector α n) (m : Nat) :
+    l.zipIdx (m + 1) = (l.zipIdx m).map (fun ⟨a, i⟩ => (a, i + 1)) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.zipIdx_succ]
+
+/-- Replace `zipIdx` with a starting index with `zipIdx` starting from 0,
+followed by a `map` increasing the indices. -/
+theorem zipIdx_eq_map_add (l : Vector α n) (m : Nat) :
+    l.zipIdx m = l.zipIdx.map (fun ⟨a, i⟩ => (a, m + i)) := by
+  rcases l with ⟨l, rfl⟩
+  simp only [zipIdx_mk, map_mk, eq_mk]
+  rw [Array.zipIdx_eq_map_add]
+
+@[simp]
+theorem zipIdx_singleton (x : α) (k : Nat) : zipIdx #v[x] k = #v[(x, k)] :=
+  rfl
+
+theorem mk_add_mem_zipIdx_iff_getElem? {k i : Nat} {x : α} {l : Vector α n} :
+    (x, k + i) ∈ zipIdx l k ↔ l[i]? = some x := by
+  simp [mem_iff_getElem?, and_left_comm]
+
+theorem le_snd_of_mem_zipIdx {x : α × Nat} {k : Nat} {l : Vector α n} (h : x ∈ zipIdx l k) :
+    k ≤ x.2 :=
+  (mk_mem_zipIdx_iff_le_and_getElem?_sub.1 h).1
+
+theorem snd_lt_add_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x ∈ zipIdx l k) :
+    x.2 < k + n := by
+  rcases mem_iff_getElem.1 h with ⟨i, h', rfl⟩
+  simpa using h'
+
+theorem snd_lt_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x ∈ l.zipIdx k) :
+    x.2 < n + k := by
+  simpa [Nat.add_comm] using snd_lt_add_of_mem_zipIdx h
+
+theorem map_zipIdx (f : α → β) (l : Vector α n) (k : Nat) :
+    map (Prod.map f id) (zipIdx l k) = zipIdx (l.map f) k := by
+  cases l
+  simp [Array.map_zipIdx]
+
+theorem fst_mem_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x ∈ zipIdx l k) : x.1 ∈ l :=
+  zipIdx_map_fst k l ▸ mem_map_of_mem _ h
+
+theorem fst_eq_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x ∈ zipIdx l k) :
+    x.1 = l[x.2 - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) := by
+  cases l
+  exact Array.fst_eq_of_mem_zipIdx (by simpa using h)
+
+theorem mem_zipIdx {x : α} {i : Nat} {xs : Vector α n} {k : Nat} (h : (x, i) ∈ xs.zipIdx k) :
+    k ≤ i ∧ i < k + n ∧
+      x = xs[i - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
+  ⟨le_snd_of_mem_zipIdx h, snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h⟩
+
+/-- Variant of `mem_zipIdx` specialized at `k = 0`. -/
+theorem mem_zipIdx' {x : α} {i : Nat} {xs : Vector α n} (h : (x, i) ∈ xs.zipIdx) :
+    i < n ∧ x = xs[i]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
+  ⟨by simpa using snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h⟩
+
+theorem zipIdx_map (l : Vector α n) (k : Nat) (f : α → β) :
+    zipIdx (l.map f) k = (zipIdx l k).map (Prod.map f id) := by
+  cases l
+  simp [Array.zipIdx_map]
+
+theorem zipIdx_append (xs : Vector α n) (ys : Vector α m) (k : Nat) :
+    zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + n) := by
+  rcases xs with ⟨xs, rfl⟩
+  rcases ys with ⟨ys, rfl⟩
+  simp [Array.zipIdx_append]
+
+theorem zipIdx_eq_append_iff {l : Vector α (n + m)} {k : Nat} :
+    zipIdx l k = l₁ ++ l₂ ↔
+      ∃ (l₁' : Vector α n) (l₂' : Vector α m),
+        l = l₁' ++ l₂' ∧ l₁ = zipIdx l₁' k ∧ l₂ = zipIdx l₂' (k + n) := by
+  rcases l with ⟨l, h⟩
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, rfl⟩
+  simp only [zipIdx_mk, mk_append_mk, eq_mk, Array.zipIdx_eq_append_iff, mk_eq, toArray_append,
+    toArray_zipIdx]
+  constructor
+  · rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
+    exact ⟨⟨l₁', by simp⟩, ⟨l₂', by simp⟩, by simp⟩
+  · rintro ⟨⟨l₁', h₁⟩, ⟨l₂', h₂⟩, rfl, w₁, w₂⟩
+    exact ⟨l₁', l₂', by simp, w₁, by simp [h₁, w₂]⟩
+
+end Vector

src/Init/Data/Vector/Zip.lean

@@ -0,0 +1,287 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Zip
+import Init.Data.Vector.Lemmas
+
+/-!
+# Lemmas about `Vector.zip`, `Vector.zipWith`, `Vector.zipWithAll`, and `Vector.unzip`.
+-/
+
+namespace Vector
+
+open Nat
+
+/-! ## Zippers -/
+
+/-! ### zipWith -/
+
+theorem zipWith_comm (f : α → β → γ) (la : Vector α n) (lb : Vector β n) :
+    zipWith f la lb = zipWith (fun b a => f a b) lb la := by
+  rcases la with ⟨la, rfl⟩
+  rcases lb with ⟨lb, h⟩
+  simpa using Array.zipWith_comm _ _ _
+
+theorem zipWith_comm_of_comm (f : α → α → β) (comm : ∀ x y : α, f x y = f y x) (l l' : Vector α n) :
+    zipWith f l l' = zipWith f l' l := by
+  rw [zipWith_comm]
+  simp only [comm]
+
+@[simp]
+theorem zipWith_self (f : α → α → δ) (l : Vector α n) : zipWith f l l = l.map fun a => f a a := by
+  cases l
+  simp
+
+/--
+See also `getElem?_zipWith'` for a variant
+using `Option.map` and `Option.bind` rather than a `match`.
+-/
+theorem getElem?_zipWith {f : α → β → γ} {i : Nat} :
+    (zipWith f as bs)[i]? = match as[i]?, bs[i]? with
+      | some a, some b => some (f a b) | _, _ => none := by
+  cases as
+  cases bs
+  simp [Array.getElem?_zipWith]
+  rfl
+
+/-- Variant of `getElem?_zipWith` using `Option.map` and `Option.bind` rather than a `match`. -/
+theorem getElem?_zipWith' {f : α → β → γ} {i : Nat} :
+    (zipWith f l₁ l₂)[i]? = (l₁[i]?.map f).bind fun g => l₂[i]?.map g := by
+  cases l₁
+  cases l₂
+  simp [Array.getElem?_zipWith']
+
+theorem getElem?_zipWith_eq_some {f : α → β → γ} {l₁ : Vector α n} {l₂ : Vector β n} {z : γ} {i : Nat} :
+    (zipWith f l₁ l₂)[i]? = some z ↔
+      ∃ x y, l₁[i]? = some x ∧ l₂[i]? = some y ∧ f x y = z := by
+  cases l₁
+  cases l₂
+  simp [Array.getElem?_zipWith_eq_some]
+
+theorem getElem?_zip_eq_some {l₁ : Vector α n} {l₂ : Vector β n} {z : α × β} {i : Nat} :
+    (zip l₁ l₂)[i]? = some z ↔ l₁[i]? = some z.1 ∧ l₂[i]? = some z.2 := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.getElem?_zip_eq_some]
+
+@[simp]
+theorem zipWith_map {μ} (f : γ → δ → μ) (g : α → γ) (h : β → δ) (l₁ : Vector α n) (l₂ : Vector β n) :
+    zipWith f (l₁.map g) (l₂.map h) = zipWith (fun a b => f (g a) (h b)) l₁ l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.zipWith_map]
+
+theorem zipWith_map_left (l₁ : Vector α n) (l₂ : Vector β n) (f : α → α') (g : α' → β → γ) :
+    zipWith g (l₁.map f) l₂ = zipWith (fun a b => g (f a) b) l₁ l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.zipWith_map_left]
+
+theorem zipWith_map_right (l₁ : Vector α n) (l₂ : Vector β n) (f : β → β') (g : α → β' → γ) :
+    zipWith g l₁ (l₂.map f) = zipWith (fun a b => g a (f b)) l₁ l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.zipWith_map_right]
+
+theorem zipWith_foldr_eq_zip_foldr {f : α → β → γ} (i : δ):
+    (zipWith f l₁ l₂).foldr g i = (zip l₁ l₂).foldr (fun p r => g (f p.1 p.2) r) i := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simpa using Array.zipWith_foldr_eq_zip_foldr _
+
+theorem zipWith_foldl_eq_zip_foldl {f : α → β → γ} (i : δ):
+    (zipWith f l₁ l₂).foldl g i = (zip l₁ l₂).foldl (fun r p => g r (f p.1 p.2)) i := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simpa using Array.zipWith_foldl_eq_zip_foldl _
+
+
+theorem map_zipWith {δ : Type _} (f : α → β) (g : γ → δ → α) (l : Vector γ n) (l' : Vector δ n) :
+    map f (zipWith g l l') = zipWith (fun x y => f (g x y)) l l' := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.map_zipWith]
+
+theorem take_zipWith : (zipWith f l l').take n = zipWith f (l.take n) (l'.take n) := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.take_zipWith]
+
+theorem extract_zipWith : (zipWith f l l').extract m n = zipWith f (l.extract m n) (l'.extract m n) := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.extract_zipWith]
+
+theorem zipWith_append (f : α → β → γ)
+    (l : Vector α n) (la : Vector α m) (l' : Vector β n) (lb : Vector β m) :
+    zipWith f (l ++ la) (l' ++ lb) = zipWith f l l' ++ zipWith f la lb := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  rcases la with ⟨la, rfl⟩
+  rcases lb with ⟨lb, h'⟩
+  simp [Array.zipWith_append, *]
+
+theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : Vector α (n + m)} {l₂ : Vector β (n + m)} :
+    zipWith f l₁ l₂ = l₁' ++ l₂' ↔
+      ∃ w x y z, l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zipWith f w y ∧ l₂' = zipWith f x z := by
+  rcases l₁ with ⟨l₁, h₁⟩
+  rcases l₂ with ⟨l₂, h₂⟩
+  rcases l₁' with ⟨l₁', rfl⟩
+  rcases l₂' with ⟨l₂', rfl⟩
+  simp only [mk_zipWith_mk, mk_append_mk, eq_mk, Array.zipWith_eq_append_iff,
+    mk_eq, toArray_append, toArray_zipWith]
+  constructor
+  · rintro ⟨w, x, y, z, h, rfl, rfl, rfl, rfl⟩
+    simp only [Array.size_append, Array.size_zipWith] at h₁ h₂
+    exact ⟨mk w (by simp; omega), mk x (by simp; omega), mk y (by simp; omega), mk z (by simp; omega), by simp⟩
+  · rintro ⟨⟨w, hw⟩, ⟨x, hx⟩, ⟨y, hy⟩, ⟨z, hz⟩, rfl, rfl, w₁, w₂⟩
+    simp only at w₁ w₂
+    exact ⟨w, x, y, z, by simpa [hw, hy] using ⟨w₁, w₂⟩⟩
+
+@[simp] theorem zipWith_mkVector {a : α} {b : β} {n : Nat} :
+    zipWith f (mkVector n a) (mkVector n b) = mkVector n (f a b) := by
+  ext
+  simp
+
+theorem map_uncurry_zip_eq_zipWith (f : α → β → γ) (l : Vector α n) (l' : Vector β n) :
+    map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.map_uncurry_zip_eq_zipWith]
+
+theorem map_zip_eq_zipWith (f : α × β → γ) (l : Vector α n) (l' : Vector β n) :
+    map f (l.zip l') = zipWith (Function.curry f) l l' := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.map_zip_eq_zipWith]
+
+theorem reverse_zipWith :
+    (zipWith f l l').reverse = zipWith f l.reverse l'.reverse := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h⟩
+  simp [Array.reverse_zipWith, h]
+
+/-! ### zip -/
+
+@[simp]
+theorem getElem_zip {l : Vector α n} {l' : Vector β n} {i : Nat} {h : i < n} :
+    (zip l l')[i] = (l[i], l'[i]) :=
+  getElem_zipWith ..
+
+theorem zip_eq_zipWith (l₁ : Vector α n) (l₂ : Vector β n) : zip l₁ l₂ = zipWith Prod.mk l₁ l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.zip_eq_zipWith, h]
+
+theorem zip_map (f : α → γ) (g : β → δ) (l₁ : Vector α n) (l₂ : Vector β n) :
+    zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g) := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.zip_map, h]
+
+theorem zip_map_left (f : α → γ) (l₁ : Vector α n) (l₂ : Vector β n) :
+    zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]
+
+theorem zip_map_right (f : β → γ) (l₁ : Vector α n) (l₂ : Vector β n) :
+    zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [← zip_map, map_id]
+
+theorem zip_append {l₁ : Vector α n} {l₂ : Vector β n} {r₁ : Vector α m} {r₂ : Vector β m} :
+    zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  rcases r₁ with ⟨r₁, rfl⟩
+  rcases r₂ with ⟨r₂, h'⟩
+  simp [Array.zip_append, h, h']
+
+theorem zip_map' (f : α → β) (g : α → γ) (l : Vector α n) :
+    zip (l.map f) (l.map g) = l.map fun a => (f a, g a) := by
+  rcases l with ⟨l, rfl⟩
+  simp [Array.zip_map']
+
+theorem of_mem_zip {a b} {l₁ : Vector α n} {l₂ : Vector β n} : (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simpa using Array.of_mem_zip
+
+theorem map_fst_zip (l₁ : Vector α n) (l₂ : Vector β n) :
+    map Prod.fst (zip l₁ l₂) = l₁ := by
+  cases l₁
+  cases l₂
+  simp_all [Array.map_fst_zip]
+
+theorem map_snd_zip (l₁ : Vector α n) (l₂ : Vector β n) :
+    map Prod.snd (zip l₁ l₂) = l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.map_snd_zip, h]
+
+theorem map_prod_left_eq_zip {l : Vector α n} (f : α → β) :
+    (l.map fun x => (x, f x)) = l.zip (l.map f) := by
+  rcases l with ⟨l, rfl⟩
+  rw [← zip_map']
+  congr
+  simp
+
+theorem map_prod_right_eq_zip {l : Vector α n} (f : α → β) :
+    (l.map fun x => (f x, x)) = (l.map f).zip l := by
+  rcases l with ⟨l, rfl⟩
+  rw [← zip_map']
+  congr
+  simp
+
+theorem zip_eq_append_iff {l₁ : Vector α (n + m)} {l₂ : Vector β (n + m)} {l₁' : Vector (α × β) n} {l₂' : Vector (α × β) m} :
+    zip l₁ l₂ = l₁' ++ l₂' ↔
+      ∃ w x y z, l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zip w y ∧ l₂' = zip x z := by
+  simp [zip_eq_zipWith, zipWith_eq_append_iff]
+
+@[simp] theorem zip_mkVector {a : α} {b : β} {n : Nat} :
+    zip (mkVector n a) (mkVector n b) = mkVector n (a, b) := by
+  ext <;> simp
+
+
+/-! ### unzip -/
+
+@[simp] theorem unzip_fst : (unzip l).fst = l.map Prod.fst := by
+  induction l <;> simp_all
+
+@[simp] theorem unzip_snd : (unzip l).snd = l.map Prod.snd := by
+  induction l <;> simp_all
+
+theorem unzip_eq_map (l : Vector (α × β) n) : unzip l = (l.map Prod.fst, l.map Prod.snd) := by
+  cases l
+  simp [List.unzip_eq_map]
+
+theorem zip_unzip (l : Vector (α × β) n) : zip (unzip l).1 (unzip l).2 = l := by
+  rcases l with ⟨l, rfl⟩
+  simp only [unzip_mk, mk_zip_mk, Array.zip_unzip]
+
+theorem unzip_zip_left {l₁ : Vector α n} {l₂ : Vector β n}  :
+    (unzip (zip l₁ l₂)).1 = l₁ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.unzip_zip_left, h, Array.map_fst_zip]
+
+theorem unzip_zip_right {l₁ : Vector α n} {l₂ : Vector β n} :
+    (unzip (zip l₁ l₂)).2 = l₂ := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.unzip_zip_right, h, Array.map_snd_zip]
+
+theorem unzip_zip {l₁ : Vector α n} {l₂ : Vector β n} :
+    unzip (zip l₁ l₂) = (l₁, l₂) := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, h⟩
+  simp [Array.unzip_zip, h, Array.map_fst_zip, Array.map_snd_zip]
+
+theorem zip_of_prod {l : Vector α n} {l' : Vector β n} {lp : Vector (α × β) n} (hl : lp.map Prod.fst = l)
+    (hr : lp.map Prod.snd = l') : lp = l.zip l' := by
+  rw [← hl, ← hr, ← zip_unzip lp, ← unzip_fst, ← unzip_snd, zip_unzip, zip_unzip]
+
+@[simp] theorem unzip_mkVector {n : Nat} {a : α} {b : β} :
+    unzip (mkVector n (a, b)) = (mkVector n a, mkVector n b) := by
+  ext1 <;> simp
+
+end Vector

src/Init/Grind/Lemmas.lean

@@ -69,6 +69,37 @@ theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by s
 theorem eq_congr  {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
 theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
 
+/-! Bool.and -/
+
+theorem Bool.and_eq_of_eq_true_left {a b : Bool} (h : a = true) : (a && b) = b := by simp [h]
+theorem Bool.and_eq_of_eq_true_right {a b : Bool} (h : b = true) : (a && b) = a := by simp [h]
+theorem Bool.and_eq_of_eq_false_left {a b : Bool} (h : a = false) : (a && b) = false := by simp [h]
+theorem Bool.and_eq_of_eq_false_right {a b : Bool} (h : b = false) : (a && b) = false := by simp [h]
+
+theorem Bool.eq_true_of_and_eq_true_left {a b : Bool} (h : (a && b) = true) : a = true := by simp_all
+theorem Bool.eq_true_of_and_eq_true_right {a b : Bool} (h : (a && b) = true) : b = true := by simp_all
+
+/-! Bool.or -/
+
+theorem Bool.or_eq_of_eq_true_left {a b : Bool} (h : a = true) : (a || b) = true := by simp [h]
+theorem Bool.or_eq_of_eq_true_right {a b : Bool} (h : b = true) : (a || b) = true := by simp [h]
+theorem Bool.or_eq_of_eq_false_left {a b : Bool} (h : a = false) : (a || b) = b := by simp [h]
+theorem Bool.or_eq_of_eq_false_right {a b : Bool} (h : b = false) : (a || b) = a := by simp [h]
+theorem Bool.eq_false_of_or_eq_false_left {a b : Bool} (h : (a || b) = false) : a = false := by
+  cases a <;> simp_all
+theorem Bool.eq_false_of_or_eq_false_right {a b : Bool} (h : (a || b) = false) : b = false := by
+  cases a <;> simp_all
+
+/-! Bool.not -/
+
+theorem Bool.not_eq_of_eq_true {a : Bool} (h : a = true) : (!a) = false := by simp [h]
+theorem Bool.not_eq_of_eq_false {a : Bool} (h : a = false) : (!a) = true := by simp [h]
+theorem Bool.eq_false_of_not_eq_true {a : Bool} (h : (!a) = true) : a = false := by simp_all
+theorem Bool.eq_true_of_not_eq_false {a : Bool} (h : (!a) = false) : a = true := by simp_all
+
+theorem Bool.false_of_not_eq_self {a : Bool} (h : (!a) = a) : False := by
+  by_cases a <;> simp_all
+
 /- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
 theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a ∨ b) ∧ (¬b ∨ a) := by
   by_cases a <;> by_cases b <;> simp_all
@@ -106,4 +137,11 @@ theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
         : HEq (@Eq.ndrec α a motive v b h) v := by
  subst h; rfl
 
+/-! decide -/
+
+theorem of_decide_eq_true {p : Prop} {_ : Decidable p} : decide p = true → p = True := by simp
+theorem of_decide_eq_false {p : Prop} {_ : Decidable p} : decide p = false → p = False := by simp
+theorem decide_eq_true {p : Prop} {_ : Decidable p} : p = True → decide p = true := by simp
+theorem decide_eq_false {p : Prop} {_ : Decidable p} : p = False → decide p = false := by simp
+
 end Lean.Grind

src/Init/Grind/Norm.lean

@@ -61,6 +61,14 @@ theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 ≤ b) := by
 theorem ge_eq [LE α] (a b : α) : (a ≥ b) = (b ≤ a) := rfl
 theorem gt_eq [LT α] (a b : α) : (a > b) = (b < a) := rfl
 
+theorem beq_eq_decide_eq {_ : BEq α} [LawfulBEq α] [DecidableEq α] (a b : α) : (a == b) = (decide (a = b)) := by
+  by_cases a = b
+  next h => simp [h]
+  next h => simp [beq_eq_false_iff_ne.mpr h, decide_eq_false h]
+
+theorem bne_eq_decide_not_eq {_ : BEq α} [LawfulBEq α] [DecidableEq α] (a b : α) : (a != b) = (decide (¬ a = b)) := by
+  by_cases a = b <;> simp [*]
+
 init_grind_norm
   /- Pre theorems -/
   not_and not_or not_ite not_forall not_exists
@@ -95,9 +103,9 @@ init_grind_norm
   -- Bool not
   Bool.not_not
   -- beq
-  beq_iff_eq
+  beq_iff_eq beq_eq_decide_eq
   -- bne
-  bne_iff_ne
+  bne_iff_ne bne_eq_decide_not_eq
   -- Bool not eq true/false
   Bool.not_eq_true Bool.not_eq_false
   -- decide

src/Init/Grind/Tactics.lean

@@ -22,7 +22,8 @@ syntax grindFwd    := "→ "
 syntax grindUsr    := &"usr "
 syntax grindCases  := &"cases "
 syntax grindCasesEager := atomic(&"cases" &"eager ")
-syntax grindMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindEqBwd <|> grindBwd <|> grindFwd <|> grindUsr <|> grindCasesEager <|> grindCases
+syntax grindIntro  := &"intro "
+syntax grindMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindEqBwd <|> grindBwd <|> grindFwd <|> grindUsr <|> grindCasesEager <|> grindCases <|> grindIntro
 syntax (name := grind) "grind" (grindMod)? : attr
 end Attr
 end Lean.Parser

src/Init/Grind/Util.lean

@@ -41,4 +41,22 @@ def MatchCond (p : Prop) : Prop := p
 theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
   subst h; apply HEq.refl
 
+@[app_unexpander nestedProof]
+def nestedProofUnexpander : PrettyPrinter.Unexpander := fun stx => do
+  match stx with
+  | `($_ $p:term) => `(‹$p›)
+  | _ => throw ()
+
+@[app_unexpander MatchCond]
+def matchCondUnexpander : PrettyPrinter.Unexpander := fun stx => do
+  match stx with
+  | `($_ $p:term) => `($p)
+  | _ => throw ()
+
+@[app_unexpander EqMatch]
+def eqMatchUnexpander : PrettyPrinter.Unexpander := fun stx => do
+  match stx with
+  | `($_ $lhs:term $rhs:term) => `($lhs = $rhs)
+  | _ => throw ()
+
 end Lean.Grind

src/Init/Prelude.lean

@@ -1222,7 +1222,7 @@ class HDiv (α : Type u) (β : Type v) (γ : outParam (Type w)) where
     It is implemented as `Int.ediv`, the unique function satisfying
     `a % b + b * (a / b) = a` and `0 ≤ a % b < natAbs b` for `b ≠ 0`.
     Other rounding conventions are available using the functions
-    `Int.fdiv` (floor rounding) and `Int.div` (truncation rounding).
+    `Int.fdiv` (floor rounding) and `Int.tdiv` (truncation rounding).
   * For `Float`, `a / 0` follows the IEEE 754 semantics for division,
     usually resulting in `inf` or `nan`. -/
   hDiv : α → β → γ
@@ -1551,7 +1551,7 @@ instance instAddNat : Add Nat where
 
 /- We mark the following definitions as pattern to make sure they can be used in recursive equations,
    and reduced by the equation Compiler. -/
-attribute [match_pattern] Nat.add Add.add HAdd.hAdd Neg.neg
+attribute [match_pattern] Nat.add Add.add HAdd.hAdd Neg.neg Mul.mul HMul.hMul
 
 set_option bootstrap.genMatcherCode false in
 /--
@@ -2706,7 +2706,7 @@ protected def Array.appendCore {α : Type u}  (as : Array α) (bs : Array α) :
   If `start` is greater or equal to `stop`, the result is empty.
   If `stop` is greater than the length of `as`, the length is used instead. -/
 -- NOTE: used in the quotation elaborator output
-def Array.extract (as : Array α) (start stop : Nat) : Array α :=
+def Array.extract (as : Array α) (start : Nat := 0) (stop : Nat := as.size) : Array α :=
   let rec loop (i : Nat) (j : Nat) (bs : Array α) : Array α :=
     dite (LT.lt j as.size)
       (fun hlt =>

src/Lean/Compiler/LCNF/ElimDeadBranches.lean

@@ -80,7 +80,7 @@ partial def merge (v1 v2 : Value) : Value :=
   | top, _ | _, top => top
   | ctor i1 vs1, ctor i2 vs2 =>
     if i1 == i2 then
-      ctor i1 (vs1.zipWith vs2 merge)
+      ctor i1 (Array.zipWith merge vs1 vs2)
     else
       choice [v1, v2]
   | choice vs1, choice vs2 =>

src/Lean/Compiler/LCNF/PullLetDecls.lean

@@ -46,7 +46,7 @@ partial def withCheckpoint (x : PullM Code) : PullM Code := do
     else
       return c
   let (c, keep) := go toPullSizeSaved (← read).included |>.run #[]
-  modify fun s => { s with toPull := s.toPull.take toPullSizeSaved ++ keep }
+  modify fun s => { s with toPull := s.toPull.shrink toPullSizeSaved ++ keep }
   return c
 
 def attachToPull (c : Code) : PullM Code := do

src/Lean/Compiler/LCNF/SpecInfo.lean

@@ -186,7 +186,7 @@ def saveSpecParamInfo (decls : Array Decl) : CompilerM Unit := do
       let mut paramsInfo := declsInfo[i]!
       let some mask := m.find? decl.name | unreachable!
       trace[Compiler.specialize.info] "{decl.name} {mask}"
-      paramsInfo := paramsInfo.zipWith mask fun info fixed => if fixed || info matches .user then info else .other
+      paramsInfo := Array.zipWith (fun info fixed => if fixed || info matches .user then info else .other) paramsInfo mask
       for j in [:paramsInfo.size] do
         let mut info := paramsInfo[j]!
         if info matches .fixedNeutral && !hasFwdDeps decl paramsInfo j then

src/Lean/Compiler/LCNF/Util.lean

@@ -80,7 +80,7 @@ List of types that have builtin runtime support
 def builtinRuntimeTypes : List Name := [
   ``String,
   ``UInt8, ``UInt16, ``UInt32, ``UInt64, ``USize,
-  ``Float,
+  ``Float, ``Float32,
   ``Thunk, ``Task,
   ``Array, ``ByteArray, ``FloatArray,
   ``Nat, ``Int

src/Lean/Compiler/Specialize.lean

@@ -33,7 +33,7 @@ private def elabSpecArgs (declName : Name) (args : Array Syntax) : MetaM (Array
           result := result.push idx
       else
         let argName := arg.getId
-        if let some idx := argNames.indexOf? argName then
+        if let some idx := argNames.idxOf? argName then
           if result.contains idx then throwErrorAt arg "invalid specialization argument name `{argName}`, it has already been specified as a specialization candidate"
           result := result.push idx
         else

src/Lean/Data/PersistentHashMap.lean

@@ -231,7 +231,7 @@ def isUnaryNode : Node α β → Option (α × β)
 
 partial def eraseAux [BEq α] : Node α β → USize → α → Node α β
   | n@(Node.collision keys vals heq), _, k =>
-    match keys.indexOf? k with
+    match keys.finIdxOf? k with
     | some idx =>
       let keys' := keys.eraseIdx idx
       have keq := keys.size_eraseIdx idx _

src/Lean/Declaration.lean

@@ -478,6 +478,10 @@ def isCtor : ConstantInfo → Bool
   | .ctorInfo _ => true
   | _           => false
 
+def isAxiom : ConstantInfo → Bool
+  | .axiomInfo _ => true
+  | _            => false
+
 def isInductive : ConstantInfo → Bool
   | .inductInfo _ => true
   | _             => false

src/Lean/Elab/App.lean

@@ -800,7 +800,7 @@ def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
         throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
       unless motiveResultType.isSort do
         throwError "motive result type must be a sort{indentExpr motiveType}"
-    let some motivePos ← pure (xs.indexOf? motive) |
+    let some motivePos ← pure (xs.idxOf? motive) |
       throwError "unexpected eliminator type{indentExpr elimType}"
     /-
     Compute transitive closure of fvars appearing in arguments to the motive.

src/Lean/Elab/Command.lean

@@ -496,8 +496,8 @@ partial def elabCommand (stx : Syntax) : CommandElabM Unit := do
                     newStx := stxNew
                     newNextMacroScope := nextMacroScope
                     hasTraces
-                    next := cmdPromises.zipWith cmds fun cmdPromise cmd =>
-                      { range? := cmd.getRange?, task := cmdPromise.result }
+                    next := Array.zipWith (fun cmdPromise cmd =>
+                      { range? := cmd.getRange?, task := cmdPromise.result }) cmdPromises cmds
                     : MacroExpandedSnapshot
                   }
                   -- After the first command whose syntax tree changed, we must disable

src/Lean/Elab/ParseImportsFast.lean

@@ -182,7 +182,7 @@ partial def moduleIdent (runtimeOnly : Bool) : Parser := fun input s =>
   let s := p input s
   match s.error? with
   | none => many p input s
-  | some _ => { pos, error? := none, imports := s.imports.take size }
+  | some _ => { pos, error? := none, imports := s.imports.shrink size }
 
 @[inline] partial def preludeOpt (k : String) : Parser :=
   keywordCore k (fun _ s => s.pushModule `Init false) (fun _ s => s)

src/Lean/Elab/PreDefinition/Structural/BRecOn.lean

@@ -292,7 +292,7 @@ def mkBrecOnApp (positions : Positions) (fnIdx : Nat) (brecOnConst : Nat → Exp
     let packedFTypes ← inferArgumentTypesN positions.size brecOn
     let packedFArgs ← positions.mapMwith PProdN.mkLambdas packedFTypes FArgs
     let brecOn := mkAppN brecOn packedFArgs
-    let some (size, idx) := positions.findSome? fun pos => (pos.size, ·) <$> pos.indexOf? fnIdx
+    let some (size, idx) := positions.findSome? fun pos => (pos.size, ·) <$> pos.finIdxOf? fnIdx
       | throwError "mkBrecOnApp: Could not find {fnIdx} in {positions}"
     let brecOn ← PProdN.projM size idx brecOn
     mkLambdaFVars ys (mkAppN brecOn otherArgs)

src/Lean/Elab/PreDefinition/Structural/FindRecArg.lean

@@ -32,8 +32,8 @@ def prettyParameterSet (fnNames : Array Name) (xs : Array Expr) (values : Array
 private def getIndexMinPos (xs : Array Expr) (indices : Array Expr) : Nat := Id.run do
   let mut minPos := xs.size
   for index in indices do
-    match xs.indexOf? index with
-    | some pos => if pos.val < minPos then minPos := pos.val
+    match xs.idxOf? index with
+    | some pos => if pos < minPos then minPos := pos
     | _        => pure ()
   return minPos
 
@@ -91,8 +91,8 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
             throwError "its type is an inductive datatype{indentExpr xType}\nand the datatype parameter{indentExpr indParam}\ndepends on the function parameter{indentExpr y}\nwhich does not come before the varying parameters and before the indices of the recursion parameter."
           | none =>
             let indAll := indInfo.all.toArray
-            let .some indIdx := indAll.indexOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
-            let indicesPos := indIndices.map fun index => match xs.indexOf? index with | some i => i.val | none => unreachable!
+            let .some indIdx := indAll.idxOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
+            let indicesPos := indIndices.map fun index => match xs.idxOf? index with | some i => i | none => unreachable!
             let indGroupInst := {
               IndGroupInfo.ofInductiveVal indInfo with
               levels := us
@@ -208,7 +208,7 @@ def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
           if let some (_index, _y) ← hasBadIndexDep? ys indIndices then
             -- throwError "its type {indInfo.name} is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
             continue
-          let indicesPos := indIndices.map fun index => match (xs++ys).indexOf? index with | some i => i.val | none => unreachable!
+          let indicesPos := indIndices.map fun index => match (xs++ys).idxOf? index with | some i => i | none => unreachable!
           return .some
             { fnName       := recArgInfo.fnName
               numFixed     := recArgInfo.numFixed

src/Lean/Elab/PreDefinition/TerminationMeasure.lean

@@ -90,7 +90,7 @@ def TerminationMeasure.elab (funName : Name) (type : Expr) (arity extraParams :
 def TerminationMeasure.structuralArg (measure : TerminationMeasure) : MetaM Nat := do
   assert! measure.structural
   lambdaTelescope measure.fn fun ys e => do
-    let .some idx := ys.indexOf? e
+    let .some idx := ys.idxOf? e
       | panic! "TerminationMeasure.structuralArg: body not one of the parameters"
     return idx
 

src/Lean/Elab/PreDefinition/WF/Eqns.lean

@@ -10,7 +10,6 @@ import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Eqns
 import Lean.Meta.ArgsPacker.Basic
 import Init.Data.Array.Basic
-import Init.Internal.Order.Basic
 
 namespace Lean.Elab.WF
 open Meta
@@ -23,35 +22,33 @@ structure EqnInfo extends EqnInfoCore where
   argsPacker      : ArgsPacker
   deriving Inhabited
 
-private partial def deltaLHSUntilFix (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
-  let target ← mvarId.getType'
-  let some (_, lhs, _) := target.eq? | throwTacticEx `deltaLHSUntilFix mvarId "equality expected"
-  if lhs.isAppOf ``WellFounded.fix then
-    return mvarId
-  else if lhs.isAppOf ``Order.fix then
-    return mvarId
-  else
-    deltaLHSUntilFix (← deltaLHS mvarId)
-
 private def rwFixEq (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
   let target ← mvarId.getType'
   let some (_, lhs, rhs) := target.eq? | unreachable!
-  let h ←
-    if lhs.isAppOf ``WellFounded.fix then
-      pure <| mkAppN (mkConst ``WellFounded.fix_eq lhs.getAppFn.constLevels!) lhs.getAppArgs
-    else if lhs.isAppOf ``Order.fix then
-      let x := lhs.getAppArgs.back!
-      let args := lhs.getAppArgs.pop
-      mkAppM ``congrFun #[mkAppN (mkConst ``Order.fix_eq lhs.getAppFn.constLevels!) args, x]
-    else
-      throwTacticEx `rwFixEq mvarId "expected fixed-point application"
-  let some (_, _, lhsNew) := (← inferType h).eq? | unreachable!
+
+  -- lhs should be an application of the declNameNonrec, which unfolds to an
+  -- application of fix in one step
+  let some lhs' ← delta? lhs | throwError "rwFixEq: cannot delta-reduce {lhs}"
+  let_expr WellFounded.fix _α _C _r _hwf F x := lhs'
+    | throwTacticEx `rwFixEq mvarId "expected saturated fixed-point application in {lhs'}"
+  let h := mkAppN (mkConst ``WellFounded.fix_eq lhs'.getAppFn.constLevels!) lhs'.getAppArgs
+
+  -- We used to just rewrite with `fix_eq` and continue with whatever RHS that produces, but that
+  -- would include more copies of `fix` resulting in large and confusing terms.
+  -- Instead we manually construct the new term in terms of the current functions,
+  -- which should be headed by the `declNameNonRec`, and should be defeq to the expected type
+
+  -- if lhs == e x and lhs' == fix .., then lhsNew := e x = F x (fun y _ => e y)
+  let ftype := (← inferType (mkApp F x)).bindingDomain!
+  let f' ← forallBoundedTelescope ftype (some 2) fun ys _ => do
+    mkLambdaFVars ys (.app lhs.appFn! ys[0]!)
+  let lhsNew := mkApp2 F x f'
   let targetNew ← mkEq lhsNew rhs
   let mvarNew ← mkFreshExprSyntheticOpaqueMVar targetNew
   mvarId.assign (← mkEqTrans h mvarNew)
   return mvarNew.mvarId!
 
-private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
+private partial def mkProof (declName declNameNonRec : Name) (type : Expr) : MetaM Expr := do
   trace[Elab.definition.wf.eqns] "proving: {type}"
   withNewMCtxDepth do
     let main ← mkFreshExprSyntheticOpaqueMVar type
@@ -83,7 +80,10 @@ private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
             -- LHS (introduced in 096e4eb), but it seems that code path was never used,
             -- so #3133 removed it again (and can be recovered from there if this was premature).
             throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
-    go (← rwFixEq (← deltaLHSUntilFix mvarId))
+
+    let mvarId ← if declName != declNameNonRec then deltaLHS mvarId else pure mvarId
+    let mvarId ← rwFixEq mvarId
+    go mvarId
     instantiateMVars main
 
 def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
@@ -101,7 +101,7 @@ def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
     trace[Elab.definition.wf.eqns] "{eqnTypes[i]}"
     let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
     thmNames := thmNames.push name
-    let value ← mkProof declName type
+    let value ← mkProof declName info.declNameNonRec type
     let (type, value) ← removeUnusedEqnHypotheses type value
     addDecl <| Declaration.thmDecl {
       name, type, value

src/Lean/Elab/PreDefinition/WF/GuessLex.lean

@@ -790,7 +790,7 @@ def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
   -- (One for each non-forbiddend arg)
   let basicMeassures₁ ← simpleMeasures preDefs fixedPrefixSize userVarNamess
   let basicMeassures₂ ← complexMeasures preDefs fixedPrefixSize userVarNamess recCalls
-  let basicMeasures := Array.zipWith basicMeassures₁ basicMeassures₂ (· ++ ·)
+  let basicMeasures := Array.zipWith (· ++ ·) basicMeassures₁ basicMeassures₂
 
   -- The list of measures, including the measures that order functions.
   -- The function ordering measures come last

src/Lean/Elab/PreDefinition/WF/PackMutual.lean

@@ -48,7 +48,7 @@ def packCalls (fixedPrefix : Nat) (argsPacker : ArgsPacker) (funNames : Array Na
     let f := e.getAppFn
     if !f.isConst then
       return TransformStep.done e
-    if let some fidx := funNames.indexOf? f.constName! then
+    if let some fidx := funNames.idxOf? f.constName! then
       let arity := fixedPrefix + argsPacker.varNamess[fidx]!.size
       let e' ← withAppN arity e fun args => do
         let packedArg ← argsPacker.pack domain fidx args[fixedPrefix:]

src/Lean/Elab/StructInst.lean

@@ -120,7 +120,7 @@ Expands fields.
   let fields? ← fields.mapM expandStructInstField
   if fields?.all (·.isNone) then
     Macro.throwUnsupported
-  let fields := fields?.zipWith fields Option.getD
+  let fields := Array.zipWith Option.getD fields? fields
   let structInstFields := structInstFields.setArg 0 <| Syntax.mkSep fields (mkAtomFrom stx ", ")
   return stx.setArg 2 structInstFields
 

src/Lean/Elab/Tactic/BVDecide/Frontend/BVDecide.lean

@@ -148,15 +148,26 @@ Diagnose spurious counter examples, currently this checks:
 -/
 def diagnose : DiagnosisM Unit := do
   for (expr, _) in ← equations do
-    match_expr expr with
-    | BitVec.ofBool x =>
-      match x with
-      | .fvar fvarId => checkRelevantHypsUsed fvarId
-      | _ => addUninterpretedSymbol expr
-    | _ =>
-      match expr with
-      | .fvar fvarId => checkRelevantHypsUsed fvarId
-      | _ => addUninterpretedSymbol expr
+    match findRelevantFVar expr with
+    | some fvarId => checkRelevantHypsUsed fvarId
+    | none => addUninterpretedSymbol expr
+where
+  findRelevantFVar (expr : Expr) : Option FVarId :=
+    match fvarId? expr with
+    | some fvarId => some fvarId
+    | none =>
+      match_expr expr with
+      | BitVec.ofBool x => fvarId? x
+      | UInt8.toBitVec x => fvarId? x
+      | UInt16.toBitVec x => fvarId? x
+      | UInt32.toBitVec x => fvarId? x
+      | UInt64.toBitVec x => fvarId? x
+      | _ => none
+  fvarId? (expr : Expr) : Option FVarId :=
+    match expr with
+    | .fvar fvarId => some fvarId
+    | _ => none
+
 
 end DiagnosisM
 

src/Lean/Elab/Tactic/BVDecide/Frontend/LRAT.lean

@@ -54,7 +54,7 @@ def TacticContext.new (lratPath : System.FilePath) (config : BVDecideConfig) :
     config
   }
 where
-  determineSolver : Lean.Elab.TermElabM System.FilePath := do
+  determineSolver : CoreM System.FilePath := do
     let opts ← getOptions
     let option := sat.solver.get opts
     if option == "" then
@@ -96,7 +96,7 @@ instance : ToExpr LRAT.IntAction where
       mkApp3 (mkConst ``LRAT.Action.del [.zero, .zero]) beta alpha (toExpr ids)
   toTypeExpr := mkConst ``LRAT.IntAction
 
-def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
+def LratCert.load (lratPath : System.FilePath) (trimProofs : Bool) : CoreM (Array LRAT.IntAction) := do
   let proofInput ← IO.FS.readBinFile lratPath
   let proof ←
     withTraceNode `sat (fun _ => return s!"Parsing LRAT file") do
@@ -118,6 +118,10 @@ def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM Lra
       pure proof
 
   trace[Meta.Tactic.sat] s!"LRAT proof has {proof.size} steps after trimming"
+  return proof
+
+def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
+  let proof ← LratCert.load lratPath trimProofs
 
   -- This is necessary because the proof might be in the binary format in which case we cannot
   -- store it as a string in the environment (yet) due to missing support for binary literals.

src/Lean/Elab/Tactic/BVDecide/Frontend/Normalize.lean

@@ -12,6 +12,7 @@ import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Structures
+import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.IntToBitVec
 
 /-!
 This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
@@ -54,6 +55,10 @@ where
       let some g' ← structuresPass.run g | return none
       g := g'
 
+    if cfg.fixedInt then
+      let some g' ← intToBitVecPass.run g | return none
+      g := g'
+
     trace[Meta.Tactic.bv] m!"Running fixpoint pipeline on:\n{g}"
     let pipeline ← passPipeline
     Pass.fixpointPipeline pipeline g

src/Lean/Elab/Tactic/BVDecide/Frontend/Normalize/Basic.lean

@@ -31,8 +31,7 @@ def getConfig : PreProcessM BVDecideConfig := read
 
 @[inline]
 def checkRewritten (fvar : FVarId) : PreProcessM Bool := do
-  let val := (← get).rewriteCache.contains fvar
-  return val
+  return (← get).rewriteCache.contains fvar
 
 @[inline]
 def rewriteFinished (fvar : FVarId) : PreProcessM Unit := do

src/Lean/Elab/Tactic/BVDecide/Frontend/Normalize/IntToBitVec.lean

@@ -0,0 +1,169 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+prelude
+import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
+import Lean.Elab.Tactic.BVDecide.Frontend.Attr
+import Lean.Elab.Tactic.Simp
+
+/-!
+This module contains the implementation of the pre processing pass for reducing `UIntX`/`IntX` to
+`BitVec` and thus allow `bv_decide` to reason about them.
+
+It:
+1. runs the `int_toBitVec` simp set
+2. If `USize.toBitVec` is used anywhere looks for equations of the form
+   `System.Platform.numBits = constant` (or flipped) and uses them to convert the system back to
+   fixed width.
+-/
+
+namespace Lean.Elab.Tactic.BVDecide
+namespace Frontend.Normalize
+
+open Lean.Meta
+
+/--
+Contains information for the `USize` elimination pass.
+-/
+structure USizeState where
+  /--
+  Contains terms of the form `USize.toBitVec e` that we will translate to constant width `BitVec`.
+  -/
+  relevantTerms : Std.HashSet Expr := {}
+  /--
+  Contains all hypotheses that contain terms from `relevantTerms`
+  -/
+  relevantHyps : Std.HashSet FVarId := {}
+
+private abbrev M := StateRefT USizeState MetaM
+
+namespace M
+
+@[inline]
+def addUSizeTerm (e : Expr) : M Unit := do
+  modify fun s => { s with relevantTerms := s.relevantTerms.insert e }
+
+@[inline]
+def addUSizeHyp (f : FVarId) : M Unit := do
+  modify fun s => { s with relevantHyps := s.relevantHyps.insert f }
+
+end M
+
+def intToBitVecPass : Pass where
+  name := `intToBitVec
+  run' goal := do
+    let intToBvThms ← intToBitVecExt.getTheorems
+    let cfg ← PreProcessM.getConfig
+    let simpCtx ← Simp.mkContext
+      (config := { failIfUnchanged := false, zetaDelta := true, maxSteps := cfg.maxSteps })
+      (simpTheorems := #[intToBvThms])
+      (congrTheorems := (← getSimpCongrTheorems))
+
+    let hyps ← goal.getNondepPropHyps
+    let ⟨result?, _⟩ ← simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := hyps)
+    let some (_, goal) := result? | return none
+    handleUSize goal |>.run' {}
+where
+  handleUSize (goal : MVarId) : M MVarId := do
+    if ← detectUSize goal then
+      replaceUSize goal
+    else
+      return goal
+
+  detectUSize (goal : MVarId) : M Bool := do
+    goal.withContext do
+      for hyp in ← getPropHyps do
+        (← hyp.getType).forEachWhere
+          (stopWhenVisited := true)
+          (·.isAppOfArity ``USize.toBitVec 1)
+          fun e => do
+            M.addUSizeTerm e
+            M.addUSizeHyp hyp
+
+      return !(← get).relevantTerms.isEmpty
+
+  /--
+  Turn `goal` into a goal containing `BitVec const` instead of `USize`.
+  -/
+  replaceUSize (goal : MVarId) : M MVarId := do
+    if let some (numBits, numBitsEq) ← findNumBitsEq goal then
+      goal.withContext do
+        let relevantHyps := (← get).relevantHyps.toArray.map mkFVar
+        let relevantTerms := (← get).relevantTerms.toArray
+        let (app, abstractedHyps) ← liftMkBindingM <| MetavarContext.revert relevantHyps goal true
+        let newMVar := app.getAppFn.mvarId!
+        let targetType ← newMVar.getType
+        /-
+        newMVar has type : h1 → h2 → ... → False`
+        This code computes a motive of the form:
+        ```
+        fun z _ => ∀ (x_1 : BitVec z) (x_2 : BitVec z) ..., h1 → h2 → ... → False
+        ```
+        Where:
+        - all terms from `relevantTerms` in the implication are substituted by `x_1`, ...
+        - all occurences of `numBits` are substituted by `z`
+
+        Additionally we compute a new metavariable with type:
+        ```
+        ∀ (x_1 : BitVec const) (x_2 : BitVec const) ..., h1 → h2 → ... → False
+        ```
+        with all occurences of `numBits` substituted by const. This meta variable is going to become
+        the next goal
+        -/
+        let (motive, newGoalType) ←
+          withLocalDeclD `z (mkConst ``Nat) fun z => do
+            let otherArgType := mkApp3 (mkConst ``Eq [1]) (mkConst ``Nat) (toExpr numBits) z
+            withLocalDeclD `h otherArgType fun other => do
+              let argType := mkApp (mkConst ``BitVec) z
+              let argTypes := relevantTerms.map (fun _ => (`x, argType))
+              let innerMotiveType ←
+                withLocalDeclsDND argTypes fun args => do
+                  let mut subst : Std.HashMap Expr Expr := Std.HashMap.empty (args.size + 1)
+                  subst := subst.insert (mkConst ``System.Platform.numBits) z
+                  for term in relevantTerms, arg in args do
+                    subst := subst.insert term arg
+                  let motiveType := targetType.replace subst.get?
+                  mkForallFVars args motiveType
+              let newGoalType := innerMotiveType.replaceFVar z (toExpr numBits)
+              let motive ← mkLambdaFVars #[z, other] innerMotiveType
+              return (motive, newGoalType)
+        let mut newGoal := (← mkFreshExprMVar newGoalType).mvarId!
+        let casesOn := mkApp6 (mkConst ``Eq.casesOn [0, 1])
+          (mkConst ``Nat)
+          (toExpr numBits)
+          motive
+          (mkConst ``System.Platform.numBits)
+          numBitsEq
+          (mkMVar newGoal)
+        goal.assign <| mkAppN casesOn (relevantTerms ++ abstractedHyps)
+        -- remove all of the hold hypotheses about USize.toBitVec to prevent false counter examples
+        (newGoal, _) ← newGoal.tryClearMany' (abstractedHyps.map Expr.fvarId!)
+        -- intro both the new `BitVec const` as well as all hypotheses about them
+        (_, newGoal) ← newGoal.introN (relevantTerms.size + abstractedHyps.size)
+        return newGoal
+    else
+      logWarning m!"Detected USize in the goal but no hypothesis about System.Platform.numBits, consider case splitting on {mkConst ``System.Platform.numBits_eq}"
+      return goal
+
+  /--
+  Builds an expression of type: `const = System.Platform.numBits` from the hypotheses in the context
+  if possible.
+  -/
+  findNumBitsEq (goal : MVarId) : MetaM (Option (Nat × Expr)) := do
+    goal.withContext do
+      for hyp in ← getPropHyps do
+        match_expr ← hyp.getType with
+        | Eq eqTyp lhs rhs =>
+          if lhs.isConstOf ``System.Platform.numBits then
+            let some val ← getNatValue? rhs | return none
+            return some (val, mkApp4 (mkConst ``Eq.symm [1]) eqTyp lhs rhs (mkFVar hyp))
+          else if rhs.isConstOf ``System.Platform.numBits then
+            let some val ← getNatValue? lhs | return none
+            return some (val, mkFVar hyp)
+        | _ => continue
+      return none
+
+end Frontend.Normalize
+end Lean.Elab.Tactic.BVDecide

src/Lean/Elab/Tactic/Grind.lean

@@ -58,7 +58,7 @@ def elabGrindParams (params : Grind.Params) (ps :  TSyntaxArray ``Parser.Tactic.
     match p with
     | `(Parser.Tactic.grindParam| - $id:ident) =>
       let declName ← realizeGlobalConstNoOverloadWithInfo id
-      if (← Grind.isCasesAttrCandidate declName false) then
+      if let some declName ← Grind.isCasesAttrCandidate? declName false then
         Grind.ensureNotBuiltinCases declName
         params := { params with casesTypes := (← params.casesTypes.eraseDecl declName) }
       else
@@ -82,9 +82,20 @@ def elabGrindParams (params : Grind.Params) (ps :  TSyntaxArray ``Parser.Tactic.
       | .cases eager =>
         withRef p <| Grind.validateCasesAttr declName eager
         params := { params with casesTypes := params.casesTypes.insert declName eager }
+      | .intro =>
+        if let some info ← Grind.isCasesAttrPredicateCandidate? declName false then
+          for ctor in info.ctors do
+            params ← withRef p <| addEMatchTheorem params ctor .default
+        else
+          throwError "invalid use of `intro` modifier, `{declName}` is not an inductive predicate"
       | .infer =>
-        if (← Grind.isCasesAttrCandidate declName false) then
+        if let some declName ← Grind.isCasesAttrCandidate? declName false then
           params := { params with casesTypes := params.casesTypes.insert declName false }
+          if let some info ← isInductivePredicate? declName then
+            -- If it is an inductive predicate,
+            -- we also add the contructors (intro rules) as E-matching rules
+            for ctor in info.ctors do
+              params ← withRef p <| addEMatchTheorem params ctor .default
         else
           params ← withRef p <| addEMatchTheorem params declName .default
     | _ => throwError "unexpected `grind` parameter{indentD p}"
@@ -93,7 +104,7 @@ where
   addEMatchTheorem (params : Grind.Params) (declName : Name) (kind : Grind.EMatchTheoremKind) : MetaM Grind.Params := do
     let info ← getConstInfo declName
     match info with
-    | .thmInfo _ =>
+    | .thmInfo _ | .axiomInfo _ | .ctorInfo _ =>
       if kind == .eqBoth then
         let params := { params with extra := params.extra.push (← Grind.mkEMatchTheoremForDecl declName .eqLhs) }
         return { params with extra := params.extra.push (← Grind.mkEMatchTheoremForDecl declName .eqRhs) }
@@ -156,7 +167,8 @@ private def evalGrindCore
   let fallback ← elabFallback fallback?
   let only := only.isSome
   let params := if let some params := params then params.getElems else #[]
-  logWarningAt ref "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
+  if Grind.grind.warning.get (← getOptions) then
+    logWarningAt ref "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
   let declName := (← Term.getDeclName?).getD `_grind
   let mut config ← elabGrindConfig config
   if trace then

src/Lean/Elab/Tactic/Induction.lean

@@ -286,8 +286,9 @@ where
               diagnostics := .empty
               inner? := none
               finished := { range? := none, task := finished.result }
-              next := altStxs.zipWith altPromises fun stx prom =>
-                { range? := stx.getRange?, task := prom.result }
+              next := Array.zipWith
+                (fun stx prom => { range? := stx.getRange?, task := prom.result })
+                altStxs altPromises
             }
             goWithIncremental <| altPromises.mapIdx fun i prom => {
               old? := do

src/Lean/Environment.lean

@@ -404,10 +404,10 @@ def AsyncConsts.add (aconsts : AsyncConsts) (aconst : AsyncConst) : AsyncConsts
 def AsyncConsts.find? (aconsts : AsyncConsts) (declName : Name) : Option AsyncConst :=
   aconsts.map.find? declName
 
-/-- Checks whether the name of any constant in the collection is a prefix of `declName`. -/
-def AsyncConsts.hasPrefix (aconsts : AsyncConsts) (declName : Name) : Bool :=
+/-- Finds the constant in the collection that is a prefix of `declName`, if any. -/
+def AsyncConsts.findPrefix? (aconsts : AsyncConsts) (declName : Name) : Option AsyncConst :=
   -- as macro scopes are a strict suffix,
-  aconsts.normalizedTrie.findLongestPrefix? (privateToUserName declName.eraseMacroScopes) |>.isSome
+  aconsts.normalizedTrie.findLongestPrefix? (privateToUserName declName.eraseMacroScopes)
 
 /--
 Elaboration-specific extension of `Kernel.Environment` that adds tracking of asynchronously
@@ -463,6 +463,18 @@ private def modifyCheckedAsync (env : Environment) (f : Kernel.Environment → K
 private def setCheckedSync (env : Environment) (newChecked : Kernel.Environment) : Environment :=
   { env with checked := .pure newChecked, checkedWithoutAsync := newChecked }
 
+/--
+Checks whether the given declaration name may potentially added, or have been added, to the current
+environment branch, which is the case either if this is the main branch or if the declaration name
+is a suffix (modulo privacy and hygiene information) of the top-level declaration name for which
+this branch was created.
+
+This function should always be checked before modifying an `AsyncMode.async` environment extension
+to ensure `findStateAsync` will be able to find the modification from other branches.
+-/
+def asyncMayContain (env : Environment) (declName : Name) : Bool :=
+  env.asyncCtx?.all (·.mayContain declName)
+
 @[extern "lean_elab_add_decl"]
 private opaque addDeclCheck (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
   (cancelTk? : @& Option IO.CancelToken) : Except Kernel.Exception Environment
@@ -515,7 +527,7 @@ def addExtraName (env : Environment) (name : Name) : Environment :=
 
 /-- Find base case: name did not match any asynchronous declaration. -/
 private def findNoAsync (env : Environment) (n : Name) : Option ConstantInfo := do
-  if env.asyncConsts.hasPrefix n then
+  if let some _ := env.asyncConsts.findPrefix? n then
     -- Constant generated in a different environment branch: wait for final kernel environment. Rare
     -- case when only proofs are elaborated asynchronously as they are rarely inspected. Could be
     -- optimized in the future by having the elaboration thread publish an (incremental?) map of
@@ -756,38 +768,81 @@ def instantiateValueLevelParams! (c : ConstantInfo) (ls : List Level) : Expr :=
 
 end ConstantInfo
 
-/-- Interface for managing environment extensions. -/
-structure EnvExtensionInterface where
-  ext          : Type → Type
-  inhabitedExt : Inhabited σ → Inhabited (ext σ)
-  registerExt  (mkInitial : IO σ) : IO (ext σ)
-  setState     (e : ext σ) (exts : Array EnvExtensionState) : σ → Array EnvExtensionState
-  modifyState  (e : ext σ) (exts : Array EnvExtensionState) : (σ → σ) → Array EnvExtensionState
-  getState     [Inhabited σ] (e : ext σ) (exts : Array EnvExtensionState) : σ
-  mkInitialExtStates : IO (Array EnvExtensionState)
-  ensureExtensionsSize : Array EnvExtensionState → IO (Array EnvExtensionState)
+/--
+Async access mode for environment extensions used in `EnvironmentExtension.get/set/modifyState`.
+Depending on their specific uses, extensions may opt out of the strict `sync` access mode in order
+to avoid blocking parallel elaboration and/or to optimize accesses. The access mode is set at
+environment extension registration time but can be overriden at `EnvironmentExtension.getState` in
+order to weaken it for specific accesses.
 
-instance : Inhabited EnvExtensionInterface where
-  default := {
-    ext                  := id
-    inhabitedExt         := id
-    ensureExtensionsSize := fun exts => pure exts
-    registerExt          := fun mk => mk
-    setState             := fun _ exts _ => exts
-    modifyState          := fun _ exts _ => exts
-    getState             := fun ext _ => ext
-    mkInitialExtStates   := pure #[]
-  }
+In all modes, the state stored into the `.olean` file for persistent environment extensions is the
+result of `getState` called on the main environment branch at the end of the file, i.e. it
+encompasses all modifications for all modes but `local`.
+-/
+inductive EnvExtension.AsyncMode where
+  /--
+  Default access mode, writing and reading the extension state to/from the full `checked`
+  environment. This mode ensures the observed state is identical independently of whether or how
+  parallel elaboration is used but `getState` will block on all prior environment branches by
+  waiting for `checked`. `setState` and `modifyState` do not block.
 
-/-! # Unsafe implementation of `EnvExtensionInterface` -/
-namespace EnvExtensionInterfaceUnsafe
+  While a safe default, any extension that reasonably could be used in parallel elaboration contexts
+  should opt for a weaker mode to avoid blocking unless there is no way to access the correct state
+  without waiting for all prior environment branches, in which case its data management should be
+  restructured if at all possible.
+  -/
+  | sync
+  /--
+  Accesses only the state of the current environment branch. Modifications on other branches are not
+  visible and are ultimately discarded except for the main branch. Provides the fastest accessors,
+  will never block.
 
-structure Ext (σ : Type) where
-  idx       : Nat
-  mkInitial : IO σ
+  This mode is particularly suitable for extensions where state does not escape from lexical scopes
+  even without parallelism, e.g. `ScopedEnvExtension`s when setting local entries.
+  -/
+  | local
+  /--
+  Like `local` but panics when trying to modify the state on anything but the main environment
+  branch. For extensions that fulfill this requirement, all modes functionally coincide but this
+  is the safest and most efficient choice in that case, preventing accidental misuse.
+
+  This mode is suitable for extensions that are modified only at the command elaboration level
+  before any environment forks in the command, and in particular for extensions that are modified
+  only at the very beginning of the file.
+  -/
+  | mainOnly
+  /--
+  Accumulates modifications in the `checked` environment like `sync`, but `getState` will panic
+  instead of blocking. Instead `findStateAsync` should be used, which will access the state of the
+  environment branch corresponding to the passed declaration name, if any, or otherwise the state
+  of the current branch. In other words, at most one environment branch will be blocked on instead
+  of all prior branches. The local state can still be accessed by calling `getState` with mode
+  `local` explicitly.
+
+  This mode is suitable for extensions with map-like state where the key uniquely identifies the
+  top-level declaration where it could have been set, e.g. because the key on modification is always
+  the surrounding declaration's name. Any calls to `modifyState`/`setState` should assert
+  `asyncMayContain` with that key to ensure state is never accidentally stored in a branch where it
+  cannot be found by `findStateAsync`. In particular, this mode is closest to how the environment's
+  own constant map works which asserts the same predicate on modification and provides `findAsync?`
+  for block-avoiding access.
+  -/
+  | async
   deriving Inhabited
 
-private builtin_initialize envExtensionsRef : IO.Ref (Array (Ext EnvExtensionState)) ← IO.mkRef #[]
+/--
+Environment extension, can only be generated by `registerEnvExtension` that allocates a unique index
+for this extension into each environment's extension state's array.
+-/
+structure EnvExtension (σ : Type) where private mk ::
+  idx       : Nat
+  mkInitial : IO σ
+  asyncMode : EnvExtension.AsyncMode
+  deriving Inhabited
+
+namespace EnvExtension
+
+private builtin_initialize envExtensionsRef : IO.Ref (Array (EnvExtension EnvExtensionState)) ← IO.mkRef #[]
 
 /--
   User-defined environment extensions are declared using the `initialize` command.
@@ -810,14 +865,14 @@ where
 
 private def invalidExtMsg := "invalid environment extension has been accessed"
 
-unsafe def setState {σ} (ext : Ext σ) (exts : Array EnvExtensionState) (s : σ) : Array EnvExtensionState :=
+private unsafe def setStateImpl {σ} (ext : EnvExtension σ) (exts : Array EnvExtensionState) (s : σ) : Array EnvExtensionState :=
   if h : ext.idx < exts.size then
     exts.set ext.idx (unsafeCast s)
   else
     have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
     panic! invalidExtMsg
 
-@[inline] unsafe def modifyState {σ : Type} (ext : Ext σ) (exts : Array EnvExtensionState) (f : σ → σ) : Array EnvExtensionState :=
+private unsafe def modifyStateImpl {σ : Type} (ext : EnvExtension σ) (exts : Array EnvExtensionState) (f : σ → σ) : Array EnvExtensionState :=
   if ext.idx < exts.size then
     exts.modify ext.idx fun s =>
       let s : σ := unsafeCast s
@@ -827,64 +882,65 @@ unsafe def setState {σ} (ext : Ext σ) (exts : Array EnvExtensionState) (s : σ
     have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
     panic! invalidExtMsg
 
-unsafe def getState {σ} [Inhabited σ] (ext : Ext σ) (exts : Array EnvExtensionState) : σ :=
+private unsafe def getStateImpl {σ} [Inhabited σ] (ext : EnvExtension σ) (exts : Array EnvExtensionState) : σ :=
   if h : ext.idx < exts.size then
-    let s : EnvExtensionState := exts[ext.idx]
-    unsafeCast s
+    unsafeCast exts[ext.idx]
   else
     panic! invalidExtMsg
 
-unsafe def registerExt {σ} (mkInitial : IO σ) : IO (Ext σ) := do
-  unless (← initializing) do
-    throw (IO.userError "failed to register environment, extensions can only be registered during initialization")
-  let exts ← envExtensionsRef.get
-  let idx := exts.size
-  let ext : Ext σ := {
-     idx        := idx,
-     mkInitial  := mkInitial,
-  }
-  envExtensionsRef.modify fun exts => exts.push (unsafeCast ext)
-  pure ext
-
 def mkInitialExtStates : IO (Array EnvExtensionState) := do
   let exts ← envExtensionsRef.get
   exts.mapM fun ext => ext.mkInitial
 
-unsafe def imp : EnvExtensionInterface := {
-  ext                  := Ext
-  ensureExtensionsSize := ensureExtensionsArraySize
-  inhabitedExt         := fun _ => ⟨default⟩
-  registerExt          := registerExt
-  setState             := setState
-  modifyState          := modifyState
-  getState             := getState
-  mkInitialExtStates   := mkInitialExtStates
-}
-
-end EnvExtensionInterfaceUnsafe
-
-@[implemented_by EnvExtensionInterfaceUnsafe.imp]
-opaque EnvExtensionInterfaceImp : EnvExtensionInterface
-
-def EnvExtension (σ : Type) : Type := EnvExtensionInterfaceImp.ext σ
-
-private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
-  let exts ← EnvExtensionInterfaceImp.ensureExtensionsSize env.checkedWithoutAsync.extensions
-  return env.modifyCheckedAsync ({ · with extensions := exts })
-
-namespace EnvExtension
-instance {σ} [s : Inhabited σ] : Inhabited (EnvExtension σ) := EnvExtensionInterfaceImp.inhabitedExt s
-
--- TODO: store extension state in `checked`
-
-def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment :=
-  { env with checkedWithoutAsync.extensions := EnvExtensionInterfaceImp.setState ext env.checkedWithoutAsync.extensions s }
+/--
+Applies the given function to the extension state. See `AsyncMode` for details on how modifications
+from different environment branches are reconciled.
 
+Note that in modes `sync` and `async`, `f` will be called twice, on the local and on the `checked`
+state.
+-/
 def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σ → σ) : Environment :=
-  { env with checkedWithoutAsync.extensions := EnvExtensionInterfaceImp.modifyState ext env.checkedWithoutAsync.extensions f }
+  -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
+  match ext.asyncMode with
+  | .mainOnly =>
+    if let some asyncCtx := env.asyncCtx? then
+      let _ : Inhabited Environment := ⟨env⟩
+      panic! s!"Environment.modifyState: environment extension is marked as `mainOnly` but used in \
+        async context '{asyncCtx.declPrefix}'"
+    else
+      { env with checkedWithoutAsync.extensions := unsafe ext.modifyStateImpl env.checkedWithoutAsync.extensions f }
+  | .local =>
+    { env with checkedWithoutAsync.extensions := unsafe ext.modifyStateImpl env.checkedWithoutAsync.extensions f }
+  | _ =>
+    env.modifyCheckedAsync fun env =>
+      { env with extensions := unsafe ext.modifyStateImpl env.extensions f }
 
-def getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment) : σ :=
-  EnvExtensionInterfaceImp.getState ext env.checkedWithoutAsync.extensions
+/--
+Sets the extension state to the given value. See `AsyncMode` for details on how modifications from
+different environment branches are reconciled.
+-/
+def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment :=
+  inline <| modifyState ext env fun _ => s
+
+-- `unsafe` fails to infer `Nonempty` here
+private unsafe def getStateUnsafe {σ : Type} [Inhabited σ] (ext : EnvExtension σ)
+    (env : Environment) (asyncMode := ext.asyncMode) : σ :=
+  -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
+  match asyncMode with
+  | .sync     => ext.getStateImpl env.checked.get.extensions
+  | .async    => panic! "EnvExtension.getState: called on `async` extension, use `findStateAsync` \
+    instead or pass `(asyncMode := .local)` to explicitly access local state"
+  | _         => ext.getStateImpl env.checkedWithoutAsync.extensions
+
+/--
+Returns the current extension state. See `AsyncMode` for details on how modifications from
+different environment branches are reconciled. Panics if the extension is marked as `async`; see its
+documentation for more details. Overriding the extension's default `AsyncMode` is usually not
+recommended and should be considered only for important optimizations.
+-/
+@[implemented_by getStateUnsafe]
+opaque getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment)
+  (asyncMode := ext.asyncMode) : σ
 
 end EnvExtension
 
@@ -895,8 +951,18 @@ end EnvExtension
 
    Note that by default, extension state is *not* stored in .olean files and will not propagate across `import`s.
    For that, you need to register a persistent environment extension. -/
-def registerEnvExtension {σ : Type} (mkInitial : IO σ) : IO (EnvExtension σ) := EnvExtensionInterfaceImp.registerExt mkInitial
-private def mkInitialExtensionStates : IO (Array EnvExtensionState) := EnvExtensionInterfaceImp.mkInitialExtStates
+def registerEnvExtension {σ : Type} (mkInitial : IO σ)
+    (asyncMode : EnvExtension.AsyncMode := .mainOnly) : IO (EnvExtension σ) := do
+  unless (← initializing) do
+    throw (IO.userError "failed to register environment, extensions can only be registered during initialization")
+  let exts ← EnvExtension.envExtensionsRef.get
+  let idx := exts.size
+  let ext : EnvExtension σ := { idx, mkInitial, asyncMode }
+  -- safety: `EnvExtensionState` is opaque, so we can upcast to it
+  EnvExtension.envExtensionsRef.modify fun exts => exts.push (unsafe unsafeCast ext)
+  pure ext
+
+private def mkInitialExtensionStates : IO (Array EnvExtensionState) := EnvExtension.mkInitialExtStates
 
 @[export lean_mk_empty_environment]
 def mkEmptyEnvironment (trustLevel : UInt32 := 0) : IO Environment := do
@@ -992,7 +1058,8 @@ instance {α β σ} [Inhabited σ] : Inhabited (PersistentEnvExtension α β σ)
 namespace PersistentEnvExtension
 
 def getModuleEntries {α β σ : Type} [Inhabited σ] (ext : PersistentEnvExtension α β σ) (env : Environment) (m : ModuleIdx) : Array α :=
-  (ext.toEnvExtension.getState env).importedEntries.get! m
+  -- `importedEntries` is identical on all environment branches, so `local` is always sufficient
+  (ext.toEnvExtension.getState (asyncMode := .local) env).importedEntries.get! m
 
 def addEntry {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (b : β) : Environment :=
   ext.toEnvExtension.modifyState env fun s =>
@@ -1011,6 +1078,24 @@ def setState {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : En
 def modifyState {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (f : σ → σ) : Environment :=
   ext.toEnvExtension.modifyState env fun ps => { ps with state := f (ps.state) }
 
+-- `unsafe` fails to infer `Nonempty` here
+private unsafe def findStateAsyncUnsafe {α β σ : Type} [Inhabited σ]
+    (ext : PersistentEnvExtension α β σ) (env : Environment) (declPrefix : Name) : σ :=
+  -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
+  if let some { exts? := some exts, .. } := env.asyncConsts.findPrefix? declPrefix then
+    ext.toEnvExtension.getStateImpl exts.get |>.state
+  else
+    ext.toEnvExtension.getStateImpl env.checkedWithoutAsync.extensions |>.state
+
+/--
+Returns the final extension state on the environment branch corresponding to the passed declaration
+name, if any, or otherwise the state on the current branch. In other words, at most one environment
+branch will be blocked on.
+-/
+@[implemented_by findStateAsyncUnsafe]
+opaque findStateAsync {α β σ : Type} [Inhabited σ] (ext : PersistentEnvExtension α β σ)
+  (env : Environment) (declPrefix : Name) : σ
+
 end PersistentEnvExtension
 
 builtin_initialize persistentEnvExtensionsRef : IO.Ref (Array (PersistentEnvExtension EnvExtensionEntry EnvExtensionEntry EnvExtensionState)) ← IO.mkRef #[]
@@ -1022,11 +1107,12 @@ structure PersistentEnvExtensionDescr (α β σ : Type) where
   addEntryFn      : σ → β → σ
   exportEntriesFn : σ → Array α
   statsFn         : σ → Format := fun _ => Format.nil
+  asyncMode       : EnvExtension.AsyncMode := .mainOnly
 
 unsafe def registerPersistentEnvExtensionUnsafe {α β σ : Type} [Inhabited σ] (descr : PersistentEnvExtensionDescr α β σ) : IO (PersistentEnvExtension α β σ) := do
   let pExts ← persistentEnvExtensionsRef.get
   if pExts.any (fun ext => ext.name == descr.name) then throw (IO.userError s!"invalid environment extension, '{descr.name}' has already been used")
-  let ext ← registerEnvExtension do
+  let ext ← registerEnvExtension (asyncMode := descr.asyncMode) do
     let initial ← descr.mkInitial
     let s : PersistentEnvExtensionState α σ := {
       importedEntries := #[],
@@ -1058,6 +1144,7 @@ structure SimplePersistentEnvExtensionDescr (α σ : Type) where
   addEntryFn    : σ → α → σ
   addImportedFn : Array (Array α) → σ
   toArrayFn     : List α → Array α := fun es => es.toArray
+  asyncMode     : EnvExtension.AsyncMode := .mainOnly
 
 def registerSimplePersistentEnvExtension {α σ : Type} [Inhabited σ] (descr : SimplePersistentEnvExtensionDescr α σ) : IO (SimplePersistentEnvExtension α σ) :=
   registerPersistentEnvExtension {
@@ -1068,6 +1155,7 @@ def registerSimplePersistentEnvExtension {α σ : Type} [Inhabited σ] (descr :
       | (entries, s) => (e::entries, descr.addEntryFn s e),
     exportEntriesFn := fun s => descr.toArrayFn s.1.reverse,
     statsFn := fun s => format "number of local entries: " ++ format s.1.length
+    asyncMode := descr.asyncMode
   }
 
 namespace SimplePersistentEnvExtension
@@ -1226,7 +1314,8 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
   let extDescrs ← persistentEnvExtensionsRef.get
   /- For extensions starting at `startingAt`, ensure their `importedEntries` array have size `mods.size`. -/
   for extDescr in extDescrs[startingAt:] do
-    states := EnvExtensionInterfaceImp.modifyState extDescr.toEnvExtension states fun s =>
+    -- safety: as in `modifyState`
+    states := unsafe extDescr.toEnvExtension.modifyStateImpl states fun s =>
       { s with importedEntries := mkArray mods.size #[] }
   /- For each module `mod`, and `mod.entries`, if the extension name is one of the extensions after `startingAt`, set `entries` -/
   let extNameIdx ← mkExtNameMap startingAt
@@ -1234,7 +1323,8 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
     let mod := mods[modIdx]
     for (extName, entries) in mod.entries do
       if let some entryIdx := extNameIdx[extName]? then
-        states := EnvExtensionInterfaceImp.modifyState extDescrs[entryIdx]!.toEnvExtension states fun s =>
+        -- safety: as in `modifyState`
+        states := unsafe extDescrs[entryIdx]!.toEnvExtension.modifyStateImpl states fun s =>
           { s with importedEntries := s.importedEntries.set! modIdx entries }
   return env.setCheckedSync { env.checkedWithoutAsync with extensions := states }
 
@@ -1251,6 +1341,10 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
 /-- "Forward declaration" for retrieving the number of builtin attributes. -/
 @[extern 1 "lean_get_num_attributes"] opaque getNumBuiltinAttributes : IO Nat
 
+private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
+  let exts ← EnvExtension.ensureExtensionsArraySize env.checkedWithoutAsync.extensions
+  return env.modifyCheckedAsync ({ · with extensions := exts })
+
 private partial def finalizePersistentExtensions (env : Environment) (mods : Array ModuleData) (opts : Options) : IO Environment := do
   loop 0 env
 where

src/Lean/Meta/ArgsPacker.lean

@@ -471,7 +471,7 @@ Given types `(x : A) → (y : B[x]) → R₁[x,y]` and `(z : C) → R₂[z]`, re
 ```
 -/
 def uncurryType (argsPacker : ArgsPacker) (types : Array Expr) : MetaM Expr := do
-  let unary ← (Array.zipWith argsPacker.varNamess types Unary.uncurryType).mapM id
+  let unary ← (Array.zipWith Unary.uncurryType argsPacker.varNamess types).mapM id
   Mutual.uncurryType unary
 
 /--
@@ -482,11 +482,11 @@ and `(z : C) → R₂[z]`, returns an expression of type
 ```
 -/
 def uncurry (argsPacker : ArgsPacker) (es : Array Expr) : MetaM Expr := do
-  let unary ← (Array.zipWith argsPacker.varNamess es Unary.uncurry).mapM id
+  let unary ← (Array.zipWith Unary.uncurry argsPacker.varNamess es).mapM id
   Mutual.uncurry unary
 
 def uncurryWithType (argsPacker : ArgsPacker) (resultType : Expr) (es : Array Expr) : MetaM Expr := do
-  let unary ← (Array.zipWith argsPacker.varNamess es Unary.uncurry).mapM id
+  let unary ← (Array.zipWith Unary.uncurry argsPacker.varNamess es).mapM id
   Mutual.uncurryWithType resultType unary
 
 /--
@@ -497,7 +497,7 @@ and `(z : C) → R`, returns an expression of type
 ```
 -/
 def uncurryND (argsPacker : ArgsPacker) (es : Array Expr) : MetaM Expr := do
-  let unary ← (Array.zipWith argsPacker.varNamess es Unary.uncurry).mapM id
+  let unary ← (Array.zipWith Unary.uncurry argsPacker.varNamess es).mapM id
   Mutual.uncurryND unary
 
 /--
@@ -533,7 +533,7 @@ Given type `(x : a ⊗' b ⊕' c ⊗' d) → R` (non-dependent), return types
 -/
 def curryType (argsPacker : ArgsPacker) (t : Expr) : MetaM (Array Expr) := do
   let unary ← Mutual.curryType argsPacker.numFuncs t
-  (Array.zipWith argsPacker.varNamess unary Unary.curryType).mapM id
+  (Array.zipWith Unary.curryType argsPacker.varNamess unary).mapM id
 
 /--
 Given expression `e` of type `(x : a ⊗' b ⊕' c ⊗' d) → e[x]`, wraps that expression

src/Lean/Meta/Basic.lean

@@ -1657,7 +1657,7 @@ def withLocalDeclsD [Inhabited α] (declInfos : Array (Name × (Array Expr → n
     (declInfos.map (fun (name, typeCtor) => (name, BinderInfo.default, typeCtor))) k
 
 /--
-Simpler variant of `withLocalDeclsD` for brining variables into scope whose types do not depend
+Simpler variant of `withLocalDeclsD` for bringing variables into scope whose types do not depend
 on each other.
 -/
 def withLocalDeclsDND [Inhabited α] (declInfos : Array (Name × Expr)) (k : (xs : Array Expr) → n α) : n α :=

src/Lean/Meta/Constructions/BRecOn.lean

@@ -195,14 +195,14 @@ private def buildBRecOnMinorPremise (rlvl : Level) (motives : Array Expr)
     let rec go (prods : Array Expr) : List Expr → MetaM Expr
       | [] => minor_type.withApp fun minor_type_fn minor_type_args => do
           let b ← PProdN.mk rlvl prods
-          let .some ⟨idx, _⟩ := motives.indexOf? minor_type_fn
+          let .some idx := motives.idxOf? minor_type_fn
             | throwError m!"Did not find {minor_type} in {motives}"
           mkPProdMk (mkAppN fs[idx]! (minor_type_args.push b)) b
       | arg::args => do
         let argType ← inferType arg
         forallTelescope argType fun arg_args arg_type => do
           arg_type.withApp fun arg_type_fn arg_type_args => do
-            if let .some idx := motives.indexOf? arg_type_fn then
+            if let .some idx := motives.idxOf? arg_type_fn then
               let name ← arg.fvarId!.getUserName
               let type' ← mkForallFVars arg_args
                 (← mkPProd arg_type (mkAppN belows[idx]! arg_type_args) )
@@ -264,7 +264,7 @@ private def mkBRecOnFromRec (recName : Name) (ind reflexive : Bool) (nParams : N
     let indices : Array Expr := refArgs[nParams + recVal.numMotives + recVal.numMinors:refArgs.size - 1]
     let major   : Expr       := refArgs[refArgs.size - 1]!
 
-    let some idx := motives.indexOf? refBody.getAppFn
+    let some idx := motives.idxOf? refBody.getAppFn
       | throwError "result type of {refType} is not one of {motives}"
 
     -- universe parameter of the type fomer.

src/Lean/Meta/FunInfo.lean

@@ -31,9 +31,9 @@ private def collectDeps (fvars : Array Expr) (e : Expr) : Array Nat :=
     | .proj _ _ e      => visit e deps
     | .mdata _ e       => visit e deps
     | .fvar ..         =>
-      match fvars.indexOf? e with
+      match fvars.idxOf? e with
       | none   => deps
-      | some i => if deps.contains i.val then deps else deps.push i.val
+      | some i => if deps.contains i then deps else deps.push i
     | _ => deps
   let deps := visit e #[]
   deps.qsort (fun i j => i < j)
@@ -82,7 +82,7 @@ private def getFunInfoAux (fn : Expr) (maxArgs? : Option Nat) : MetaM FunInfo :=
                   for h2 : i in [:args.size] do
                     if outParamPositions.contains i then
                       let arg := args[i]
-                      if let some idx := fvars.indexOf? arg then
+                      if let some idx := fvars.idxOf? arg then
                         if (← whnf (← inferType arg)).isForall then
                           paramInfo := paramInfo.modify idx fun info => { info with higherOrderOutParam := true }
                           higherOrderOutParams := higherOrderOutParams.insert arg.fvarId!

src/Lean/Meta/IndPredBelow.lean

@@ -562,7 +562,7 @@ where
 def findBelowIdx (xs : Array Expr) (motive : Expr) : MetaM $ Option (Expr × Nat) := do
   xs.findSomeM? fun x => do
   (← whnf (← inferType x)).withApp fun f _ =>
-  match f.constName?, xs.indexOf? x with
+  match f.constName?, xs.idxOf? x with
   | some name, some idx => do
     if (← isInductivePredicate name) then
       let (_, belowTy) ← belowType motive xs idx
@@ -571,7 +571,7 @@ def findBelowIdx (xs : Array Expr) (motive : Expr) : MetaM $ Option (Expr × Nat
         trace[Meta.IndPredBelow.match] "{←Meta.ppGoal below.mvarId!}"
         if (← below.mvarId!.applyRules { backtracking := false, maxDepth := 1 } []).isEmpty then
           trace[Meta.IndPredBelow.match] "Found below term in the local context: {below}"
-          if (← xs.anyM (isDefEq below)) then pure none else pure (below, idx.val)
+          if (← xs.anyM (isDefEq below)) then pure none else pure (below, idx)
         else
           trace[Meta.IndPredBelow.match] "could not find below term in the local context"
           pure none

src/Lean/Meta/LazyDiscrTree.lean

@@ -980,8 +980,8 @@ def findImportMatches
   let ngen ← getNGen
   let (cNGen, ngen) := ngen.mkChild
   setNGen ngen
-  let dummy : IO.Ref (Option (LazyDiscrTree α)) ← IO.mkRef none
-  let ref := @EnvExtension.getState _ ⟨dummy⟩ ext (←getEnv)
+  let _ : Inhabited (IO.Ref (Option (LazyDiscrTree α))) := ⟨← IO.mkRef none⟩
+  let ref := ext.getState (←getEnv)
   let importTree ← (←ref.get).getDM $ do
     profileitM Exception  "lazy discriminator import initialization" (←getOptions) $ do
       let t ← createImportedDiscrTree (createTreeCtx cctx) cNGen (←getEnv) addEntry

src/Lean/Meta/Match/Match.lean

@@ -751,9 +751,9 @@ private partial def process (p : Problem) : StateRefT State MetaM Unit := do
 private def getUElimPos? (matcherLevels : List Level) (uElim : Level) : MetaM (Option Nat) :=
   if uElim == levelZero then
     return none
-  else match matcherLevels.toArray.indexOf? uElim with
+  else match matcherLevels.idxOf? uElim with
     | none => throwError "dependent match elimination failed, universe level not found"
-    | some pos => return some pos.val
+    | some pos => return some pos
 
 /- See comment at `mkMatcher` before `mkAuxDefinition` -/
 register_builtin_option bootstrap.genMatcherCode : Bool := {

src/Lean/Meta/Match/MatchEqs.lean

@@ -74,7 +74,7 @@ where
           matchConstRec f (fun _ => return none) fun recVal _ => do
             if recVal.getMajorIdx >= args.size then
               return none
-            let major := args[recVal.getMajorIdx]!
+            let major := args[recVal.getMajorIdx]!.consumeMData
             if major.isFVar then
               return some major.fvarId!
             else
@@ -129,9 +129,9 @@ where
           let typeNew := b.instantiate1 y
           if let some (_, lhs, rhs) ← matchEq? d then
             if lhs.isFVar && ys.contains lhs && args.contains lhs && isNamedPatternProof typeNew y then
-               let some j  := ys.indexOf? lhs | unreachable!
+               let some j  := ys.finIdxOf? lhs | unreachable!
                let ys      := ys.eraseIdx j
-               let some k  := args.indexOf? lhs | unreachable!
+               let some k  := args.idxOf? lhs | unreachable!
                let mask    := mask.set! k false
                let args    := args.map fun arg => if arg == lhs then rhs else arg
                let arg     ← mkEqRefl rhs

src/Lean/Meta/RecursorInfo.lean

@@ -107,7 +107,7 @@ private def getMajorPosDepElim (declName : Name) (majorPos? : Option Nat) (xs :
     if motiveArgs.isEmpty then
       throwError "invalid user defined recursor, '{declName}' does not support dependent elimination, and position of the major premise was not specified (solution: set attribute '[recursor <pos>]', where <pos> is the position of the major premise)"
     let major := motiveArgs.back!
-    match xs.indexOf? major with
+    match xs.idxOf? major with
     | some majorPos => pure (major, majorPos, true)
     | none          => throwError "ill-formed recursor '{declName}'"
 

src/Lean/Meta/Tactic/ElimInfo.lean

@@ -60,12 +60,12 @@ def getElimExprInfo (elimExpr : Expr) (baseDeclName? : Option Name := none) : Me
         throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
       unless motiveResultType.isSort do
         throwError "motive result type must be a sort{indentExpr motiveType}"
-    let some motivePos ← pure (xs.indexOf? motive) |
+    let some motivePos ← pure (xs.idxOf? motive) |
       throwError "unexpected eliminator type{indentExpr elimType}"
     let targetsPos ← targets.mapM fun target => do
-      match xs.indexOf? target with
+      match xs.idxOf? target with
       | none => throwError "unexpected eliminator type{indentExpr elimType}"
-      | some targetPos => pure targetPos.val
+      | some targetPos => pure targetPos
     let mut altsInfo := #[]
     let env ← getEnv
     for h : i in [:xs.size] do

src/Lean/Meta/Tactic/FunInd.lean

@@ -982,7 +982,7 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
           let fns := infos.map fun info =>
             mkAppN (.const info.name (info.levelParams.map mkLevelParam)) xs
           let isRecCall : Expr → Option Expr := fun e => do
-            if let .some i := motives.indexOf? e.getAppFn then
+            if let .some i := motives.idxOf? e.getAppFn then
               if e.getAppNumArgs = motiveArities[i]! then
                 return mkAppN fns[i]! e.getAppArgs
             .none

src/Lean/Meta/Tactic/Grind/Attr.lean

@@ -12,6 +12,7 @@ namespace Lean.Meta.Grind
 inductive AttrKind where
   | ematch (k : EMatchTheoremKind)
   | cases (eager : Bool)
+  | intro
   | infer
 
 /-- Return theorem kind for `stx` of the form `Attr.grindThmMod` -/
@@ -26,6 +27,7 @@ def getAttrKindCore (stx : Syntax) : CoreM AttrKind := do
   | `(Parser.Attr.grindMod| usr) => return .ematch .user
   | `(Parser.Attr.grindMod| cases) => return .cases false
   | `(Parser.Attr.grindMod| cases eager) => return .cases true
+  | `(Parser.Attr.grindMod| intro) => return .intro
   | _ => throwError "unexpected `grind` theorem kind: `{stx}`"
 
 /-- Return theorem kind for `stx` of the form `(Attr.grindMod)?` -/
@@ -64,9 +66,20 @@ builtin_initialize
       | .ematch .user => throwInvalidUsrModifier
       | .ematch k => addEMatchAttr declName attrKind k
       | .cases eager => addCasesAttr declName eager attrKind
+      | .intro =>
+        if let some info ← isCasesAttrPredicateCandidate? declName false then
+          for ctor in info.ctors do
+            addEMatchAttr ctor attrKind .default
+        else
+          throwError "invalid `[grind intro]`, `{declName}` is not an inductive predicate"
       | .infer =>
-        if (← isCasesAttrCandidate declName false) then
+        if let some declName ← isCasesAttrCandidate? declName false then
           addCasesAttr declName false attrKind
+          if let some info ← isInductivePredicate? declName then
+            -- If it is an inductive predicate,
+            -- we also add the contructors (intro rules) as E-matching rules
+            for ctor in info.ctors do
+              addEMatchAttr ctor attrKind .default
         else
           addEMatchAttr declName attrKind .default
     erase := fun declName => MetaM.run' do

src/Lean/Meta/Tactic/Grind/Cases.lean

@@ -73,14 +73,21 @@ private def getAlias? (value : Expr) : MetaM (Option Name) :=
     else
       return none
 
-partial def isCasesAttrCandidate (declName : Name) (eager : Bool) : CoreM Bool := do
+partial def isCasesAttrCandidate? (declName : Name) (eager : Bool) : CoreM (Option Name) := do
   match (← getConstInfo declName) with
-  | .inductInfo info => return !info.isRec || !eager
+  | .inductInfo info => if !info.isRec || !eager then return some declName else return none
   | .defnInfo info =>
     let some declName ← getAlias? info.value |>.run' {} {}
-      | return false
-    isCasesAttrCandidate declName eager
-  | _ => return false
+      | return none
+    isCasesAttrCandidate? declName eager
+  | _ => return none
+
+def isCasesAttrCandidate (declName : Name) (eager : Bool) : CoreM Bool := do
+  return (← isCasesAttrCandidate? declName eager).isSome
+
+def isCasesAttrPredicateCandidate? (declName : Name) (eager : Bool) : MetaM (Option InductiveVal) := do
+  let some declName ← isCasesAttrCandidate? declName eager | return none
+  isInductivePredicate? declName
 
 def validateCasesAttr (declName : Name) (eager : Bool) : CoreM Unit := do
   unless (← isCasesAttrCandidate declName eager) do

src/Lean/Meta/Tactic/Grind/EMatch.lean

@@ -279,7 +279,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
       let vType ← inferType v
       let report : M Unit := do
         reportIssue m!"type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
-      unless (← isDefEq mvarIdType vType) do
+      unless (← withDefault <| isDefEq mvarIdType vType) do
         let some heq ← proveEq? vType mvarIdType
           | report
             return ()

src/Lean/Meta/Tactic/Grind/EMatchTheorem.lean

@@ -359,9 +359,7 @@ def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
       else
         return (← x.fvarId!.getDecl).binderInfo matches .instImplicit
 
-private partial def go (pattern : Expr) (root := false) : M Expr := do
-  if root && !pattern.hasLooseBVars then
-    throwError "invalid pattern, it does not have pattern variables"
+private partial def go (pattern : Expr) : M Expr := do
   if let some (e, k) := isOffsetPattern? pattern then
     let e ← goArg e (isSupport := false)
     if e == dontCare then
@@ -550,9 +548,11 @@ def mkEMatchTheoremCore (origin : Origin) (levelParams : Array Name) (numParams
     levelParams, origin, kind
   }
 
-private def getProofFor (declName : Name) : CoreM Expr := do
-  let .thmInfo info ← getConstInfo declName
-    | throwError "`{declName}` is not a theorem"
+private def getProofFor (declName : Name) : MetaM Expr := do
+  let info ← getConstInfo declName
+  unless info.isTheorem do
+    unless (← isProp info.type) do
+      throwError "invalid E-matching theorem `{declName}`, type is not a proposition"
   let us := info.levelParams.map mkLevelParam
   return mkConst declName us
 
@@ -653,11 +653,42 @@ private def addNewPattern (p : Expr) : CollectorM Unit := do
     trace[grind.ematch.pattern.search] "found full coverage"
   modify fun s => { s with patterns := s.patterns.push p, done }
 
+/-- Collect the pattern (i.e., de Bruijn) variables in the given pattern. -/
+private def collectPatternBVars (p : Expr) : List Nat :=
+  go p |>.run [] |>.2
+where
+  go (e : Expr) : StateM (List Nat) Unit := do
+    match e with
+    | .app f a    => go f; go a
+    | .mdata _ b  => go b
+    | .bvar idx   => modify fun s => if s.contains idx then s else idx :: s
+    | _           => return ()
+
+/--
+Returns `true` if pattern `p` contains a child `c` such that
+1- `p` and `c` have the same pattern variables.
+2- `c` is not a support argument. See `NormalizePattern.getPatternSupportMask` for definition.
+3- `c` is not an offset pattern.
+4- `c` is not a bound variable.
+-/
+private def hasChildWithSameBVars (p : Expr) (supportMask : Array Bool) : CoreM Bool := do
+  let s := collectPatternBVars p
+  for arg in p.getAppArgs, support in supportMask do
+    unless support do
+    unless arg.isBVar do
+    unless isOffsetPattern? arg |>.isSome do
+      let sArg := collectPatternBVars arg
+      if s ⊆ sArg then
+        trace[Meta.debug] "SKIPPED: {p}, {arg}, {s}, {sArg}"
+        return true
+  return false
+
 private partial def collect (e : Expr) : CollectorM Unit := do
   if (← get).done then return ()
   match e with
   | .app .. =>
     let f := e.getAppFn
+    let supportMask ← NormalizePattern.getPatternSupportMask f e.getAppNumArgs
     if (← isPatternFnCandidate f) then
       let saved ← getThe NormalizePattern.State
       try
@@ -668,8 +699,9 @@ private partial def collect (e : Expr) : CollectorM Unit := do
           return ()
         let p ← NormalizePattern.normalizePattern p
         if saved.bvarsFound.size < (← getThe NormalizePattern.State).bvarsFound.size then
-          addNewPattern p
-          return ()
+          unless (← hasChildWithSameBVars p supportMask) do
+            addNewPattern p
+            return ()
         trace[grind.ematch.pattern.search] "skip, no new variables covered"
         -- restore state and continue search
         set saved
@@ -678,8 +710,8 @@ private partial def collect (e : Expr) : CollectorM Unit := do
         -- restore state and continue search
         set saved
     let args := e.getAppArgs
-    for arg in args, flag in (← NormalizePattern.getPatternSupportMask f args.size) do
-      unless flag do
+    for arg in args, support in supportMask do
+      unless support do
         collect arg
   | .forallE _ d b _ =>
     if (← pure e.isArrow <&&> isProp d <&&> isProp b) then
@@ -699,7 +731,55 @@ private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Ar
     | return none
   return some (ps, s.symbols.toList)
 
-def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : EMatchTheoremKind) : MetaM (Option EMatchTheorem) := do
+/--
+Tries to find a ground pattern to activate the theorem.
+This is used for theorems such as `theorem evenZ : Even 0`.
+This function is only used if `collectPatterns?` returns `none`.
+-/
+private partial def collectGroundPattern? (proof : Expr) (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option (Expr × List HeadIndex)) := do
+  unless (← checkCoverage proof xs.size {}) matches .ok do
+    return none
+  let go? : CollectorM (Option Expr) := do
+    for place in searchPlaces do
+      let place ← preprocessPattern place
+      if let some r ← visit? place then
+        return r
+    return none
+  let (some p, s) ← go? { proof, xs } |>.run' {} |>.run {}
+    | return none
+  return some (p, s.symbols.toList)
+where
+  visit? (e : Expr) : CollectorM (Option Expr) := do
+    match e with
+    | .app .. =>
+      let f := e.getAppFn
+      if (← isPatternFnCandidate f) then
+        let e ← NormalizePattern.normalizePattern e
+        return some e
+      else
+        let args := e.getAppArgs
+        for arg in args, flag in (← NormalizePattern.getPatternSupportMask f args.size) do
+          unless flag do
+            if let some r ← visit? arg then
+              return r
+        return none
+    | .forallE _ d b _ =>
+      if (← pure e.isArrow <&&> isProp d <&&> isProp b) then
+        if let some d ← visit? d then return d
+        visit? b
+      else
+        return none
+    | _ => return none
+
+/--
+Creates an E-match theorem using the given proof and kind.
+If `groundPatterns` is `true`, it accepts patterns without pattern variables. This is useful for
+theorems such as `theorem evenZ : Even 0`. For local theorems, we use `groundPatterns := false`
+since the theorem is already in the `grind` state and there is nothing to be instantiated.
+-/
+def mkEMatchTheoremWithKind?
+      (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : EMatchTheoremKind)
+      (groundPatterns := true) : MetaM (Option EMatchTheorem) := do
   if kind == .eqLhs then
     return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := true) (useLhs := true))
   else if kind == .eqRhs then
@@ -707,7 +787,24 @@ def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof
   else if kind == .eqBwd then
     return (← mkEMatchEqBwdTheoremCore origin levelParams proof)
   let type ← inferType proof
-  forallTelescopeReducing type fun xs type => do
+  /-
+  Remark: we should not use `forallTelescopeReducing` (with default reducibility) here
+  because it may unfold a definition/abstraction, and then select a suboptimal pattern.
+  Here is an example. Suppose we have
+  ```
+  def State.le (σ₁ σ₂ : State) : Prop := ∀ ⦃x : Var⦄ ⦃v : Val⦄, σ₁.find? x = some v → σ₂.find? x = some v
+
+  infix:50 " ≼ " => State.le
+  ```
+  Then, we write the theorem
+  ```
+  @[grind] theorem State.join_le_left (σ₁ σ₂ : State) : σ₁.join σ₂ ≼ σ₁ := by
+  ```
+  We do not want `State.le` to be unfolded and the abstraction exposed.
+
+  That said, we must still reduce `[reducible]` definitions since `grind` unfolds them.
+  -/
+  withReducible <| forallTelescopeReducing type fun xs type => withDefault do
     let searchPlaces ← match kind with
       | .fwd =>
         let ps ← getPropTypes xs
@@ -720,8 +817,14 @@ def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof
     go xs searchPlaces
 where
   go (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option EMatchTheorem) := do
-    let some (patterns, symbols) ← collectPatterns? proof xs searchPlaces
-      | return none
+    let (patterns, symbols) ← if let some r ← collectPatterns? proof xs searchPlaces then
+      pure r
+    else if !groundPatterns then
+      return none
+    else if let some (pattern, symbols) ← collectGroundPattern? proof xs searchPlaces then
+      pure ([pattern], symbols)
+    else
+      return none
     let numParams := xs.size
     trace[grind.ematch.pattern] "{← origin.pp}: {patterns.map ppPattern}"
     return some {
@@ -774,11 +877,13 @@ def addEMatchAttr (declName : Name) (attrKind : AttributeKind) (thmKind : EMatch
   else if thmKind == .eqBoth then
     addGrindEqAttr declName attrKind thmKind (useLhs := true)
     addGrindEqAttr declName attrKind thmKind (useLhs := false)
-  else if !(← getConstInfo declName).isTheorem then
-    addGrindEqAttr declName attrKind thmKind
   else
-    let thm ← mkEMatchTheoremForDecl declName thmKind
-    ematchTheoremsExt.add thm attrKind
+    let info ← getConstInfo declName
+    if !info.isTheorem && !info.isCtor && !info.isAxiom then
+      addGrindEqAttr declName attrKind thmKind
+    else
+      let thm ← mkEMatchTheoremForDecl declName thmKind
+      ematchTheoremsExt.add thm attrKind
 
 def eraseEMatchAttr (declName : Name) : MetaM Unit := do
   /-

src/Lean/Meta/Tactic/Grind/ForallProp.lean

@@ -55,7 +55,7 @@ private def isEqTrueHyp? (proof : Expr) : Option FVarId := Id.run do
 /-- Similar to `mkEMatchTheoremWithKind?`, but swallow any exceptions. -/
 private def mkEMatchTheoremWithKind'? (origin : Origin) (proof : Expr) (kind : EMatchTheoremKind) : MetaM (Option EMatchTheorem) := do
   try
-    mkEMatchTheoremWithKind? origin #[] proof kind
+    mkEMatchTheoremWithKind? origin #[] proof kind (groundPatterns := false)
   catch _ =>
     return none
 

src/Lean/Meta/Tactic/Grind/Main.lean

@@ -56,21 +56,28 @@ def GrindM.run (x : GrindM α) (mainDeclName : Name) (params : Params) (fallback
   let scState := ShareCommon.State.mk _
   let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
   let (trueExpr, scState)  := ShareCommon.State.shareCommon scState (mkConst ``True)
+  let (bfalseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``Bool.false)
+  let (btrueExpr, scState)  := ShareCommon.State.shareCommon scState (mkConst ``Bool.true)
   let (natZExpr, scState)  := ShareCommon.State.shareCommon scState (mkNatLit 0)
   let simprocs := params.normProcs
   let simp := params.norm
   let config := params.config
-  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr, natZExpr }
+  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp }
+    |>.run' { scState, trueExpr, falseExpr, natZExpr, btrueExpr, bfalseExpr }
 
 private def mkGoal (mvarId : MVarId) (params : Params) : GrindM Goal := do
   let trueExpr ← getTrueExpr
   let falseExpr ← getFalseExpr
+  let btrueExpr ← getBoolTrueExpr
+  let bfalseExpr ← getBoolFalseExpr
   let natZeroExpr ← getNatZeroExpr
   let thmMap := params.ematch
   let casesTypes := params.casesTypes
   GoalM.run' { mvarId, thmMap, casesTypes } do
     mkENodeCore falseExpr (interpreted := true) (ctor := false) (generation := 0)
     mkENodeCore trueExpr (interpreted := true) (ctor := false) (generation := 0)
+    mkENodeCore btrueExpr (interpreted := false) (ctor := true) (generation := 0)
+    mkENodeCore bfalseExpr (interpreted := false) (ctor := true) (generation := 0)
     mkENodeCore natZeroExpr (interpreted := true) (ctor := false) (generation := 0)
     for thm in params.extra do
       activateTheorem thm 0
@@ -94,6 +101,30 @@ structure Result where
   issues   : List MessageData
   config   : Grind.Config
   trace    : Trace
+  counters : Counters
+
+private def countersToMessageData (header : String) (cls : Name) (data : Array (Name × Nat)) : MetaM MessageData := do
+  let data := data.qsort fun (d₁, c₁) (d₂, c₂) => if c₁ == c₂ then Name.lt d₁ d₂ else c₁ > c₂
+  let data ← data.mapM fun (declName, counter) =>
+    return .trace { cls } m!"{.ofConst (← mkConstWithLevelParams declName)} ↦ {counter}" #[]
+  return .trace { cls } header data
+
+def Counters.toMessageData? (cs : Counters) : MetaM (Option MessageData) := do
+  let thms := cs.thm.toList.toArray.filterMap fun (origin, c) =>
+    match origin with
+    | .decl declName => some (declName, c)
+    | _ => none
+  -- We do not report `cases` applications on builtin types
+  let cases := cs.case.toList.toArray.filter fun (declName, _) => !isBuiltinEagerCases declName
+  let mut msgs := #[]
+  unless thms.isEmpty do
+    msgs := msgs.push <| (← countersToMessageData "E-Matching instances" `thm thms)
+  unless cases.isEmpty do
+    msgs := msgs.push <| (← countersToMessageData "Cases instances" `cases cases)
+  if msgs.isEmpty then
+    return none
+  else
+    return some <| .trace { cls := `grind } "Counters" msgs
 
 def Result.hasFailures (r : Result) : Bool :=
   !r.failures.isEmpty
@@ -106,16 +137,24 @@ def Result.toMessageData (result : Result) : MetaM MessageData := do
     issues := .trace { cls := `issue } m #[] :: issues
   unless issues.isEmpty do
     msgs := msgs ++ [.trace { cls := `grind } "Issues" issues.reverse.toArray]
+  if let some msg ← result.counters.toMessageData? then
+    msgs := msgs ++ [msg]
   return MessageData.joinSep msgs m!"\n"
 
-def main (mvarId : MVarId) (params : Params) (mainDeclName : Name) (fallback : Fallback) : MetaM Result := do
+def main (mvarId : MVarId) (params : Params) (mainDeclName : Name) (fallback : Fallback) : MetaM Result := do profileitM Exception "grind" (← getOptions) do
   let go : GrindM Result := do
     let goals ← initCore mvarId params
     let (failures, skipped) ← solve goals fallback
     trace[grind.debug.final] "{← ppGoals goals}"
-    let issues := (← get).issues
-    let trace := (← get).trace
-    return { failures, skipped, issues, config := params.config, trace }
+    let issues   := (← get).issues
+    let trace    := (← get).trace
+    let counters := (← get).counters
+    if failures.isEmpty then
+      -- If there are no failures and diagnostics are enabled, we still report the performance counters.
+      if (← isDiagnosticsEnabled) then
+        if let some msg ← counters.toMessageData? then
+          logInfo msg
+    return { failures, skipped, issues, config := params.config, trace, counters }
   go.run mainDeclName params fallback
 
 end Lean.Meta.Grind

src/Lean/Meta/Tactic/Grind/MatchCond.lean

@@ -291,7 +291,12 @@ where
     let some (α?, lhs, rhs) := isEqHEq? (← inferType h)
       | return none
     let target ← (← get).mvarId.getType
-    let root ← getRootENode lhs
+    -- We use `shareCommon` here because we may accessing a new expression
+    -- created when we infer the type of the `noConfusion` term below
+    let lhs ← shareCommon lhs
+    let some root ← getRootENode? lhs
+      | reportIssue "found term that has not been internalized{indentExpr lhs}\nwhile trying to construct a proof for `MatchCond`{indentExpr e}"
+        return none
     let isHEq := α?.isSome
     let h ← if isHEq then
       mkEqOfHEq (← mkHEqTrans (← mkHEqProof root.self lhs) h)
@@ -300,6 +305,7 @@ where
     if root.ctor then
       let some ctorLhs ← isConstructorApp? root.self | return none
       let some ctorRhs ← isConstructorApp? rhs | return none
+      -- See comment on `shareCommon` above.
       let h ← mkNoConfusion target h
       if ctorLhs.name ≠ ctorRhs.name then
         return some h

src/Lean/Meta/Tactic/Grind/PP.lean

@@ -105,15 +105,15 @@ private def ppEqcs : M Unit := do
      pushMsg <| .trace { cls := `eqc } "Equivalence classes" otherEqcs
 
 private def ppEMatchTheorem (thm : EMatchTheorem) : MetaM MessageData := do
-  let m := m!"{← thm.origin.pp}:\n{← inferType thm.proof}\npatterns: {thm.patterns.map ppPattern}"
+  let m := m!"{← thm.origin.pp}: {thm.patterns.map ppPattern}"
   return .trace { cls := `thm } m #[]
 
-private def ppActiveTheorems : M Unit := do
+private def ppActiveTheoremPatterns : M Unit := do
   let goal ← read
   let m ← goal.thms.toArray.mapM fun thm => ppEMatchTheorem thm
   let m := m ++ (← goal.newThms.toArray.mapM fun thm => ppEMatchTheorem thm)
   unless m.isEmpty do
-    pushMsg <| .trace { cls := `ematch } "E-matching" m
+    pushMsg <| .trace { cls := `ematch } "E-matching patterns" m
 
 private def ppOffset : M Unit := do
   let goal ← read
@@ -142,6 +142,14 @@ private def ppThresholds (c : Grind.Config) : M Unit := do
   unless msgs.isEmpty do
     pushMsg <| .trace { cls := `limits } "Thresholds reached" msgs
 
+private def ppCasesTrace : M Unit := do
+  let goal ← read
+  unless goal.casesTrace.isEmpty do
+    let mut msgs := #[]
+    for (e, num) in goal.casesTrace.reverse do
+      msgs := msgs.push <| .trace { cls := `cases } m!"[{num}]: {e}" #[]
+    pushMsg <| .trace { cls := `cases } "Case analyses" msgs
+
 def goalToMessageData (goal : Goal) (config : Grind.Config) : MetaM MessageData := goal.mvarId.withContext do
   let (_, m) ← go goal |>.run #[]
   let gm := MessageData.trace { cls := `grind, collapsed := false } "Diagnostics" m
@@ -151,7 +159,8 @@ where
   go : M Unit := do
     pushMsg <| ppExprArray `facts "Asserted facts" goal.facts.toArray `prop
     ppEqcs
-    ppActiveTheorems
+    ppCasesTrace
+    ppActiveTheoremPatterns
     ppOffset
     ppThresholds config
 

src/Lean/Meta/Tactic/Grind/Propagate.lean

@@ -27,16 +27,16 @@ builtin_grind_propagator propagateAndUp ↑And := fun e => do
   let_expr And a b := e | return ()
   if (← isEqTrue a) then
     -- a = True → (a ∧ b) = b
-    pushEq e b <| mkApp3 (mkConst ``Lean.Grind.and_eq_of_eq_true_left) a b (← mkEqTrueProof a)
+    pushEq e b <| mkApp3 (mkConst ``Grind.and_eq_of_eq_true_left) a b (← mkEqTrueProof a)
   else if (← isEqTrue b) then
     -- b = True → (a ∧ b) = a
-    pushEq e a <| mkApp3 (mkConst ``Lean.Grind.and_eq_of_eq_true_right) a b (← mkEqTrueProof b)
+    pushEq e a <| mkApp3 (mkConst ``Grind.and_eq_of_eq_true_right) a b (← mkEqTrueProof b)
   else if (← isEqFalse a) then
     -- a = False → (a ∧ b) = False
-    pushEqFalse e <| mkApp3 (mkConst ``Lean.Grind.and_eq_of_eq_false_left) a b (← mkEqFalseProof a)
+    pushEqFalse e <| mkApp3 (mkConst ``Grind.and_eq_of_eq_false_left) a b (← mkEqFalseProof a)
   else if (← isEqFalse b) then
     -- b = False → (a ∧ b) = False
-    pushEqFalse e <| mkApp3 (mkConst ``Lean.Grind.and_eq_of_eq_false_right) a b (← mkEqFalseProof b)
+    pushEqFalse e <| mkApp3 (mkConst ``Grind.and_eq_of_eq_false_right) a b (← mkEqFalseProof b)
 
 /--
 Propagates truth values downwards for a conjunction `a ∧ b` when the
@@ -46,8 +46,8 @@ builtin_grind_propagator propagateAndDown ↓And := fun e => do
   if (← isEqTrue e) then
     let_expr And a b := e | return ()
     let h ← mkEqTrueProof e
-    pushEqTrue a <| mkApp3 (mkConst ``Lean.Grind.eq_true_of_and_eq_true_left) a b h
-    pushEqTrue b <| mkApp3 (mkConst ``Lean.Grind.eq_true_of_and_eq_true_right) a b h
+    pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_and_eq_true_left) a b h
+    pushEqTrue b <| mkApp3 (mkConst ``Grind.eq_true_of_and_eq_true_right) a b h
 
 /--
 Propagates equalities for a disjunction `a ∨ b` based on the truth values
@@ -63,16 +63,16 @@ builtin_grind_propagator propagateOrUp ↑Or := fun e => do
   let_expr Or a b := e | return ()
   if (← isEqFalse a) then
     -- a = False → (a ∨ b) = b
-    pushEq e b <| mkApp3 (mkConst ``Lean.Grind.or_eq_of_eq_false_left) a b (← mkEqFalseProof a)
+    pushEq e b <| mkApp3 (mkConst ``Grind.or_eq_of_eq_false_left) a b (← mkEqFalseProof a)
   else if (← isEqFalse b) then
     -- b = False → (a ∨ b) = a
-    pushEq e a <| mkApp3 (mkConst ``Lean.Grind.or_eq_of_eq_false_right) a b (← mkEqFalseProof b)
+    pushEq e a <| mkApp3 (mkConst ``Grind.or_eq_of_eq_false_right) a b (← mkEqFalseProof b)
   else if (← isEqTrue a) then
     -- a = True → (a ∨ b) = True
-    pushEqTrue e <| mkApp3 (mkConst ``Lean.Grind.or_eq_of_eq_true_left) a b (← mkEqTrueProof a)
+    pushEqTrue e <| mkApp3 (mkConst ``Grind.or_eq_of_eq_true_left) a b (← mkEqTrueProof a)
   else if (← isEqTrue b) then
     -- b = True → (a ∧ b) = True
-    pushEqTrue e <| mkApp3 (mkConst ``Lean.Grind.or_eq_of_eq_true_right) a b (← mkEqTrueProof b)
+    pushEqTrue e <| mkApp3 (mkConst ``Grind.or_eq_of_eq_true_right) a b (← mkEqTrueProof b)
 
 /--
 Propagates truth values downwards for a disjuction `a ∨ b` when the
@@ -82,8 +82,8 @@ builtin_grind_propagator propagateOrDown ↓Or := fun e => do
   if (← isEqFalse e) then
     let_expr Or a b := e | return ()
     let h ← mkEqFalseProof e
-    pushEqFalse a <| mkApp3 (mkConst ``Lean.Grind.eq_false_of_or_eq_false_left) a b h
-    pushEqFalse b <| mkApp3 (mkConst ``Lean.Grind.eq_false_of_or_eq_false_right) a b h
+    pushEqFalse a <| mkApp3 (mkConst ``Grind.eq_false_of_or_eq_false_left) a b h
+    pushEqFalse b <| mkApp3 (mkConst ``Grind.eq_false_of_or_eq_false_right) a b h
 
 /--
 Propagates equalities for a negation `Not a` based on the truth value of `a`.
@@ -96,12 +96,12 @@ builtin_grind_propagator propagateNotUp ↑Not := fun e => do
   let_expr Not a := e | return ()
   if (← isEqFalse a) then
     -- a = False → (Not a) = True
-    pushEqTrue e <| mkApp2 (mkConst ``Lean.Grind.not_eq_of_eq_false) a (← mkEqFalseProof a)
+    pushEqTrue e <| mkApp2 (mkConst ``Grind.not_eq_of_eq_false) a (← mkEqFalseProof a)
   else if (← isEqTrue a) then
     -- a = True → (Not a) = False
-    pushEqFalse e <| mkApp2 (mkConst ``Lean.Grind.not_eq_of_eq_true) a (← mkEqTrueProof a)
+    pushEqFalse e <| mkApp2 (mkConst ``Grind.not_eq_of_eq_true) a (← mkEqTrueProof a)
   else if (← isEqv e a) then
-    closeGoal <| mkApp2 (mkConst ``Lean.Grind.false_of_not_eq_self) a (← mkEqProof e a)
+    closeGoal <| mkApp2 (mkConst ``Grind.false_of_not_eq_self) a (← mkEqProof e a)
 
 /--
 Propagates truth values downwards for a negation expression `Not a` based on the truth value of `Not a`.
@@ -113,21 +113,31 @@ This function performs the following:
 builtin_grind_propagator propagateNotDown ↓Not := fun e => do
   let_expr Not a := e | return ()
   if (← isEqFalse e) then
-    pushEqTrue a <| mkApp2 (mkConst ``Lean.Grind.eq_true_of_not_eq_false) a (← mkEqFalseProof e)
+    pushEqTrue a <| mkApp2 (mkConst ``Grind.eq_true_of_not_eq_false) a (← mkEqFalseProof e)
   else if (← isEqTrue e) then
-    pushEqFalse a <| mkApp2 (mkConst ``Lean.Grind.eq_false_of_not_eq_true) a (← mkEqTrueProof e)
+    pushEqFalse a <| mkApp2 (mkConst ``Grind.eq_false_of_not_eq_true) a (← mkEqTrueProof e)
   else if (← isEqv e a) then
-    closeGoal <| mkApp2 (mkConst ``Lean.Grind.false_of_not_eq_self) a (← mkEqProof e a)
+    closeGoal <| mkApp2 (mkConst ``Grind.false_of_not_eq_self) a (← mkEqProof e a)
 
 /-- Propagates `Eq` upwards -/
 builtin_grind_propagator propagateEqUp ↑Eq := fun e => do
   let_expr Eq _ a b := e | return ()
   if (← isEqTrue a) then
-    pushEq e b <| mkApp3 (mkConst ``Lean.Grind.eq_eq_of_eq_true_left) a b (← mkEqTrueProof a)
+    pushEq e b <| mkApp3 (mkConst ``Grind.eq_eq_of_eq_true_left) a b (← mkEqTrueProof a)
   else if (← isEqTrue b) then
-    pushEq e a <| mkApp3 (mkConst ``Lean.Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
+    pushEq e a <| mkApp3 (mkConst ``Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
   else if (← isEqv a b) then
     pushEqTrue e <| mkEqTrueCore e (← mkEqProof a b)
+  let aRoot ← getRootENode a
+  let bRoot ← getRootENode b
+  if aRoot.ctor && bRoot.ctor && aRoot.self.getAppFn != bRoot.self.getAppFn then
+    -- ¬a = b
+    let hne ← withLocalDeclD `h (← mkEq a b) fun h => do
+      let hf ← mkEqTrans (← mkEqProof aRoot.self a) h
+      let hf ← mkEqTrans hf (← mkEqProof b bRoot.self)
+      let hf ← mkNoConfusion (← getFalseExpr) hf
+      mkLambdaFVars #[h] hf
+    pushEqFalse e <| mkApp2 (mkConst ``eq_false) e hne
 
 /-- Propagates `Eq` downwards -/
 builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
@@ -197,4 +207,80 @@ builtin_grind_propagator propagateDIte ↑dite := fun e => do
      internalize r (← getGeneration e)
      pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) α c h a b r h₁ h₂
 
+builtin_grind_propagator propagateDecideDown ↓decide := fun e => do
+  let root ← getRootENode e
+  unless root.ctor do return ()
+  let_expr decide p h := e | return ()
+  if root.self.isConstOf ``true then
+    pushEqTrue p <| mkApp3 (mkConst ``Grind.of_decide_eq_true) p h (← mkEqProof e root.self)
+  else if root.self.isConstOf ``false then
+    pushEqFalse p <| mkApp3 (mkConst ``Grind.of_decide_eq_false) p h (← mkEqProof e root.self)
+
+builtin_grind_propagator propagateDecideUp ↑decide := fun e => do
+  let_expr decide p h := e | return ()
+  if (← isEqTrue p) then
+    pushEq e (← getBoolTrueExpr) <| mkApp3 (mkConst ``Grind.decide_eq_true) p h (← mkEqTrueProof p)
+  else if (← isEqFalse p) then
+    pushEq e (← getBoolFalseExpr) <| mkApp3 (mkConst ``Grind.decide_eq_false) p h (← mkEqFalseProof p)
+
+/-- `Bool` version of `propagateAndUp` -/
+builtin_grind_propagator propagateBoolAndUp ↑Bool.and := fun e => do
+  let_expr Bool.and a b := e | return ()
+  if (← isEqBoolTrue a) then
+    pushEq e b <| mkApp3 (mkConst ``Grind.Bool.and_eq_of_eq_true_left) a b (← mkEqBoolTrueProof a)
+  else if (← isEqBoolTrue b) then
+    pushEq e a <| mkApp3 (mkConst ``Grind.Bool.and_eq_of_eq_true_right) a b (← mkEqBoolTrueProof b)
+  else if (← isEqBoolFalse a) then
+    pushEqBoolFalse e <| mkApp3 (mkConst ``Grind.Bool.and_eq_of_eq_false_left) a b (← mkEqBoolFalseProof a)
+  else if (← isEqBoolFalse b) then
+    pushEqBoolFalse e <| mkApp3 (mkConst ``Grind.Bool.and_eq_of_eq_false_right) a b (← mkEqBoolFalseProof b)
+
+/-- `Bool` version of `propagateAndDown` -/
+builtin_grind_propagator propagateBoolAndDown ↓Bool.and := fun e => do
+  if (← isEqBoolTrue e) then
+    let_expr Bool.and a b := e | return ()
+    let h ← mkEqBoolTrueProof e
+    pushEqBoolTrue a <| mkApp3 (mkConst ``Grind.Bool.eq_true_of_and_eq_true_left) a b h
+    pushEqBoolTrue b <| mkApp3 (mkConst ``Grind.Bool.eq_true_of_and_eq_true_right) a b h
+
+/-- `Bool` version of `propagateOrUp` -/
+builtin_grind_propagator propagateBoolOrUp ↑Bool.or := fun e => do
+  let_expr Bool.or a b := e | return ()
+  if (← isEqBoolFalse a) then
+    pushEq e b <| mkApp3 (mkConst ``Grind.Bool.or_eq_of_eq_false_left) a b (← mkEqBoolFalseProof a)
+  else if (← isEqBoolFalse b) then
+    pushEq e a <| mkApp3 (mkConst ``Grind.Bool.or_eq_of_eq_false_right) a b (← mkEqBoolFalseProof b)
+  else if (← isEqBoolTrue a) then
+    pushEqBoolTrue e <| mkApp3 (mkConst ``Grind.Bool.or_eq_of_eq_true_left) a b (← mkEqBoolTrueProof a)
+  else if (← isEqBoolTrue b) then
+    pushEqBoolTrue e <| mkApp3 (mkConst ``Grind.Bool.or_eq_of_eq_true_right) a b (← mkEqBoolTrueProof b)
+
+/-- `Bool` version of `propagateOrDown` -/
+builtin_grind_propagator propagateBoolOrDown ↓Bool.or := fun e => do
+  if (← isEqBoolFalse e) then
+    let_expr Bool.or a b := e | return ()
+    let h ← mkEqBoolFalseProof e
+    pushEqBoolFalse a <| mkApp3 (mkConst ``Grind.Bool.eq_false_of_or_eq_false_left) a b h
+    pushEqBoolFalse b <| mkApp3 (mkConst ``Grind.Bool.eq_false_of_or_eq_false_right) a b h
+
+/-- `Bool` version of `propagateNotUp` -/
+builtin_grind_propagator propagateBoolNotUp ↑Bool.not := fun e => do
+  let_expr Bool.not a := e | return ()
+  if (← isEqBoolFalse a) then
+    pushEqBoolTrue e <| mkApp2 (mkConst ``Grind.Bool.not_eq_of_eq_false) a (← mkEqBoolFalseProof a)
+  else if (← isEqBoolTrue a) then
+    pushEqBoolFalse e <| mkApp2 (mkConst ``Grind.Bool.not_eq_of_eq_true) a (← mkEqBoolTrueProof a)
+  else if (← isEqv e a) then
+    closeGoal <| mkApp2 (mkConst ``Grind.Bool.false_of_not_eq_self) a (← mkEqProof e a)
+
+/-- `Bool` version of `propagateNotDown` -/
+builtin_grind_propagator propagateBoolNotDown ↓Bool.not := fun e => do
+  let_expr Bool.not a := e | return ()
+  if (← isEqBoolFalse e) then
+    pushEqBoolTrue a <| mkApp2 (mkConst ``Grind.Bool.eq_true_of_not_eq_false) a (← mkEqBoolFalseProof e)
+  else if (← isEqBoolTrue e) then
+    pushEqBoolFalse a <| mkApp2 (mkConst ``Grind.Bool.eq_false_of_not_eq_true) a (← mkEqBoolTrueProof e)
+  else if (← isEqv e a) then
+    closeGoal <| mkApp2 (mkConst ``Grind.Bool.false_of_not_eq_self) a (← mkEqProof e a)
+
 end Lean.Meta.Grind

src/Lean/Meta/Tactic/Grind/Split.lean

@@ -195,7 +195,8 @@ def splitNext : GrindTactic := fun goal => do
           saveCases declName false
       cases (← get).mvarId major
     let goal ← get
-    let goals := mvarIds.map fun mvarId => { goal with mvarId }
+    let numSubgoals := mvarIds.length
+    let goals := mvarIds.map fun mvarId => { goal with mvarId, casesTrace := (c, numSubgoals) :: goal.casesTrace }
     let goals ← introNewHyp goals [] genNew
     return some goals
   return goals?

src/Lean/Meta/Tactic/Grind/Types.lean

@@ -45,6 +45,12 @@ register_builtin_option grind.debug.proofs : Bool := {
   descr    := "check proofs between the elements of all equivalence classes"
 }
 
+register_builtin_option grind.warning : Bool := {
+  defValue := true
+  group    := "debug"
+  descr    := "disable `grind` usage warning"
+}
+
 /-- Context for `GrindM` monad. -/
 structure Context where
   simp         : Simp.Context
@@ -82,10 +88,19 @@ structure Trace where
   cases      : PHashSet Name := {}
   deriving Inhabited
 
+structure Counters where
+  /-- Number of times E-match theorem has been instantiated. -/
+  thm  : PHashMap Origin Nat := {}
+  /-- Number of times a `cases` has been performed on an inductive type/predicate -/
+  case : PHashMap Name Nat := {}
+  deriving Inhabited
+
+private def emptySC : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
+
 /-- State for the `GrindM` monad. -/
 structure State where
   /-- `ShareCommon` (aka `Hashconsing`) state. -/
-  scState    : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
+  scState    : ShareCommon.State.{0} ShareCommon.objectFactory := emptySC
   /-- Next index for creating auxiliary theorems. -/
   nextThmIdx : Nat := 1
   /--
@@ -98,6 +113,8 @@ structure State where
   trueExpr   : Expr
   falseExpr  : Expr
   natZExpr   : Expr
+  btrueExpr  : Expr
+  bfalseExpr : Expr
   /--
   Used to generate trace messages of the for `[grind] working on <tag>`,
   and implement the macro `trace_goal`.
@@ -110,6 +127,8 @@ structure State where
   issues     : List MessageData := []
   /-- `trace` for `grind?` -/
   trace      : Trace := {}
+  /-- Performance counters -/
+  counters   : Counters := {}
 
 private opaque MethodsRefPointed : NonemptyType.{0}
 private def MethodsRef : Type := MethodsRefPointed.type
@@ -129,6 +148,14 @@ def getTrueExpr : GrindM Expr := do
 def getFalseExpr : GrindM Expr := do
   return (← get).falseExpr
 
+/-- Returns the internalized `Bool.true`.  -/
+def getBoolTrueExpr : GrindM Expr := do
+  return (← get).btrueExpr
+
+/-- Returns the internalized `Bool.false`.  -/
+def getBoolFalseExpr : GrindM Expr := do
+  return (← get).bfalseExpr
+
 /-- Returns the internalized `0 : Nat` numeral.  -/
 def getNatZeroExpr : GrindM Expr := do
   return (← get).natZExpr
@@ -139,6 +166,12 @@ def getMainDeclName : GrindM Name :=
 def saveEMatchTheorem (thm : EMatchTheorem) : GrindM Unit := do
   if (← getConfig).trace then
     modify fun s => { s with trace.thms := s.trace.thms.insert { origin := thm.origin, kind := thm.kind } }
+  modify fun s => { s with
+    counters.thm := if let some n := s.counters.thm.find? thm.origin then
+      s.counters.thm.insert thm.origin (n+1)
+    else
+      s.counters.thm.insert thm.origin 1
+  }
 
 def saveCases (declName : Name) (eager : Bool) : GrindM Unit := do
   if (← getConfig).trace then
@@ -146,6 +179,12 @@ def saveCases (declName : Name) (eager : Bool) : GrindM Unit := do
       modify fun s => { s with trace.eagerCases := s.trace.eagerCases.insert declName }
     else
       modify fun s => { s with trace.cases := s.trace.cases.insert declName }
+  modify fun s => { s with
+    counters.case := if let some n := s.counters.case.find? declName then
+      s.counters.case.insert declName (n+1)
+    else
+      s.counters.case.insert declName 1
+  }
 
 @[inline] def getMethodsRef : GrindM MethodsRef :=
   read
@@ -168,9 +207,10 @@ Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
 been hash-consed. We perform this step before we internalize expressions.
 -/
 def shareCommon (e : Expr) : GrindM Expr := do
-  modifyGet fun { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag, issues, trace } =>
-    let (e, scState) := ShareCommon.State.shareCommon scState e
-    (e, { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag, issues, trace })
+  let scState ← modifyGet fun s => (s.scState, { s with scState := emptySC })
+  let (e, scState) := ShareCommon.State.shareCommon scState e
+  modify fun s => { s with scState }
+  return e
 
 /-- Returns `true` if `e` is the internalized `True` expression.  -/
 def isTrueExpr (e : Expr) : GrindM Bool :=
@@ -440,6 +480,12 @@ structure Goal where
   facts      : PArray Expr := {}
   /-- Cached extensionality theorems for types. -/
   extThms    : PHashMap ENodeKey (Array Ext.ExtTheorem) := {}
+  /--
+  Sequence of cases steps that generated this goal. We only use this information for diagnostics.
+  Remark: `casesTrace.length ≥ numSplits` because we don't increase the counter for `cases`
+  applications that generated only 1 subgoal.
+  -/
+  casesTrace : List (Expr × Nat) := []
   deriving Inhabited
 
 def Goal.admit (goal : Goal) : MetaM Unit :=
@@ -536,13 +582,19 @@ def getGeneration (e : Expr) : GoalM Nat := do
 
 /-- Returns `true` if `e` is in the equivalence class of `True`. -/
 def isEqTrue (e : Expr) : GoalM Bool := do
-  let n ← getENode e
-  return isSameExpr n.root (← getTrueExpr)
+  return isSameExpr (← getENode e).root (← getTrueExpr)
 
 /-- Returns `true` if `e` is in the equivalence class of `False`. -/
 def isEqFalse (e : Expr) : GoalM Bool := do
-  let n ← getENode e
-  return isSameExpr n.root (← getFalseExpr)
+  return isSameExpr (← getENode e).root (← getFalseExpr)
+
+/-- Returns `true` if `e` is in the equivalence class of `Bool.true`. -/
+def isEqBoolTrue (e : Expr) : GoalM Bool := do
+  return isSameExpr (← getENode e).root (← getBoolTrueExpr)
+
+/-- Returns `true` if `e` is in the equivalence class of `Bool.false`. -/
+def isEqBoolFalse (e : Expr) : GoalM Bool := do
+  return isSameExpr (← getENode e).root (← getBoolFalseExpr)
 
 /-- Returns `true` if `a` and `b` are in the same equivalence class. -/
 def isEqv (a b : Expr) : GoalM Bool := do
@@ -644,6 +696,14 @@ def pushEqTrue (a proof : Expr) : GoalM Unit := do
 def pushEqFalse (a proof : Expr) : GoalM Unit := do
   pushEq a (← getFalseExpr) proof
 
+/-- Pushes `a = Bool.true` with `proof` to `newEqs`. -/
+def pushEqBoolTrue (a proof : Expr) : GoalM Unit := do
+  pushEq a (← getBoolTrueExpr) proof
+
+/-- Pushes `a = Bool.false` with `proof` to `newEqs`. -/
+def pushEqBoolFalse (a proof : Expr) : GoalM Unit := do
+  pushEq a (← getBoolFalseExpr) proof
+
 /--
 Records that `parent` is a parent of `child`. This function actually stores the
 information in the root (aka canonical representative) of `child`.
@@ -803,6 +863,20 @@ It assumes `a` and `False` are in the same equivalence class.
 def mkEqFalseProof (a : Expr) : GoalM Expr := do
   mkEqProof a (← getFalseExpr)
 
+/--
+Returns a proof that `a = Bool.true`.
+It assumes `a` and `Bool.true` are in the same equivalence class.
+-/
+def mkEqBoolTrueProof (a : Expr) : GoalM Expr := do
+  mkEqProof a (← getBoolTrueExpr)
+
+/--
+Returns a proof that `a = Bool.false`.
+It assumes `a` and `Bool.false` are in the same equivalence class.
+-/
+def mkEqBoolFalseProof (a : Expr) : GoalM Expr := do
+  mkEqProof a (← getBoolFalseExpr)
+
 /-- Marks current goal as inconsistent without assigning `mvarId`. -/
 def markAsInconsistent : GoalM Unit := do
   unless (← get).inconsistent do

src/Lean/Meta/Tactic/LinearArith/Solver.lean

@@ -37,8 +37,8 @@ abbrev Assignment.get? (a : Assignment) (x : Var) : Option Rat :=
 abbrev Assignment.push (a : Assignment) (v : Rat) : Assignment :=
   { a with val := a.val.push v }
 
-abbrev Assignment.take (a : Assignment) (newSize : Nat) : Assignment :=
-  { a with val := a.val.take newSize }
+abbrev Assignment.shrink (a : Assignment) (newSize : Nat) : Assignment :=
+  { a with val := a.val.shrink newSize }
 
 structure Poly where
   val : Array (Int × Var)
@@ -243,7 +243,7 @@ def resolve (s : State) (cl : Cnstr) (cu : Cnstr) : Sum Result State :=
     let maxVarIdx := c.lhs.getMaxVar.id
     match s with -- Hack: we avoid { s with ... } to make sure we get a destructive update
     | { lowers, uppers, int, assignment, } =>
-      let assignment := assignment.take maxVarIdx
+      let assignment := assignment.shrink maxVarIdx
       if c.lhs.getMaxVarCoeff < 0 then
         let lowers := lowers.modify maxVarIdx (·.push c)
         Sum.inr { lowers, uppers, int, assignment }

src/Lean/Meta/WHNF.lean

@@ -112,7 +112,7 @@ private def mkNullaryCtor (type : Expr) (nparams : Nat) : MetaM (Option Expr) :=
   let .const d lvls := type.getAppFn
     | return none
   let (some ctor) ← getFirstCtor d | pure none
-  return mkAppN (mkConst ctor lvls) (type.getAppArgs.take nparams)
+  return mkAppN (mkConst ctor lvls) (type.getAppArgs.shrink nparams)
 
 private def getRecRuleFor (recVal : RecursorVal) (major : Expr) : Option RecursorRule :=
   match major.getAppFn with
@@ -180,7 +180,7 @@ private def toCtorWhenStructure (inductName : Name) (major : Expr) : MetaM Expr
       else
         let some ctorName ← getFirstCtor d | pure major
         let ctorInfo ← getConstInfoCtor ctorName
-        let params := majorType.getAppArgs.take ctorInfo.numParams
+        let params := majorType.getAppArgs.shrink ctorInfo.numParams
         let mut result := mkAppN (mkConst ctorName us) params
         for i in [:ctorInfo.numFields] do
           result := mkApp result (← mkProjFn ctorInfo us params i major)