chore: update stage0

This PR fixes a bug in #13164 where the bulk request would hang if the
response was large.

.github/workflows/build-template.yml

@@ -276,10 +276,10 @@ jobs:
       - name: Check rebootstrap
         run: |
           set -e
-          # clean rebuild in case of Makefile changes/Lake does not detect uncommited stage 0
-          # changes yet
+          git config user.email "stage0@lean-fro.org"
+          git config user.name "update-stage0"
           make -C build update-stage0
-          make -C build/stage1 clean-stdlib
+          git commit --allow-empty -m "chore: update-stage0"
           time make -C build -j$NPROC
           time ctest --preset ${{ matrix.CMAKE_PRESET || 'release' }} --test-dir build/stage1 -j$NPROC
         if: matrix.check-rebootstrap

script/release_repos.yml

@@ -14,13 +14,6 @@ repositories:
     bump-branch: true
     dependencies: []
 
-  - name: lean4checker
-    url: https://github.com/leanprover/lean4checker
-    toolchain-tag: true
-    stable-branch: true
-    branch: master
-    dependencies: []
-
   - name: quote4
     url: https://github.com/leanprover-community/quote4
     toolchain-tag: true

src/Init/Control/ExceptCps.lean

@@ -37,7 +37,7 @@ set_option linter.unusedVariables false in  -- `s` unused
 Use a monadic action that may throw an exception by providing explicit success and failure
 continuations.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def runK {ε α : Type u} (x : ExceptCpsT ε m α) (s : ε) (ok : α → m β) (error : ε → m β) : m β :=
   x _ ok error
 
@@ -83,6 +83,8 @@ of `True`.
 -/
 instance : MonadAttach (ExceptCpsT ε m) := .trivial
 
+@[simp] theorem throw_bind [Monad m] (e : ε) (f : α → ExceptCpsT ε m β) : (throw e >>= f : ExceptCpsT ε m β) = throw e := rfl
+
 @[simp] theorem run_pure [Monad m] : run (pure x : ExceptCpsT ε m α) = pure (Except.ok x) := rfl
 
 @[simp] theorem run_lift {α ε : Type u} [Monad m] (x : m α) : run (ExceptCpsT.lift x : ExceptCpsT ε m α) = (x >>= fun a => pure (Except.ok a) : m (Except ε α)) := rfl
@@ -91,7 +93,20 @@ instance : MonadAttach (ExceptCpsT ε m) := .trivial
 
 @[simp] theorem run_bind_lift [Monad m] (x : m α) (f : α → ExceptCpsT ε m β) : run (ExceptCpsT.lift x >>= f : ExceptCpsT ε m β) = x >>= fun a => run (f a) := rfl
 
-@[simp] theorem run_bind_throw [Monad m] (e : ε) (f : α → ExceptCpsT ε m β) : run (throw e >>= f : ExceptCpsT ε m β) = run (throw e) := rfl
+@[deprecated throw_bind (since := "2026-03-13")]
+theorem run_bind_throw [Monad m] (e : ε) (f : α → ExceptCpsT ε m β) : run (throw e >>= f : ExceptCpsT ε m β) = run (throw e) := rfl
+
+@[simp] theorem runK_pure :
+    runK (pure x : ExceptCpsT ε m α) s ok error = ok x := rfl
+
+@[simp] theorem runK_lift {α ε : Type u} [Monad m] (x : m α) (s : ε) (ok : α → m β) (error : ε → m β) :
+    runK (ExceptCpsT.lift x : ExceptCpsT ε m α) s ok error = x >>= ok := rfl
+
+@[simp] theorem runK_throw [Monad m] :
+    runK (throw e : ExceptCpsT ε m β) s ok error = error e := rfl
+
+@[simp] theorem runK_bind_lift [Monad m] (x : m α) (f : α → ExceptCpsT ε m β) :
+    runK (ExceptCpsT.lift x >>= f : ExceptCpsT ε m β) s ok error = x >>= fun a => runK (f a) s ok error := rfl
 
 @[simp] theorem runCatch_pure [Monad m] : runCatch (pure x : ExceptCpsT α m α) = pure x := rfl
 
@@ -102,6 +117,7 @@ instance : MonadAttach (ExceptCpsT ε m) := .trivial
 
 @[simp] theorem runCatch_bind_lift [Monad m] (x : m α) (f : α → ExceptCpsT β m β) : runCatch (ExceptCpsT.lift x >>= f : ExceptCpsT β m β) = x >>= fun a => runCatch (f a) := rfl
 
-@[simp] theorem runCatch_bind_throw [Monad m] (e : β) (f : α → ExceptCpsT β m β) : runCatch (throw e >>= f : ExceptCpsT β m β) = pure e := rfl
+@[deprecated throw_bind (since := "2026-03-13")]
+theorem runCatch_bind_throw [Monad m] (e : β) (f : α → ExceptCpsT β m β) : runCatch (throw e >>= f : ExceptCpsT β m β) = pure e := rfl
 
 end ExceptCpsT

src/Init/Data/Array/MinMax.lean

@@ -113,7 +113,7 @@ public theorem _root_.List.min?_toArray [Min α] {l : List α} :
   · simp [List.min_toArray, List.min_eq_get_min?, - List.get_min?]
   · simp_all
 
-@[simp, grind =]
+@[simp, grind =, cbv_eval ←]
 public theorem min?_toList [Min α] {xs : Array α} :
     xs.toList.min? = xs.min? := by
   cases xs; simp
@@ -153,7 +153,7 @@ public theorem _root_.List.max?_toArray [Max α] {l : List α} :
   · simp [List.max_toArray, List.max_eq_get_max?, - List.get_max?]
   · simp_all
 
-@[simp, grind =]
+@[simp, grind =, cbv_eval ←]
 public theorem max?_toList [Max α] {xs : Array α} :
     xs.toList.max? = xs.max? := by
   cases xs; simp

src/Init/Data/Fin/Lemmas.lean

@@ -527,6 +527,14 @@ theorem castLE_of_eq {m n : Nat} (h : m = n) {h' : m ≤ n} : castLE h' = Fin.ca
 
 @[simp, grind =] theorem val_castAdd (m : Nat) (i : Fin n) : (castAdd m i : Nat) = i := rfl
 
+/-
+**Note**
+The current pattern inference heuristic includes the implicit term `n + m` as pattern of the pattern,
+but arithmetic is problematic in patterns because it is an interpreted symbol. For example,
+we will fail to match `@val n (castNat 0 i)`. Thus, we mark the implicit subterm with `no_index`
+-/
+grind_pattern val_castAdd => @val (no_index _) (castAdd m i)
+
 @[deprecated val_castAdd (since := "2025-11-21")]
 theorem coe_castAdd (m : Nat) (i : Fin n) : (castAdd m i : Nat) = i := rfl
 
@@ -637,7 +645,15 @@ theorem exists_castSucc_eq {n : Nat} {i : Fin (n + 1)} : (∃ j, castSucc j = i)
 
 theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = i.succ.castSucc := rfl
 
-@[simp, grind =] theorem val_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl
+@[simp] theorem val_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl
+
+/-
+**Note**
+The current pattern inference heuristic includes the implicit term `n + m` as pattern of the pattern,
+but arithmetic is problematic in patterns because it is an interpreted symbol. For example,
+we will fail to match `@val n (addNat i 0)`. Thus, we mark the implicit subterm with `no_index`
+-/
+grind_pattern val_addNat => @val (no_index _) (addNat i m)
 
 @[deprecated val_addNat (since := "2025-11-21")]
 theorem coe_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl

src/Init/Data/Iterators/Consumers/Collect.lean

@@ -66,7 +66,7 @@ lists are prepend-only, this `toListRev` is usually more efficient that `toList`
 If the iterator is not finite, this function might run forever. The variant
 `it.ensureTermination.toListRev` always terminates after finitely many steps.
 -/
-@[always_inline, inline]
+@[always_inline, inline, cbv_opaque]
 def Iter.toListRev {α : Type w} {β : Type w}
     [Iterator α Id β] (it : Iter (α := α) β) : List β :=
   it.toIterM.toListRev.run

src/Init/Data/Iterators/Consumers/Loop.lean

@@ -226,7 +226,7 @@ any element emitted by the iterator {name}`it`.
 {lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
 examined in order of iteration.
 -/
-@[inline]
+@[inline, cbv_opaque]
 def Iter.any {α β : Type w}
     [Iterator α Id β] [IteratorLoop α Id Id]
     (p : β → Bool) (it : Iter (α := α) β) : Bool :=
@@ -292,7 +292,7 @@ all element emitted by the iterator {name}`it`.
 {lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
 examined in order of iteration.
 -/
-@[inline]
+@[inline, cbv_opaque]
 def Iter.all {α β : Type w}
     [Iterator α Id β] [IteratorLoop α Id Id]
     (p : β → Bool) (it : Iter (α := α) β) : Bool :=
@@ -644,7 +644,7 @@ Examples:
 * `[7, 6].iter.first? = some 7`
 * `[].iter.first? = none`
 -/
-@[inline]
+@[inline, cbv_opaque]
 def Iter.first? {α β : Type w} [Iterator α Id β] [IteratorLoop α Id Id]
     (it : Iter (α := α) β) : Option β :=
   it.toIterM.first?.run

src/Init/Data/Iterators/Lemmas/Consumers/Collect.lean

@@ -110,6 +110,7 @@ theorem Iter.reverse_toListRev_ensureTermination [Iterator α Id β] [Finite α
     it.ensureTermination.toListRev.reverse = it.toList := by
   simp
 
+@[cbv_eval]
 theorem Iter.toListRev_eq {α β} [Iterator α Id β] [Finite α Id]
     {it : Iter (α := α) β} :
     it.toListRev = it.toList.reverse := by

src/Init/Data/Iterators/Lemmas/Consumers/Loop.lean

@@ -637,6 +637,7 @@ theorem Iter.any_eq_forIn {α β : Type w} [Iterator α Id β]
           return .yield false)).run := by
   simp [any_eq_anyM, anyM_eq_forIn]
 
+@[cbv_eval ←]
 theorem Iter.any_toList {α β : Type w} [Iterator α Id β]
     [Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
     {it : Iter (α := α) β} {p : β → Bool} :
@@ -727,6 +728,7 @@ theorem Iter.all_eq_forIn {α β : Type w} [Iterator α Id β]
           return .done false)).run := by
   simp [all_eq_allM, allM_eq_forIn]
 
+@[cbv_eval ←]
 theorem Iter.all_toList {α β : Type w} [Iterator α Id β]
     [Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
     {it : Iter (α := α) β} {p : β → Bool} :
@@ -954,7 +956,7 @@ theorem Iter.first?_eq_match_step {α β : Type w} [Iterator α Id β] [Iterator
   generalize it.toIterM.step.run.inflate = s
   rcases s with ⟨_|_|_, _⟩ <;> simp [Iter.first?_eq_first?_toIterM]
 
-@[simp, grind =]
+@[simp, grind =, cbv_eval ←]
 theorem Iter.head?_toList {α β : Type w} [Iterator α Id β] [IteratorLoop α Id Id]
     [Finite α Id] [LawfulIteratorLoop α Id Id] {it : Iter (α := α) β} :
     it.toList.head? = it.first? := by

src/Init/Data/Slice/Array/Lemmas.lean

@@ -193,6 +193,7 @@ public theorem Array.toSubarray_eq_toSubarray_of_min_eq_min {xs : Array α}
         simp [*]; omega
       · simp
 
+@[cbv_eval]
 public theorem Array.toSubarray_eq_min {xs : Array α} {lo hi : Nat} :
     xs.toSubarray lo hi = ⟨⟨xs, min lo (min hi xs.size), min hi xs.size, Nat.min_le_right _ _,
       Nat.min_le_right _ _⟩⟩ := by

src/Init/Data/String/Lemmas/FindPos.lean

@@ -201,6 +201,10 @@ theorem Pos.prev_eq_iff {s : Slice} {p q : s.Pos} {h} :
 theorem Pos.prev_lt {s : Slice} {p : s.Pos} {h} : p.prev h < p := by
   simp
 
+@[simp]
+theorem Pos.prev_le {s : Slice} {p : s.Pos} {h} : p.prev h ≤ p :=
+  Std.le_of_lt (by simp)
+
 @[simp]
 theorem Pos.prev_ne_endPos {s : Slice} {p : s.Pos} {h} : p.prev h ≠ s.endPos :=
   ne_endPos_of_lt prev_lt
@@ -211,6 +215,29 @@ theorem Pos.prevn_le {s : Slice} {p : s.Pos} {n : Nat} : p.prevn n ≤ p := by
   | case2 p n h ih => exact Std.le_of_lt (by simpa using ih)
   | case3 => simp
 
+theorem Pos.ofSliceTo_prev {s : Slice} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {h} :
+    Pos.ofSliceTo (p.prev h) = (Pos.ofSliceTo p).prev (by simpa [← Pos.ofSliceTo_inj] using h) := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [Pos.ofSliceTo_lt_ofSliceTo_iff, Pos.le_ofSliceTo_iff]
+  simp [Pos.lt_ofSliceTo_iff]
+
+theorem Pos.prev_ofSliceTo {s : Slice} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {h} :
+    (Pos.ofSliceTo p).prev h = Pos.ofSliceTo (p.prev (by simpa [← Pos.ofSliceTo_inj])) := by
+  simp [ofSliceTo_prev]
+
+theorem Pos.ofSliceFrom_prev {s : Slice} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos} {h} :
+    Pos.ofSliceFrom (p.prev h) = (Pos.ofSliceFrom p).prev (by exact ofSliceFrom_ne_startPos h) := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [Pos.ofSliceFrom_lt_ofSliceFrom_iff,  Pos.le_ofSliceFrom_iff]
+  simp [Pos.lt_ofSliceFrom_iff]
+
+theorem Pos.ofSlice_prev {s : Slice} {p₀ p₁ : s.Pos} {h}
+    {p : (s.slice p₀ p₁ h).Pos} {h'} :
+    Pos.ofSlice (p.prev h') = (Pos.ofSlice p).prev (by exact ofSlice_ne_startPos h') := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [ofSlice_lt_ofSlice_iff,  le_ofSlice_iff]
+  simpa +contextual [← ofSlice_lt_ofSlice_iff] using fun q hq => Std.le_of_lt (Std.lt_of_lt_of_le hq ofSlice_le)
+
 @[simp]
 theorem Pos.prev_next {s : Slice} {p : s.Pos} {h} : (p.next h).prev (by simp) = p :=
   prev_eq_iff.2 (by simp)
@@ -439,6 +466,10 @@ theorem Pos.prev_eq_iff {s : String} {p q : s.Pos} {h} :
 theorem Pos.prev_lt {s : String} {p : s.Pos} {h} : p.prev h < p := by
   simp
 
+@[simp]
+theorem Pos.prev_le {s : String} {p : s.Pos} {h} : p.prev h ≤ p :=
+  Std.le_of_lt (by simp)
+
 @[simp]
 theorem Pos.prev_ne_endPos {s : String} {p : s.Pos} {h} : p.prev h ≠ s.endPos :=
   ne_endPos_of_lt prev_lt
@@ -463,6 +494,29 @@ theorem Pos.prevn_le {s : String} {p : s.Pos} {n : Nat} :
     p.prevn n ≤ p := by
   simpa [Pos.le_iff, ← offset_toSlice] using Slice.Pos.prevn_le
 
+theorem Pos.ofSliceTo_prev {s : String} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {h} :
+    Pos.ofSliceTo (p.prev h) = (Pos.ofSliceTo p).prev (by simpa [← Pos.ofSliceTo_inj] using h) := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [Pos.ofSliceTo_lt_ofSliceTo_iff, Pos.le_ofSliceTo_iff]
+  simp [Pos.lt_ofSliceTo_iff]
+
+theorem Pos.prev_ofSliceTo {s : String} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {h} :
+    (Pos.ofSliceTo p).prev h = Pos.ofSliceTo (p.prev (by simpa [← Pos.ofSliceTo_inj])) := by
+  simp [ofSliceTo_prev]
+
+theorem Pos.ofSliceFrom_prev {s : String} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos} {h} :
+    Pos.ofSliceFrom (p.prev h) = (Pos.ofSliceFrom p).prev (by exact ofSliceFrom_ne_startPos h) := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [Pos.ofSliceFrom_lt_ofSliceFrom_iff, Pos.le_ofSliceFrom_iff]
+  simp [Pos.lt_ofSliceFrom_iff]
+
+theorem Pos.ofSlice_prev {s : String} {p₀ p₁ : s.Pos} {h}
+    {p : (s.slice p₀ p₁ h).Pos} {h'} :
+    Pos.ofSlice (p.prev h') = (Pos.ofSlice p).prev (by exact ofSlice_ne_startPos h') := by
+  rw [eq_comm, Pos.prev_eq_iff]
+  simp only [ofSlice_lt_ofSlice_iff, le_ofSlice_iff]
+  simpa +contextual [← ofSlice_lt_ofSlice_iff] using fun q hq => Std.le_of_lt (Std.lt_of_lt_of_le hq ofSlice_le)
+
 @[simp]
 theorem Pos.prev_next {s : String} {p : s.Pos} {h} : (p.next h).prev (by simp) = p :=
   prev_eq_iff.2 (by simp)

src/Init/Data/String/Lemmas/IsEmpty.lean

@@ -204,7 +204,7 @@ theorem Slice.copy_sliceTo_startPos {s : Slice} : (s.sliceTo s.startPos).copy =
   simp
 
 @[simp]
-theorem Slice.copy_sliceFrom_startPos {s : Slice} : (s.sliceFrom s.endPos).copy = "" := by
+theorem Slice.copy_sliceFrom_endPos {s : Slice} : (s.sliceFrom s.endPos).copy = "" := by
   simp
 
 end CopyEqEmpty

src/Init/Data/String/Lemmas/Order.lean

@@ -11,6 +11,7 @@ import Init.Data.String.OrderInstances
 import Init.Data.String.Lemmas.Basic
 import Init.Data.Order.Lemmas
 import Init.Omega
+import Init.ByCases
 
 public section
 
@@ -70,7 +71,7 @@ theorem Pos.le_startPos {s : String} (p : s.Pos) : p ≤ s.startPos ↔ p = s.st
   ⟨fun h => Std.le_antisymm h (startPos_le _), by simp +contextual⟩
 
 @[simp]
-theorem Pos.startPos_lt_iff {s : String} {p : s.Pos} : s.startPos < p ↔ p ≠ s.startPos := by
+theorem Pos.startPos_lt_iff {s : String} (p : s.Pos) : s.startPos < p ↔ p ≠ s.startPos := by
   simp [← le_startPos, Std.not_le]
 
 @[simp]
@@ -235,6 +236,10 @@ theorem Slice.Pos.ofSliceFrom_next {s : Slice} {p₀ : s.Pos} {p : (s.sliceFrom
     Pos.next_le_iff_lt, true_and]
   simp [Pos.ofSliceFrom_lt_iff]
 
+theorem Slice.Pos.next_ofSliceFrom {s : Slice} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos} {h} :
+    (Pos.ofSliceFrom p).next h = Pos.ofSliceFrom (p.next (by simpa [← Pos.ofSliceFrom_inj])) := by
+  simp [ofSliceFrom_next]
+
 theorem Pos.ofSliceFrom_next {s : String} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos} {h} :
     Pos.ofSliceFrom (p.next h) = (Pos.ofSliceFrom p).next (by simpa [← Pos.ofSliceFrom_inj] using h) := by
   rw [eq_comm, Pos.next_eq_iff]
@@ -242,6 +247,10 @@ theorem Pos.ofSliceFrom_next {s : String} {p₀ : s.Pos} {p : (s.sliceFrom p₀)
     Slice.Pos.next_le_iff_lt, true_and]
   simp [Pos.ofSliceFrom_lt_iff]
 
+theorem Pos.next_ofSliceFrom {s : String} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos} {h} :
+    (Pos.ofSliceFrom p).next h = Pos.ofSliceFrom (p.next (by simpa [← Pos.ofSliceFrom_inj])) := by
+  simp [Pos.ofSliceFrom_next]
+
 theorem Slice.Pos.le_ofSliceTo_iff {s : Slice} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {q : s.Pos} :
     q ≤ Pos.ofSliceTo p ↔ ∃ h, Slice.Pos.sliceTo p₀ q h ≤ p := by
   refine ⟨fun h => ⟨Slice.Pos.le_trans h Pos.ofSliceTo_le, ?_⟩, fun ⟨h, h'⟩ => ?_⟩
@@ -359,11 +368,21 @@ theorem Slice.Pos.ofSliceTo_ne_endPos {s : Slice} {p₀ : s.Pos} {p : (s.sliceTo
   refine (lt_endPos_iff _).1 (Std.lt_of_lt_of_le ?_ (le_endPos p₀))
   simpa [← lt_endPos_iff, ← ofSliceTo_lt_ofSliceTo_iff] using h
 
+theorem Slice.Pos.ofSliceFrom_ne_startPos {s : Slice} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos}
+    (h : p ≠ (s.sliceFrom p₀).startPos) : Pos.ofSliceFrom p ≠ s.startPos := by
+  refine (startPos_lt_iff _).1 (Std.lt_of_le_of_lt (startPos_le p₀) ?_)
+  simpa [← startPos_lt_iff, ← ofSliceFrom_lt_ofSliceFrom_iff] using h
+
 theorem Pos.ofSliceTo_ne_endPos {s : String} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos}
     (h : p ≠ (s.sliceTo p₀).endPos) : Pos.ofSliceTo p ≠ s.endPos := by
   refine (lt_endPos_iff _).1 (Std.lt_of_lt_of_le ?_ (le_endPos p₀))
   simpa [← Slice.Pos.lt_endPos_iff, ← ofSliceTo_lt_ofSliceTo_iff] using h
 
+theorem Pos.ofSliceFrom_ne_startPos {s : String} {p₀ : s.Pos} {p : (s.sliceFrom p₀).Pos}
+    (h : p ≠ (s.sliceFrom p₀).startPos) : Pos.ofSliceFrom p ≠ s.startPos := by
+  refine (startPos_lt_iff _).1 (Std.lt_of_le_of_lt (startPos_le p₀) ?_)
+  simpa [← Slice.Pos.startPos_lt_iff, ← ofSliceFrom_lt_ofSliceFrom_iff] using h
+
 theorem Slice.Pos.ofSliceTo_next {s : Slice} {p₀ : s.Pos} {p : (s.sliceTo p₀).Pos} {h} :
     Pos.ofSliceTo (p.next h) = (Pos.ofSliceTo p).next (ofSliceTo_ne_endPos h) := by
   rw [eq_comm, Pos.next_eq_iff]
@@ -406,16 +425,110 @@ theorem Pos.slice_le_slice_iff {s : String} {p₀ p₁ : s.Pos} {q r : s.Pos}
   simp [Slice.Pos.le_iff, Pos.le_iff, Pos.Raw.le_iff] at h₁ h₁' ⊢
   omega
 
+theorem Slice.Pos.le_ofSlice_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    q ≤ Pos.ofSlice p ↔ ∃ h₁, ∀ h₀, Slice.Pos.slice q p₀ p₁ h₀ h₁ ≤ p := by
+  refine ⟨fun h => ⟨Std.le_trans h ofSlice_le, fun h' => ?_⟩, fun ⟨h₁, h⟩ => ?_⟩
+  · simp only [← Slice.Pos.slice_ofSlice (pos := p), slice_le_slice_iff]
+    simpa
+  · by_cases h₀ : p₀ ≤ q
+    · simpa only [← Slice.Pos.ofSlice_slice (h₁ := h₀) (h₂ := h₁), ofSlice_le_ofSlice_iff] using h h₀
+    · exact Std.le_of_lt (Std.lt_of_lt_of_le (Std.not_le.1 h₀) le_ofSlice)
+
+theorem Slice.Pos.ofSlice_lt_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    Pos.ofSlice p < q ↔ ∀ h₁, ∃ h₀, p < Slice.Pos.slice q p₀ p₁ h₀ h₁ := by
+  simp [← Std.not_le, le_ofSlice_iff]
+
+theorem Slice.Pos.lt_ofSlice_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    q < Pos.ofSlice p ↔ ∃ h₁, ∀ h₀, Slice.Pos.slice q p₀ p₁ h₀ h₁ < p := by
+  refine ⟨fun h => ⟨Std.le_of_lt (Std.lt_of_lt_of_le h ofSlice_le), fun h' => ?_⟩, fun ⟨h₁, h⟩ => ?_⟩
+  · simp only [← Slice.Pos.slice_ofSlice (pos := p), slice_lt_slice_iff]
+    simpa
+  · by_cases h₀ : p₀ ≤ q
+    · simpa only [← Slice.Pos.ofSlice_slice (h₁ := h₀) (h₂ := h₁), ofSlice_lt_ofSlice_iff] using h h₀
+    · exact Std.lt_of_lt_of_le (Std.not_le.1 h₀) le_ofSlice
+
+theorem Slice.Pos.ofSlice_le_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    Pos.ofSlice p ≤ q ↔ ∀ h₁, ∃ h₀, p ≤ Slice.Pos.slice q p₀ p₁ h₀ h₁ := by
+  simp [← Std.not_lt, lt_ofSlice_iff]
+
+theorem Pos.le_ofSlice_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    q ≤ Pos.ofSlice p ↔ ∃ h₁, ∀ h₀, Pos.slice q p₀ p₁ h₀ h₁ ≤ p := by
+  refine ⟨fun h => ⟨Std.le_trans h ofSlice_le, fun h' => ?_⟩, fun ⟨h₁, h⟩ => ?_⟩
+  · simp only [← Pos.slice_ofSlice (pos := p), slice_le_slice_iff]
+    simpa
+  · by_cases h₀ : p₀ ≤ q
+    · simpa only [← Pos.ofSlice_slice (h₁ := h₀) (h₂ := h₁), ofSlice_le_ofSlice_iff] using h h₀
+    · exact Std.le_of_lt (Std.lt_of_lt_of_le (Std.not_le.1 h₀) le_ofSlice)
+
+theorem Pos.ofSlice_lt_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    Pos.ofSlice p < q ↔ ∀ h₁, ∃ h₀, p < Pos.slice q p₀ p₁ h₀ h₁ := by
+  simp [← Std.not_le, le_ofSlice_iff]
+
+theorem Pos.lt_ofSlice_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    q < Pos.ofSlice p ↔ ∃ h₁, ∀ h₀, Pos.slice q p₀ p₁ h₀ h₁ < p := by
+  refine ⟨fun h => ⟨Std.le_of_lt (Std.lt_of_lt_of_le h ofSlice_le), fun h' => ?_⟩, fun ⟨h₁, h⟩ => ?_⟩
+  · simp only [← Pos.slice_ofSlice (pos := p), slice_lt_slice_iff]
+    simpa
+  · by_cases h₀ : p₀ ≤ q
+    · simpa only [← Pos.ofSlice_slice (h₁ := h₀) (h₂ := h₁), ofSlice_lt_ofSlice_iff] using h h₀
+    · exact Std.lt_of_lt_of_le (Std.not_le.1 h₀) le_ofSlice
+
+theorem Pos.ofSlice_le_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} :
+    Pos.ofSlice p ≤ q ↔ ∀ h₁, ∃ h₀, p ≤ Pos.slice q p₀ p₁ h₀ h₁ := by
+  simp [← Std.not_lt, lt_ofSlice_iff]
+
+theorem Slice.Pos.slice_le_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    Slice.Pos.slice q p₀ p₁ h₀ h₁ ≤ p ↔ q ≤ Pos.ofSlice p := by
+  simp [le_ofSlice_iff, h₀, h₁]
+
+theorem Slice.Pos.lt_slice_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    p < Slice.Pos.slice q p₀ p₁ h₀ h₁ ↔ Pos.ofSlice p < q := by
+  simp [ofSlice_lt_iff, h₀, h₁]
+
+theorem Slice.Pos.slice_lt_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    Slice.Pos.slice q p₀ p₁ h₀ h₁ < p ↔ q < Pos.ofSlice p := by
+  simp [lt_ofSlice_iff, h₀, h₁]
+
+theorem Slice.Pos.le_slice_iff {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    p ≤ Slice.Pos.slice q p₀ p₁ h₀ h₁ ↔ Pos.ofSlice p ≤ q := by
+  simp [ofSlice_le_iff, h₀, h₁]
+
+theorem Pos.slice_le_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    Pos.slice q p₀ p₁ h₀ h₁ ≤ p ↔ q ≤ Pos.ofSlice p := by
+  simp [le_ofSlice_iff, h₀, h₁]
+
+theorem Pos.lt_slice_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    p < Pos.slice q p₀ p₁ h₀ h₁ ↔ Pos.ofSlice p < q := by
+  simp [ofSlice_lt_iff, h₀, h₁]
+
+theorem Pos.slice_lt_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    Pos.slice q p₀ p₁ h₀ h₁ < p ↔ q < Pos.ofSlice p := by
+  simp [lt_ofSlice_iff, h₀, h₁]
+
+theorem Pos.le_slice_iff {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos} {q : s.Pos} {h₀ h₁} :
+    p ≤ Pos.slice q p₀ p₁ h₀ h₁ ↔ Pos.ofSlice p ≤ q := by
+  simp [ofSlice_le_iff, h₀, h₁]
+
 theorem Slice.Pos.ofSlice_ne_endPos {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos}
     (h : p ≠ (s.slice p₀ p₁ h).endPos) : Pos.ofSlice p ≠ s.endPos := by
   refine (lt_endPos_iff _).1 (Std.lt_of_lt_of_le ?_ (le_endPos p₁))
   simpa [← lt_endPos_iff, ← ofSlice_lt_ofSlice_iff] using h
 
+theorem Slice.Pos.ofSlice_ne_startPos {s : Slice} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos}
+    (h : p ≠ (s.slice p₀ p₁ h).startPos) : Pos.ofSlice p ≠ s.startPos := by
+  refine (startPos_lt_iff _).1 (Std.lt_of_le_of_lt (startPos_le p₀) ?_)
+  simpa [← startPos_lt_iff, ← ofSlice_lt_ofSlice_iff] using h
+
 theorem Pos.ofSlice_ne_endPos {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos}
     (h : p ≠ (s.slice p₀ p₁ h).endPos) : Pos.ofSlice p ≠ s.endPos := by
   refine (lt_endPos_iff _).1 (Std.lt_of_lt_of_le ?_ (le_endPos p₁))
   simpa [← Slice.Pos.lt_endPos_iff, ← ofSlice_lt_ofSlice_iff] using h
 
+theorem Pos.ofSlice_ne_startPos {s : String} {p₀ p₁ : s.Pos} {h} {p : (s.slice p₀ p₁ h).Pos}
+    (h : p ≠ (s.slice p₀ p₁ h).startPos) : Pos.ofSlice p ≠ s.startPos := by
+  refine (startPos_lt_iff _).1 (Std.lt_of_le_of_lt (startPos_le p₀) ?_)
+  simpa [← Slice.Pos.startPos_lt_iff, ← ofSlice_lt_ofSlice_iff] using h
+
 @[simp]
 theorem Slice.Pos.offset_le_rawEndPos {s : Slice} {p : s.Pos} :
     p.offset ≤ s.rawEndPos :=

src/Init/Data/String/Lemmas/Pattern/Basic.lean

@@ -19,6 +19,7 @@ import Init.Data.Order.Lemmas
 import Init.ByCases
 import Init.Data.Option.Lemmas
 import Init.Data.Iterators.Lemmas.Consumers.Collect
+import Init.Data.String.Lemmas.FindPos
 
 set_option doc.verso true
 
@@ -31,19 +32,20 @@ This file develops basic theory around searching in strings.
 
 We provide a typeclass for providing semantics to a pattern and then define the relevant notions
 of matching a pattern that let us state compatibility typeclasses for {name}`ForwardPattern` and
-{name}`ToForwardSearcher`. These typeclasses can then be required by correctness results for
-string functions which are implemented using the pattern framework.
+{name}`ToForwardSearcher` as well as their backwards variants. These typeclasses can then be
+required by correctness results for string functions which are implemented using the pattern
+framework.
 -/
 
 /--
 This data-carrying typeclass is used to give semantics to a pattern type that implements
 {name}`ForwardPattern` and/or {name}`ToForwardSearcher` by providing an abstract, not necessarily
-decidable {name}`ForwardPatternModel.Matches` predicate that implementates of {name}`ForwardPattern`
+decidable {name}`PatternModel.Matches` predicate that implementates of {name}`ForwardPattern`
 and {name}`ToForwardSearcher` can be validated against.
 
 Correctness results for generic functions relying on the pattern infrastructure, for example the
 correctness result for {name (scope := "Init.Data.String.Slice")}`String.Slice.split`, are then
-stated in terms of {name}`ForwardPatternModel.Matches`, and can be specialized to specific patterns
+stated in terms of {name}`PatternModel.Matches`, and can be specialized to specific patterns
 from there.
 
 The corresponding compatibility typeclasses are
@@ -59,7 +61,7 @@ searching.
 This means that pattern types that allow searching for the empty string will have to special-case
 the empty string in their correctness statements.
 -/
-class ForwardPatternModel {ρ : Type} (pat : ρ) : Type where
+class PatternModel {ρ : Type} (pat : ρ) : Type where
   /-- The predicate that says which strings match the pattern. -/
   Matches : String → Prop
   not_matches_empty : ¬ Matches ""
@@ -69,49 +71,72 @@ Predicate stating that the region between the start of the slice {name}`s` and t
 {name}`endPos` matches the pattern {name}`pat`. Note that there might be a longer match, see
 {name (scope := "Init.Data.String.Lemmas.Pattern.Basic")}`String.Slice.Pattern.IsLongestMatch`.
 -/
-structure IsMatch (pat : ρ) [ForwardPatternModel pat] {s : Slice} (endPos : s.Pos) : Prop where
-  matches_copy : ForwardPatternModel.Matches pat (s.sliceTo endPos).copy
+structure IsMatch (pat : ρ) [PatternModel pat] {s : Slice} (endPos : s.Pos) : Prop where
+  matches_copy : PatternModel.Matches pat (s.sliceTo endPos).copy
 
-theorem IsMatch.ne_startPos {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos : s.Pos}
+theorem IsMatch.ne_startPos {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos}
     (h : IsMatch pat pos) : pos ≠ s.startPos := by
   intro hc
-  apply ForwardPatternModel.not_matches_empty (pat := pat)
+  apply PatternModel.not_matches_empty (pat := pat)
   simpa [hc] using h.matches_copy
 
-theorem isMatch_iff {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos : s.Pos} :
-    IsMatch pat pos ↔ ForwardPatternModel.Matches pat (s.sliceTo pos).copy :=
+theorem isMatch_iff {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
+    IsMatch pat pos ↔ PatternModel.Matches pat (s.sliceTo pos).copy :=
   ⟨fun ⟨h⟩ => h, fun h => ⟨h⟩⟩
 
-theorem isMatch_iff_exists_splits {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos : s.Pos} :
-    IsMatch pat pos ↔ ∃ t₁ t₂, pos.Splits t₁ t₂ ∧ ForwardPatternModel.Matches pat t₁ := by
+theorem isMatch_iff_exists_splits {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
+    IsMatch pat pos ↔ ∃ t₁ t₂, pos.Splits t₁ t₂ ∧ PatternModel.Matches pat t₁ := by
   rw [isMatch_iff]
   refine ⟨fun h => ⟨_, _, pos.splits, h⟩, fun ⟨t₁, t₂, h₁, h₂⟩ => ?_⟩
   rwa [h₁.eq_left pos.splits] at h₂
 
+/--
+Predicate stating that the region between the position {name}`startPos` and the end of the slice
+{name}`s` matches the pattern {name}`pat`. Note that there might be a longer match.
+-/
+structure IsRevMatch (pat : ρ) [PatternModel pat] {s : Slice} (startPos : s.Pos) : Prop where
+  matches_copy : PatternModel.Matches pat (s.sliceFrom startPos).copy
+
+theorem IsRevMatch.ne_endPos {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos}
+    (h : IsRevMatch pat pos) : pos ≠ s.endPos := by
+  intro hc
+  apply PatternModel.not_matches_empty (pat := pat)
+  simpa [hc] using h.matches_copy
+
+theorem isRevMatch_iff {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
+    IsRevMatch pat pos ↔ PatternModel.Matches pat (s.sliceFrom pos).copy :=
+  ⟨fun ⟨h⟩ => h, fun h => ⟨h⟩⟩
+
+theorem isRevMatch_iff_exists_splits {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
+    IsRevMatch pat pos ↔ ∃ t₁ t₂, pos.Splits t₁ t₂ ∧ PatternModel.Matches pat t₂ := by
+  rw [isRevMatch_iff]
+  refine ⟨fun h => ⟨_, _, pos.splits, h⟩, fun ⟨t₁, t₂, h₁, h₂⟩ => ?_⟩
+  rwa [h₁.eq_right pos.splits] at h₂
+
 /--
 Predicate stating that the region between the start of the slice {name}`s` and the position
-{name}`endPos` matches that pattern {name}`pat`, and that there is no longer match starting at the
+{name}`pos` matches the pattern {name}`pat`, and that there is no longer match starting at the
 beginning of the slice. This is what a correct matcher should match.
 
 In some cases, being a match and being a longest match will coincide, see
-{name (scope := "Init.Data.String.Lemmas.Pattern.Basic")}`String.Slice.Pattern.Model.NoPrefixForwardPatternModel`.
+{name (scope := "Init.Data.String.Lemmas.Pattern.Basic")}`String.Slice.Pattern.Model.NoPrefixPatternModel`.
 -/
-structure IsLongestMatch (pat : ρ) [ForwardPatternModel pat] {s : Slice} (pos : s.Pos) where
+structure IsLongestMatch (pat : ρ) [PatternModel pat] {s : Slice} (pos : s.Pos) where
   isMatch : IsMatch pat pos
   not_isMatch : ∀ pos', pos < pos' → ¬ IsMatch pat pos'
 
-theorem IsLongestMatch.ne_startPos {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos : s.Pos}
+theorem IsLongestMatch.ne_startPos {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos}
     (h : IsLongestMatch pat pos) : pos ≠ s.startPos :=
   h.isMatch.ne_startPos
 
-theorem IsLongestMatch.eq {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos pos' : s.Pos}
+theorem IsLongestMatch.eq {pat : ρ} [PatternModel pat] {s : Slice} {pos pos' : s.Pos}
     (h : IsLongestMatch pat pos) (h' : IsLongestMatch pat pos') : pos = pos' := by
   apply Std.le_antisymm
   · exact Std.not_lt.1 (fun hlt => h'.not_isMatch _ hlt h.isMatch)
   · exact Std.not_lt.1 (fun hlt => h.not_isMatch _ hlt h'.isMatch)
 
 open Classical in
-theorem IsMatch.exists_isLongestMatch {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos : s.Pos} :
+theorem IsMatch.exists_isLongestMatch {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
     IsMatch pat pos → ∃ (pos' : s.Pos), IsLongestMatch pat pos' := by
   induction pos using WellFounded.induction Pos.wellFounded_gt with | h pos ih
   intro h₁
@@ -120,61 +145,118 @@ theorem IsMatch.exists_isLongestMatch {pat : ρ} [ForwardPatternModel pat] {s :
     exact ih _ hp₁ hp₂
   · exact ⟨pos, ⟨h₁, fun p' hp₁ hp₂ => h₂ ⟨_, hp₁, hp₂⟩⟩⟩
 
-theorem IsLongestMatch.le_of_isMatch {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos pos' : s.Pos}
+theorem IsLongestMatch.le_of_isMatch {pat : ρ} [PatternModel pat] {s : Slice} {pos pos' : s.Pos}
     (h : IsLongestMatch pat pos) (h' : IsMatch pat pos') : pos' ≤ pos :=
   Std.not_lt.1 (fun hlt => h.not_isMatch _ hlt h')
 
+/--
+Predicate stating that the region between the start of the slice {name}`s` and the position
+{name}`pos` matches the patten {name}`pat`, and that there is no longer match starting at the
+beginning of the slice. This is what a correct matcher should match.
+
+In some cases, being a match and being a longest match will coincide, see
+{name (scope := "Init.Data.String.Lemmas.Pattern.Basic")}`String.Slice.Pattern.Model.NoPrefixPatternModel`.
+-/
+structure IsLongestRevMatch (pat : ρ) [PatternModel pat] {s : Slice} (pos : s.Pos) where
+  isRevMatch : IsRevMatch pat pos
+  not_isRevMatch : ∀ pos', pos' < pos → ¬ IsRevMatch pat pos'
+
+theorem IsLongestRevMatch.ne_endPos {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos}
+    (h : IsLongestRevMatch pat pos) : pos ≠ s.endPos :=
+  h.isRevMatch.ne_endPos
+
+theorem IsLongestRevMatch.eq {pat : ρ} [PatternModel pat] {s : Slice} {pos pos' : s.Pos}
+    (h : IsLongestRevMatch pat pos) (h' : IsLongestRevMatch pat pos') : pos = pos' := by
+  apply Std.le_antisymm
+  · exact Std.not_lt.1 (fun hlt => h.not_isRevMatch _ hlt h'.isRevMatch)
+  · exact Std.not_lt.1 (fun hlt => h'.not_isRevMatch _ hlt h.isRevMatch)
+
+open Classical in
+theorem IsRevMatch.exists_isLongestRevMatch {pat : ρ} [PatternModel pat] {s : Slice} {pos : s.Pos} :
+    IsRevMatch pat pos → ∃ (pos' : s.Pos), IsLongestRevMatch pat pos' := by
+  induction pos using WellFounded.induction Pos.wellFounded_lt with | h pos ih
+  intro h₁
+  by_cases h₂ : ∃ pos', pos' < pos ∧ IsRevMatch pat pos'
+  · obtain ⟨pos', hp₁, hp₂⟩ := h₂
+    exact ih _ hp₁ hp₂
+  · exact ⟨pos, ⟨h₁, fun p' hp₁ hp₂ => h₂ ⟨_, hp₁, hp₂⟩⟩⟩
+
+theorem IsLongestRevMatch.le_of_isRevMatch {pat : ρ} [PatternModel pat] {s : Slice} {pos pos' : s.Pos}
+    (h : IsLongestRevMatch pat pos) (h' : IsRevMatch pat pos') : pos ≤ pos' :=
+  Std.not_lt.1 (fun hlt => h.not_isRevMatch _ hlt h')
+
 /--
 Predicate stating that a match for a given pattern is never a proper prefix of another match.
 
 This implies that the notion of match and longest match coincide.
 -/
-class NoPrefixForwardPatternModel {ρ : Type} (pat : ρ) [ForwardPatternModel pat] : Prop where
-  eq_empty (s t) : ForwardPatternModel.Matches pat s → ForwardPatternModel.Matches pat (s ++ t) → t = ""
+class NoPrefixPatternModel {ρ : Type} (pat : ρ) [PatternModel pat] : Prop where
+  eq_empty (s t) : PatternModel.Matches pat s → PatternModel.Matches pat (s ++ t) → t = ""
 
-theorem NoPrefixForwardPatternModel.of_length_eq {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
-    (h : ∀ s t, ForwardPatternModel.Matches pat s → ForwardPatternModel.Matches pat t → s.length = t.length) :
-    NoPrefixForwardPatternModel pat where
+theorem NoPrefixPatternModel.of_length_eq {ρ : Type} {pat : ρ} [PatternModel pat]
+    (h : ∀ s t, PatternModel.Matches pat s → PatternModel.Matches pat t → s.length = t.length) :
+    NoPrefixPatternModel pat where
   eq_empty s t hs ht := by simpa using h s _ hs ht
 
-theorem isLongestMatch_iff_isMatch {ρ : Type} (pat : ρ) [ForwardPatternModel pat] [NoPrefixForwardPatternModel pat]
+theorem isLongestMatch_iff_isMatch {ρ : Type} (pat : ρ) [PatternModel pat] [NoPrefixPatternModel pat]
     {s : Slice} {pos : s.Pos} : IsLongestMatch pat pos ↔ IsMatch pat pos := by
   refine ⟨fun h => h.isMatch, fun h => ⟨h, fun pos' hpos' hm => ?_⟩⟩
   obtain ⟨t₁, t₂, ht₁, ht₂⟩ := isMatch_iff_exists_splits.1 h
   obtain ⟨t₁', t₂', ht₁', ht₂'⟩ := isMatch_iff_exists_splits.1 hm
   obtain ⟨t₅, ht₅, ht₅', ht₅''⟩ := (ht₁.lt_iff_exists_eq_append ht₁').1 hpos'
-  exact ht₅ (NoPrefixForwardPatternModel.eq_empty _ _ ht₂ (ht₅' ▸ ht₂'))
+  exact ht₅ (NoPrefixPatternModel.eq_empty _ _ ht₂ (ht₅' ▸ ht₂'))
+
+/--
+Predicate stating that a match for a given pattern is never a proper suffix of another match.
+
+This implies that the notion of reverse match and longest reverse match coincide.
+-/
+class NoSuffixPatternModel {ρ : Type} (pat : ρ) [PatternModel pat] : Prop where
+  eq_empty (s t) : PatternModel.Matches pat t → PatternModel.Matches pat (s ++ t) → s = ""
+
+theorem NoSuffixPatternModel.of_length_eq {ρ : Type} {pat : ρ} [PatternModel pat]
+    (h : ∀ s t, PatternModel.Matches pat s → PatternModel.Matches pat t → s.length = t.length) :
+    NoSuffixPatternModel pat where
+  eq_empty s t hs ht := by simpa using h t _ hs ht
+
+theorem isLongestRevMatch_iff_isRevMatch {ρ : Type} (pat : ρ) [PatternModel pat] [NoSuffixPatternModel pat]
+    {s : Slice} {pos : s.Pos} : IsLongestRevMatch pat pos ↔ IsRevMatch pat pos := by
+  refine ⟨fun h => h.isRevMatch, fun h => ⟨h, fun pos' hpos' hm => ?_⟩⟩
+  obtain ⟨t₁, t₂, ht₁, ht₂⟩ := isRevMatch_iff_exists_splits.1 h
+  obtain ⟨t₁', t₂', ht₁', ht₂'⟩ := isRevMatch_iff_exists_splits.1 hm
+  obtain ⟨t₅, ht₅, ht₅', ht₅''⟩ := (ht₁'.lt_iff_exists_eq_append ht₁).1 hpos'
+  exact ht₅ (NoSuffixPatternModel.eq_empty _ _ ht₂ (ht₅'' ▸ ht₂'))
 
 /--
 Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains is a match
 of {name}`pat` in {name}`s` and it is longest among matches starting at {name}`startPos`.
 -/
-structure IsLongestMatchAt (pat : ρ) [ForwardPatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
+structure IsLongestMatchAt (pat : ρ) [PatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
   le : startPos ≤ endPos
   isLongestMatch_sliceFrom : IsLongestMatch pat (Slice.Pos.sliceFrom _ _ le)
 
-theorem isLongestMatchAt_iff {pat : ρ} [ForwardPatternModel pat] {s : Slice} {pos₁ pos₂ : s.Pos} :
+theorem isLongestMatchAt_iff {pat : ρ} [PatternModel pat] {s : Slice} {pos₁ pos₂ : s.Pos} :
     IsLongestMatchAt pat pos₁ pos₂ ↔
       ∃ (h : pos₁ ≤ pos₂), IsLongestMatch pat (Slice.Pos.sliceFrom _ _ h) :=
   ⟨fun ⟨h, h'⟩ => ⟨h, h'⟩, fun ⟨h, h'⟩ => ⟨h, h'⟩⟩
 
-theorem IsLongestMatchAt.lt {pat : ρ} [ForwardPatternModel pat] {s : Slice} {startPos endPos : s.Pos}
+theorem IsLongestMatchAt.lt {pat : ρ} [PatternModel pat] {s : Slice} {startPos endPos : s.Pos}
     (h : IsLongestMatchAt pat startPos endPos) : startPos < endPos := by
   have := h.isLongestMatch_sliceFrom.ne_startPos
   rw [← Pos.startPos_lt_iff, ← Slice.Pos.ofSliceFrom_lt_ofSliceFrom_iff] at this
   simpa
 
-theorem IsLongestMatchAt.eq {pat : ρ} [ForwardPatternModel pat] {s : Slice} {startPos endPos endPos' : s.Pos}
+theorem IsLongestMatchAt.eq {pat : ρ} [PatternModel pat] {s : Slice} {startPos endPos endPos' : s.Pos}
     (h : IsLongestMatchAt pat startPos endPos) (h' : IsLongestMatchAt pat startPos endPos') :
     endPos = endPos' := by
   simpa using h.isLongestMatch_sliceFrom.eq h'.isLongestMatch_sliceFrom
 
-private theorem isLongestMatch_of_eq {pat : ρ} [ForwardPatternModel pat] {s t : Slice}
+private theorem isLongestMatch_of_eq {pat : ρ} [PatternModel pat] {s t : Slice}
     {pos : s.Pos} {pos' : t.Pos} (h_eq : s = t) (h_pos : pos.offset = pos'.offset)
     (hm : IsLongestMatch pat pos) : IsLongestMatch pat pos' := by
   subst h_eq; exact (Slice.Pos.ext h_pos) ▸ hm
 
-theorem isLongestMatchAt_iff_isLongestMatchAt_ofSliceFrom {pat : ρ} [ForwardPatternModel pat]
+theorem isLongestMatchAt_iff_isLongestMatchAt_ofSliceFrom {pat : ρ} [PatternModel pat]
     {s : Slice} {base : s.Pos} {startPos endPos : (s.sliceFrom base).Pos} :
     IsLongestMatchAt pat startPos endPos ↔ IsLongestMatchAt pat (Pos.ofSliceFrom startPos) (Pos.ofSliceFrom endPos) := by
   constructor
@@ -187,35 +269,88 @@ theorem isLongestMatchAt_iff_isLongestMatchAt_ofSliceFrom {pat : ρ} [ForwardPat
     exact isLongestMatch_of_eq Slice.sliceFrom_sliceFrom.symm
       (by simp [Pos.Raw.ext_iff]; omega) h.isLongestMatch_sliceFrom
 
-theorem IsLongestMatch.isLongestMatchAt_ofSliceFrom {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem IsLongestMatch.isLongestMatchAt_ofSliceFrom {pat : ρ} [PatternModel pat] {s : Slice}
     {p₀ : s.Pos} {pos : (s.sliceFrom p₀).Pos} (h : IsLongestMatch pat pos) :
     IsLongestMatchAt pat p₀ (Slice.Pos.ofSliceFrom pos) where
   le := Slice.Pos.le_ofSliceFrom
   isLongestMatch_sliceFrom := by simpa
 
 @[simp]
-theorem isLongestMatchAt_startPos_iff {pat : ρ} [ForwardPatternModel pat] {s : Slice} {endPos : s.Pos} :
+theorem isLongestMatchAt_startPos_iff {pat : ρ} [PatternModel pat] {s : Slice} {endPos : s.Pos} :
     IsLongestMatchAt pat s.startPos endPos ↔ IsLongestMatch pat endPos := by
   simpa [isLongestMatchAt_iff] using
     ⟨fun h => isLongestMatch_of_eq (by simp) (by simp) h,
      fun h => isLongestMatch_of_eq (by simp) (by simp) h⟩
 
+/--
+Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains is a match
+of {name}`pat` in {name}`s` and it is longest among matches ending at {name}`endPos`.
+-/
+structure IsLongestRevMatchAt (pat : ρ) [PatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
+  le : startPos ≤ endPos
+  isLongestRevMatch_sliceTo : IsLongestRevMatch pat (Slice.Pos.sliceTo _ _ le)
+
+theorem isLongestRevMatchAt_iff {pat : ρ} [PatternModel pat] {s : Slice} {pos₁ pos₂ : s.Pos} :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔
+      ∃ (h : pos₁ ≤ pos₂), IsLongestRevMatch pat (Slice.Pos.sliceTo _ _ h) :=
+  ⟨fun ⟨h, h'⟩ => ⟨h, h'⟩, fun ⟨h, h'⟩ => ⟨h, h'⟩⟩
+
+theorem IsLongestRevMatchAt.lt {pat : ρ} [PatternModel pat] {s : Slice} {startPos endPos : s.Pos}
+    (h : IsLongestRevMatchAt pat startPos endPos) : startPos < endPos := by
+  have := h.isLongestRevMatch_sliceTo.ne_endPos
+  rw [← Pos.lt_endPos_iff, ← Slice.Pos.ofSliceTo_lt_ofSliceTo_iff] at this
+  simpa
+
+theorem IsLongestRevMatchAt.eq {pat : ρ} [PatternModel pat] {s : Slice} {startPos startPos' endPos : s.Pos}
+    (h : IsLongestRevMatchAt pat startPos endPos) (h' : IsLongestRevMatchAt pat startPos' endPos) :
+    startPos = startPos' := by
+  simpa using h.isLongestRevMatch_sliceTo.eq h'.isLongestRevMatch_sliceTo
+
+private theorem isLongestRevMatch_of_eq {pat : ρ} [PatternModel pat] {s t : Slice}
+    {pos : s.Pos} {pos' : t.Pos} (h_eq : s = t) (h_pos : pos.offset = pos'.offset)
+    (hm : IsLongestRevMatch pat pos) : IsLongestRevMatch pat pos' := by
+  subst h_eq; exact (Slice.Pos.ext h_pos) ▸ hm
+
+theorem isLongestRevMatchAt_iff_isLongestRevMatchAt_ofSliceTo {pat : ρ} [PatternModel pat]
+    {s : Slice} {base : s.Pos} {startPos endPos : (s.sliceTo base).Pos} :
+    IsLongestRevMatchAt pat startPos endPos ↔ IsLongestRevMatchAt pat (Pos.ofSliceTo startPos) (Pos.ofSliceTo endPos) := by
+  constructor
+  · intro h
+    refine ⟨Slice.Pos.ofSliceTo_le_ofSliceTo_iff.mpr h.le, ?_⟩
+    exact isLongestRevMatch_of_eq Slice.sliceTo_sliceTo (by simp) h.isLongestRevMatch_sliceTo
+  · intro h
+    refine ⟨Slice.Pos.ofSliceTo_le_ofSliceTo_iff.mp h.le, ?_⟩
+    exact isLongestRevMatch_of_eq Slice.sliceTo_sliceTo.symm (by simp) h.isLongestRevMatch_sliceTo
+
+theorem IsLongestRevMatch.isLongestRevMatchAt_ofSliceTo {pat : ρ} [PatternModel pat] {s : Slice}
+    {p₀ : s.Pos} {pos : (s.sliceTo p₀).Pos} (h : IsLongestRevMatch pat pos) :
+    IsLongestRevMatchAt pat (Slice.Pos.ofSliceTo pos) p₀ where
+  le := Slice.Pos.ofSliceTo_le
+  isLongestRevMatch_sliceTo := by simpa
+
+@[simp]
+theorem isLongestRevMatchAt_endPos_iff {pat : ρ} [PatternModel pat] {s : Slice} {startPos : s.Pos} :
+    IsLongestRevMatchAt pat startPos s.endPos ↔ IsLongestRevMatch pat startPos := by
+  simpa [isLongestRevMatchAt_iff] using
+    ⟨fun h => isLongestRevMatch_of_eq (by simp) (by simp) h,
+     fun h => isLongestRevMatch_of_eq (by simp) (by simp) h⟩
+
 /--
 Predicate stating that there is a (longest) match starting at the given position.
 -/
-structure MatchesAt (pat : ρ) [ForwardPatternModel pat] {s : Slice} (pos : s.Pos) : Prop where
+structure MatchesAt (pat : ρ) [PatternModel pat] {s : Slice} (pos : s.Pos) : Prop where
   exists_isLongestMatchAt : ∃ endPos, IsLongestMatchAt pat pos endPos
 
-theorem matchesAt_iff_exists_isLongestMatchAt {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem matchesAt_iff_exists_isLongestMatchAt {pat : ρ} [PatternModel pat] {s : Slice}
     {pos : s.Pos} : MatchesAt pat pos ↔ ∃ endPos, IsLongestMatchAt pat pos endPos :=
   ⟨fun ⟨h⟩ => h, fun h => ⟨h⟩⟩
 
-theorem matchesAt_iff_exists_isLongestMatch {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem matchesAt_iff_exists_isLongestMatch {pat : ρ} [PatternModel pat] {s : Slice}
     {pos : s.Pos} :
     MatchesAt pat pos ↔ ∃ (endPos : s.Pos), ∃ h, IsLongestMatch pat (pos.sliceFrom endPos h) :=
   ⟨fun ⟨p, h⟩ => ⟨p, h.le, h.isLongestMatch_sliceFrom⟩, fun ⟨p, h₁, h₂⟩ => ⟨p, ⟨h₁, h₂⟩⟩⟩
 
-theorem matchesAt_iff_exists_isMatch {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem matchesAt_iff_exists_isMatch {pat : ρ} [PatternModel pat] {s : Slice}
     {pos : s.Pos} :
     MatchesAt pat pos ↔ ∃ (endPos : s.Pos), ∃ h, IsMatch pat (pos.sliceFrom endPos h) := by
   refine ⟨fun ⟨p, h⟩ => ⟨p, h.le, h.isLongestMatch_sliceFrom.isMatch⟩, fun ⟨p, h₁, h₂⟩ => ?_⟩
@@ -225,13 +360,13 @@ theorem matchesAt_iff_exists_isMatch {pat : ρ} [ForwardPatternModel pat] {s : S
      by simpa using hq⟩⟩
 
 @[simp]
-theorem not_matchesAt_endPos {pat : ρ} [ForwardPatternModel pat] {s : Slice} :
+theorem not_matchesAt_endPos {pat : ρ} [PatternModel pat] {s : Slice} :
     ¬ MatchesAt pat s.endPos := by
   simp only [matchesAt_iff_exists_isMatch, Pos.endPos_le, exists_prop_eq]
   intro h
   simpa [← Pos.ofSliceFrom_inj] using h.ne_startPos
 
-theorem matchesAt_iff_matchesAt_ofSliceFrom {pat : ρ} [ForwardPatternModel pat] {s : Slice} {base : s.Pos}
+theorem matchesAt_iff_matchesAt_ofSliceFrom {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
     {pos : (s.sliceFrom base).Pos} : MatchesAt pat pos ↔ MatchesAt pat (Pos.ofSliceFrom pos) := by
   simp only [matchesAt_iff_exists_isLongestMatchAt]
   constructor
@@ -241,21 +376,66 @@ theorem matchesAt_iff_matchesAt_ofSliceFrom {pat : ρ} [ForwardPatternModel pat]
     exact ⟨base.sliceFrom endPos (Std.le_trans Slice.Pos.le_ofSliceFrom h.le),
            isLongestMatchAt_iff_isLongestMatchAt_ofSliceFrom.mpr (by simpa using h)⟩
 
-theorem IsLongestMatchAt.matchesAt {pat : ρ} [ForwardPatternModel pat] {s : Slice} {startPos endPos : s.Pos}
+theorem IsLongestMatchAt.matchesAt {pat : ρ} [PatternModel pat] {s : Slice} {startPos endPos : s.Pos}
     (h : IsLongestMatchAt pat startPos endPos) : MatchesAt pat startPos where
   exists_isLongestMatchAt := ⟨_, h⟩
 
+/--
+Predicate stating that there is a (longest) match ending at the given position.
+-/
+structure RevMatchesAt (pat : ρ) [PatternModel pat] {s : Slice} (pos : s.Pos) : Prop where
+  exists_isLongestRevMatchAt : ∃ startPos, IsLongestRevMatchAt pat startPos pos
+
+theorem revMatchesAt_iff_exists_isLongestRevMatchAt {pat : ρ} [PatternModel pat] {s : Slice}
+    {pos : s.Pos} : RevMatchesAt pat pos ↔ ∃ startPos, IsLongestRevMatchAt pat startPos pos :=
+  ⟨fun ⟨h⟩ => h, fun h => ⟨h⟩⟩
+
+theorem revMatchesAt_iff_exists_isLongestRevMatch {pat : ρ} [PatternModel pat] {s : Slice}
+    {pos : s.Pos} :
+    RevMatchesAt pat pos ↔ ∃ (startPos : s.Pos), ∃ h, IsLongestRevMatch pat (pos.sliceTo startPos h) :=
+  ⟨fun ⟨p, h⟩ => ⟨p, h.le, h.isLongestRevMatch_sliceTo⟩, fun ⟨p, h₁, h₂⟩ => ⟨p, ⟨h₁, h₂⟩⟩⟩
+
+theorem revMatchesAt_iff_exists_isRevMatch {pat : ρ} [PatternModel pat] {s : Slice}
+    {pos : s.Pos} :
+    RevMatchesAt pat pos ↔ ∃ (startPos : s.Pos), ∃ h, IsRevMatch pat (pos.sliceTo startPos h) := by
+  refine ⟨fun ⟨p, h⟩ => ⟨p, h.le, h.isLongestRevMatch_sliceTo.isRevMatch⟩, fun ⟨p, h₁, h₂⟩ => ?_⟩
+  obtain ⟨q, hq⟩ := h₂.exists_isLongestRevMatch
+  exact ⟨Pos.ofSliceTo q,
+    ⟨Std.le_trans (by simpa [← Pos.ofSliceTo_le_ofSliceTo_iff] using hq.le_of_isRevMatch h₂) h₁,
+     by simpa using hq⟩⟩
+
+@[simp]
+theorem not_revMatchesAt_startPos {pat : ρ} [PatternModel pat] {s : Slice} :
+    ¬ RevMatchesAt pat s.startPos := by
+  simp only [revMatchesAt_iff_exists_isRevMatch, Pos.le_startPos, exists_prop_eq]
+  intro h
+  simpa [← Pos.ofSliceTo_inj] using h.ne_endPos
+
+theorem revMatchesAt_iff_revMatchesAt_ofSliceto {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
+    {pos : (s.sliceTo base).Pos} : RevMatchesAt pat pos ↔ RevMatchesAt pat (Pos.ofSliceTo pos) := by
+  simp only [revMatchesAt_iff_exists_isLongestRevMatchAt]
+  constructor
+  · rintro ⟨startPos, h⟩
+    exact ⟨Pos.ofSliceTo startPos, isLongestRevMatchAt_iff_isLongestRevMatchAt_ofSliceTo.mp h⟩
+  · rintro ⟨startPos, h⟩
+    exact ⟨base.sliceTo startPos (Std.le_trans h.le Slice.Pos.ofSliceTo_le),
+           isLongestRevMatchAt_iff_isLongestRevMatchAt_ofSliceTo.mpr (by simpa using h)⟩
+
+theorem IsLongestRevMatchAt.revMatchesAt {pat : ρ} [PatternModel pat] {s : Slice} {startPos endPos : s.Pos}
+    (h : IsLongestRevMatchAt pat startPos endPos) : RevMatchesAt pat endPos where
+  exists_isLongestRevMatchAt := ⟨_, h⟩
+
 open Classical in
 /--
 Noncomputable model function returning the end point of the longest match starting at the given
 position, or {lean}`none` if there is no match.
 -/
-noncomputable def matchAt? {ρ : Type} (pat : ρ) [ForwardPatternModel pat]
+noncomputable def matchAt? {ρ : Type} (pat : ρ) [PatternModel pat]
     {s : Slice} (startPos : s.Pos) : Option s.Pos :=
   if h : ∃ endPos, IsLongestMatchAt pat startPos endPos then some h.choose else none
 
 @[simp]
-theorem matchAt?_eq_some_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
+theorem matchAt?_eq_some_iff {ρ : Type} {pat : ρ} [PatternModel pat]
     {s : Slice} {startPos endPos : s.Pos} :
     matchAt? pat startPos = some endPos ↔ IsLongestMatchAt pat startPos endPos := by
   fun_cases matchAt? with
@@ -263,40 +443,92 @@ theorem matchAt?_eq_some_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
   | case2 => simp_all
 
 @[simp]
-theorem matchAt?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
+theorem matchAt?_eq_none_iff {ρ : Type} {pat : ρ} [PatternModel pat]
     {s : Slice} {startPos : s.Pos} :
     matchAt? pat startPos = none ↔ ¬ MatchesAt pat startPos := by
   fun_cases matchAt? with
   | case1 h => simpa using ⟨h⟩
   | case2 h => simpa using fun ⟨h'⟩ => h h'
 
+open Classical in
 /--
-Predicate stating compatibility between {name}`ForwardPatternModel` and {name}`ForwardPattern`.
+Noncomputable model function returning the start point of the longest match ending at the given
+position, or {lean}`none` if there is no match.
+-/
+noncomputable def revMatchAt? {ρ : Type} (pat : ρ) [PatternModel pat]
+    {s : Slice} (endPos : s.Pos) : Option s.Pos :=
+  if h : ∃ startPos, IsLongestRevMatchAt pat startPos endPos then some h.choose else none
+
+@[simp]
+theorem revMatchAt?_eq_some_iff {ρ : Type} {pat : ρ} [PatternModel pat]
+    {s : Slice} {startPos endPos : s.Pos} :
+    revMatchAt? pat endPos = some startPos ↔ IsLongestRevMatchAt pat startPos endPos := by
+  fun_cases revMatchAt? with
+  | case1 h => simpa using ⟨by rintro rfl; exact h.choose_spec, fun h' => h.choose_spec.eq h'⟩
+  | case2 => simp_all
+
+@[simp]
+theorem revMatchAt?_eq_none_iff {ρ : Type} {pat : ρ} [PatternModel pat]
+    {s : Slice} {endPos : s.Pos} :
+    revMatchAt? pat endPos = none ↔ ¬ RevMatchesAt pat endPos := by
+  fun_cases revMatchAt? with
+  | case1 h => simpa using ⟨h⟩
+  | case2 h => simpa using fun ⟨h'⟩ => h h'
+
+/--
+Predicate stating compatibility between {name}`PatternModel` and {name}`ForwardPattern`.
 
 This extends {name}`LawfulForwardPattern`, but it is much stronger because it forces the
 {name}`ForwardPattern` to match the longest prefix of the given slice that matches the property
-supplied by the {name}`ForwardPatternModel` instance.
+supplied by the {name}`PatternModel` instance.
 -/
 class LawfulForwardPatternModel {ρ : Type} (pat : ρ) [ForwardPattern pat]
-    [ForwardPatternModel pat] : Prop extends LawfulForwardPattern pat where
+    [PatternModel pat] : Prop extends LawfulForwardPattern pat where
   skipPrefix?_eq_some_iff (pos) : ForwardPattern.skipPrefix? pat s = some pos ↔ IsLongestMatch pat pos
 
-open Classical in
-theorem LawfulForwardPatternModel.skipPrefix?_sliceFrom_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPattern pat] [ForwardPatternModel pat]
+theorem LawfulForwardPatternModel.skipPrefix?_sliceFrom_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPattern pat] [PatternModel pat]
     [LawfulForwardPatternModel pat] {s : Slice} {p₀ : s.Pos} :
     ForwardPattern.skipPrefix? pat (s.sliceFrom p₀) = none ↔ ¬ MatchesAt pat p₀ := by
+  classical
   rw [← Decidable.not_iff_not]
   simp [Option.ne_none_iff_exists', LawfulForwardPatternModel.skipPrefix?_eq_some_iff]
   refine ⟨fun ⟨p, hp⟩ => ?_, fun ⟨p, hp⟩ => ?_⟩
   · exact ⟨Slice.Pos.ofSliceFrom p, hp.isLongestMatchAt_ofSliceFrom⟩
   · exact ⟨p₀.sliceFrom p hp.le, hp.isLongestMatch_sliceFrom⟩
 
-theorem LawfulForwardPatternModel.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPattern pat] [ForwardPatternModel pat]
+theorem LawfulForwardPatternModel.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPattern pat] [PatternModel pat]
     [LawfulForwardPatternModel pat] {s : Slice} :
     ForwardPattern.skipPrefix? pat s = none ↔ ¬ MatchesAt pat s.startPos := by
   conv => lhs; rw [← sliceFrom_startPos (s := s)]
   simp [skipPrefix?_sliceFrom_eq_none_iff]
 
+/--
+Predicate stating compatibility between {name}`PatternModel` and {name}`BackwardPattern`.
+
+This extends {name}`LawfulForwardPattern`, but it is much stronger because it forces the
+{name}`ForwardPattern` to match the longest prefix of the given slice that matches the property
+supplied by the {name}`PatternModel` instance.
+-/
+class LawfulBackwardPatternModel {ρ : Type} (pat : ρ) [BackwardPattern pat]
+    [PatternModel pat] : Prop extends LawfulBackwardPattern pat where
+  skipSuffix?_eq_some_iff (pos) : BackwardPattern.skipSuffix? pat s = some pos ↔ IsLongestRevMatch pat pos
+
+theorem LawfulBackwardPatternModel.skipSuffix?_sliceTo_eq_none_iff {ρ : Type} {pat : ρ} [BackwardPattern pat] [PatternModel pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} {p₀ : s.Pos} :
+    BackwardPattern.skipSuffix? pat (s.sliceTo p₀) = none ↔ ¬ RevMatchesAt pat p₀ := by
+  classical
+  rw [← Decidable.not_iff_not]
+  simp [Option.ne_none_iff_exists', LawfulBackwardPatternModel.skipSuffix?_eq_some_iff]
+  refine ⟨fun ⟨p, hp⟩ => ?_, fun ⟨p, hp⟩ => ?_⟩
+  · exact ⟨Slice.Pos.ofSliceTo p, hp.isLongestRevMatchAt_ofSliceTo⟩
+  · exact ⟨p₀.sliceTo p hp.le, hp.isLongestRevMatch_sliceTo⟩
+
+theorem LawfulBackwardPatternModel.skipSuffix?_eq_none_iff {ρ : Type} {pat : ρ} [BackwardPattern pat] [PatternModel pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} :
+    BackwardPattern.skipSuffix? pat s = none ↔ ¬ RevMatchesAt pat s.endPos := by
+  conv => lhs; rw [← sliceTo_endPos (s := s)]
+  simp [skipSuffix?_sliceTo_eq_none_iff]
+
 /--
 Inductive predicate stating that a list of search steps represents a valid search from a given
 position in a slice.
@@ -306,7 +538,7 @@ matches.
 
 Hence, this predicate determines the list of search steps up to grouping of rejections.
 -/
-inductive IsValidSearchFrom (pat : ρ) [ForwardPatternModel pat] {s : Slice} :
+inductive IsValidSearchFrom (pat : ρ) [PatternModel pat] {s : Slice} :
     s.Pos → List (SearchStep s) → Prop where
   | endPos : IsValidSearchFrom pat s.endPos []
   | matched {startPos endPos : s.Pos} :
@@ -316,14 +548,14 @@ inductive IsValidSearchFrom (pat : ρ) [ForwardPatternModel pat] {s : Slice} :
       (∀ pos, startPos ≤ pos → pos < endPos → ¬ MatchesAt pat pos) →
       IsValidSearchFrom pat endPos l → IsValidSearchFrom pat startPos (.rejected startPos endPos :: l)
 
-theorem IsValidSearchFrom.matched_of_eq {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem IsValidSearchFrom.matched_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
     {startPos startPos' endPos : s.Pos} {l : List (SearchStep s)} (h₁ : IsValidSearchFrom pat endPos l)
     (h₂ : IsLongestMatchAt pat startPos' endPos)
     (h₃ : startPos = startPos') : IsValidSearchFrom pat startPos' (.matched startPos endPos :: l) := by
   cases h₃
   exact IsValidSearchFrom.matched h₂ h₁
 
-theorem IsValidSearchFrom.mismatched_of_eq {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem IsValidSearchFrom.mismatched_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
     {startPos startPos' endPos : s.Pos} {l : List (SearchStep s)} (h₁ : IsValidSearchFrom pat endPos l)
       (h₀ : startPos' < endPos)
       (h₂ : ∀ pos, startPos' ≤ pos → pos < endPos → ¬ MatchesAt pat pos) (h₃ : startPos = startPos') :
@@ -331,7 +563,7 @@ theorem IsValidSearchFrom.mismatched_of_eq {pat : ρ} [ForwardPatternModel pat]
   cases h₃
   exact IsValidSearchFrom.mismatched h₀ h₂ h₁
 
-theorem IsValidSearchFrom.endPos_of_eq {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+theorem IsValidSearchFrom.endPos_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
     {p : s.Pos} {l : List (SearchStep s)} (hp : p = s.endPos) (hl : l = []) :
     IsValidSearchFrom pat p l := by
   cases hp
@@ -339,18 +571,18 @@ theorem IsValidSearchFrom.endPos_of_eq {pat : ρ} [ForwardPatternModel pat] {s :
   exact IsValidSearchFrom.endPos
 
 /--
-Predicate stating compatibility between {name}`ForwardPatternModel` and {name}`ToForwardSearcher`.
+Predicate stating compatibility between {name}`PatternModel` and {name}`ToForwardSearcher`.
 
 We require the searcher to always match the longest match at the first position where the pattern
 matches; see {name}`IsValidSearchFrom`.
 -/
-class LawfulToForwardSearcherModel {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {σ : Slice → Type}
+class LawfulToForwardSearcherModel {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
     [ToForwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
     [∀ s, Std.Iterators.Finite (σ s) Id] : Prop where
   isValidSearchFrom_toList (s) : IsValidSearchFrom pat s.startPos (ToForwardSearcher.toSearcher pat s).toList
 
 theorem LawfulToForwardSearcherModel.defaultImplementation {pat : ρ} [ForwardPattern pat] [StrictForwardPattern pat]
-    [ForwardPatternModel pat] [LawfulForwardPatternModel pat] :
+    [PatternModel pat] [LawfulForwardPatternModel pat] :
     letI : ToForwardSearcher pat (ToForwardSearcher.DefaultForwardSearcher pat) := .defaultImplementation
     LawfulToForwardSearcherModel pat := by
   let inst : ToForwardSearcher pat (ToForwardSearcher.DefaultForwardSearcher pat) := .defaultImplementation
@@ -390,4 +622,97 @@ theorem LawfulToForwardSearcherModel.defaultImplementation {pat : ρ} [ForwardPa
     · split at heq <;> simp at heq
     · split at heq <;> simp at heq
 
+/--
+Inductive predicate stating that a list of search steps represents a valid backwards search from a
+given position in a slice.
+
+"Searching" here means always taking the longest match at the first position where the pattern
+matches.
+
+Hence, this predicate determines the list of search steps up to grouping of rejections.
+-/
+inductive IsValidRevSearchFrom (pat : ρ) [PatternModel pat] {s : Slice} :
+    s.Pos → List (SearchStep s) → Prop where
+  | startPos : IsValidRevSearchFrom pat s.startPos []
+  | matched {startPos endPos : s.Pos} :
+      IsLongestRevMatchAt pat startPos endPos → IsValidRevSearchFrom pat startPos l →
+      IsValidRevSearchFrom pat endPos (.matched startPos endPos :: l)
+  | mismatched {startPos endPos : s.Pos} : startPos < endPos →
+      (∀ pos, startPos < pos → pos ≤ endPos → ¬ RevMatchesAt pat pos) →
+      IsValidRevSearchFrom pat startPos l → IsValidRevSearchFrom pat endPos (.rejected startPos endPos :: l)
+
+theorem IsValidRevSearchFrom.matched_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
+    {startPos endPos endPos' : s.Pos} {l : List (SearchStep s)} (h₁ : IsValidRevSearchFrom pat startPos l)
+    (h₂ : IsLongestRevMatchAt pat startPos endPos')
+    (h₃ : endPos = endPos') : IsValidRevSearchFrom pat endPos' (.matched startPos endPos :: l) := by
+  cases h₃
+  exact IsValidRevSearchFrom.matched h₂ h₁
+
+theorem IsValidRevSearchFrom.mismatched_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
+    {startPos endPos endPos' : s.Pos} {l : List (SearchStep s)} (h₁ : IsValidRevSearchFrom pat startPos l)
+      (h₀ : startPos < endPos')
+      (h₂ : ∀ pos, startPos < pos → pos ≤ endPos' → ¬ RevMatchesAt pat pos) (h₃ : endPos = endPos') :
+      IsValidRevSearchFrom pat endPos' (.rejected startPos endPos :: l) := by
+  cases h₃
+  exact IsValidRevSearchFrom.mismatched h₀ h₂ h₁
+
+theorem IsValidRevSearchFrom.startPos_of_eq {pat : ρ} [PatternModel pat] {s : Slice}
+    {p : s.Pos} {l : List (SearchStep s)} (hp : p = s.startPos) (hl : l = []) :
+    IsValidRevSearchFrom pat p l := by
+  cases hp
+  cases hl
+  exact IsValidRevSearchFrom.startPos
+
+/--
+Predicate stating compatibility between {name}`PatternModel` and {name}`ToBackwardSearcher`.
+
+We require the searcher to always match the longest match at the first position where the pattern
+matches; see {name}`IsValidRevSearchFrom`.
+-/
+class LawfulToBackwardSearcherModel {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
+    [ToBackwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
+    [∀ s, Std.Iterators.Finite (σ s) Id] : Prop where
+  isValidRevSearchFrom_toList (s) : IsValidRevSearchFrom pat s.endPos (ToBackwardSearcher.toSearcher pat s).toList
+
+theorem LawfulToBackwardSearcherModel.defaultImplementation {pat : ρ} [BackwardPattern pat] [StrictBackwardPattern pat]
+    [PatternModel pat] [LawfulBackwardPatternModel pat] :
+    letI : ToBackwardSearcher pat (ToBackwardSearcher.DefaultBackwardSearcher pat) := .defaultImplementation
+    LawfulToBackwardSearcherModel pat := by
+  let inst : ToBackwardSearcher pat (ToBackwardSearcher.DefaultBackwardSearcher pat) := .defaultImplementation
+  refine ⟨fun s => ?_⟩
+  suffices ∀ (pos : s.Pos),
+      IsValidRevSearchFrom pat pos (Std.Iter.mk (α := ToBackwardSearcher.DefaultBackwardSearcher pat s) ⟨pos⟩).toList from
+    this s.endPos
+  intro pos
+  induction pos using WellFounded.induction Slice.Pos.wellFounded_lt with | h pos ih
+  rw [Std.Iter.toList_eq_match_step, Std.Iter.step_eq]
+  simp only [Std.Iter.toIterM, ne_eq]
+  by_cases h : pos = s.startPos
+  · simpa [h] using IsValidRevSearchFrom.startPos
+  · simp only [h, ↓reduceDIte]
+    split <;> rename_i heq
+    · split at heq <;> rename_i pos' heq'
+      · simp only [Id.run_pure, Std.Shrink.inflate_deflate, Std.IterM.Step.toPure_yield,
+          Std.PlausibleIterStep.yield, Std.IterStep.yield.injEq] at heq
+        rw [← heq.1, ← heq.2]
+        apply IsValidRevSearchFrom.matched
+        · rw [LawfulBackwardPattern.skipSuffixOfNonempty?_eq,
+            LawfulBackwardPatternModel.skipSuffix?_eq_some_iff] at heq'
+          exact heq'.isLongestRevMatchAt_ofSliceTo
+        · simp only [Std.IterM.toIter]
+          apply ih
+          refine Std.lt_of_lt_of_le (Slice.Pos.ofSliceTo_lt_ofSliceTo_iff.2 ?_)
+            (Slice.Pos.ofSliceTo_le (pos := Slice.endPos _))
+          simpa using StrictBackwardPattern.ne_endPos _ _ heq'
+      · simp only [Id.run_pure, Std.Shrink.inflate_deflate, Std.IterM.Step.toPure_yield,
+          Std.PlausibleIterStep.yield, Std.IterStep.yield.injEq] at heq
+        rw [← heq.1, ← heq.2]
+        apply IsValidRevSearchFrom.mismatched (by simp) _ (ih _ (by simp))
+        intro p' hp' hp''
+        obtain rfl : pos = p' := Std.le_antisymm (by simpa using hp') hp''
+        rwa [LawfulBackwardPattern.skipSuffixOfNonempty?_eq,
+          LawfulBackwardPatternModel.skipSuffix?_sliceTo_eq_none_iff] at heq'
+    · split at heq <;> simp at heq
+    · split at heq <;> simp at heq
+
 end String.Slice.Pattern.Model

src/Init/Data/String/Lemmas/Pattern/Char.lean

@@ -20,28 +20,42 @@ import Init.Data.String.Lemmas.Order
 import Init.Data.Order.Lemmas
 import Init.Data.String.OrderInstances
 import Init.Omega
+import Init.Data.String.Lemmas.FindPos
 
 public section
 
 namespace String.Slice.Pattern.Model.Char
 
-instance {c : Char} : ForwardPatternModel c where
+instance {c : Char} : PatternModel c where
   Matches s := s = String.singleton c
   not_matches_empty := by simp
 
-instance {c : Char} : NoPrefixForwardPatternModel c :=
-  .of_length_eq (by simp +contextual [ForwardPatternModel.Matches])
+instance {c : Char} : NoPrefixPatternModel c :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
+
+instance {c : Char} : NoSuffixPatternModel c :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
 
 theorem isMatch_iff {c : Char} {s : Slice} {pos : s.Pos} :
     IsMatch c pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ s.startPos.get h = c := by
-  simp only [Model.isMatch_iff, ForwardPatternModel.Matches, sliceTo_copy_eq_iff_exists_splits]
+  simp only [Model.isMatch_iff, PatternModel.Matches, copy_sliceTo_eq_iff_exists_splits]
   refine ⟨?_, ?_⟩
   · simp only [splits_singleton_iff]
     exact fun ⟨t₂, h, h₁, h₂, h₃⟩ => ⟨h, h₁, h₂⟩
   · rintro ⟨h, rfl, rfl⟩
     exact ⟨_, Slice.splits_next_startPos⟩
 
+theorem isRevMatch_iff {c : Char} {s : Slice} {pos : s.Pos} :
+    IsRevMatch c pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c := by
+  simp only [Model.isRevMatch_iff, PatternModel.Matches, copy_sliceFrom_eq_iff_exists_splits]
+  refine ⟨?_, ?_⟩
+  · simp only [splits_singleton_right_iff]
+    exact fun ⟨t₂, h, h₁, h₂, h₃⟩ => ⟨h, h₁, h₂⟩
+  · rintro ⟨h, rfl, rfl⟩
+    exact ⟨_, Slice.splits_prev_endPos⟩
+
 theorem isLongestMatch_iff {c : Char} {s : Slice} {pos : s.Pos} :
     IsLongestMatch c pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ s.startPos.get h = c := by
@@ -52,21 +66,46 @@ theorem isLongestMatchAt_iff {c : Char} {s : Slice} {pos pos' : s.Pos} :
   simp +contextual [Model.isLongestMatchAt_iff, isLongestMatch_iff, ← Pos.ofSliceFrom_inj,
     Pos.get_eq_get_ofSliceFrom, Pos.ofSliceFrom_next]
 
+theorem isLongestRevMatch_iff {c : Char} {s : Slice} {pos : s.Pos} :
+    IsLongestRevMatch c pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c := by
+  rw [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff]
+
+theorem isLongestRevMatchAt_iff {c : Char} {s : Slice} {pos pos' : s.Pos} :
+    IsLongestRevMatchAt c pos pos' ↔ ∃ h, pos = pos'.prev h ∧ (pos'.prev h).get (by simp) = c := by
+  simp +contextual [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff, ← Pos.ofSliceTo_inj,
+    Pos.get_eq_get_ofSliceTo, Pos.ofSliceTo_prev]
+
 theorem isLongestMatchAt_of_get_eq {c : Char} {s : Slice} {pos : s.Pos} {h : pos ≠ s.endPos}
     (hc : pos.get h = c) : IsLongestMatchAt c pos (pos.next h) :=
   isLongestMatchAt_iff.2 ⟨h, by simp [hc]⟩
 
+theorem isLongestRevMatchAt_of_get_eq {c : Char} {s : Slice} {pos : s.Pos} {h : pos ≠ s.startPos}
+    (hc : (pos.prev h).get (by simp) = c) : IsLongestRevMatchAt c (pos.prev h) pos :=
+  isLongestRevMatchAt_iff.2 ⟨h, by simp [hc]⟩
+
 instance {c : Char} : LawfulForwardPatternModel c where
   skipPrefix?_eq_some_iff {s} pos := by
     simp [isLongestMatch_iff, ForwardPattern.skipPrefix?, and_comm, eq_comm (b := pos)]
 
+instance {c : Char} : LawfulBackwardPatternModel c where
+  skipSuffix?_eq_some_iff {s} pos := by
+    simp [isLongestRevMatch_iff, BackwardPattern.skipSuffix?, and_comm, eq_comm (b := pos)]
+
 theorem toSearcher_eq {c : Char} {s : Slice} :
   ToForwardSearcher.toSearcher c s = ToForwardSearcher.toSearcher (· == c) s := (rfl)
 
+theorem toBackwardSearcher_eq {c : Char} {s : Slice} :
+  ToBackwardSearcher.toSearcher c s = ToBackwardSearcher.toSearcher (· == c) s := (rfl)
+
 theorem matchesAt_iff {c : Char} {s : Slice} {pos : s.Pos} :
     MatchesAt c pos ↔ ∃ (h : pos ≠ s.endPos), pos.get h = c := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff, exists_comm]
 
+theorem revMatchesAt_iff {c : Char} {s : Slice} {pos : s.Pos} :
+    RevMatchesAt c pos ↔ ∃ (h : pos ≠ s.startPos), (pos.prev h).get (by simp) = c := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff, exists_comm]
+
 theorem matchesAt_iff_splits {c : Char} {s : Slice} {pos : s.Pos} :
     MatchesAt c pos ↔ ∃ t₁ t₂, pos.Splits t₁ (singleton c ++ t₂) := by
   rw [matchesAt_iff]
@@ -77,37 +116,81 @@ theorem matchesAt_iff_splits {c : Char} {s : Slice} {pos : s.Pos} :
     have hne := hs.ne_endPos_of_singleton
     exact ⟨hne, (singleton_append_inj.mp (hs.eq_right (pos.splits_next_right hne))).1.symm⟩
 
+theorem revMatchesAt_iff_splits {c : Char} {s : Slice} {pos : s.Pos} :
+    RevMatchesAt c pos ↔ ∃ t₁ t₂, pos.Splits (t₁ ++ singleton c) t₂ := by
+  rw [revMatchesAt_iff]
+  refine ⟨?_, ?_⟩
+  · rintro ⟨h, rfl⟩
+    exact ⟨_, _, pos.splits_prev_right h⟩
+  · rintro ⟨t₁, t₂, hs⟩
+    have hne := hs.ne_startPos_of_singleton
+    refine ⟨hne, ?_⟩
+    have := hs.eq_left (pos.splits_prev_right hne)
+    simp only [append_singleton, push_inj] at this
+    exact this.2.symm
+
 theorem not_matchesAt_of_get_ne {c : Char} {s : Slice} {pos : s.Pos} {h : pos ≠ s.endPos}
     (hc : pos.get h ≠ c) : ¬ MatchesAt c pos := by
   simp [matchesAt_iff, hc]
 
+theorem not_revMatchesAt_of_get_ne {c : Char} {s : Slice} {pos : s.Pos} {h : pos ≠ s.startPos}
+    (hc : (pos.prev h).get (by simp) ≠ c) : ¬ RevMatchesAt c pos := by
+  simp [revMatchesAt_iff, hc]
+
 theorem matchAt?_eq {s : Slice} {pos : s.Pos} {c : Char} :
     matchAt? c pos =
       if h₀ : ∃ (h : pos ≠ s.endPos), pos.get h = c then some (pos.next h₀.1) else none := by
   split <;> simp_all [isLongestMatchAt_iff, matchesAt_iff]
 
+theorem revMatchAt?_eq {s : Slice} {pos : s.Pos} {c : Char} :
+    revMatchAt? c pos =
+      if h₀ : ∃ (h : pos ≠ s.startPos), (pos.prev h).get (by simp) = c then some (pos.prev h₀.1) else none := by
+  split <;> simp_all [isLongestRevMatchAt_iff, revMatchesAt_iff]
+
 theorem isMatch_iff_isMatch_beq {c : Char} {s : Slice} {pos : s.Pos} :
     IsMatch c pos ↔ IsMatch (· == c) pos := by
   simp [isMatch_iff, CharPred.isMatch_iff, beq_iff_eq]
 
+theorem isRevMatch_iff_isRevMatch_beq {c : Char} {s : Slice} {pos : s.Pos} :
+    IsRevMatch c pos ↔ IsRevMatch (· == c) pos := by
+  simp [isRevMatch_iff, CharPred.isRevMatch_iff, beq_iff_eq]
+
 theorem isLongestMatch_iff_isLongestMatch_beq {c : Char} {s : Slice} {pos : s.Pos} :
     IsLongestMatch c pos ↔ IsLongestMatch (· == c) pos := by
   simp [isLongestMatch_iff_isMatch, isMatch_iff_isMatch_beq]
 
+theorem isLongestRevMatch_iff_isLongestRevMatch_beq {c : Char} {s : Slice} {pos : s.Pos} :
+    IsLongestRevMatch c pos ↔ IsLongestRevMatch (· == c) pos := by
+  simp [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff_isRevMatch_beq]
+
 theorem isLongestMatchAt_iff_isLongestMatchAt_beq {c : Char} {s : Slice}
     {pos pos' : s.Pos} :
     IsLongestMatchAt c pos pos' ↔ IsLongestMatchAt (· == c) pos pos' := by
   simp [Model.isLongestMatchAt_iff, isLongestMatch_iff_isLongestMatch_beq]
 
+theorem isLongestRevMatchAt_iff_isLongestRevMatchAt_beq {c : Char} {s : Slice}
+    {pos pos' : s.Pos} :
+    IsLongestRevMatchAt c pos pos' ↔ IsLongestRevMatchAt (· == c) pos pos' := by
+  simp [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff_isLongestRevMatch_beq]
+
 theorem matchesAt_iff_matchesAt_beq {c : Char} {s : Slice} {pos : s.Pos} :
     MatchesAt c pos ↔ MatchesAt (· == c) pos := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff_isLongestMatchAt_beq]
 
+theorem revMatchesAt_iff_revMatchesAt_beq {c : Char} {s : Slice} {pos : s.Pos} :
+    RevMatchesAt c pos ↔ RevMatchesAt (· == c) pos := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff_isLongestRevMatchAt_beq]
+
 theorem matchAt?_eq_matchAt?_beq {c : Char} {s : Slice} {pos : s.Pos} :
     matchAt? c pos = matchAt? (· == c) pos := by
   refine Option.ext (fun pos' => ?_)
   simp [matchAt?_eq_some_iff, isLongestMatchAt_iff_isLongestMatchAt_beq]
 
+theorem revMatchAt?_eq_revMatchAt?_beq {c : Char} {s : Slice} {pos : s.Pos} :
+    revMatchAt? c pos = revMatchAt? (· == c) pos := by
+  refine Option.ext (fun pos' => ?_)
+  simp [revMatchAt?_eq_some_iff, isLongestRevMatchAt_iff_isLongestRevMatchAt_beq]
+
 theorem isValidSearchFrom_iff_isValidSearchFrom_beq {c : Char} {s : Slice} {p : s.Pos}
     {l : List (SearchStep s)} : IsValidSearchFrom c p l ↔ IsValidSearchFrom (· == c) p l := by
   refine ⟨fun h => ?_, fun h => ?_⟩
@@ -120,11 +203,28 @@ theorem isValidSearchFrom_iff_isValidSearchFrom_beq {c : Char} {s : Slice} {p :
     | matched => simp_all [IsValidSearchFrom.matched, isLongestMatchAt_iff_isLongestMatchAt_beq]
     | mismatched => simp_all [IsValidSearchFrom.mismatched, matchesAt_iff_matchesAt_beq]
 
+theorem isValidRevSearchFrom_iff_isValidRevSearchFrom_beq {c : Char} {s : Slice} {p : s.Pos}
+    {l : List (SearchStep s)} : IsValidRevSearchFrom c p l ↔ IsValidRevSearchFrom (· == c) p l := by
+  refine ⟨fun h => ?_, fun h => ?_⟩
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched, isLongestRevMatchAt_iff_isLongestRevMatchAt_beq]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_beq]
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched, isLongestRevMatchAt_iff_isLongestRevMatchAt_beq]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_beq]
+
 instance {c : Char} : LawfulToForwardSearcherModel c where
   isValidSearchFrom_toList s := by
     simpa [toSearcher_eq, isValidSearchFrom_iff_isValidSearchFrom_beq] using
       LawfulToForwardSearcherModel.isValidSearchFrom_toList (pat := (· == c)) (s := s)
 
+instance {c : Char} : LawfulToBackwardSearcherModel c where
+  isValidRevSearchFrom_toList s := by
+    simpa [toBackwardSearcher_eq, isValidRevSearchFrom_iff_isValidRevSearchFrom_beq] using
+      LawfulToBackwardSearcherModel.isValidRevSearchFrom_toList (pat := (· == c)) (s := s)
+
 end Pattern.Model.Char
 
 theorem startsWith_char_eq_startsWith_beq {c : Char} {s : Slice} :

src/Init/Data/String/Lemmas/Pattern/Find/Basic.lean

@@ -23,7 +23,7 @@ open Std String.Slice Pattern Pattern.Model
 
 namespace String.Slice
 
-theorem Pattern.Model.find?_eq_some_iff {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.find?_eq_some_iff {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} {pos : s.Pos} :
@@ -40,7 +40,7 @@ theorem Pattern.Model.find?_eq_some_iff {ρ : Type} (pat : ρ) [ForwardPatternMo
   | matched h₁ _ _ => have := h₁.matchesAt; grind
   | mismatched => grind
 
-theorem Pattern.Model.find?_eq_none_iff {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.find?_eq_none_iff {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} :
@@ -65,14 +65,14 @@ theorem find?_eq_none_iff {ρ : Type} (pat : ρ) {σ : Slice → Type}
     [ToForwardSearcher pat σ] {s : Slice} : s.find? pat = none ↔ s.contains pat = false := by
   rw [← Option.isNone_iff_eq_none, ← Option.isSome_eq_false_iff, isSome_find?]
 
-theorem Pattern.Model.contains_eq_false_iff {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.contains_eq_false_iff {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} :
     s.contains pat = false ↔ ∀ (pos : s.Pos), ¬ MatchesAt pat pos := by
   rw [← find?_eq_none_iff, Slice.find?_eq_none_iff]
 
-theorem Pattern.Model.contains_eq_true_iff {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.contains_eq_true_iff {ρ : Type} (pat : ρ) [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} :
@@ -85,7 +85,7 @@ theorem Pos.find?_eq_find?_sliceFrom {ρ : Type} {pat : ρ} {σ : Slice → Type
     p.find? pat = ((s.sliceFrom p).find? pat).map Pos.ofSliceFrom :=
   (rfl)
 
-theorem Pattern.Model.posFind?_eq_some_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.posFind?_eq_some_iff {ρ : Type} {pat : ρ} [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} {pos pos' : s.Pos} :
@@ -100,7 +100,7 @@ theorem Pattern.Model.posFind?_eq_some_iff {ρ : Type} {pat : ρ} [ForwardPatter
     refine ⟨Pos.sliceFrom _ _ h₁, ⟨by simpa using h₂, fun p hp₁ hp₂ => ?_⟩, by simp⟩
     exact h₃ (Pos.ofSliceFrom p) Slice.Pos.le_ofSliceFrom (Pos.lt_sliceFrom_iff.1 hp₁) hp₂
 
-theorem Pattern.Model.posFind?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] {σ : Slice → Type}
+theorem Pattern.Model.posFind?_eq_none_iff {ρ : Type} {pat : ρ} [PatternModel pat] {σ : Slice → Type}
     [∀ s, Iterator (σ s) Id (SearchStep s)] [∀ s, Iterators.Finite (σ s) Id]
     [∀ s, IteratorLoop (σ s) Id Id] [∀ s, LawfulIteratorLoop (σ s) Id Id]
     [ToForwardSearcher pat σ] [LawfulToForwardSearcherModel pat] {s : Slice} {pos : s.Pos} :

src/Init/Data/String/Lemmas/Pattern/Pred.lean

@@ -19,124 +19,228 @@ import Init.Data.String.Lemmas.Order
 import Init.Data.Order.Lemmas
 import Init.Data.String.OrderInstances
 import Init.Omega
+import Init.Data.String.Lemmas.FindPos
 
 public section
 
 namespace String.Slice.Pattern.Model.CharPred
 
-instance {p : Char → Bool} : ForwardPatternModel p where
+instance {p : Char → Bool} : PatternModel p where
   Matches s := ∃ c, s = singleton c ∧ p c
   not_matches_empty := by
     simp
 
-instance {p : Char → Bool} : NoPrefixForwardPatternModel p :=
-  .of_length_eq (by simp +contextual [ForwardPatternModel.Matches])
+instance {p : Char → Bool} : NoPrefixPatternModel p :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
+
+instance {p : Char → Bool} : NoSuffixPatternModel p :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
 
 theorem isMatch_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
     IsMatch p pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ p (s.startPos.get h) := by
-  simp only [Model.isMatch_iff, ForwardPatternModel.Matches, sliceTo_copy_eq_iff_exists_splits]
+  simp only [Model.isMatch_iff, PatternModel.Matches, copy_sliceTo_eq_iff_exists_splits]
   refine ⟨?_, ?_⟩
   · simp only [splits_singleton_iff]
     refine fun ⟨c, ⟨t₂, h, h₁, h₂, h₃⟩, hc⟩ => ⟨h, h₁, h₂ ▸ hc⟩
   · rintro ⟨h, rfl, h'⟩
     exact ⟨s.startPos.get h, ⟨_, Slice.splits_next_startPos⟩, h'⟩
 
+theorem isRevMatch_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
+    IsRevMatch p pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) := by
+  simp only [Model.isRevMatch_iff, PatternModel.Matches, copy_sliceFrom_eq_iff_exists_splits]
+  refine ⟨?_, ?_⟩
+  · simp only [splits_singleton_right_iff]
+    refine fun ⟨c, ⟨t₂, h, h₁, h₂, h₃⟩, hc⟩ => ⟨h, h₁, h₂ ▸ hc⟩
+  · rintro ⟨h, rfl, h'⟩
+    exact ⟨(s.endPos.prev h).get (by simp), ⟨_, Slice.splits_prev_endPos⟩, h'⟩
+
 theorem isLongestMatch_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
     IsLongestMatch p pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ p (s.startPos.get h) := by
   rw [isLongestMatch_iff_isMatch, isMatch_iff]
 
+theorem isLongestRevMatch_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
+    IsLongestRevMatch p pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) := by
+  rw [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff]
+
 theorem isLongestMatchAt_iff {p : Char → Bool} {s : Slice} {pos pos' : s.Pos} :
     IsLongestMatchAt p pos pos' ↔ ∃ h, pos' = pos.next h ∧ p (pos.get h) := by
   simp +contextual [Model.isLongestMatchAt_iff, isLongestMatch_iff, ← Pos.ofSliceFrom_inj,
     Pos.get_eq_get_ofSliceFrom, Pos.ofSliceFrom_next]
 
+theorem isLongestRevMatchAt_iff {p : Char → Bool} {s : Slice} {pos pos' : s.Pos} :
+    IsLongestRevMatchAt p pos pos' ↔ ∃ h, pos = pos'.prev h ∧ p ((pos'.prev h).get (by simp)) := by
+  simp +contextual [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff, ← Pos.ofSliceTo_inj,
+    Pos.get_eq_get_ofSliceTo, Pos.ofSliceTo_prev]
+
 theorem isLongestMatchAt_of_get {p : Char → Bool} {s : Slice} {pos : s.Pos} {h : pos ≠ s.endPos}
     (hc : p (pos.get h)) : IsLongestMatchAt p pos (pos.next h) :=
   isLongestMatchAt_iff.2 ⟨h, by simp [hc]⟩
 
+theorem isLongestRevMatchAt_of_get {p : Char → Bool} {s : Slice} {pos : s.Pos} {h : pos ≠ s.startPos}
+    (hc : p ((pos.prev h).get (by simp))) : IsLongestRevMatchAt p (pos.prev h) pos :=
+  isLongestRevMatchAt_iff.2 ⟨h, by simp [hc]⟩
+
 instance {p : Char → Bool} : LawfulForwardPatternModel p where
   skipPrefix?_eq_some_iff {s} pos := by
     simp [isLongestMatch_iff, ForwardPattern.skipPrefix?, and_comm, eq_comm (b := pos)]
 
+instance {p : Char → Bool} : LawfulBackwardPatternModel p where
+  skipSuffix?_eq_some_iff {s} pos := by
+    simp [isLongestRevMatch_iff, BackwardPattern.skipSuffix?, and_comm, eq_comm (b := pos)]
+
 instance {p : Char → Bool} : LawfulToForwardSearcherModel p :=
   .defaultImplementation
 
+instance {p : Char → Bool} : LawfulToBackwardSearcherModel p :=
+  .defaultImplementation
+
 theorem matchesAt_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
     MatchesAt p pos ↔ ∃ (h : pos ≠ s.endPos), p (pos.get h) := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff, exists_comm]
 
+theorem revMatchesAt_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
+    RevMatchesAt p pos ↔ ∃ (h : pos ≠ s.startPos), p ((pos.prev h).get (by simp)) := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff, exists_comm]
+
 theorem not_matchesAt_of_get {p : Char → Bool} {s : Slice} {pos : s.Pos} {h : pos ≠ s.endPos}
     (hc : p (pos.get h) = false) : ¬ MatchesAt p pos := by
   simp [matchesAt_iff, hc]
 
+theorem not_revMatchesAt_of_get {p : Char → Bool} {s : Slice} {pos : s.Pos} {h : pos ≠ s.startPos}
+    (hc : p ((pos.prev h).get (by simp)) = false) : ¬ RevMatchesAt p pos := by
+  simp [revMatchesAt_iff, hc]
+
 theorem matchAt?_eq {s : Slice} {pos : s.Pos} {p : Char → Bool} :
     matchAt? p pos =
       if h₀ : ∃ (h : pos ≠ s.endPos), p (pos.get h) then some (pos.next h₀.1) else none := by
   split <;> simp_all [isLongestMatchAt_iff, matchesAt_iff]
 
+theorem revMatchAt?_eq {s : Slice} {pos : s.Pos} {p : Char → Bool} :
+    revMatchAt? p pos =
+      if h₀ : ∃ (h : pos ≠ s.startPos), p ((pos.prev h).get (by simp)) then some (pos.prev h₀.1) else none := by
+  split <;> simp_all [isLongestRevMatchAt_iff, revMatchesAt_iff]
+
 namespace Decidable
 
-instance {p : Char → Prop} [DecidablePred p] : ForwardPatternModel p where
-  Matches := ForwardPatternModel.Matches (decide <| p ·)
-  not_matches_empty := ForwardPatternModel.not_matches_empty (pat := (decide <| p ·))
+instance {p : Char → Prop} [DecidablePred p] : PatternModel p where
+  Matches := PatternModel.Matches (decide <| p ·)
+  not_matches_empty := PatternModel.not_matches_empty (pat := (decide <| p ·))
 
-instance {p : Char → Prop} [DecidablePred p] : NoPrefixForwardPatternModel p where
-  eq_empty := NoPrefixForwardPatternModel.eq_empty (pat := (decide <| p ·))
+instance {p : Char → Prop} [DecidablePred p] : NoPrefixPatternModel p where
+  eq_empty := NoPrefixPatternModel.eq_empty (pat := (decide <| p ·))
+
+instance {p : Char → Prop} [DecidablePred p] : NoSuffixPatternModel p where
+  eq_empty := NoSuffixPatternModel.eq_empty (pat := (decide <| p ·))
 
 theorem isMatch_iff_isMatch_decide {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
     IsMatch p pos ↔ IsMatch (decide <| p ·) pos :=
   ⟨fun ⟨h⟩ => ⟨h⟩, fun ⟨h⟩ => ⟨h⟩⟩
 
+theorem isRevMatch_iff_isRevMatch_decide {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
+    IsRevMatch p pos ↔ IsRevMatch (decide <| p ·) pos :=
+  ⟨fun ⟨h⟩ => ⟨h⟩, fun ⟨h⟩ => ⟨h⟩⟩
+
 theorem isMatch_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
     IsMatch p pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ p (s.startPos.get h) := by
   simp [isMatch_iff_isMatch_decide, CharPred.isMatch_iff]
 
+theorem isRevMatch_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
+    IsRevMatch p pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) := by
+  simp [isRevMatch_iff_isRevMatch_decide, CharPred.isRevMatch_iff]
+
 theorem isLongestMatch_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
     IsLongestMatch p pos ↔
       ∃ (h : s.startPos ≠ s.endPos), pos = s.startPos.next h ∧ p (s.startPos.get h) := by
   rw [isLongestMatch_iff_isMatch, isMatch_iff]
 
+theorem isLongestRevMatch_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
+    IsLongestRevMatch p pos ↔
+      ∃ (h : s.endPos ≠ s.startPos), pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) := by
+  simp [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff]
+
 theorem isLongestMatch_iff_isLongestMatch_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
     {pos : s.Pos} : IsLongestMatch p pos ↔ IsLongestMatch (decide <| p ·) pos := by
   simp [isLongestMatch_iff_isMatch, isMatch_iff_isMatch_decide]
 
+theorem isLongestRevMatch_iff_isLongestRevMatch_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
+    {pos : s.Pos} : IsLongestRevMatch p pos ↔ IsLongestRevMatch (decide <| p ·) pos := by
+  simp [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff_isRevMatch_decide]
+
 theorem isLongestMatchAt_iff_isLongestMatchAt_decide {p : Char → Prop} [DecidablePred p]
     {s : Slice} {pos pos' : s.Pos} :
     IsLongestMatchAt p pos pos' ↔ IsLongestMatchAt (decide <| p ·) pos pos' := by
   simp [Model.isLongestMatchAt_iff, isLongestMatch_iff_isLongestMatch_decide]
 
+theorem isLongestRevMatchAt_iff_isLongestRevMatchAt_decide {p : Char → Prop} [DecidablePred p]
+    {s : Slice} {pos pos' : s.Pos} :
+    IsLongestRevMatchAt p pos pos' ↔ IsLongestRevMatchAt (decide <| p ·) pos pos' := by
+  simp [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff_isLongestRevMatch_decide]
+
 theorem isLongestMatchAt_iff {p : Char → Prop} [DecidablePred p] {s : Slice}
     {pos pos' : s.Pos} :
     IsLongestMatchAt p pos pos' ↔ ∃ h, pos' = pos.next h ∧ p (pos.get h) := by
   simp [isLongestMatchAt_iff_isLongestMatchAt_decide, CharPred.isLongestMatchAt_iff]
 
+theorem isLongestRevMatchAt_iff {p : Char → Prop} [DecidablePred p] {s : Slice}
+    {pos pos' : s.Pos} :
+    IsLongestRevMatchAt p pos pos' ↔ ∃ h, pos = pos'.prev h ∧ p ((pos'.prev h).get (by simp)) := by
+  simp [isLongestRevMatchAt_iff_isLongestRevMatchAt_decide, CharPred.isLongestRevMatchAt_iff]
+
 theorem isLongestMatchAt_of_get {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos}
     {h : pos ≠ s.endPos} (hc : p (pos.get h)) : IsLongestMatchAt p pos (pos.next h) :=
   isLongestMatchAt_iff.2 ⟨h, by simp [hc]⟩
 
+theorem isLongestRevMatchAt_of_get {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos}
+    {h : pos ≠ s.startPos} (hc : p ((pos.prev h).get (by simp))) :
+    IsLongestRevMatchAt p (pos.prev h) pos :=
+  isLongestRevMatchAt_iff.2 ⟨h, by simp [hc]⟩
+
 theorem matchesAt_iff_matchesAt_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
     {pos : s.Pos} : MatchesAt p pos ↔ MatchesAt (decide <| p ·) pos := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff_isLongestMatchAt_decide]
 
+theorem revMatchesAt_iff_revMatchesAt_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
+    {pos : s.Pos} : RevMatchesAt p pos ↔ RevMatchesAt (decide <| p ·) pos := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff_isLongestRevMatchAt_decide]
+
 theorem matchAt?_eq_matchAt?_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
     {pos : s.Pos} : matchAt? p pos = matchAt? (decide <| p ·) pos := by
   ext endPos
   simp [isLongestMatchAt_iff_isLongestMatchAt_decide]
 
+theorem revMatchAt?_eq_revMatchAt?_decide {p : Char → Prop} [DecidablePred p] {s : Slice}
+    {pos : s.Pos} : revMatchAt? p pos = revMatchAt? (decide <| p ·) pos := by
+  ext startPos
+  simp [isLongestRevMatchAt_iff_isLongestRevMatchAt_decide]
+
 theorem skipPrefix?_eq_skipPrefix?_decide {p : Char → Prop} [DecidablePred p] :
     ForwardPattern.skipPrefix? p = ForwardPattern.skipPrefix? (decide <| p ·) := rfl
 
+theorem skipSuffix?_eq_skipSuffix?_decide {p : Char → Prop} [DecidablePred p] :
+    BackwardPattern.skipSuffix? p = BackwardPattern.skipSuffix? (decide <| p ·) := rfl
+
 instance {p : Char → Prop} [DecidablePred p] : LawfulForwardPatternModel p where
   skipPrefix?_eq_some_iff {s} pos := by
     rw [skipPrefix?_eq_skipPrefix?_decide, isLongestMatch_iff_isLongestMatch_decide]
     exact LawfulForwardPatternModel.skipPrefix?_eq_some_iff ..
 
+instance {p : Char → Prop} [DecidablePred p] : LawfulBackwardPatternModel p where
+  skipSuffix?_eq_some_iff {s} pos := by
+    rw [skipSuffix?_eq_skipSuffix?_decide, isLongestRevMatch_iff_isLongestRevMatch_decide]
+    exact LawfulBackwardPatternModel.skipSuffix?_eq_some_iff ..
+
 theorem toSearcher_eq {p : Char → Prop} [DecidablePred p] {s : Slice} :
     ToForwardSearcher.toSearcher p s = ToForwardSearcher.toSearcher (decide <| p ·) s := (rfl)
 
+theorem toBackwardSearcher_eq {p : Char → Prop} [DecidablePred p] {s : Slice} :
+    ToBackwardSearcher.toSearcher p s = ToBackwardSearcher.toSearcher (decide <| p ·) s := (rfl)
+
 theorem isValidSearchFrom_iff_isValidSearchFrom_decide {p : Char → Prop} [DecidablePred p]
     {s : Slice} {pos : s.Pos} {l : List (SearchStep s)} :
     IsValidSearchFrom p pos l ↔ IsValidSearchFrom (decide <| p ·) pos l := by
@@ -150,24 +254,55 @@ theorem isValidSearchFrom_iff_isValidSearchFrom_decide {p : Char → Prop} [Deci
     | matched => simp_all [IsValidSearchFrom.matched, isLongestMatchAt_iff_isLongestMatchAt_decide]
     | mismatched => simp_all [IsValidSearchFrom.mismatched, matchesAt_iff_matchesAt_decide]
 
+theorem isValidRevSearchFrom_iff_isValidRevSearchFrom_decide {p : Char → Prop} [DecidablePred p]
+    {s : Slice} {pos : s.Pos} {l : List (SearchStep s)} :
+    IsValidRevSearchFrom p pos l ↔ IsValidRevSearchFrom (decide <| p ·) pos l := by
+  refine ⟨fun h => ?_, fun h => ?_⟩
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched, isLongestRevMatchAt_iff_isLongestRevMatchAt_decide]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_decide]
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched, isLongestRevMatchAt_iff_isLongestRevMatchAt_decide]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_decide]
+
 instance {p : Char → Prop} [DecidablePred p] : LawfulToForwardSearcherModel p where
   isValidSearchFrom_toList s := by
     simpa [toSearcher_eq, isValidSearchFrom_iff_isValidSearchFrom_decide] using
       LawfulToForwardSearcherModel.isValidSearchFrom_toList (pat := (decide <| p ·)) (s := s)
 
+instance {p : Char → Prop} [DecidablePred p] : LawfulToBackwardSearcherModel p where
+  isValidRevSearchFrom_toList s := by
+    simpa [toBackwardSearcher_eq, isValidRevSearchFrom_iff_isValidRevSearchFrom_decide] using
+      LawfulToBackwardSearcherModel.isValidRevSearchFrom_toList (pat := (decide <| p ·)) (s := s)
+
 theorem matchesAt_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
     MatchesAt p pos ↔ ∃ (h : pos ≠ s.endPos), p (pos.get h) := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff, exists_comm]
 
+theorem revMatchesAt_iff {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos} :
+    RevMatchesAt p pos ↔ ∃ (h : pos ≠ s.startPos), p ((pos.prev h).get (by simp)) := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff, exists_comm]
+
 theorem not_matchesAt_of_get {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos}
     {h : pos ≠ s.endPos} (hc : ¬ p (pos.get h)) : ¬ MatchesAt p pos := by
   simp [matchesAt_iff, hc]
 
+theorem not_revMatchesAt_of_get {p : Char → Prop} [DecidablePred p] {s : Slice} {pos : s.Pos}
+    {h : pos ≠ s.startPos} (hc : ¬ p ((pos.prev h).get (by simp))) : ¬ RevMatchesAt p pos := by
+  simp [revMatchesAt_iff, hc]
+
 theorem matchAt?_eq {s : Slice} {pos : s.Pos} {p : Char → Prop} [DecidablePred p] :
     matchAt? p pos =
       if h₀ : ∃ (h : pos ≠ s.endPos), p (pos.get h) then some (pos.next h₀.1) else none := by
   split <;> simp_all [isLongestMatchAt_iff, matchesAt_iff]
 
+theorem revMatchAt?_eq {s : Slice} {pos : s.Pos} {p : Char → Prop} [DecidablePred p] :
+    revMatchAt? p pos =
+      if h₀ : ∃ (h : pos ≠ s.startPos), p ((pos.prev h).get (by simp)) then some (pos.prev h₀.1) else none := by
+  split <;> simp_all [isLongestRevMatchAt_iff, revMatchesAt_iff]
+
 end Decidable
 
 end Pattern.Model.CharPred

src/Init/Data/String/Lemmas/Pattern/Split/Basic.lean

@@ -28,7 +28,7 @@ set_option doc.verso true
 # Verification of {name}`String.Slice.splitToSubslice`
 
 This PR verifies the {name}`String.Slice.splitToSubslice` function by relating it to a model
-implementation based on the {name}`String.Slice.Pattern.Model.ForwardPatternModel` class.
+implementation based on the {name}`String.Slice.Pattern.Model.PatternModel` class.
 
 This gives a low-level correctness proof from which higher-level API lemmas can be derived.
 -/
@@ -36,7 +36,7 @@ This gives a low-level correctness proof from which higher-level API lemmas can
 namespace String.Slice.Pattern.Model
 
 @[cbv_opaque]
-public protected noncomputable def split {ρ : Type} (pat : ρ) [ForwardPatternModel pat] {s : Slice}
+public protected noncomputable def split {ρ : Type} (pat : ρ) [PatternModel pat] {s : Slice}
     (firstRejected curr : s.Pos) (hle : firstRejected ≤ curr) : List s.Subslice :=
   if h : curr = s.endPos then
     [s.subslice _ _ hle]
@@ -49,12 +49,12 @@ public protected noncomputable def split {ρ : Type} (pat : ρ) [ForwardPatternM
 termination_by curr
 
 @[simp]
-public theorem split_endPos {ρ : Type} {pat : ρ} [ForwardPatternModel pat] {s : Slice}
+public theorem split_endPos {ρ : Type} {pat : ρ} [PatternModel pat] {s : Slice}
     {firstRejected : s.Pos} :
     Model.split (s := s) pat firstRejected s.endPos (by simp) = [s.subslice firstRejected s.endPos (by simp)] := by
   simp [Model.split]
 
-public theorem split_eq_of_isLongestMatchAt {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
+public theorem split_eq_of_isLongestMatchAt {ρ : Type} {pat : ρ} [PatternModel pat]
     {s : Slice} {firstRejected start stop : s.Pos} {hle} (h : IsLongestMatchAt pat start stop) :
     Model.split pat firstRejected start hle =
       s.subslice _ _ hle :: Model.split pat stop stop (by exact Std.le_refl _) := by
@@ -63,7 +63,7 @@ public theorem split_eq_of_isLongestMatchAt {ρ : Type} {pat : ρ} [ForwardPatte
   · congr <;> exact (matchAt?_eq_some_iff.1 ‹_›).eq h
   · simp [matchAt?_eq_some_iff.2 ‹_›] at *
 
-public theorem split_eq_of_not_matchesAt {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
+public theorem split_eq_of_not_matchesAt {ρ : Type} {pat : ρ} [PatternModel pat]
     {s : Slice} {firstRejected start} (stop : s.Pos) (h₀ : start ≤ stop) {hle}
     (h : ∀ p, start ≤ p → p < stop → ¬ MatchesAt pat p) :
     Model.split pat firstRejected start hle =
@@ -80,7 +80,7 @@ public theorem split_eq_of_not_matchesAt {ρ : Type} {pat : ρ} [ForwardPatternM
   · obtain rfl : start = stop := Std.le_antisymm h₀ (Std.not_lt.1 h')
     simp
 
-public theorem split_eq_next_of_not_matchesAt {ρ : Type} {pat : ρ} [ForwardPatternModel pat]
+public theorem split_eq_next_of_not_matchesAt {ρ : Type} {pat : ρ} [PatternModel pat]
     {s : Slice} {firstRejected start} {hle} (hs : start ≠ s.endPos) (h : ¬ MatchesAt pat start) :
     Model.split pat firstRejected start hle =
       Model.split pat firstRejected (start.next hs) (by exact Std.le_trans hle (by simp)) := by
@@ -103,7 +103,7 @@ def splitFromSteps {s : Slice} (currPos : s.Pos) (l : List (SearchStep s)) : Lis
   | .matched p q :: l => s.subslice! currPos p :: splitFromSteps q l
 
 theorem IsValidSearchFrom.splitFromSteps_eq_extend_split {ρ : Type} (pat : ρ)
-    [ForwardPatternModel pat] (l : List (SearchStep s)) (pos pos' : s.Pos) (h₀ : pos ≤ pos')
+    [PatternModel pat] (l : List (SearchStep s)) (pos pos' : s.Pos) (h₀ : pos ≤ pos')
     (h' : ∀ p, pos ≤ p → p < pos' → ¬ MatchesAt pat p)
     (h : IsValidSearchFrom pat pos' l) :
     splitFromSteps pos l = Model.split pat pos pos' h₀ := by
@@ -155,7 +155,7 @@ end Model
 open Model
 
 @[cbv_eval]
-public theorem toList_splitToSubslice_eq_modelSplit {ρ : Type} (pat : ρ) [ForwardPatternModel pat]
+public theorem toList_splitToSubslice_eq_modelSplit {ρ : Type} (pat : ρ) [PatternModel pat]
     {σ : Slice → Type} [ToForwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
     [∀ s, Std.Iterators.Finite (σ s) Id] [LawfulToForwardSearcherModel pat] (s : Slice) :
     (s.splitToSubslice pat).toList = Model.split pat s.startPos s.startPos (by exact Std.le_refl _) := by
@@ -168,7 +168,7 @@ end Pattern
 open Pattern
 
 public theorem toList_splitToSubslice_of_isEmpty {ρ : Type} (pat : ρ)
-    [Model.ForwardPatternModel pat] {σ : Slice → Type}
+    [Model.PatternModel pat] {σ : Slice → Type}
     [ToForwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
     [∀ s, Std.Iterators.Finite (σ s) Id] [Model.LawfulToForwardSearcherModel pat] {s : Slice}
     (h : s.isEmpty = true) :
@@ -182,7 +182,7 @@ public theorem toList_split_eq_splitToSubslice {ρ : Type} (pat : ρ) {σ : Slic
   simp [split, Std.Iter.toList_map]
 
 public theorem toList_split_of_isEmpty {ρ : Type} (pat : ρ)
-    [Model.ForwardPatternModel pat] {σ : Slice → Type}
+    [Model.PatternModel pat] {σ : Slice → Type}
     [ToForwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
     [∀ s, Std.Iterators.Finite (σ s) Id] [Model.LawfulToForwardSearcherModel pat] {s : Slice}
     (h : s.isEmpty = true) :
@@ -200,7 +200,7 @@ public theorem split_eq_split_toSlice {ρ : Type} {pat : ρ} {σ : Slice → Typ
 
 @[simp]
 public theorem toList_split_empty {ρ : Type} (pat : ρ)
-    [Model.ForwardPatternModel pat] {σ : Slice → Type}
+    [Model.PatternModel pat] {σ : Slice → Type}
     [ToForwardSearcher pat σ] [∀ s, Std.Iterator (σ s) Id (SearchStep s)]
     [∀ s, Std.Iterators.Finite (σ s) Id] [Model.LawfulToForwardSearcherModel pat] :
     ("".split pat).toList.map Slice.copy = [""] := by

src/Init/Data/String/Lemmas/Pattern/String/Basic.lean

@@ -19,12 +19,12 @@ namespace String.Slice.Pattern.Model
 
 namespace ForwardSliceSearcher
 
-instance {pat : Slice} : ForwardPatternModel pat where
+instance {pat : Slice} : PatternModel pat where
   /-
-  See the docstring of `ForwardPatternModel` for an explanation about why we disallow matching the
+  See the docstring of `PatternModel` for an explanation about why we disallow matching the
   empty string.
 
-  Requiring `s ≠ ""` is a trick that allows us to give a `ForwardPatternModel` instance
+  Requiring `s ≠ ""` is a trick that allows us to give a `PatternModel` instance
   unconditionally, without forcing `pat.copy` to be non-empty (which would make it very awkward
   to state theorems about the instance). It does not change anything about the fact that all lemmas
   about this instance require `pat.isEmpty = false`.
@@ -32,34 +32,60 @@ instance {pat : Slice} : ForwardPatternModel pat where
   Matches s := s ≠ "" ∧ s = pat.copy
   not_matches_empty := by simp
 
-instance {pat : Slice} : NoPrefixForwardPatternModel pat :=
-  .of_length_eq (by simp +contextual [ForwardPatternModel.Matches])
+instance {pat : Slice} : NoPrefixPatternModel pat :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
+
+instance {pat : Slice} : NoSuffixPatternModel pat :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
 
 theorem isMatch_iff {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     IsMatch pat pos ↔ (s.sliceTo pos).copy = pat.copy := by
-  simp only [Model.isMatch_iff, ForwardPatternModel.Matches, ne_eq, copy_eq_empty_iff,
+  simp only [Model.isMatch_iff, PatternModel.Matches, ne_eq, copy_eq_empty_iff,
     Bool.not_eq_true, and_iff_right_iff_imp]
   intro h'
   rw [← isEmpty_copy (s := s.sliceTo pos), h', isEmpty_copy, h]
 
+theorem isRevMatch_iff {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
+    IsRevMatch pat pos ↔ (s.sliceFrom pos).copy = pat.copy := by
+  simp only [Model.isRevMatch_iff, PatternModel.Matches, ne_eq, copy_eq_empty_iff,
+    Bool.not_eq_true, and_iff_right_iff_imp]
+  intro h'
+  rw [← isEmpty_copy (s := s.sliceFrom pos), h', isEmpty_copy, h]
+
 theorem isLongestMatch_iff {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     IsLongestMatch pat pos ↔ (s.sliceTo pos).copy = pat.copy := by
   rw [isLongestMatch_iff_isMatch, isMatch_iff h]
 
+theorem isLongestRevMatch_iff {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
+    IsLongestRevMatch pat pos ↔ (s.sliceFrom pos).copy = pat.copy := by
+  rw [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff h]
+
 theorem isLongestMatchAt_iff {pat s : Slice} {pos₁ pos₂ : s.Pos} (h : pat.isEmpty = false) :
     IsLongestMatchAt pat pos₁ pos₂ ↔ ∃ h, (s.slice pos₁ pos₂ h).copy = pat.copy := by
   simp [Model.isLongestMatchAt_iff, isLongestMatch_iff h]
 
+theorem isLongestRevMatchAt_iff {pat s : Slice} {pos₁ pos₂ : s.Pos} (h : pat.isEmpty = false) :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔ ∃ h, (s.slice pos₁ pos₂ h).copy = pat.copy := by
+  simp [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff h]
+
 theorem isLongestMatchAt_iff_splits {pat s : Slice} {pos₁ pos₂ : s.Pos} (h : pat.isEmpty = false) :
     IsLongestMatchAt pat pos₁ pos₂ ↔ ∃ t₁ t₂, pos₁.Splits t₁ (pat.copy ++ t₂) ∧
       pos₂.Splits (t₁ ++ pat.copy) t₂ := by
   simp only [isLongestMatchAt_iff h, copy_slice_eq_iff_splits]
 
+theorem isLongestRevMatchAt_iff_splits {pat s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat.isEmpty = false) :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔ ∃ t₁ t₂, pos₁.Splits t₁ (pat.copy ++ t₂) ∧
+      pos₂.Splits (t₁ ++ pat.copy) t₂ := by
+  simp only [isLongestRevMatchAt_iff h, copy_slice_eq_iff_splits]
+
 theorem isLongestMatch_iff_splits {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     IsLongestMatch pat pos ↔ ∃ t, pos.Splits pat.copy t := by
-  simp only [← isLongestMatchAt_startPos_iff, isLongestMatchAt_iff_splits h, splits_startPos_iff,
-    and_assoc, exists_and_left, exists_eq_left, empty_append]
-  exact ⟨fun ⟨h, _, h'⟩ => ⟨h, h'⟩, fun ⟨h, h'⟩ => ⟨h, h'.eq_append.symm, h'⟩⟩
+  rw [isLongestMatch_iff h, copy_sliceTo_eq_iff_exists_splits]
+
+theorem isLongestRevMatch_iff_splits {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
+    IsLongestRevMatch pat pos ↔ ∃ t, pos.Splits t pat.copy := by
+  rw [isLongestRevMatch_iff h, copy_sliceFrom_eq_iff_exists_splits]
 
 theorem isLongestMatchAt_iff_extract {pat s : Slice} {pos₁ pos₂ : s.Pos} (h : pat.isEmpty = false) :
     IsLongestMatchAt pat pos₁ pos₂ ↔
@@ -71,6 +97,18 @@ theorem isLongestMatchAt_iff_extract {pat s : Slice} {pos₁ pos₂ : s.Pos} (h
     exact ⟨by simp [Pos.le_iff, Pos.Raw.le_iff]; omega,
       by simp [← h', ← toByteArray_inj, toByteArray_copy_slice]⟩
 
+theorem isLongestRevMatchAt_iff_extract {pat s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat.isEmpty = false) :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔
+      s.copy.toByteArray.extract pos₁.offset.byteIdx pos₂.offset.byteIdx =
+        pat.copy.toByteArray := by
+  rw [isLongestRevMatchAt_iff h]
+  refine ⟨fun ⟨h, h'⟩ => ?_, fun h' => ?_⟩
+  · simp [← h', toByteArray_copy_slice]
+  · rw [← Slice.toByteArray_copy_ne_empty_iff, ← h', ne_eq, ByteArray.extract_eq_empty_iff] at h
+    exact ⟨by simp [Pos.le_iff, Pos.Raw.le_iff]; omega,
+      by simp [← h', ← toByteArray_inj, toByteArray_copy_slice]⟩
+
 theorem offset_of_isLongestMatchAt {pat s : Slice} {pos₁ pos₂ : s.Pos} (h : pat.isEmpty = false)
     (h' : IsLongestMatchAt pat pos₁ pos₂) : pos₂.offset = pos₁.offset.increaseBy pat.utf8ByteSize := by
   simp only [Pos.Raw.ext_iff, Pos.Raw.byteIdx_increaseBy]
@@ -81,12 +119,29 @@ theorem offset_of_isLongestMatchAt {pat s : Slice} {pos₁ pos₂ : s.Pos} (h :
   suffices pos₂.offset.byteIdx ≤ s.utf8ByteSize by omega
   simpa [Pos.le_iff, Pos.Raw.le_iff] using pos₂.le_endPos
 
+theorem offset_of_isLongestRevMatchAt {pat s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat.isEmpty = false) (h' : IsLongestRevMatchAt pat pos₁ pos₂) :
+    pos₂.offset = pos₁.offset.increaseBy pat.utf8ByteSize := by
+  simp only [Pos.Raw.ext_iff, Pos.Raw.byteIdx_increaseBy]
+  rw [isLongestRevMatchAt_iff_extract h] at h'
+  rw [← Slice.toByteArray_copy_ne_empty_iff, ← h', ne_eq, ByteArray.extract_eq_empty_iff] at h
+  replace h' := congrArg ByteArray.size h'
+  simp only [ByteArray.size_extract, size_toByteArray, utf8ByteSize_copy] at h'
+  suffices pos₂.offset.byteIdx ≤ s.utf8ByteSize by omega
+  simpa [Pos.le_iff, Pos.Raw.le_iff] using pos₂.le_endPos
+
 theorem matchesAt_iff_splits {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     MatchesAt pat pos ↔ ∃ t₁ t₂, pos.Splits t₁ (pat.copy ++ t₂) := by
   simp only [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff_splits h]
   exact ⟨fun ⟨e, t₁, t₂, ht₁, ht₂⟩ => ⟨t₁, t₂, ht₁⟩,
     fun ⟨t₁, t₂, ht⟩ => ⟨ht.rotateRight, t₁, t₂, ht, ht.splits_rotateRight⟩⟩
 
+theorem revMatchesAt_iff_splits {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
+    RevMatchesAt pat pos ↔ ∃ t₁ t₂, pos.Splits (t₁ ++ pat.copy) t₂ := by
+  simp only [revMatchesAt_iff_exists_isLongestRevMatchAt, isLongestRevMatchAt_iff_splits h]
+  exact ⟨fun ⟨e, t₁, t₂, ht₁, ht₂⟩ => ⟨t₁, t₂, ht₂⟩,
+    fun ⟨t₁, t₂, ht⟩ => ⟨ht.rotateLeft, t₁, t₂, ht.splits_rotateLeft, ht⟩⟩
+
 theorem exists_matchesAt_iff_eq_append {pat s : Slice} (h : pat.isEmpty = false) :
     (∃ (pos : s.Pos), MatchesAt pat pos) ↔ ∃ t₁ t₂, s.copy = t₁ ++ pat.copy ++ t₂ := by
   simp only [matchesAt_iff_splits h]
@@ -99,6 +154,18 @@ theorem exists_matchesAt_iff_eq_append {pat s : Slice} (h : pat.isEmpty = false)
         ⟨t₁, pat.copy ++ t₂, by rw [← append_assoc]; exact heq, rfl⟩
     exact ⟨s.pos _ hvalid, t₁, t₂, ⟨by rw [← append_assoc]; exact heq, by simp⟩⟩
 
+theorem exists_revMatchesAt_iff_eq_append {pat s : Slice} (h : pat.isEmpty = false) :
+    (∃ (pos : s.Pos), RevMatchesAt pat pos) ↔ ∃ t₁ t₂, s.copy = t₁ ++ pat.copy ++ t₂ := by
+  simp only [revMatchesAt_iff_splits h]
+  constructor
+  · rintro ⟨pos, t₁, t₂, hsplit⟩
+    exact ⟨t₁, t₂, by rw [hsplit.eq_append, append_assoc]⟩
+  · rintro ⟨t₁, t₂, heq⟩
+    have hvalid : (t₁ ++ pat.copy).rawEndPos.IsValidForSlice s :=
+      Pos.Raw.isValidForSlice_iff_exists_append.mpr
+        ⟨t₁ ++ pat.copy, t₂, heq, rfl⟩
+    exact ⟨s.pos _ hvalid, t₁, t₂, ⟨heq, by simp⟩⟩
+
 theorem matchesAt_iff_isLongestMatchAt {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     MatchesAt pat pos ↔ ∃ (h : (pos.offset.increaseBy pat.utf8ByteSize).IsValidForSlice s),
       IsLongestMatchAt pat pos (s.pos _ h) := by
@@ -108,6 +175,25 @@ theorem matchesAt_iff_isLongestMatchAt {pat s : Slice} {pos : s.Pos} (h : pat.is
   obtain rfl : p = s.pos _ this := by simpa [Pos.ext_iff] using offset_of_isLongestMatchAt h h'
   exact h'
 
+theorem revMatchesAt_iff_isLongestRevMatchAt {pat s : Slice} {pos : s.Pos}
+    (h : pat.isEmpty = false) :
+    RevMatchesAt pat pos ↔
+      ∃ (h : (pos.offset.decreaseBy pat.utf8ByteSize).IsValidForSlice s),
+        IsLongestRevMatchAt pat (s.pos _ h) pos := by
+  refine ⟨fun ⟨⟨p, h'⟩⟩ => ?_, fun ⟨_, h⟩ => ⟨⟨_, h⟩⟩⟩
+  have hoff := offset_of_isLongestRevMatchAt h h'
+  have hvalid : (pos.offset.decreaseBy pat.utf8ByteSize).IsValidForSlice s := by
+    rw [show pos.offset.decreaseBy pat.utf8ByteSize = p.offset from by
+      simp [Pos.Raw.ext_iff, Pos.Raw.byteIdx_decreaseBy, Pos.Raw.byteIdx_increaseBy] at hoff ⊢
+      omega]
+    exact p.isValidForSlice
+  refine ⟨hvalid, ?_⟩
+  obtain rfl : p = s.pos _ hvalid := by
+    simp only [Pos.ext_iff, offset_pos]
+    simp [Pos.Raw.ext_iff, Pos.Raw.byteIdx_decreaseBy, Pos.Raw.byteIdx_increaseBy] at hoff ⊢
+    omega
+  exact h'
+
 theorem matchesAt_iff_getElem {pat s : Slice} {pos : s.Pos} (h : pat.isEmpty = false) :
     MatchesAt pat pos ↔
       ∃ (h : pos.offset.byteIdx + pat.copy.toByteArray.size ≤ s.copy.toByteArray.size),
@@ -146,31 +232,56 @@ end ForwardSliceSearcher
 
 namespace ForwardStringSearcher
 
-instance {pat : String} : ForwardPatternModel pat where
+instance {pat : String} : PatternModel pat where
   Matches s := s ≠ "" ∧ s = pat
   not_matches_empty := by simp
 
-instance {pat : String} : NoPrefixForwardPatternModel pat :=
-  .of_length_eq (by simp +contextual [ForwardPatternModel.Matches])
+instance {pat : String} : NoPrefixPatternModel pat :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
+
+instance {pat : String} : NoSuffixPatternModel pat :=
+  .of_length_eq (by simp +contextual [PatternModel.Matches])
 
 theorem isMatch_iff_slice {pat : String} {s : Slice} {pos : s.Pos} :
     IsMatch (ρ := String) pat pos ↔ IsMatch (ρ := Slice) pat.toSlice pos := by
-  simp only [Model.isMatch_iff, ForwardPatternModel.Matches, copy_toSlice]
+  simp only [Model.isMatch_iff, PatternModel.Matches, copy_toSlice]
+
+theorem isRevMatch_iff_slice {pat : String} {s : Slice} {pos : s.Pos} :
+    IsRevMatch (ρ := String) pat pos ↔ IsRevMatch (ρ := Slice) pat.toSlice pos := by
+  simp only [Model.isRevMatch_iff, PatternModel.Matches, copy_toSlice]
 
 theorem isLongestMatch_iff_isLongestMatch_toSlice {pat : String} {s : Slice} {pos : s.Pos} :
     IsLongestMatch (ρ := String) pat pos ↔ IsLongestMatch (ρ := Slice) pat.toSlice pos where
   mp h := ⟨isMatch_iff_slice.1 h.isMatch, fun p hp hm => h.not_isMatch p hp (isMatch_iff_slice.2 hm)⟩
   mpr h := ⟨isMatch_iff_slice.2 h.isMatch, fun p hp hm => h.not_isMatch p hp (isMatch_iff_slice.1 hm)⟩
 
+theorem isLongestRevMatch_iff_isLongestRevMatch_toSlice {pat : String} {s : Slice} {pos : s.Pos} :
+    IsLongestRevMatch (ρ := String) pat pos ↔ IsLongestRevMatch (ρ := Slice) pat.toSlice pos where
+  mp h := ⟨isRevMatch_iff_slice.1 h.isRevMatch,
+    fun p hp hm => h.not_isRevMatch p hp (isRevMatch_iff_slice.2 hm)⟩
+  mpr h := ⟨isRevMatch_iff_slice.2 h.isRevMatch,
+    fun p hp hm => h.not_isRevMatch p hp (isRevMatch_iff_slice.1 hm)⟩
+
 theorem isLongestMatchAt_iff_isLongestMatchAt_toSlice {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos} :
     IsLongestMatchAt (ρ := String) pat pos₁ pos₂ ↔
       IsLongestMatchAt (ρ := Slice) pat.toSlice pos₁ pos₂ := by
   simp [Model.isLongestMatchAt_iff, isLongestMatch_iff_isLongestMatch_toSlice]
 
+theorem isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice {pat : String} {s : Slice}
+    {pos₁ pos₂ : s.Pos} :
+    IsLongestRevMatchAt (ρ := String) pat pos₁ pos₂ ↔
+      IsLongestRevMatchAt (ρ := Slice) pat.toSlice pos₁ pos₂ := by
+  simp [Model.isLongestRevMatchAt_iff, isLongestRevMatch_iff_isLongestRevMatch_toSlice]
+
 theorem matchesAt_iff_toSlice {pat : String} {s : Slice} {pos : s.Pos} :
     MatchesAt (ρ := String) pat pos ↔ MatchesAt (ρ := Slice) pat.toSlice pos := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff_isLongestMatchAt_toSlice]
 
+theorem revMatchesAt_iff_toSlice {pat : String} {s : Slice} {pos : s.Pos} :
+    RevMatchesAt (ρ := String) pat pos ↔ RevMatchesAt (ρ := Slice) pat.toSlice pos := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt,
+    isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice]
+
 private theorem toSlice_isEmpty (h : pat ≠ "") : pat.toSlice.isEmpty = false := by
   rwa [isEmpty_toSlice, isEmpty_eq_false_iff]
 
@@ -179,16 +290,31 @@ theorem isMatch_iff {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
   rw [isMatch_iff_slice, ForwardSliceSearcher.isMatch_iff (toSlice_isEmpty h)]
   simp
 
+theorem isRevMatch_iff {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
+    IsRevMatch pat pos ↔ (s.sliceFrom pos).copy = pat := by
+  rw [isRevMatch_iff_slice, ForwardSliceSearcher.isRevMatch_iff (toSlice_isEmpty h)]
+  simp
+
 theorem isLongestMatch_iff {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
     IsLongestMatch pat pos ↔ (s.sliceTo pos).copy = pat := by
   rw [isLongestMatch_iff_isMatch, isMatch_iff h]
 
+theorem isLongestRevMatch_iff {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
+    IsLongestRevMatch pat pos ↔ (s.sliceFrom pos).copy = pat := by
+  rw [isLongestRevMatch_iff_isRevMatch, isRevMatch_iff h]
+
 theorem isLongestMatchAt_iff {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos} (h : pat ≠ "") :
     IsLongestMatchAt pat pos₁ pos₂ ↔ ∃ h, (s.slice pos₁ pos₂ h).copy = pat := by
   rw [isLongestMatchAt_iff_isLongestMatchAt_toSlice,
     ForwardSliceSearcher.isLongestMatchAt_iff (toSlice_isEmpty h)]
   simp
 
+theorem isLongestRevMatchAt_iff {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos} (h : pat ≠ "") :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔ ∃ h, (s.slice pos₁ pos₂ h).copy = pat := by
+  rw [isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice,
+    ForwardSliceSearcher.isLongestRevMatchAt_iff (toSlice_isEmpty h)]
+  simp
+
 theorem isLongestMatchAt_iff_splits {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
     (h : pat ≠ "") :
     IsLongestMatchAt pat pos₁ pos₂ ↔
@@ -197,6 +323,14 @@ theorem isLongestMatchAt_iff_splits {pat : String} {s : Slice} {pos₁ pos₂ :
     ForwardSliceSearcher.isLongestMatchAt_iff_splits (toSlice_isEmpty h)]
   simp
 
+theorem isLongestRevMatchAt_iff_splits {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat ≠ "") :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔
+      ∃ t₁ t₂, pos₁.Splits t₁ (pat ++ t₂) ∧ pos₂.Splits (t₁ ++ pat) t₂ := by
+  rw [isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice,
+    ForwardSliceSearcher.isLongestRevMatchAt_iff_splits (toSlice_isEmpty h)]
+  simp
+
 theorem isLongestMatchAt_iff_extract {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
     (h : pat ≠ "") :
     IsLongestMatchAt pat pos₁ pos₂ ↔
@@ -205,6 +339,14 @@ theorem isLongestMatchAt_iff_extract {pat : String} {s : Slice} {pos₁ pos₂ :
     ForwardSliceSearcher.isLongestMatchAt_iff_extract (toSlice_isEmpty h)]
   simp
 
+theorem isLongestRevMatchAt_iff_extract {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat ≠ "") :
+    IsLongestRevMatchAt pat pos₁ pos₂ ↔
+      s.copy.toByteArray.extract pos₁.offset.byteIdx pos₂.offset.byteIdx = pat.toByteArray := by
+  rw [isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice,
+    ForwardSliceSearcher.isLongestRevMatchAt_iff_extract (toSlice_isEmpty h)]
+  simp
+
 theorem offset_of_isLongestMatchAt {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
     (h : pat ≠ "") (h' : IsLongestMatchAt pat pos₁ pos₂) :
     pos₂.offset = pos₁.offset.increaseBy pat.utf8ByteSize := by
@@ -212,12 +354,25 @@ theorem offset_of_isLongestMatchAt {pat : String} {s : Slice} {pos₁ pos₂ : s
   exact ForwardSliceSearcher.offset_of_isLongestMatchAt (toSlice_isEmpty h)
     (isLongestMatchAt_iff_isLongestMatchAt_toSlice.1 h')
 
+theorem offset_of_isLongestRevMatchAt {pat : String} {s : Slice} {pos₁ pos₂ : s.Pos}
+    (h : pat ≠ "") (h' : IsLongestRevMatchAt pat pos₁ pos₂) :
+    pos₂.offset = pos₁.offset.increaseBy pat.utf8ByteSize := by
+  rw [show pat.utf8ByteSize = pat.toSlice.utf8ByteSize from utf8ByteSize_toSlice.symm]
+  exact ForwardSliceSearcher.offset_of_isLongestRevMatchAt (toSlice_isEmpty h)
+    (isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice.1 h')
+
 theorem matchesAt_iff_splits {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
     MatchesAt pat pos ↔ ∃ t₁ t₂, pos.Splits t₁ (pat ++ t₂) := by
   rw [matchesAt_iff_toSlice,
     ForwardSliceSearcher.matchesAt_iff_splits (toSlice_isEmpty h)]
   simp
 
+theorem revMatchesAt_iff_splits {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
+    RevMatchesAt pat pos ↔ ∃ t₁ t₂, pos.Splits (t₁ ++ pat) t₂ := by
+  rw [revMatchesAt_iff_toSlice,
+    ForwardSliceSearcher.revMatchesAt_iff_splits (toSlice_isEmpty h)]
+  simp
+
 theorem exists_matchesAt_iff_eq_append {pat : String} {s : Slice} (h : pat ≠ "") :
     (∃ (pos : s.Pos), MatchesAt pat pos) ↔ ∃ t₁ t₂, s.copy = t₁ ++ pat ++ t₂ := by
   simp only [matchesAt_iff_splits h]
@@ -230,6 +385,14 @@ theorem exists_matchesAt_iff_eq_append {pat : String} {s : Slice} (h : pat ≠ "
         ⟨t₁, pat ++ t₂, by rw [← append_assoc]; exact heq, rfl⟩
     exact ⟨s.pos _ hvalid, t₁, t₂, ⟨by rw [← append_assoc]; exact heq, by simp⟩⟩
 
+theorem exists_revMatchesAt_iff_eq_append {pat : String} {s : Slice} (h : pat ≠ "") :
+    (∃ (pos : s.Pos), RevMatchesAt pat pos) ↔ ∃ t₁ t₂, s.copy = t₁ ++ pat ++ t₂ := by
+  rw [show (∃ (pos : s.Pos), RevMatchesAt (ρ := String) pat pos) ↔
+      (∃ (pos : s.Pos), RevMatchesAt (ρ := Slice) pat.toSlice pos) from by
+    simp [revMatchesAt_iff_toSlice],
+    ForwardSliceSearcher.exists_revMatchesAt_iff_eq_append (toSlice_isEmpty h)]
+  simp
+
 theorem matchesAt_iff_isLongestMatchAt {pat : String} {s : Slice} {pos : s.Pos}
     (h : pat ≠ "") :
     MatchesAt pat pos ↔ ∃ (h : (pos.offset.increaseBy pat.utf8ByteSize).IsValidForSlice s),
@@ -239,6 +402,16 @@ theorem matchesAt_iff_isLongestMatchAt {pat : String} {s : Slice} {pos : s.Pos}
   simp only [utf8ByteSize_toSlice, ← isLongestMatchAt_iff_isLongestMatchAt_toSlice] at key
   rwa [matchesAt_iff_toSlice]
 
+theorem revMatchesAt_iff_isLongestRevMatchAt {pat : String} {s : Slice} {pos : s.Pos}
+    (h : pat ≠ "") :
+    RevMatchesAt pat pos ↔
+      ∃ (h : (pos.offset.decreaseBy pat.utf8ByteSize).IsValidForSlice s),
+        IsLongestRevMatchAt pat (s.pos _ h) pos := by
+  have key := ForwardSliceSearcher.revMatchesAt_iff_isLongestRevMatchAt (pat := pat.toSlice)
+    (toSlice_isEmpty h) (pos := pos)
+  simp only [utf8ByteSize_toSlice, ← isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice] at key
+  rwa [revMatchesAt_iff_toSlice]
+
 theorem matchesAt_iff_getElem {pat : String} {s : Slice} {pos : s.Pos} (h : pat ≠ "") :
     MatchesAt pat pos ↔
       ∃ (h : pos.offset.byteIdx + pat.toByteArray.size ≤ s.copy.toByteArray.size),
@@ -259,6 +432,11 @@ theorem matchesAt_iff_matchesAt_toSlice {pat : String} {s : Slice}
     {pos : s.Pos} : MatchesAt pat pos ↔ MatchesAt pat.toSlice pos := by
   simp [matchesAt_iff_exists_isLongestMatchAt, isLongestMatchAt_iff_isLongestMatchAt_toSlice]
 
+theorem revMatchesAt_iff_revMatchesAt_toSlice {pat : String} {s : Slice}
+    {pos : s.Pos} : RevMatchesAt pat pos ↔ RevMatchesAt pat.toSlice pos := by
+  simp [revMatchesAt_iff_exists_isLongestRevMatchAt,
+    isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice]
+
 theorem toSearcher_eq {pat : String} {s : Slice} :
     ToForwardSearcher.toSearcher pat s = ToForwardSearcher.toSearcher pat.toSlice s := (rfl)
 
@@ -275,6 +453,21 @@ theorem isValidSearchFrom_iff_isValidSearchFrom_toSlice {pat : String}
     | matched => simp_all [IsValidSearchFrom.matched, isLongestMatchAt_iff_isLongestMatchAt_toSlice]
     | mismatched => simp_all [IsValidSearchFrom.mismatched, matchesAt_iff_matchesAt_toSlice]
 
+theorem isValidRevSearchFrom_iff_isValidRevSearchFrom_toSlice {pat : String}
+    {s : Slice} {pos : s.Pos} {l : List (SearchStep s)} :
+    IsValidRevSearchFrom pat pos l ↔ IsValidRevSearchFrom pat.toSlice pos l := by
+  refine ⟨fun h => ?_, fun h => ?_⟩
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched,
+        isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_toSlice]
+  · induction h with
+    | startPos => simpa using IsValidRevSearchFrom.startPos
+    | matched => simp_all [IsValidRevSearchFrom.matched,
+        isLongestRevMatchAt_iff_isLongestRevMatchAt_toSlice]
+    | mismatched => simp_all [IsValidRevSearchFrom.mismatched, revMatchesAt_iff_revMatchesAt_toSlice]
+
 end ForwardStringSearcher
 
 end String.Slice.Pattern.Model

src/Init/Data/String/Lemmas/Pattern/String/ForwardPattern.lean

@@ -76,10 +76,12 @@ namespace Model.ForwardSliceSearcher
 
 open Pattern.ForwardSliceSearcher
 
+public instance {pat : Slice} : LawfulForwardPattern pat where
+  skipPrefixOfNonempty?_eq _ := rfl
+  startsWith_eq _ := isSome_skipPrefix?.symm
+
 public theorem lawfulForwardPatternModel {pat : Slice} (hpat : pat.isEmpty = false) :
     LawfulForwardPatternModel pat where
-  skipPrefixOfNonempty?_eq h := rfl
-  startsWith_eq s := isSome_skipPrefix?.symm
   skipPrefix?_eq_some_iff pos := by
     simp [ForwardPattern.skipPrefix?, skipPrefix?_eq_some_iff, isLongestMatch_iff hpat]
 
@@ -89,15 +91,116 @@ namespace Model.ForwardStringSearcher
 
 open Pattern.ForwardSliceSearcher
 
+public instance {pat : String} : LawfulForwardPattern pat where
+  skipPrefixOfNonempty?_eq _ := rfl
+  startsWith_eq _ := isSome_skipPrefix?.symm
+
 public theorem lawfulForwardPatternModel {pat : String} (hpat : pat ≠ "") :
     LawfulForwardPatternModel pat where
-  skipPrefixOfNonempty?_eq h := rfl
-  startsWith_eq s := isSome_skipPrefix?.symm
   skipPrefix?_eq_some_iff pos := by
     simp [ForwardPattern.skipPrefix?, skipPrefix?_eq_some_iff, isLongestMatch_iff hpat]
 
 end Model.ForwardStringSearcher
 
+namespace BackwardSliceSearcher
+
+theorem endsWith_iff {pat s : Slice} : endsWith pat s ↔ ∃ t, s.copy = t ++ pat.copy := by
+  rw [endsWith]
+  simp [Internal.memcmpSlice_eq_true_iff, utf8ByteSize_eq_size_toByteArray_copy, -size_toByteArray]
+  generalize pat.copy = pat
+  generalize s.copy = s
+  refine ⟨fun ⟨h₁, h₂⟩ => ?_, ?_⟩
+  · rw [Nat.sub_add_cancel h₁] at h₂
+    suffices (s.rawEndPos.unoffsetBy pat.rawEndPos).IsValid s by
+      have h₃ : (s.sliceFrom (s.pos _ this)).copy = pat := by
+        rw [← toByteArray_inj, (s.pos _ this).splits.toByteArray_right_eq]
+        simpa [offset_pos, Pos.Raw.byteIdx_unoffsetBy, byteIdx_rawEndPos]
+      have := (s.pos _ this).splits
+      rw [h₃] at this
+      exact ⟨_, this.eq_append⟩
+    rw [Pos.Raw.isValid_iff_isValidUTF8_extract_utf8ByteSize]
+    refine ⟨by simp [Pos.Raw.le_iff, Pos.Raw.byteIdx_unoffsetBy], ?_⟩
+    simp only [size_toByteArray] at h₂
+    simpa [Pos.Raw.byteIdx_unoffsetBy, byteIdx_rawEndPos, h₂] using pat.isValidUTF8
+  · rintro ⟨t, rfl⟩
+    exact ⟨by simp, by rw [Nat.sub_add_cancel (by simp)]; exact
+      ByteArray.extract_append_eq_right (by simp) (by simp)⟩
+
+theorem skipSuffix?_eq_some_iff {pat s : Slice} {pos : s.Pos} :
+    skipSuffix? pat s = some pos ↔ (s.sliceFrom pos).copy = pat.copy := by
+  fun_cases skipSuffix? with
+  | case1 h =>
+    simp only [Option.some.injEq]
+    obtain ⟨t, ht⟩ := endsWith_iff.1 h
+    have hpc : pat.copy.utf8ByteSize = pat.utf8ByteSize := Slice.utf8ByteSize_copy
+    have hsz : s.utf8ByteSize = t.utf8ByteSize + pat.utf8ByteSize := by
+      have := congrArg String.utf8ByteSize ht
+      simp only [utf8ByteSize_append, Slice.utf8ByteSize_copy] at this
+      exact this
+    have hoff : (s.endPos.offset.unoffsetBy pat.rawEndPos) = t.rawEndPos := by
+      ext
+      simp only [offset_endPos, Pos.Raw.byteIdx_unoffsetBy, byteIdx_rawEndPos,
+        String.byteIdx_rawEndPos]
+      omega
+    have hval : (s.endPos.offset.unoffsetBy pat.rawEndPos).IsValidForSlice s :=
+      Pos.Raw.isValidForSlice_iff_exists_append.mpr ⟨t, pat.copy, ht, hoff⟩
+    have hsp : (s.pos _ hval).Splits t pat.copy := ⟨ht, hoff⟩
+    rw [Slice.pos!_eq_pos hval]
+    exact ⟨(· ▸ hsp.copy_sliceFrom_eq),
+      fun h => hsp.pos_eq_of_eq_right (h ▸ pos.splits)⟩
+  | case2 h =>
+    simp only [endsWith_iff, not_exists] at h
+    simp only [reduceCtorEq, false_iff]
+    intro heq
+    have := h (s.sliceTo pos).copy
+    simp [← heq, pos.splits.eq_append] at this
+
+theorem isSome_skipSuffix? {pat s : Slice} : (skipSuffix? pat s).isSome = endsWith pat s := by
+  fun_cases skipSuffix? <;> simp_all
+
+public theorem endsWith_of_isEmpty {pat s : Slice} (hpat : pat.isEmpty = true) :
+    BackwardPattern.endsWith pat s = true := by
+  suffices pat.copy = "" by simp [BackwardPattern.endsWith, endsWith_iff, this]
+  simpa
+
+public theorem skipSuffix?_of_isEmpty {pat s : Slice} (hpat : pat.isEmpty = true) :
+    BackwardPattern.skipSuffix? pat s = some s.endPos := by
+  simpa [BackwardPattern.skipSuffix?, skipSuffix?_eq_some_iff]
+
+end BackwardSliceSearcher
+
+namespace Model.BackwardSliceSearcher
+
+open Pattern.BackwardSliceSearcher
+
+public instance {pat : Slice} : LawfulBackwardPattern pat where
+  skipSuffixOfNonempty?_eq _ := rfl
+  endsWith_eq _ := isSome_skipSuffix?.symm
+
+public theorem lawfulBackwardPatternModel {pat : Slice} (hpat : pat.isEmpty = false) :
+    LawfulBackwardPatternModel pat where
+  skipSuffix?_eq_some_iff pos := by
+    simp [BackwardPattern.skipSuffix?, skipSuffix?_eq_some_iff,
+      ForwardSliceSearcher.isLongestRevMatch_iff hpat]
+
+end Model.BackwardSliceSearcher
+
+namespace Model.BackwardStringSearcher
+
+open Pattern.BackwardSliceSearcher
+
+public instance {pat : String} : LawfulBackwardPattern pat where
+  skipSuffixOfNonempty?_eq _ := rfl
+  endsWith_eq _ := isSome_skipSuffix?.symm
+
+public theorem lawfulBackwardPatternModel {pat : String} (hpat : pat ≠ "") :
+    LawfulBackwardPatternModel pat where
+  skipSuffix?_eq_some_iff pos := by
+    simp [BackwardPattern.skipSuffix?, skipSuffix?_eq_some_iff,
+      ForwardStringSearcher.isLongestRevMatch_iff hpat]
+
+end Model.BackwardStringSearcher
+
 end Pattern
 
 public theorem startsWith_string_eq_startsWith_toSlice {pat : String} {s : Slice} :

src/Init/Data/String/Lemmas/Pattern/TakeDrop/Basic.lean

@@ -29,12 +29,12 @@ theorem startsWith_eq_forwardPatternStartsWith {ρ : Type} {pat : ρ} [ForwardPa
 theorem dropPrefix?_eq_map_skipPrefix? {ρ : Type} {pat : ρ} [ForwardPattern pat] {s : Slice} :
     s.dropPrefix? pat = (s.skipPrefix? pat).map s.sliceFrom := (rfl)
 
-theorem Pattern.Model.skipPrefix?_eq_some_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] [ForwardPattern pat]
+theorem Pattern.Model.skipPrefix?_eq_some_iff {ρ : Type} {pat : ρ} [PatternModel pat] [ForwardPattern pat]
     [LawfulForwardPatternModel pat] {s : Slice} {pos : s.Pos} :
     s.skipPrefix? pat = some pos ↔ IsLongestMatch pat pos := by
   rw [skipPrefix?_eq_forwardPatternSkipPrefix?, LawfulForwardPatternModel.skipPrefix?_eq_some_iff]
 
-theorem Pattern.Model.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] [ForwardPattern pat]
+theorem Pattern.Model.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ} [PatternModel pat] [ForwardPattern pat]
     [LawfulForwardPatternModel pat] {s : Slice} :
     s.skipPrefix? pat = none ↔ ¬ MatchesAt pat s.startPos := by
   rw [skipPrefix?_eq_forwardPatternSkipPrefix?, LawfulForwardPatternModel.skipPrefix?_eq_none_iff]
@@ -44,13 +44,13 @@ theorem isSome_skipPrefix? {ρ : Type} {pat : ρ} [ForwardPattern pat] [LawfulFo
     (s.skipPrefix? pat).isSome = s.startsWith pat := by
   rw [startsWith_eq_forwardPatternStartsWith, skipPrefix?, LawfulForwardPattern.startsWith_eq]
 
-theorem Pattern.Model.startsWith_eq_false_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] [ForwardPattern pat]
+theorem Pattern.Model.startsWith_eq_false_iff {ρ : Type} {pat : ρ} [PatternModel pat] [ForwardPattern pat]
     [LawfulForwardPatternModel pat] {s : Slice} :
     s.startsWith pat = false ↔ ¬ MatchesAt pat s.startPos := by
   rw [← Pattern.Model.skipPrefix?_eq_none_iff, ← Option.isNone_iff_eq_none,
     ← isSome_skipPrefix?, Option.isSome_eq_false_iff]
 
-theorem Pattern.Model.startsWith_iff {ρ : Type} {pat : ρ} [ForwardPatternModel pat] [ForwardPattern pat]
+theorem Pattern.Model.startsWith_iff {ρ : Type} {pat : ρ} [PatternModel pat] [ForwardPattern pat]
     [LawfulForwardPatternModel pat] {s : Slice} :
     s.startsWith pat = true ↔ MatchesAt pat s.startPos := by
   rw [← Bool.not_eq_false, startsWith_eq_false_iff, Classical.not_not]
@@ -65,13 +65,65 @@ theorem dropPrefix?_eq_none_iff {ρ : Type} {pat : ρ} [ForwardPattern pat] [Law
     {s : Slice} : s.dropPrefix? pat = none ↔ s.startsWith pat = false := by
   simp [dropPrefix?_eq_map_skipPrefix?]
 
-theorem Pattern.Model.eq_append_of_dropPrefix?_eq_some {ρ : Type} {pat : ρ} [ForwardPatternModel pat] [ForwardPattern pat]
+theorem Pattern.Model.eq_append_of_dropPrefix?_eq_some {ρ : Type} {pat : ρ} [PatternModel pat] [ForwardPattern pat]
     [LawfulForwardPatternModel pat] {s res : Slice} (h : s.dropPrefix? pat = some res) :
-    ∃ t, ForwardPatternModel.Matches pat t ∧ s.copy = t ++ res.copy := by
+    ∃ t, PatternModel.Matches pat t ∧ s.copy = t ++ res.copy := by
   simp only [dropPrefix?_eq_map_skipPrefix?, Option.map_eq_some_iff, skipPrefix?_eq_some_iff] at h
   obtain ⟨pos, h₁, h₂⟩ := h
   exact ⟨(s.sliceTo pos).copy, h₁.isMatch.matches_copy, by simp [← h₂, ← copy_eq_copy_sliceTo]⟩
 
+theorem skipSuffix?_eq_backwardPatternSkipSuffix? {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : Slice} :
+    s.skipSuffix? pat = BackwardPattern.skipSuffix? pat s := (rfl)
+
+theorem endsWith_eq_backwardPatternEndsWith {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : Slice} :
+    s.endsWith pat = BackwardPattern.endsWith pat s := (rfl)
+
+theorem dropSuffix?_eq_map_skipSuffix? {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : Slice} :
+    s.dropSuffix? pat = (s.skipSuffix? pat).map s.sliceTo := (rfl)
+
+theorem Pattern.Model.skipSuffix?_eq_some_iff {ρ : Type} {pat : ρ} [PatternModel pat] [BackwardPattern pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} {pos : s.Pos} :
+    s.skipSuffix? pat = some pos ↔ IsLongestRevMatch pat pos := by
+  rw [skipSuffix?_eq_backwardPatternSkipSuffix?, LawfulBackwardPatternModel.skipSuffix?_eq_some_iff]
+
+theorem Pattern.Model.skipSuffix?_eq_none_iff {ρ : Type} {pat : ρ} [PatternModel pat] [BackwardPattern pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} :
+    s.skipSuffix? pat = none ↔ ¬ RevMatchesAt pat s.endPos := by
+  rw [skipSuffix?_eq_backwardPatternSkipSuffix?, LawfulBackwardPatternModel.skipSuffix?_eq_none_iff]
+
+@[simp]
+theorem isSome_skipSuffix? {ρ : Type} {pat : ρ} [BackwardPattern pat] [LawfulBackwardPattern pat] {s : Slice} :
+    (s.skipSuffix? pat).isSome = s.endsWith pat := by
+  rw [endsWith_eq_backwardPatternEndsWith, skipSuffix?, LawfulBackwardPattern.endsWith_eq]
+
+theorem Pattern.Model.endsWith_eq_false_iff {ρ : Type} {pat : ρ} [PatternModel pat] [BackwardPattern pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} :
+    s.endsWith pat = false ↔ ¬ RevMatchesAt pat s.endPos := by
+  rw [← Pattern.Model.skipSuffix?_eq_none_iff, ← Option.isNone_iff_eq_none,
+    ← isSome_skipSuffix?, Option.isSome_eq_false_iff]
+
+theorem Pattern.Model.endsWith_iff {ρ : Type} {pat : ρ} [PatternModel pat] [BackwardPattern pat]
+    [LawfulBackwardPatternModel pat] {s : Slice} :
+    s.endsWith pat = true ↔ RevMatchesAt pat s.endPos := by
+  rw [← Bool.not_eq_false, endsWith_eq_false_iff, Classical.not_not]
+
+@[simp]
+theorem skipSuffix?_eq_none_iff {ρ : Type} {pat : ρ} [BackwardPattern pat] [LawfulBackwardPattern pat]
+    {s : Slice} : s.skipSuffix? pat = none ↔ s.endsWith pat = false := by
+  rw [← Option.isNone_iff_eq_none, ← Option.isSome_eq_false_iff, isSome_skipSuffix?]
+
+@[simp]
+theorem dropSuffix?_eq_none_iff {ρ : Type} {pat : ρ} [BackwardPattern pat] [LawfulBackwardPattern pat]
+    {s : Slice} : s.dropSuffix? pat = none ↔ s.endsWith pat = false := by
+  simp [dropSuffix?_eq_map_skipSuffix?]
+
+theorem Pattern.Model.eq_append_of_dropSuffix?_eq_some {ρ : Type} {pat : ρ} [PatternModel pat] [BackwardPattern pat]
+    [LawfulBackwardPatternModel pat] {s res : Slice} (h : s.dropSuffix? pat = some res) :
+    ∃ t, PatternModel.Matches pat t ∧ s.copy = res.copy ++ t := by
+  simp only [dropSuffix?_eq_map_skipSuffix?, Option.map_eq_some_iff, skipSuffix?_eq_some_iff] at h
+  obtain ⟨pos, h₁, h₂⟩ := h
+  exact ⟨(s.sliceFrom pos).copy, h₁.isRevMatch.matches_copy, by simp [← h₂, ← copy_eq_copy_sliceTo]⟩
+
 end Slice
 
 theorem skipPrefix?_eq_skipPrefix?_toSlice {ρ : Type} {pat : ρ} [ForwardPattern pat] {s : String} :
@@ -83,4 +135,13 @@ theorem startsWith_eq_startsWith_toSlice {ρ : Type} {pat : ρ} [ForwardPattern
 theorem dropPrefix?_eq_dropPrefix?_toSlice {ρ : Type} {pat : ρ} [ForwardPattern pat] {s : String} :
     s.dropPrefix? pat = s.toSlice.dropPrefix? pat := (rfl)
 
+theorem skipSuffix?_eq_skipSuffix?_toSlice {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : String} :
+    s.skipSuffix? pat = (s.toSlice.skipSuffix? pat).map Pos.ofToSlice := (rfl)
+
+theorem endsWith_eq_endsWith_toSlice {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : String} :
+    s.endsWith pat = s.toSlice.endsWith pat := (rfl)
+
+theorem dropSuffix?_eq_dropSuffix?_toSlice {ρ : Type} {pat : ρ} [BackwardPattern pat] {s : String} :
+    s.dropSuffix? pat = s.toSlice.dropSuffix? pat := (rfl)
+
 end String

src/Init/Data/String/Lemmas/Pattern/TakeDrop/Char.lean

@@ -11,6 +11,8 @@ public import Init.Data.String.TakeDrop
 import Init.Data.String.Lemmas.Pattern.TakeDrop.Basic
 import Init.Data.String.Lemmas.Pattern.Char
 import Init.Data.Option.Lemmas
+import Init.Data.String.Lemmas.FindPos
+import Init.Data.List.Sublist
 
 public section
 
@@ -52,7 +54,42 @@ theorem startsWith_char_eq_false_iff_forall_append {c : Char} {s : Slice} :
 
 theorem eq_append_of_dropPrefix?_char_eq_some {c : Char} {s res : Slice} (h : s.dropPrefix? c = some res) :
     s.copy = singleton c ++ res.copy := by
-  simpa [ForwardPatternModel.Matches] using Pattern.Model.eq_append_of_dropPrefix?_eq_some h
+  simpa [PatternModel.Matches] using Pattern.Model.eq_append_of_dropPrefix?_eq_some h
+
+theorem skipSuffix?_char_eq_some_iff {c : Char} {s : Slice} {pos : s.Pos} :
+    s.skipSuffix? c = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c := by
+  rw [Pattern.Model.skipSuffix?_eq_some_iff, Char.isLongestRevMatch_iff]
+
+theorem endsWith_char_iff_get {c : Char} {s : Slice} :
+    s.endsWith c ↔ ∃ h, (s.endPos.prev h).get (by simp) = c := by
+  simp [Pattern.Model.endsWith_iff, Char.revMatchesAt_iff]
+
+theorem endsWith_char_eq_false_iff_get {c : Char} {s : Slice} :
+    s.endsWith c = false ↔ ∀ h, (s.endPos.prev h).get (by simp) ≠ c := by
+  simp [Pattern.Model.endsWith_eq_false_iff, Char.revMatchesAt_iff]
+
+theorem endsWith_char_iff_exists_append {c : Char} {s : Slice} :
+    s.endsWith c ↔ ∃ t, s.copy = t ++ singleton c := by
+  rw [Pattern.Model.endsWith_iff, Char.revMatchesAt_iff_splits]
+  simp only [splits_endPos_iff, exists_eq_right, eq_comm (a := s.copy)]
+
+theorem endsWith_char_eq_getLast? {c : Char} {s : Slice} :
+    s.endsWith c = (s.copy.toList.getLast? == some c) := by
+  rw [Bool.eq_iff_iff, endsWith_char_iff_exists_append, beq_iff_eq,
+    ← List.singleton_suffix_iff_getLast?_eq_some, List.suffix_iff_exists_eq_append]
+  constructor
+  · rintro ⟨t, ht⟩
+    exact ⟨t.toList, by rw [ht, toList_append, toList_singleton]⟩
+  · rintro ⟨l, hl⟩
+    exact ⟨ofList l, by rw [← toList_inj, toList_append, toList_singleton, toList_ofList]; exact hl⟩
+
+theorem endsWith_char_eq_false_iff_forall_append {c : Char} {s : Slice} :
+    s.endsWith c = false ↔ ∀ t, s.copy ≠ t ++ singleton c := by
+  simp [← Bool.not_eq_true, endsWith_char_iff_exists_append]
+
+theorem eq_append_of_dropSuffix?_char_eq_some {c : Char} {s res : Slice} (h : s.dropSuffix? c = some res) :
+    s.copy = res.copy ++ singleton c := by
+  simpa [PatternModel.Matches] using Pattern.Model.eq_append_of_dropSuffix?_eq_some h
 
 end Slice
 
@@ -86,4 +123,34 @@ theorem eq_append_of_dropPrefix?_char_eq_some {c : Char} {s : String} {res : Sli
   rw [dropPrefix?_eq_dropPrefix?_toSlice] at h
   simpa using Slice.eq_append_of_dropPrefix?_char_eq_some h
 
+theorem skipSuffix?_char_eq_some_iff {c : Char} {s : String} {pos : s.Pos} :
+    s.skipSuffix? c = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c := by
+  simp [skipSuffix?_eq_skipSuffix?_toSlice, Slice.skipSuffix?_char_eq_some_iff, ← Pos.toSlice_inj,
+    Pos.prev_toSlice]
+
+theorem endsWith_char_iff_get {c : Char} {s : String} :
+    s.endsWith c ↔ ∃ h, (s.endPos.prev h).get (by simp) = c := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_char_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_char_eq_false_iff_get {c : Char} {s : String} :
+    s.endsWith c = false ↔ ∀ h, (s.endPos.prev h).get (by simp) ≠ c := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_char_eq_false_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_char_eq_getLast? {c : Char} {s : String} :
+    s.endsWith c = (s.toList.getLast? == some c) := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_char_eq_getLast?]
+
+theorem endsWith_char_iff_exists_append {c : Char} {s : String} :
+    s.endsWith c ↔ ∃ t, s = t ++ singleton c := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_char_iff_exists_append]
+
+theorem endsWith_char_eq_false_iff_forall_append {c : Char} {s : String} :
+    s.endsWith c = false ↔ ∀ t, s ≠ t ++ singleton c := by
+  simp [← Bool.not_eq_true, endsWith_char_iff_exists_append]
+
+theorem eq_append_of_dropSuffix?_char_eq_some {c : Char} {s : String} {res : Slice} (h : s.dropSuffix? c = some res) :
+    s = res.copy ++ singleton c := by
+  rw [dropSuffix?_eq_dropSuffix?_toSlice] at h
+  simpa using Slice.eq_append_of_dropSuffix?_char_eq_some h
+
 end String

src/Init/Data/String/Lemmas/Pattern/TakeDrop/Pred.lean

@@ -11,6 +11,7 @@ public import Init.Data.String.TakeDrop
 import Init.Data.String.Lemmas.Pattern.TakeDrop.Basic
 import Init.Data.String.Lemmas.Pattern.Pred
 import Init.Data.Option.Lemmas
+import Init.Data.String.Lemmas.FindPos
 import Init.ByCases
 
 public section
@@ -45,7 +46,7 @@ theorem startsWith_bool_eq_head? {p : Char → Bool} {s : Slice} :
 
 theorem eq_append_of_dropPrefix?_bool_eq_some {p : Char → Bool} {s res : Slice} (h : s.dropPrefix? p = some res) :
     ∃ c, s.copy = singleton c ++ res.copy ∧ p c = true := by
-  obtain ⟨_, ⟨c, ⟨rfl, h₁⟩⟩, h₂⟩ := by simpa [ForwardPatternModel.Matches] using Pattern.Model.eq_append_of_dropPrefix?_eq_some h
+  obtain ⟨_, ⟨c, ⟨rfl, h₁⟩⟩, h₂⟩ := by simpa [PatternModel.Matches] using Pattern.Model.eq_append_of_dropPrefix?_eq_some h
   exact ⟨_, h₂, h₁⟩
 
 theorem skipPrefix?_prop_eq_some_iff {P : Char → Prop} [DecidablePred P] {s : Slice} {pos : s.Pos} :
@@ -69,6 +70,54 @@ theorem eq_append_of_dropPrefix_prop_eq_some {P : Char → Prop} [DecidablePred
   rw [dropPrefix?_prop_eq_dropPrefix?_decide] at h
   simpa using eq_append_of_dropPrefix?_bool_eq_some h
 
+theorem skipSuffix?_bool_eq_some_iff {p : Char → Bool} {s : Slice} {pos : s.Pos} :
+    s.skipSuffix? p = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) = true := by
+  rw [Pattern.Model.skipSuffix?_eq_some_iff, CharPred.isLongestRevMatch_iff]
+
+theorem endsWith_bool_iff_get {p : Char → Bool} {s : Slice} :
+    s.endsWith p ↔ ∃ h, p ((s.endPos.prev h).get (by simp)) = true := by
+  simp [Pattern.Model.endsWith_iff, CharPred.revMatchesAt_iff]
+
+theorem endsWith_bool_eq_false_iff_get {p : Char → Bool} {s : Slice} :
+    s.endsWith p = false ↔ ∀ h, p ((s.endPos.prev h).get (by simp)) = false := by
+  simp [Pattern.Model.endsWith_eq_false_iff, CharPred.revMatchesAt_iff]
+
+theorem endsWith_bool_eq_getLast? {p : Char → Bool} {s : Slice} :
+    s.endsWith p = s.copy.toList.getLast?.any p := by
+  rw [Bool.eq_iff_iff, Pattern.Model.endsWith_iff, CharPred.revMatchesAt_iff]
+  by_cases h : s.endPos = s.startPos
+  · refine ⟨fun ⟨h', _⟩ => by simp_all, ?_⟩
+    have : s.copy = "" := by simp_all [Slice.startPos_eq_endPos_iff.mp h.symm]
+    simp [this]
+  · obtain ⟨t, ht⟩ := s.splits_endPos.exists_eq_append_singleton_of_ne_startPos h
+    simp [h, ht]
+
+theorem eq_append_of_dropSuffix?_bool_eq_some {p : Char → Bool} {s res : Slice} (h : s.dropSuffix? p = some res) :
+    ∃ c, s.copy = res.copy ++ singleton c ∧ p c = true := by
+  obtain ⟨_, ⟨c, ⟨rfl, h₁⟩⟩, h₂⟩ := by simpa [PatternModel.Matches] using Pattern.Model.eq_append_of_dropSuffix?_eq_some h
+  exact ⟨_, h₂, h₁⟩
+
+theorem skipSuffix?_prop_eq_some_iff {P : Char → Prop} [DecidablePred P] {s : Slice} {pos : s.Pos} :
+    s.skipSuffix? P = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ P ((s.endPos.prev h).get (by simp)) := by
+  simp [skipSuffix?_prop_eq_skipSuffix?_decide, skipSuffix?_bool_eq_some_iff]
+
+theorem endsWith_prop_iff_get {P : Char → Prop} [DecidablePred P] {s : Slice} :
+    s.endsWith P ↔ ∃ h, P ((s.endPos.prev h).get (by simp)) := by
+  simp [endsWith_prop_eq_endsWith_decide, endsWith_bool_iff_get]
+
+theorem endsWith_prop_eq_false_iff_get {P : Char → Prop} [DecidablePred P] {s : Slice} :
+    s.endsWith P = false ↔ ∀ h, ¬ P ((s.endPos.prev h).get (by simp)) := by
+  simp [endsWith_prop_eq_endsWith_decide, endsWith_bool_eq_false_iff_get]
+
+theorem endsWith_prop_eq_getLast? {P : Char → Prop} [DecidablePred P] {s : Slice} :
+    s.endsWith P = s.copy.toList.getLast?.any (decide <| P ·) := by
+  simp [endsWith_prop_eq_endsWith_decide, endsWith_bool_eq_getLast?]
+
+theorem eq_append_of_dropSuffix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropSuffix? P = some res) :
+    ∃ c, s.copy = res.copy ++ singleton c ∧ P c := by
+  rw [dropSuffix?_prop_eq_dropSuffix?_decide] at h
+  simpa using eq_append_of_dropSuffix?_bool_eq_some h
+
 end Slice
 
 theorem skipPrefix?_bool_eq_some_iff {p : Char → Bool} {s : String} {pos : s.Pos} :
@@ -115,4 +164,48 @@ theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred
   rw [dropPrefix?_eq_dropPrefix?_toSlice] at h
   simpa using Slice.eq_append_of_dropPrefix_prop_eq_some h
 
+theorem skipSuffix?_bool_eq_some_iff {p : Char → Bool} {s : String} {pos : s.Pos} :
+    s.skipSuffix? p = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) = true := by
+  simp [skipSuffix?_eq_skipSuffix?_toSlice, Slice.skipSuffix?_bool_eq_some_iff, ← Pos.toSlice_inj,
+    Pos.prev_toSlice]
+
+theorem endsWith_bool_iff_get {p : Char → Bool} {s : String} :
+    s.endsWith p ↔ ∃ h, p ((s.endPos.prev h).get (by simp)) = true := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_bool_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_bool_eq_false_iff_get {p : Char → Bool} {s : String} :
+    s.endsWith p = false ↔ ∀ h, p ((s.endPos.prev h).get (by simp)) = false := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_bool_eq_false_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_bool_eq_getLast? {p : Char → Bool} {s : String} :
+    s.endsWith p = s.toList.getLast?.any p := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_bool_eq_getLast?]
+
+theorem eq_append_of_dropSuffix?_bool_eq_some {p : Char → Bool} {s : String} {res : Slice} (h : s.dropSuffix? p = some res) :
+    ∃ c, s = res.copy ++ singleton c ∧ p c = true := by
+  rw [dropSuffix?_eq_dropSuffix?_toSlice] at h
+  simpa using Slice.eq_append_of_dropSuffix?_bool_eq_some h
+
+theorem skipSuffix?_prop_eq_some_iff {P : Char → Prop} [DecidablePred P] {s : String} {pos : s.Pos} :
+    s.skipSuffix? P = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ P ((s.endPos.prev h).get (by simp)) := by
+  simp [skipSuffix?_eq_skipSuffix?_toSlice, Slice.skipSuffix?_prop_eq_some_iff, ← Pos.toSlice_inj,
+    Pos.prev_toSlice]
+
+theorem endsWith_prop_iff_get {P : Char → Prop} [DecidablePred P] {s : String} :
+    s.endsWith P ↔ ∃ h, P ((s.endPos.prev h).get (by simp)) := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_prop_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_prop_eq_false_iff_get {P : Char → Prop} [DecidablePred P] {s : String} :
+    s.endsWith P = false ↔ ∀ h, ¬ P ((s.endPos.prev h).get (by simp)) := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_prop_eq_false_iff_get, Pos.prev_toSlice]
+
+theorem endsWith_prop_eq_getLast? {P : Char → Prop} [DecidablePred P] {s : String} :
+    s.endsWith P = s.toList.getLast?.any (decide <| P ·) := by
+  simp [endsWith_eq_endsWith_toSlice, Slice.endsWith_prop_eq_getLast?]
+
+theorem eq_append_of_dropSuffix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s : String} {res : Slice}
+    (h : s.dropSuffix? P = some res) : ∃ c, s = res.copy ++ singleton c ∧ P c := by
+  rw [dropSuffix?_eq_dropSuffix?_toSlice] at h
+  simpa using Slice.eq_append_of_dropSuffix?_prop_eq_some h
+
 end String

src/Init/Data/String/Lemmas/Pattern/TakeDrop/String.lean

@@ -67,7 +67,7 @@ theorem eq_append_of_dropPrefix?_slice_eq_some {pat s res : Slice} (h : s.dropPr
   | false =>
     have := ForwardSliceSearcher.lawfulForwardPatternModel hpat
     have := Pattern.Model.eq_append_of_dropPrefix?_eq_some h
-    simp only [ForwardPatternModel.Matches] at this
+    simp only [PatternModel.Matches] at this
     obtain ⟨_, ⟨-, rfl⟩, h⟩ := this
     exact h
   | true => simp [Option.some.inj (h ▸ dropPrefix?_slice_of_isEmpty hpat), (show pat.copy = "" by simpa)]
@@ -104,6 +104,87 @@ theorem eq_append_of_dropPrefix?_string_eq_some {pat : String} {s res : Slice} (
   rw [dropPrefix?_string_eq_dropPrefix?_toSlice] at h
   simpa using eq_append_of_dropPrefix?_slice_eq_some h
 
+theorem skipSuffix?_slice_of_isEmpty {pat s : Slice} (hpat : pat.isEmpty = true) :
+    s.skipSuffix? pat = some s.endPos := by
+  rw [skipSuffix?_eq_backwardPatternSkipSuffix?, BackwardSliceSearcher.skipSuffix?_of_isEmpty hpat]
+
+@[simp]
+theorem skipSuffix?_slice_eq_some_iff {pat s : Slice} {pos : s.Pos} :
+    s.skipSuffix? pat = some pos ↔ ∃ t, pos.Splits t pat.copy := by
+  match h : pat.isEmpty with
+  | false =>
+    have := BackwardSliceSearcher.lawfulBackwardPatternModel h
+    rw [Pattern.Model.skipSuffix?_eq_some_iff, ForwardSliceSearcher.isLongestRevMatch_iff_splits h]
+  | true => simp [skipSuffix?_slice_of_isEmpty h, (show pat.copy = "" by simpa), eq_comm]
+
+theorem endsWith_slice_of_isEmpty {pat s : Slice} (hpat : pat.isEmpty = true) :
+    s.endsWith pat = true := by
+  rw [endsWith_eq_backwardPatternEndsWith, BackwardSliceSearcher.endsWith_of_isEmpty hpat]
+
+@[simp]
+theorem endsWith_slice_iff {pat s : Slice} :
+    s.endsWith pat ↔ pat.copy.toList <:+ s.copy.toList := by
+  match h : pat.isEmpty with
+  | false =>
+    have := BackwardSliceSearcher.lawfulBackwardPatternModel h
+    simp only [Model.endsWith_iff, ForwardSliceSearcher.revMatchesAt_iff_splits h,
+      splits_endPos_iff, exists_eq_right]
+    simp only [← toList_inj, toList_append, List.suffix_iff_exists_append_eq]
+    exact ⟨fun ⟨t, ht⟩ => ⟨t.toList, by simp [ht]⟩, fun ⟨t, ht⟩ => ⟨String.ofList t, by simp [← ht]⟩⟩
+  | true => simp [endsWith_slice_of_isEmpty h, (show pat.copy = "" by simpa)]
+
+@[simp]
+theorem endsWith_slice_eq_false_iff {pat s : Slice} :
+    s.endsWith pat = false ↔ ¬ (pat.copy.toList <:+ s.copy.toList) := by
+  simp [← Bool.not_eq_true, endsWith_slice_iff]
+
+theorem dropSuffix?_slice_of_isEmpty {pat s : Slice} (hpat : pat.isEmpty = true) :
+    s.dropSuffix? pat = some s := by
+  simp [dropSuffix?_eq_map_skipSuffix?, skipSuffix?_slice_of_isEmpty hpat]
+
+theorem eq_append_of_dropSuffix?_slice_eq_some {pat s res : Slice} (h : s.dropSuffix? pat = some res) :
+    s.copy = res.copy ++ pat.copy := by
+  match hpat : pat.isEmpty with
+  | false =>
+    have := BackwardSliceSearcher.lawfulBackwardPatternModel hpat
+    have := Pattern.Model.eq_append_of_dropSuffix?_eq_some h
+    simp only [PatternModel.Matches] at this
+    obtain ⟨_, ⟨-, rfl⟩, h⟩ := this
+    exact h
+  | true => simp [Option.some.inj (h ▸ dropSuffix?_slice_of_isEmpty hpat), (show pat.copy = "" by simpa)]
+
+@[simp]
+theorem skipSuffix?_string_eq_some_iff' {pat : String} {s : Slice} {pos : s.Pos} :
+    s.skipSuffix? pat = some pos ↔ ∃ t, pos.Splits t pat := by
+  simp [skipSuffix?_string_eq_skipSuffix?_toSlice]
+
+@[simp]
+theorem skipSuffix?_string_empty {s : Slice} : s.skipSuffix? "" = some s.endPos := by
+  simp
+
+@[simp]
+theorem endsWith_string_iff {pat : String} {s : Slice} :
+    s.endsWith pat ↔ pat.toList <:+ s.copy.toList := by
+  simp [endsWith_string_eq_endsWith_toSlice]
+
+@[simp]
+theorem endsWith_string_empty {s : Slice} : s.endsWith "" = true := by
+  simp
+
+@[simp]
+theorem endsWith_string_eq_false_iff {pat : String} {s : Slice} :
+    s.endsWith pat = false ↔ ¬ (pat.toList <:+ s.copy.toList) := by
+  simp [endsWith_string_eq_endsWith_toSlice]
+
+@[simp]
+theorem dropSuffix?_string_empty {s : Slice} : s.dropSuffix? "" = some s := by
+  simpa [dropSuffix?_string_eq_dropSuffix?_toSlice] using dropSuffix?_slice_of_isEmpty (by simp)
+
+theorem eq_append_of_dropSuffix?_string_eq_some {pat : String} {s res : Slice} (h : s.dropSuffix? pat = some res) :
+    s.copy = res.copy ++ pat := by
+  rw [dropSuffix?_string_eq_dropSuffix?_toSlice] at h
+  simpa using eq_append_of_dropSuffix?_slice_eq_some h
+
 end Slice
 
 theorem skipPrefix?_slice_of_isEmpty {pat : Slice} {s : String} (hpat : pat.isEmpty = true) :

src/Init/Data/String/Lemmas/Splits.lean

@@ -367,7 +367,7 @@ theorem Slice.Pos.Splits.of_prev {s : Slice} {p : s.Pos} {hp}
   obtain ⟨rfl, rfl, rfl⟩ := by simpa using h.eq (splits_prev p hp)
   exact splits_prev_right p hp
 
-theorem Slice.sliceTo_copy_eq_iff_exists_splits {s : Slice} {p : s.Pos} {t₁ : String} :
+theorem Slice.copy_sliceTo_eq_iff_exists_splits {s : Slice} {p : s.Pos} {t₁ : String} :
     (s.sliceTo p).copy = t₁ ↔ ∃ t₂, p.Splits t₁ t₂ := by
   refine ⟨?_, ?_⟩
   · rintro rfl
@@ -375,13 +375,21 @@ theorem Slice.sliceTo_copy_eq_iff_exists_splits {s : Slice} {p : s.Pos} {t₁ :
   · rintro ⟨t₂, h⟩
     exact p.splits.eq_left h
 
-theorem sliceTo_copy_eq_iff_exists_splits {s : String} {p : s.Pos} {t₁ : String} :
-    (s.sliceTo p).copy = t₁ ↔ ∃ t₂, p.Splits t₁ t₂ := by
+theorem Slice.copy_sliceFrom_eq_iff_exists_splits {s : Slice} {p : s.Pos} {t₂ : String} :
+    (s.sliceFrom p).copy = t₂ ↔ ∃ t₁, p.Splits t₁ t₂ := by
   refine ⟨?_, ?_⟩
   · rintro rfl
     exact ⟨_, p.splits⟩
   · rintro ⟨t₂, h⟩
-    exact p.splits.eq_left h
+    exact p.splits.eq_right h
+
+theorem copy_sliceTo_eq_iff_exists_splits {s : String} {p : s.Pos} {t₁ : String} :
+    (s.sliceTo p).copy = t₁ ↔ ∃ t₂, p.Splits t₁ t₂ := by
+  simp [← Pos.splits_toSlice_iff, ← Slice.copy_sliceTo_eq_iff_exists_splits]
+
+theorem copy_sliceFrom_eq_iff_exists_splits {s : String} {p : s.Pos} {t₂ : String} :
+    (s.sliceFrom p).copy = t₂ ↔ ∃ t₁, p.Splits t₁ t₂ := by
+  simp [← Pos.splits_toSlice_iff, ← Slice.copy_sliceFrom_eq_iff_exists_splits]
 
 theorem Pos.Splits.offset_eq_decreaseBy {s : String} {p : s.Pos} (h : p.Splits t₁ t₂) :
     p.offset = s.rawEndPos.decreaseBy t₂.utf8ByteSize := by
@@ -427,8 +435,7 @@ theorem Slice.splits_singleton_iff {s : Slice} {p : s.Pos} {c : Char} {t : Strin
       simp [startPos_ne_endPos_iff, ← copy_ne_empty_iff, h.eq_append]
     have spl : (s.startPos.next this).Splits (singleton c) t := by
       rw [← empty_append (s := singleton c)]
-      apply Pos.Splits.next
-      simp [h.eq_append]
+      exact Pos.Splits.next (by simp [h.eq_append])
     refine ⟨this, ⟨h.pos_eq spl, ?_, h.eq_append⟩⟩
     rw [← empty_append (s := singleton c)] at spl
     exact spl.get_eq_of_singleton
@@ -442,6 +449,27 @@ theorem splits_singleton_iff {s : String} {p : s.Pos} {c : Char} {t : String} :
   rw [← Pos.splits_toSlice_iff, Slice.splits_singleton_iff]
   simp [← Pos.ofToSlice_inj]
 
+theorem Slice.splits_singleton_right_iff {s : Slice} {p : s.Pos} {c : Char} {t : String} :
+    p.Splits t (singleton c) ↔
+      ∃ h, p = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c ∧ s.copy = t ++ singleton c := by
+  refine ⟨fun h => ?_, ?_⟩
+  · have : s.endPos ≠ s.startPos := by
+      simp [ne_comm (a := s.endPos), startPos_ne_endPos_iff, ← copy_ne_empty_iff, h.eq_append]
+    have spl : (s.endPos.prev this).Splits t (singleton c) := by
+      rw [← append_empty (s := singleton c)]
+      exact Pos.Splits.prev (by simp [h.eq_append])
+    refine ⟨this, ⟨h.pos_eq spl, ?_, h.eq_append⟩⟩
+    exact (h.eq_append ▸ Pos.next_prev (h := this) ▸ s.splits_endPos).get_eq_of_singleton
+  · rintro ⟨h, ⟨rfl, rfl, h'⟩⟩
+    rw [← String.append_empty (s := singleton _)]
+    exact Pos.Splits.prev (by simp [h'])
+
+theorem splits_singleton_right_iff {s : String} {p : s.Pos} {c : Char} {t : String} :
+    p.Splits t (singleton c) ↔
+      ∃ h, p = s.endPos.prev h ∧ (s.endPos.prev h).get (by simp) = c ∧ s = t ++ singleton c := by
+  rw [← Pos.splits_toSlice_iff, Slice.splits_singleton_right_iff]
+  simp [← Pos.ofToSlice_inj, Pos.prev_toSlice]
+
 theorem Slice.splits_next_startPos {s : Slice} {h : s.startPos ≠ s.endPos} :
     (s.startPos.next h).Splits
       (singleton (s.startPos.get h)) (s.sliceFrom (s.startPos.next h)).copy := by
@@ -456,6 +484,20 @@ theorem splits_next_startPos {s : String} {h : s.startPos ≠ s.endPos} :
   rw [← Pos.splits_toSlice_iff]
   apply (Slice.splits_next_startPos).of_eq <;> simp [String.Pos.next_toSlice]
 
+theorem Slice.splits_prev_endPos {s : Slice} {h : s.endPos ≠ s.startPos} :
+    (s.endPos.prev h).Splits
+      (s.sliceTo (s.endPos.prev h)).copy (singleton ((s.endPos.prev h).get (by simp))) := by
+  rw [← String.append_empty (s := singleton _)]
+  apply Slice.Pos.Splits.prev
+  have := Slice.Pos.splits_prev_right s.endPos h
+  rwa [copy_sliceFrom_endPos] at this
+
+theorem splits_prev_endPos {s : String} {h : s.endPos ≠ s.startPos} :
+    (s.endPos.prev h).Splits
+      (s.sliceTo (s.endPos.prev h)).copy (singleton ((s.endPos.prev h).get (by simp))) := by
+  rw [← Pos.splits_toSlice_iff]
+  apply (Slice.splits_prev_endPos).of_eq <;> simp [String.Pos.prev_toSlice, h]
+
 theorem Slice.Pos.Splits.toByteArray_eq_left {s : Slice} {p : s.Pos} {t₁ t₂ : String} (h : p.Splits t₁ t₂) :
     t₁.toByteArray = s.copy.toByteArray.extract 0 p.offset.byteIdx := by
   rw [h.eq_left p.splits]

src/Init/Data/String/Pattern/Basic.lean

@@ -117,7 +117,7 @@ class ForwardPattern {ρ : Type} (pat : ρ) where
   -/
   startsWith : (s : Slice) → Bool := fun s => (skipPrefix? s).isSome
 
-@[deprecated ForwardPattern.dropPrefix? (since := "2026-03-19")]
+@[deprecated ForwardPattern.skipPrefix? (since := "2026-03-19")]
 def ForwardPattern.dropPrefix? {ρ : Type} (pat : ρ) [ForwardPattern pat] (s : Slice) : Option s.Pos :=
   ForwardPattern.skipPrefix? pat s
 

src/Init/Data/String/Pattern/Char.lean

@@ -47,8 +47,8 @@ instance {c : Char} : LawfulBackwardPattern c where
   skipSuffixOfNonempty?_eq h := LawfulBackwardPattern.skipSuffixOfNonempty?_eq (pat := (· == c)) h
   endsWith_eq s := LawfulBackwardPattern.endsWith_eq (pat := (· == c)) s
 
-instance {c : Char} : ToBackwardSearcher c (ToBackwardSearcher.DefaultBackwardSearcher c) :=
-  .defaultImplementation
+instance {c : Char} : ToBackwardSearcher c (ToBackwardSearcher.DefaultBackwardSearcher (· == c)) where
+  toSearcher s := ToBackwardSearcher.toSearcher (· == c) s
 
 end Char
 

src/Init/Data/String/Pattern/Pred.lean

@@ -139,8 +139,9 @@ instance {p : Char → Prop} [DecidablePred p] : LawfulBackwardPattern p where
   skipSuffixOfNonempty?_eq h := LawfulBackwardPattern.skipSuffixOfNonempty?_eq (pat := (decide <| p ·)) h
   endsWith_eq s := LawfulBackwardPattern.endsWith_eq (pat := (decide <| p ·)) s
 
-instance {p : Char → Prop} [DecidablePred p] : ToBackwardSearcher p (ToBackwardSearcher.DefaultBackwardSearcher p) :=
-  .defaultImplementation
+instance {p : Char → Prop} [DecidablePred p] :
+    ToBackwardSearcher p (ToBackwardSearcher.DefaultBackwardSearcher (decide <| p ·)) where
+  toSearcher s := ToBackwardSearcher.toSearcher (decide <| p ·) s
 
 end Decidable
 

src/Init/Grind/Util.lean

@@ -32,6 +32,12 @@ using `eq_self`.
 -/
 def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
 
+/--
+Gadget for protecting lambda abstractions created by `abstractGroundMismatches?`
+from beta reduction during preprocessing. See `ProveEq.lean` for details.
+-/
+def abstractFn {α : Sort u} (a : α) : α := a
+
 /-- Gadget for representing offsets `t+k` in patterns. -/
 def offset (a b : Nat) : Nat := a + b
 

src/Init/Prelude.lean

@@ -185,13 +185,9 @@ example : foo.default = (default, default) :=
 abbrev inferInstance {α : Sort u} [i : α] : α := i
 
 set_option checkBinderAnnotations false in
-/-- `inferInstanceAs α` synthesizes an instance of type `α`, transporting it from a
-definitionally equal type if necessary. This is useful when `α` is definitionally equal to
-some `α'` for which instances are registered, as it prevents leaking the definition's RHS
-at lower transparencies.
-
-`inferInstanceAs` requires an expected type from context. If you just need to synthesize an
-instance without transporting between types, use `inferInstance` instead.
+/--
+`inferInstanceAs α` synthesizes an instance of type `α` and then adjusts it to conform to the
+expected type `β`, which must be inferable from context.
 
 Example:
 ```
@@ -199,7 +195,26 @@ def D := Nat
 instance : Inhabited D := inferInstanceAs (Inhabited Nat)
 ```
 
-See `Lean.Meta.WrapInstance` for details.
+The adjustment will make sure that when the resulting instance will not "leak" the RHS `Nat` when
+reduced at transparency levels below `semireducible`, i.e. where `D` would not be unfolded either,
+preventing "defeq abuse".
+
+More specifically, given the "source type" (the argument) and "target type" (the expected type),
+`inferInstanceAs` synthesizes an instance for the source type and then unfolds and rewraps its
+components (fields, nested instances) as necessary to make them compatible with the target type. The
+individual steps are represented by the following options, which all default to enabled and can be
+disabled to help with porting:
+
+* `backward.inferInstanceAs.wrap`: master switch for instance adjustment in both `inferInstanceAs`
+  and the default deriving handler
+* `backward.inferInstanceAs.wrap.reuseSubInstances`: reuse existing instances for the target type
+  for sub-instance fields to avoid non-defeq instance diamonds
+* `backward.inferInstanceAs.wrap.instances`: wrap non-reducible instances in auxiliary definitions
+* `backward.inferInstanceAs.wrap.data`: wrap data fields in auxiliary definitions (proof fields are
+  always wrapped)
+
+If you just need to synthesize an instance without transporting between types, use `inferInstance`
+instead, potentially with a type annotation for the expected type.
 -/
 abbrev «inferInstanceAs» (α : Sort u) [i : α] : α := i
 
@@ -3673,7 +3688,7 @@ def panic {α : Sort u} [Inhabited α] (msg : String) : α :=
   panicCore msg
 
 -- TODO: this be applied directly to `Inhabited`'s definition when we remove the above workaround
-attribute [nospecialize] Inhabited
+attribute [weak_specialize] Inhabited
 
 /--
 The `>>=` operator is overloaded via instances of `bind`.

src/Lean/Attributes.lean

@@ -186,11 +186,11 @@ def registerTagAttribute (name : Name) (descr : String)
     mkInitial       := pure {}
     addImportedFn   := fun _ _ => pure {}
     addEntryFn      := fun (s : NameSet) n => s.insert n
-    exportEntriesFnEx := fun env es _ =>
-      let r : Array Name := es.foldl (fun a e => a.push e) #[]
-      -- Do not export info for private defs
-      let r := r.filter (env.contains (skipRealize := false))
-      r.qsort Name.quickLt
+    exportEntriesFnEx := fun env es =>
+      let all : Array Name := es.foldl (fun a e => a.push e) #[] |>.qsort Name.quickLt
+      -- Do not export info for private defs at exported/server levels
+      let exported := all.filter ((env.setExporting true).contains (skipRealize := false))
+      { exported, server := exported, «private» := all }
     statsFn         := fun s => "tag attribute" ++ Format.line ++ "number of local entries: " ++ format s.size
     asyncMode       := asyncMode
     replay?         := some fun _ newState newConsts s =>
@@ -266,15 +266,14 @@ def registerParametricAttribute (impl : ParametricAttributeImpl α) : IO (Parame
     mkInitial       := pure ([], {})
     addImportedFn   := fun _ => pure ([], {})
     addEntryFn      := fun (decls, m) (p : Name × α) => (p.1 :: decls, m.insert p.1 p.2)
-    exportEntriesFnEx := fun env (decls, m) lvl => Id.run do
-      let mut r := if impl.preserveOrder then
+    exportEntriesFnEx := fun env (decls, m) => Id.run do
+      let all := if impl.preserveOrder then
         decls.toArray.reverse.filterMap (fun n => return (n, ← m.find? n))
       else
         let r := m.foldl (fun a n p => a.push (n, p)) #[]
         r.qsort (fun a b => Name.quickLt a.1 b.1)
-      if lvl != .private then
-        r := r.filter (fun ⟨n, a⟩ => impl.filterExport env n a)
-      r
+      let exported := all.filter (fun ⟨n, a⟩ => impl.filterExport env n a)
+      { exported, server := exported, «private» := all }
     statsFn         := fun (_, m) => "parametric attribute" ++ Format.line ++ "number of local entries: " ++ format m.size
   }
   let attrImpl : AttributeImpl := {
@@ -333,11 +332,11 @@ def registerEnumAttributes (attrDescrs : List (Name × String × α))
     mkInitial       := pure {}
     addImportedFn   := fun _ _ => pure {}
     addEntryFn      := fun (s : NameMap α) (p : Name × α) => s.insert p.1 p.2
-    exportEntriesFnEx := fun env m _ =>
-      let r : Array (Name × α) := m.foldl (fun a n p => a.push (n, p)) #[]
-      -- Do not export info for private defs
-      let r := r.filter (env.contains (skipRealize := false) ·.1)
-      r.qsort (fun a b => Name.quickLt a.1 b.1)
+    exportEntriesFnEx := fun env m =>
+      let all : Array (Name × α) := m.foldl (fun a n p => a.push (n, p)) #[] |>.qsort (fun a b => Name.quickLt a.1 b.1)
+      -- Do not export info for private defs at exported/server levels
+      let exported := all.filter ((env.setExporting true).contains (skipRealize := false) ·.1)
+      { exported, server := exported, «private» := all }
     statsFn         := fun s => "enumeration attribute extension" ++ Format.line ++ "number of local entries: " ++ format s.size
     -- We assume (and check in `modifyState`) that, if used asynchronously, enum attributes are set
     -- only in the same context in which the tagged declaration was created

src/Lean/Compiler/ExternAttr.lean

@@ -55,11 +55,6 @@ private def syntaxToExternAttrData (stx : Syntax) : AttrM ExternAttrData := do
       entries := entries.push <| ExternEntry.inline backend str
   return { entries := entries.toList }
 
--- Forward declaration
-set_option compiler.ignoreBorrowAnnotation true in
-@[extern "lean_add_extern"]
-opaque addExtern (declName : Name) (externAttrData : ExternAttrData) : CoreM Unit
-
 builtin_initialize externAttr : ParametricAttribute ExternAttrData ←
   registerParametricAttribute {
     name := `extern
@@ -71,7 +66,7 @@ builtin_initialize externAttr : ParametricAttribute ExternAttrData ←
         if let some (.thmInfo ..) := env.find? declName then
           -- We should not mark theorems as extern
           return ()
-        addExtern declName externAttrData
+        compileDecls #[declName]
   }
 
 def getExternAttrData? (env : Environment) (n : Name) : Option ExternAttrData :=

src/Lean/Compiler/IR.lean

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
 module
 
 prelude
-public import Lean.Compiler.IR.AddExtern
 public import Lean.Compiler.IR.Basic
 public import Lean.Compiler.IR.Format
 public import Lean.Compiler.IR.CompilerM

src/Lean/Compiler/IR/AddExtern.lean

@@ -1,86 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Cameron Zwarich
--/
-
-module
-
-prelude
-import Init.While
-import Lean.Compiler.IR.ToIR
-import Lean.Compiler.LCNF.ToImpureType
-import Lean.Compiler.LCNF.ToImpure
-import Lean.Compiler.LCNF.ExplicitBoxing
-import Lean.Compiler.LCNF.Internalize
-public import Lean.Compiler.ExternAttr
-import Lean.Compiler.LCNF.ExplicitRC
-import Lean.Compiler.Options
-
-public section
-
-namespace Lean.IR
-
-set_option compiler.ignoreBorrowAnnotation true in
-@[export lean_add_extern]
-def addExtern (declName : Name) (externAttrData : ExternAttrData) : CoreM Unit := do
-  if !isPrivateName declName then
-    modifyEnv (Compiler.LCNF.setDeclPublic · declName)
-  let monoDecl ← addMono declName
-  let impureDecls ← addImpure monoDecl
-  addIr impureDecls
-where
-  addMono (declName : Name) : CoreM (Compiler.LCNF.Decl .pure) := do
-    let type ← Compiler.LCNF.getOtherDeclMonoType declName
-    let mut typeIter := type
-    let mut params := #[]
-    let ignoreBorrow := Compiler.compiler.ignoreBorrowAnnotation.get (← getOptions)
-    repeat
-      let .forallE binderName ty b _ := typeIter | break
-      let borrow := !ignoreBorrow && isMarkedBorrowed ty
-      params := params.push {
-        fvarId := (← mkFreshFVarId)
-        type := ty,
-        binderName,
-        borrow
-      }
-      typeIter := b
-    let decl := {
-      name := declName,
-      levelParams := [],
-      value := .extern externAttrData,
-      inlineAttr? := some .noinline,
-      type,
-      params,
-    }
-    decl.saveMono
-    return decl
-
-  addImpure (decl : Compiler.LCNF.Decl .pure) : CoreM (Array (Compiler.LCNF.Decl .impure)) := do
-    let type ← Compiler.LCNF.lowerResultType decl.type decl.params.size
-    let params ← decl.params.mapM fun param =>
-      return { param with type := ← Compiler.LCNF.toImpureType param.type }
-    let decl : Compiler.LCNF.Decl .impure := {
-      name := decl.name,
-      levelParams := decl.levelParams,
-      value := .extern externAttrData
-      inlineAttr? := some .noinline,
-      type,
-      params
-    }
-    Compiler.LCNF.CompilerM.run (phase := .impure) do
-      let decl ← decl.internalize
-      decl.saveImpure
-      let decls ← Compiler.LCNF.addBoxedVersions #[decl]
-      let decls ← Compiler.LCNF.runExplicitRc decls
-      for decl in decls do
-        decl.saveImpure
-        modifyEnv fun env => Compiler.LCNF.recordFinalImpureDecl env decl.name
-      return decls
-
-  addIr (decls : Array (Compiler.LCNF.Decl .impure)) : CoreM Unit := do
-    let decls ← toIR decls
-    logDecls `result decls
-    addDecls decls
-
-end Lean.IR

src/Lean/Compiler/IR/CompilerM.lean

@@ -86,11 +86,11 @@ builtin_initialize declMapExt : SimplePersistentEnvExtension Decl DeclMap ←
     addEntryFn    := fun s d => s.insert d.name d
     -- Store `meta` closure only in `.olean`, turn all other decls into opaque externs.
     -- Leave storing the remainder for `meta import` and server `#eval` to `exportIREntries` below.
-    exportEntriesFnEx? := some fun env s entries _ =>
+    exportEntriesFnEx? := some fun env s entries =>
       let decls := entries.foldl (init := #[]) fun decls decl => decls.push decl
       let entries := sortDecls decls
       -- Do not save all IR even in .olean.private as it will be in .ir anyway
-      if env.header.isModule then
+      .uniform <| if env.header.isModule then
         entries.filterMap fun d => do
           if isDeclMeta env d.name then
             return d
@@ -126,12 +126,12 @@ private def exportIREntries (env : Environment) : Array (Name × Array EnvExtens
   -- save all initializers independent of meta/private. Non-meta initializers will only be used when
   -- .ir is actually loaded, and private ones iff visible.
   let initDecls : Array (Name × Name) :=
-    regularInitAttr.ext.exportEntriesFn env (regularInitAttr.ext.getState env) .private
+    (regularInitAttr.ext.exportEntriesFn env (regularInitAttr.ext.getState env)).private
   -- safety: cast to erased type
   let initDecls : Array EnvExtensionEntry := unsafe unsafeCast initDecls
 
   -- needed during initialization via interpreter
-  let modPkg : Array (Option PkgId) := modPkgExt.exportEntriesFn env (modPkgExt.getState env) .private
+  let modPkg : Array (Option PkgId) := (modPkgExt.exportEntriesFn env (modPkgExt.getState env)).private
   -- safety: cast to erased type
   let modPkg : Array EnvExtensionEntry := unsafe unsafeCast modPkg
 

src/Lean/Compiler/LCNF/CoalesceRC.lean

@@ -0,0 +1,104 @@
+/-
+Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+module
+
+prelude
+public import Lean.Compiler.LCNF.CompilerM
+public import Lean.Compiler.LCNF.PassManager
+
+namespace Lean.Compiler.LCNF
+
+/-!
+# Coalesce Reference Counting Operations
+
+This pass coalesces multiple `inc`/`dec` operations on the same variable within a basic block.
+Within a basic block, it is always safe to:
+- Move all increments on a variable to the first `inc` location (summing the counts). Because if
+  there are later `inc`s no intermediate operation can observe RC=1 (as the value must stay alive
+  until the later inc) and thus doing all relevant `inc` in the beginning doesn't change
+  semantics.
+- Move all decrements on a variable to the last `dec` location (summing the counts). Because the
+  value is guaranteed to stay alive until at least the last `dec` anyway so a similiar argument to
+  `inc` holds.
+
+Crucially this pass must be placed after `expandResetReuse` as that one relies on `inc`s still being
+present in their original location for optimization purposes.
+-/
+
+private structure State where
+  /-- Total inc count per variable in the current basic block (accumulated going forward). -/
+  incTotal : Std.HashMap FVarId Nat := {}
+  /-- Total dec count per variable in the current basic block (accumulated going forward). -/
+  decTotal : Std.HashMap FVarId Nat := {}
+  /--
+  Inc count seen so far per variable going backward. When this equals `incTotal`, we've
+  reached the first inc and should emit the coalesced operation.
+  -/
+  incAccum : Std.HashMap FVarId Nat := {}
+  /--
+  Whether we've already emitted the coalesced dec for a variable (going backward, the first
+  dec encountered is the last in the block).
+  -/
+  decPlaced : Std.HashSet FVarId := {}
+
+private abbrev M := StateRefT State CompilerM
+
+/--
+Coalesce inc/dec operations within individual basic blocks.
+-/
+partial def Code.coalesceRC (code : Code .impure) : CompilerM (Code .impure) := do
+  go code |>.run' {}
+where
+  go (code : Code .impure) : M (Code .impure) := do
+    match code with
+    | .inc fvarId n check persistent k _ =>
+      modify fun s => { s with incTotal := s.incTotal.alter fvarId (fun v? => some ((v?.getD 0) + n)) }
+      let k ← go k
+      modify fun s => { s with incAccum := s.incAccum.alter fvarId (fun v? => some ((v?.getD 0) + n)) }
+      let s ← get
+      if s.incAccum[fvarId]! == s.incTotal[fvarId]! then
+        return .inc fvarId s.incTotal[fvarId]! check persistent k
+      else
+        return k
+    | .dec fvarId n check persistent k _ =>
+      modify fun s => { s with decTotal := s.decTotal.alter fvarId (fun v? => some ((v?.getD 0) + n)) }
+      let k ← go k
+      let s ← get
+      if !s.decPlaced.contains fvarId then
+        modify fun s => { s with decPlaced := s.decPlaced.insert fvarId }
+        return .dec fvarId s.decTotal[fvarId]! check persistent k
+      else
+        return k
+    | .let _ k =>
+      let k ← go k
+      return code.updateCont! k
+    | .jp decl k =>
+      let value ← decl.value.coalesceRC
+      let decl ← decl.updateValue value
+      let k ← go k
+      return code.updateFun! decl k
+    | .cases c =>
+      let alts ← c.alts.mapMonoM (·.mapCodeM (·.coalesceRC))
+      return code.updateAlts! alts
+    | .del _ k _ =>
+      let k ← go k
+      return code.updateCont! k
+    | .oset (k := k) .. | .uset (k := k) .. | .sset (k := k) .. | .setTag (k := k) .. =>
+      let k ← go k
+      return code.updateCont! k
+    | .return .. | .jmp .. | .unreach .. => return code
+
+def Decl.coalesceRC (decl : Decl .impure) : CompilerM (Decl .impure) := do
+  let value ← decl.value.mapCodeM Code.coalesceRC
+  return { decl with value }
+
+public def coalesceRC : Pass :=
+  .mkPerDeclaration `coalesceRc .impure Decl.coalesceRC
+
+builtin_initialize
+  registerTraceClass `Compiler.coalesceRc (inherited := true)
+
+end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ElimDeadBranches.lean

@@ -291,10 +291,9 @@ builtin_initialize functionSummariesExt : SimplePersistentEnvExtension (Name ×
   registerSimplePersistentEnvExtension {
     addImportedFn := fun _ => {}
     addEntryFn := fun s ⟨e, n⟩ => s.insert e n
-    exportEntriesFnEx? := some fun _ s _ => fun
+    exportEntriesFnEx? := some fun _ s _ =>
       -- preserved for non-modules, make non-persistent at some point?
-      | .private => s.toArray.qsort decLt
-      | _ => #[]
+      { exported := #[], server := #[], «private» := s.toArray.qsort decLt }
     asyncMode := .sync  -- compilation is non-parallel anyway
     replay? := some <| SimplePersistentEnvExtension.replayOfFilter (!·.contains ·.1) (fun s ⟨e, n⟩ => s.insert e n)
   }

src/Lean/Compiler/LCNF/ExplicitRC.lean

@@ -31,9 +31,12 @@ namespace Lean.Compiler.LCNF
 open ImpureType
 
 /-!
-The following section contains the derived value analysis. It figures out a dependency tree of
+The following section contains the derived value analysis. It figures out a dependency graph of
 values that were derived from other values through projections or `Array` accesses. This information
 is later used in the derived borrow analysis to reduce reference counting pressure.
+
+When a derived value has more than one parent, it is derived from one of the parent values but we
+cannot statically determine which one.
 -/
 
 /--
@@ -41,10 +44,10 @@ Contains information about values derived through various forms of projection fr
 -/
 structure DerivedValInfo where
   /--
-  The variable this value was derived from. This is always set except for parameters as they have no
-  value to be derived from.
+  The set of variables this value may derive from. This is always set except for parameters as they
+  have no value to be derived from.
   -/
-  parent? : Option FVarId
+  parents : Array FVarId
   /--
   The set of variables that were derived from this value.
   -/
@@ -56,59 +59,85 @@ abbrev DerivedValMap := Std.HashMap FVarId DerivedValInfo
 namespace CollectDerivedValInfo
 
 structure State where
+  /--
+  The dependency graph of values.
+  -/
   varMap : DerivedValMap := {}
-  borrowedParams : FVarIdHashSet := {}
+  /--
+  The set of values that are to be interpreted as being borrowed by nature. This currently includes:
+  - borrowed parameters
+  - variables that are initialized from constants
+  -/
+  borrowedValues : FVarIdHashSet := {}
 
 abbrev M := StateRefT State CompilerM
 
 @[inline]
-def visitParam (p : Param .impure) : M Unit :=
+def addDerivedValue (parents : Array FVarId) (child : FVarId) : M Unit := do
   modify fun s => { s with
-    varMap := s.varMap.insert p.fvarId {
-      parent? := none
-      children := {}
-    }
-    borrowedParams :=
-      if p.borrow && p.type.isPossibleRef then
-        s.borrowedParams.insert p.fvarId
-      else
-        s.borrowedParams
+    varMap :=
+      let varMap := parents.foldl (init := s.varMap)
+        (·.modify · (fun info => { info with children := info.children.insert child }))
+      varMap.insert child { parents := parents, children := {} }
   }
 
 @[inline]
-def addDerivedValue (parent : FVarId) (child : FVarId) : M Unit := do
-  modify fun s => { s with
-    varMap :=
-      s.varMap
-        |>.modify parent (fun info => { info with children := info.children.insert child })
-        |>.insert child { parent? := some parent, children := {} }
-  }
+def addBorrowedValue (fvarId : FVarId) : M Unit := do
+  modify fun s => { s with borrowedValues := s.borrowedValues.insert fvarId }
 
-def removeFromParent (child : FVarId) : M Unit := do
-  if let some parent := (← get).varMap.get? child |>.bind (·.parent?) then
-    modify fun s => { s with
-      varMap := s.varMap.modify parent fun info =>
-        { info with children := info.children.erase child }
-    }
+def addDerivedLetValue (parents : Array FVarId) (child : FVarId) : M Unit := do
+  let type ← getType child
+  if !type.isPossibleRef then
+    return ()
+  let parents ← parents.filterM fun fvarId => do
+    let type ← getType fvarId
+    return type.isPossibleRef
+  addDerivedValue parents child
+  if parents.isEmpty then
+      addBorrowedValue child
+
+@[inline]
+def visitParam (p : Param .impure) : M Unit := do
+  addDerivedValue #[] p.fvarId
+  if p.borrow && p.type.isPossibleRef then
+    addBorrowedValue p.fvarId
+
+def removeFromParents (child : FVarId) : M Unit := do
+  if let some entry := (← get).varMap.get? child then
+    for parent in entry.parents do
+      modify fun s => { s with
+        varMap := s.varMap.modify parent fun info =>
+          { info with children := info.children.erase child }
+      }
 
 partial def collectCode (code : Code .impure) : M Unit := do
   match code with
   | .let decl k =>
     match decl.value with
     | .oproj _ parent =>
-      addDerivedValue parent decl.fvarId
+      addDerivedLetValue #[parent] decl.fvarId
     -- Keep in sync with PropagateBorrow, InferBorrow
     | .fap ``Array.getInternal args =>
       if let .fvar parent := args[1]! then
-        addDerivedValue parent decl.fvarId
+        addDerivedLetValue #[parent] decl.fvarId
     | .fap ``Array.get!Internal args =>
+      let mut parents := #[]
+      /-
+      Because execution may continue after a panic, the value resulting from a get!InternalBorrowed
+      may be derived from either the `Inhabited` instance or the `Array` argument.
+      -/
+      if let .fvar parent := args[1]! then
+        parents := parents.push parent
       if let .fvar parent := args[2]! then
-        addDerivedValue parent decl.fvarId
+        parents := parents.push parent
+      addDerivedLetValue parents decl.fvarId
     | .fap ``Array.uget args =>
       if let .fvar parent := args[1]! then
-        addDerivedValue parent decl.fvarId
+        addDerivedLetValue #[parent] decl.fvarId
+    | .fap _ #[] =>
+      addDerivedLetValue #[] decl.fvarId
     | .reset _ target =>
-      removeFromParent target
+      removeFromParents target
     | _ => pure ()
     collectCode k
   | .jp decl k =>
@@ -125,8 +154,8 @@ Collect the derived value tree as well as the set of parameters that take object
 -/
 def collect (ps : Array (Param .impure)) (code : Code .impure) :
     CompilerM (DerivedValMap × FVarIdHashSet) := do
-  let ⟨_, { varMap, borrowedParams }⟩ ← go |>.run {}
-  return ⟨varMap, borrowedParams⟩
+  let ⟨_, { varMap, borrowedValues }⟩ ← go |>.run {}
+  return ⟨varMap, borrowedValues⟩
 where
   go : M Unit := do
     ps.forM visitParam
@@ -170,13 +199,21 @@ def LiveVars.erase (liveVars : LiveVars) (fvarId : FVarId) : LiveVars :=
   let borrows := liveVars.borrows.erase fvarId
   { vars, borrows }
 
+@[inline]
+def LiveVars.insertBorrow (liveVars : LiveVars) (fvarId : FVarId) : LiveVars :=
+  { liveVars with borrows := liveVars.borrows.insert fvarId }
+
+@[inline]
+def LiveVars.insertLive (liveVars : LiveVars) (fvarId : FVarId) : LiveVars :=
+  { liveVars with vars := liveVars.vars.insert fvarId }
+
 abbrev JPLiveVarMap := FVarIdMap LiveVars
 
 structure Context where
   /--
-  The set of all parameters that are borrowed and take potential objects as arguments.
+  The set of all values that are borrowed and potentially objects
   -/
-  borrowedParams : FVarIdHashSet
+  borrowedValues : FVarIdHashSet
   /--
   The derived value tree.
   -/
@@ -277,18 +314,21 @@ def withCollectLiveVars (x : RcM α) : RcM (α × LiveVars) := do
   return (ret, collected)
 
 /--
-Traverse the transitive closure of values derived from `fvarId` and add them to `s` if they pass
-`shouldAdd`.
+Traverse the transitive closure of values derived from `fvarId` and add them to `s` if:
+- they pass `shouldAdd`.
+- all their parents are accessible
 -/
 @[specialize]
-partial def addDescendants (fvarId : FVarId) (derivedValMap : DerivedValMap) (s : FVarIdHashSet)
-    (shouldAdd : FVarId → Bool := fun _ => true) : FVarIdHashSet :=
+partial def addDescendants (fvarId : FVarId) (derivedValMap : DerivedValMap) (liveVars : LiveVars)
+    (shouldAdd : FVarId → Bool := fun _ => true) : LiveVars :=
   if let some info := derivedValMap.get? fvarId then
-    info.children.fold (init := s) fun s child =>
-      let s := if shouldAdd child then s.insert child else s
-      addDescendants child derivedValMap s shouldAdd
+    info.children.fold (init := liveVars) fun liveVars child =>
+      let cinfo := derivedValMap.get! child
+      let parentsOk := cinfo.parents.all fun fvarId => (liveVars.vars.contains fvarId || liveVars.borrows.contains fvarId)
+      let liveVars := if parentsOk && shouldAdd child then liveVars.insertBorrow child else liveVars
+      addDescendants child derivedValMap liveVars shouldAdd
   else
-    s
+    liveVars
 
 /--
 Mark `fvarId` as live from here on out and if there are any derived values that are not live anymore
@@ -299,20 +339,21 @@ alive after all).
 def useVar (fvarId : FVarId) (shouldBorrow : FVarId → Bool := fun _ => true) : RcM Unit := do
   if !(← isLive fvarId) then
     let derivedValMap := (← read).derivedValMap
+    modifyLive fun liveVars => { liveVars with vars := liveVars.vars.insert fvarId }
     modifyLive fun liveVars =>
-      { liveVars with
-          borrows := addDescendants fvarId derivedValMap liveVars.borrows fun y =>
-            !liveVars.vars.contains y && shouldBorrow y
-          vars := liveVars.vars.insert fvarId
-      }
+      addDescendants fvarId derivedValMap liveVars fun y =>
+        !liveVars.vars.contains y && shouldBorrow y
 
 def useArgs (args : Array (Arg .impure)) : RcM Unit := do
   args.forM fun arg =>
     match arg with
     | .fvar fvarId =>
       useVar fvarId fun y =>
-        -- If a value is used as an argument we are going to mark it live anyways so don't mark it
-        -- as borrowed.
+        /-
+        If we are in a situation like `f x y` where `x` would imply that `y` remains borrowed we are
+        going to mark `y` as being live instead of borrowed later on anyways. Instead we skip this
+        intermediate state and don't even begin to consider it as borrowed.
+        -/
         args.all fun arg =>
           match arg with
           | .fvar z => y != z
@@ -341,9 +382,9 @@ def setRetLiveVars : RcM Unit := do
   let derivedValMap := (← read).derivedValMap
   -- At the end of a function no values are live and all borrows derived from parameters will still
   -- be around.
-  let borrows := (← read).borrowedParams.fold (init := {}) fun borrows x =>
-    addDescendants x derivedValMap (borrows.insert x)
-  modifyLive fun _ => { vars := {}, borrows }
+  let liveVars := (← read).borrowedValues.fold (init := {}) fun liveVars x =>
+    addDescendants x derivedValMap (liveVars.insertBorrow x)
+  modifyLive (fun _ => liveVars)
 
 @[inline]
 def addInc (fvarId : FVarId) (k : Code .impure) (n : Nat := 1) : RcM (Code .impure) := do
@@ -625,9 +666,9 @@ partial def Code.explicitRc (code : Code .impure) : RcM (Code .impure) := do
 def Decl.explicitRc (decl : Decl .impure) :
     CompilerM (Decl .impure) := do
   let value ← decl.value.mapCodeM fun code => do
-    let ⟨derivedValMap, borrowedParams⟩ ← CollectDerivedValInfo.collect decl.params code
+    let ⟨derivedValMap, borrowedValues⟩ ← CollectDerivedValInfo.collect decl.params code
     go code |>.run {
-      borrowedParams,
+      borrowedValues,
       derivedValMap,
     } |>.run' {}
   return { decl with value }

src/Lean/Compiler/LCNF/InferBorrow.lean

@@ -375,7 +375,6 @@ where
     match v with
     | .reset _ x => ownFVar z (.resetReuse z); ownFVar x (.resetReuse z)
     | .reuse x _ _ args => ownFVar z (.resetReuse z); ownFVar x (.resetReuse z); ownArgsIfParam z args
-    | .ctor _ args => ownFVar z (.constructorResult z); ownArgsIfParam z args
     | .oproj _ x _ =>
       if ← isOwned x then ownFVar z (.forwardProjectionProp z)
       if ← isOwned z then ownFVar x (.backwardProjectionProp z)
@@ -384,6 +383,8 @@ where
       if let .fvar parent := args[1]! then
         if ← isOwned parent then ownFVar z (.forwardProjectionProp z)
     | .fap ``Array.get!Internal args =>
+      if let .fvar parent := args[1]! then
+        if ← isOwned parent then ownFVar z (.forwardProjectionProp z)
       if let .fvar parent := args[2]! then
         if ← isOwned parent then ownFVar z (.forwardProjectionProp z)
     | .fap ``Array.uget args =>
@@ -396,6 +397,9 @@ where
         let ps ← getParamInfo (.decl f)
         ownFVar z (.functionCallResult z)
         ownArgsUsingParams args ps (.functionCallArg z)
+    | .ctor i args =>
+      if !i.isScalar then
+        ownFVar z (.constructorResult z); ownArgsIfParam z args
     | .fvar x args =>
       ownFVar z (.functionCallResult z); ownFVar x (.fvarCall z); ownArgs (.fvarCall z) args
     | .pap _ args => ownFVar z (.functionCallResult z); ownArgs (.partialApplication z) args

src/Lean/Compiler/LCNF/Main.lean

@@ -96,9 +96,9 @@ builtin_initialize postponedCompileDeclsExt : SimplePersistentEnvExtension Postp
     asyncMode     := .sync
     replay?       := some <| SimplePersistentEnvExtension.replayOfFilter
       (fun s e => !e.declNames.any s.contains) (fun s e => e.declNames.foldl (·.insert · e) s)
-    exportEntriesFnEx? := some fun _ _ es lvl =>
+    exportEntriesFnEx? := some fun _ _ es =>
       -- `leanir` imports the target module privately
-      if lvl == .private then es.toArray else #[]
+      { exported := #[], server := #[], «private» := es.toArray }
   }
 
 def resumeCompilation (declName : Name) : CoreM Unit := do

src/Lean/Compiler/LCNF/Passes.lean

@@ -26,6 +26,7 @@ public import Lean.Compiler.LCNF.SimpCase
 public import Lean.Compiler.LCNF.InferBorrow
 public import Lean.Compiler.LCNF.ExplicitBoxing
 public import Lean.Compiler.LCNF.ExplicitRC
+public import Lean.Compiler.LCNF.CoalesceRC
 public import Lean.Compiler.LCNF.Toposort
 public import Lean.Compiler.LCNF.ExpandResetReuse
 public import Lean.Compiler.LCNF.SimpleGroundExpr
@@ -149,6 +150,7 @@ def builtinPassManager : PassManager := {
     explicitBoxing,
     explicitRc,
     expandResetReuse,
+    coalesceRC,
     pushProj (occurrence := 1),
     detectSimpleGround,
     inferVisibility (phase := .impure),

src/Lean/Compiler/LCNF/PhaseExt.lean

@@ -93,16 +93,15 @@ def mkDeclExt (phase : Phase) (name : Name := by exact decl_name%) :
     mkInitial := pure {},
     addImportedFn := fun _ => pure {},
     addEntryFn := fun s decl => s.insert decl.name decl
-    exportEntriesFnEx env s level := Id.run do
-      let mut entries := sortedEntries s declLt
-      if level != .private then
-        entries := entries.filterMap fun decl => do
-          guard <| isDeclPublic env decl.name
-          if isDeclTransparent env phase decl.name then
-            some decl
-          else
-            some { decl with value := .extern { entries := [.opaque] } }
-      return entries
+    exportEntriesFnEx env s := Id.run do
+      let all := sortedEntries s declLt
+      let exported := all.filterMap fun decl => do
+        guard <| isDeclPublic env decl.name
+        if isDeclTransparent env phase decl.name then
+          some decl
+        else
+          some { decl with value := .extern { entries := [.opaque] } }
+      return { exported, server := exported, «private» := all }
     statsFn := statsFn,
     asyncMode := .sync,
     replay? := some (replayFn phase)
@@ -138,13 +137,12 @@ def mkSigDeclExt (phase : Phase) (name : Name := by exact decl_name%) :
     mkInitial := pure {},
     addImportedFn := fun _ => pure {},
     addEntryFn := fun s sig => s.insert sig.name sig
-    exportEntriesFnEx env s level := Id.run do
-      let mut entries := sortedEntries s sigLt
-      if level != .private then
-        entries := entries.filterMap fun sig => do
-          guard <| isDeclPublic env sig.name
-          some sig
-      return entries
+    exportEntriesFnEx env s := Id.run do
+      let all := sortedEntries s sigLt
+      let exported := all.filterMap fun sig => do
+        guard <| isDeclPublic env sig.name
+        some sig
+      return { exported, server := exported, «private» := all }
     statsFn := statsFn,
     asyncMode := .sync,
     replay? := some (replayFn phase)

src/Lean/Compiler/LCNF/PropagateBorrow.lean

@@ -114,6 +114,9 @@ where
         let parentVal ← getOwnedness parent
         join z parentVal
     | .fap ``Array.get!Internal args =>
+      if let .fvar parent := args[1]! then
+        let parentVal ← getOwnedness parent
+        join z parentVal
       if let .fvar parent := args[2]! then
         let parentVal ← getOwnedness parent
         join z parentVal
@@ -124,7 +127,10 @@ where
     | .fap _ args =>
       let value := if args.isEmpty then .borrow else .own
       join z value
-    | .ctor .. | .fvar .. | .pap .. | .sproj .. | .uproj .. | .erased .. | .lit .. =>
+    | .ctor i _ =>
+      let value := if i.isScalar then .borrow else .own
+      join z value
+    | .fvar .. | .pap .. | .sproj .. | .uproj .. | .erased .. | .lit .. =>
       join z .own
     | _ => unreachable!
 

src/Lean/Compiler/LCNF/SimpleGroundExpr.lean

@@ -178,10 +178,11 @@ partial def compileToSimpleGroundExpr (code : Code .impure) : CompilerM (Option
 where
   go (code : Code .impure) : DetectM SimpleGroundExpr := do
     match code with
-    | .let decl (.return fvarId) =>
+    | .let decl (.return fvarId) | .let decl (.inc _ _ _ true  (.return fvarId)) =>
       guard <| decl.fvarId == fvarId
       compileFinalLet decl.value
     | .let decl k => compileNonFinalLet decl k
+    | .inc (persistent := true) (k := k) .. => go k
     | _ => failure
 
   @[inline]

src/Lean/Compiler/LCNF/SpecInfo.lean

@@ -20,8 +20,10 @@ inductive SpecParamInfo where
   /--
   A parameter that is an type class instance (or an arrow that produces a type class instance),
   and is fixed in recursive declarations. By default, Lean always specializes this kind of argument.
+  If the `weak` parameter is set we only specialize for this parameter iff another parameter causes
+  specialization as well.
   -/
-  | fixedInst
+  | fixedInst (weak : Bool)
   /--
   A parameter that is a function and is fixed in recursive declarations. If the user tags a declaration
   with `@[specialize]` without specifying which arguments should be specialized, Lean will specialize
@@ -49,14 +51,15 @@ namespace SpecParamInfo
 
 @[inline]
 def causesSpecialization : SpecParamInfo → Bool
-  | .fixedInst | .fixedHO | .user => true
-  | .fixedNeutral | .other => false
+  | .fixedInst false | .fixedHO | .user => true
+  | .fixedInst true | .fixedNeutral | .other => false
 
 end SpecParamInfo
 
 instance : ToMessageData SpecParamInfo where
   toMessageData
-    | .fixedInst => "I"
+    | .fixedInst false => "I"
+    | .fixedInst true => "W"
     | .fixedHO => "H"
     | .fixedNeutral => "N"
     | .user => "U"
@@ -130,6 +133,18 @@ private def isNoSpecType (env : Environment) (type : Expr) : Bool :=
     else
       false
 
+/--
+Return `true` if `type` is a type tagged with `@[weak_specialize]` or an arrow that produces this kind of type.
+-/
+private def isWeakSpecType (env : Environment) (type : Expr) : Bool :=
+  match type with
+  | .forallE _ _ b _ => isWeakSpecType env b
+  | _ =>
+    if let .const declName _ := type.getAppFn then
+      hasWeakSpecializeAttribute env declName
+    else
+      false
+
 /-!
 *Note*: `fixedNeutral` must have forward dependencies.
 
@@ -160,7 +175,7 @@ See comment at `.fixedNeutral`.
 private def hasFwdDeps (decl : Decl .pure) (paramsInfo : Array SpecParamInfo) (j : Nat) : Bool := Id.run do
   let param := decl.params[j]!
   for h : k in (j+1)...decl.params.size do
-    if paramsInfo[k]!.causesSpecialization then
+    if paramsInfo[k]!.causesSpecialization || paramsInfo[k]! matches .fixedInst .. then
       let param' := decl.params[k]
       if param'.type.containsFVar param.fvarId then
         return true
@@ -199,7 +214,7 @@ def computeSpecEntries (decls : Array (Decl .pure)) (autoSpecialize : Name → O
           else if isTypeFormerType param.type then
             pure .fixedNeutral
           else if (← isArrowClass? param.type).isSome then
-            pure .fixedInst
+            pure (.fixedInst (weak := isWeakSpecType (← getEnv) param.type))
           /-
           Recall that if `specArgs? == some #[]`, then user annotated function with `@[specialize]`, but did not
           specify which arguments must be specialized besides instances. In this case, we try to specialize

src/Lean/Compiler/LCNF/Specialize.lean

@@ -31,11 +31,8 @@ builtin_initialize specCacheExt : SimplePersistentEnvExtension CacheEntry Cache
   registerSimplePersistentEnvExtension {
     addEntryFn    := addEntry
     addImportedFn := fun es => (mkStateFromImportedEntries addEntry {} es).switch
-    exportEntriesFnEx? := some fun _ _ entries level =>
-      if level == .private then
-        entries.toArray
-      else
-        #[]
+    exportEntriesFnEx? := some fun _ _ entries =>
+      { exported := #[], server := #[], «private» := entries.toArray }
     asyncMode     := .sync
     replay?       := some <| SimplePersistentEnvExtension.replayOfFilter
       (!·.contains ·.key) addEntry
@@ -209,7 +206,7 @@ def collect (paramsInfo : Array SpecParamInfo) (args : Array (Arg .pure)) :
       match paramInfo with
       | .other =>
         argMask := argMask.push none
-      | .fixedNeutral | .user | .fixedInst | .fixedHO =>
+      | .fixedNeutral | .user | .fixedInst .. | .fixedHO =>
         argMask := argMask.push (some arg)
         Closure.collectArg arg
     return argMask
@@ -257,7 +254,8 @@ def shouldSpecialize (specEntry : SpecEntry) (args : Array (Arg .pure)) : Specia
     match paramInfo with
     | .other => pure ()
     | .fixedNeutral => pure () -- If we want to monomorphize types such as `Array`, we need to change here
-    | .fixedInst | .user => if ← isGround arg then return true
+    | .fixedInst true => pure ()  -- weak: don't trigger specialization on its own
+    | .fixedInst false | .user => if ← isGround arg then return true
     | .fixedHO => if ← hoCheck arg then return true
 
   return false
@@ -509,7 +507,7 @@ def updateLocalSpecParamInfo : SpecializeM Unit := do
   for entry in infos do
     if let some mask := (← get).parentMasks[entry.declName]? then
       let maskInfo info :=
-        mask.zipWith info (f := fun b i => if !b && i.causesSpecialization then .other else i)
+        mask.zipWith info (f := fun b i => if !b && (i.causesSpecialization || i matches .fixedInst ..) then .other else i)
       let entry := { entry with paramsInfo := maskInfo entry.paramsInfo }
       modify fun s => {
         s with

src/Lean/Compiler/MetaAttr.lean

@@ -39,11 +39,9 @@ private builtin_initialize declMetaExt : SimplePersistentEnvExtension Name NameS
     addEntryFn := fun s n => s.insert n
     asyncMode := .sync
     replay? := some <| SimplePersistentEnvExtension.replayOfFilter (!·.contains ·) (·.insert ·)
-    exportEntriesFnEx? := some fun env s entries => fun
-      | .private =>
-        let decls := entries.foldl (init := #[]) fun decls decl => decls.push decl
-        decls.qsort Name.quickLt
-      | _ => #[]
+    exportEntriesFnEx? := some fun env s entries =>
+      let decls := entries.foldl (init := #[]) fun decls decl => decls.push decl
+      { exported := #[], server := #[], «private» := decls.qsort Name.quickLt }
   }
 
 /-- Whether a declaration should be exported for interpretation. -/

src/Lean/Compiler/Specialize.lean

@@ -24,6 +24,17 @@ Marks a definition to never be specialized during code generation.
 builtin_initialize nospecializeAttr : TagAttribute ←
   registerTagAttribute `nospecialize "mark definition to never be specialized"
 
+/--
+Marks a type for weak specialization: Parameters of this type are only specialized when
+another argument already triggers specialization. Unlike `@[nospecialize]`, if specialization
+happens for other reasons, parameters of this type will participate in the specialization
+rather than being ignored.
+-/
+@[builtin_doc]
+builtin_initialize weakSpecializeAttr : TagAttribute ←
+  registerTagAttribute `weak_specialize
+    "mark type for weak specialization: instances are only specialized when another argument already triggers specialization"
+
 private def elabSpecArgs (declName : Name) (args : Array Syntax) : MetaM (Array Nat) := do
   if args.isEmpty then return #[]
   let info ← getConstInfo declName
@@ -82,4 +93,7 @@ def hasSpecializeAttribute (env : Environment) (declName : Name) : Bool :=
 def hasNospecializeAttribute (env : Environment) (declName : Name) : Bool :=
   nospecializeAttr.hasTag env declName
 
+def hasWeakSpecializeAttribute (env : Environment) (declName : Name) : Bool :=
+  weakSpecializeAttr.hasTag env declName
+
 end Lean.Compiler

src/Lean/DeclarationRange.lean

@@ -18,10 +18,9 @@ namespace Lean
 
 builtin_initialize builtinDeclRanges : IO.Ref (NameMap DeclarationRanges) ← IO.mkRef {}
 builtin_initialize declRangeExt : MapDeclarationExtension DeclarationRanges ←
-  mkMapDeclarationExtension (exportEntriesFn := fun _ s level =>
-    if level < .server then
-      #[]
-    else s.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun _ s =>
+    let ents := s.toArray
+    { exported := #[], server := ents, «private» := ents })
 
 def addBuiltinDeclarationRanges (declName : Name) (declRanges : DeclarationRanges) : IO Unit :=
   builtinDeclRanges.modify (·.insert declName declRanges)

src/Lean/DocString/Extension.lean

@@ -78,27 +78,21 @@ private builtin_initialize builtinDocStrings : IO.Ref (NameMap String) ← IO.mk
 builtin_initialize docStringExt : MapDeclarationExtension String ←
   mkMapDeclarationExtension
     (asyncMode := .async .asyncEnv)
-    (exportEntriesFn := fun _ s level =>
-      if level < .server then
-        {}
-      else
-        s.toArray)
+    (exportEntriesFn := fun _ s =>
+      let ents := s.toArray
+      { exported := #[], server := ents, «private» := ents })
 private builtin_initialize inheritDocStringExt : MapDeclarationExtension Name ←
-  mkMapDeclarationExtension (exportEntriesFn := fun _ s level =>
-    if level < .server then
-      {}
-    else
-      s.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun _ s =>
+    let ents := s.toArray
+    { exported := #[], server := ents, «private» := ents })
 
 private builtin_initialize builtinVersoDocStrings : IO.Ref (NameMap VersoDocString) ← IO.mkRef {}
 builtin_initialize versoDocStringExt : MapDeclarationExtension VersoDocString ←
   mkMapDeclarationExtension
     (asyncMode := .async .asyncEnv)
-    (exportEntriesFn := fun _ s level =>
-      if level < .server then
-        {}
-      else
-        s.toArray)
+    (exportEntriesFn := fun _ s =>
+      let ents := s.toArray
+      { exported := #[], server := ents, «private» := ents })
 
 /--
 Adds a builtin docstring to the compiler.
@@ -196,11 +190,9 @@ private builtin_initialize moduleDocExt :
     SimplePersistentEnvExtension ModuleDoc (PersistentArray ModuleDoc) ← registerSimplePersistentEnvExtension {
   addImportedFn := fun _ => {}
   addEntryFn    := fun s e => s.push e
-  exportEntriesFnEx? := some fun _ _ es level =>
-    if level < .server then
-      #[]
-    else
-      es.toArray
+  exportEntriesFnEx? := some fun _ _ es =>
+    let ents := es.toArray
+    { exported := #[], server := ents, «private» := ents }
 }
 
 def addMainModuleDoc (env : Environment) (doc : ModuleDoc) : Environment :=
@@ -407,11 +399,9 @@ private builtin_initialize versoModuleDocExt :
     SimplePersistentEnvExtension VersoModuleDocs.Snippet VersoModuleDocs ← registerSimplePersistentEnvExtension {
   addImportedFn := fun _ => {}
   addEntryFn    := fun s e => s.add! e
-  exportEntriesFnEx? := some fun _ _ es level =>
-    if level < .server then
-      #[]
-    else
-      es.toArray
+  exportEntriesFnEx? := some fun _ _ es =>
+    let ents := es.toArray
+    { exported := #[], server := ents, «private» := ents }
 }
 
 

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

@@ -26,9 +26,11 @@ public structure EqnInfo where
   deriving Inhabited
 
 public builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ←
-  mkMapDeclarationExtension (exportEntriesFn := fun env s _ =>
-    -- Do not export for non-exposed defs
-    s.filter (fun n _ => env.find? n |>.any (·.hasValue)) |>.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun env s =>
+    let all := s.toArray
+    -- Do not export for non-exposed defs at exported/server levels
+    let exported := s.filter (fun n _ => (env.setExporting true).find? n |>.any (·.hasValue)) |>.toArray
+    { exported, server := exported, «private» := all })
 
 public def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name)
     (fixedParamPerms : FixedParamPerms) (fixpointType : Array PartialFixpointType): MetaM Unit := do

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

@@ -148,9 +148,11 @@ where
             throwError "no progress at goal\n{MessageData.ofGoal mvarId}"
 
 public builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ←
-  mkMapDeclarationExtension (exportEntriesFn := fun env s _ =>
-    -- Do not export for non-exposed defs
-    s.filter (fun n _ => env.find? n |>.any (·.hasValue)) |>.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun env s =>
+    let all := s.toArray
+    -- Do not export for non-exposed defs at exported/server levels
+    let exported := s.filter (fun n _ => (env.setExporting true).find? n |>.any (·.hasValue)) |>.toArray
+    { exported, server := exported, «private» := all })
 
 public def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat)
     (fixedParamPerms : FixedParamPerms) : CoreM Unit := do

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

@@ -24,9 +24,11 @@ public structure EqnInfo where
   deriving Inhabited
 
 public builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ←
-  mkMapDeclarationExtension (exportEntriesFn := fun env s _ =>
-    -- Do not export for non-exposed defs
-    s.filter (fun n _ => env.find? n |>.any (·.hasValue)) |>.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun env s =>
+    let all := s.toArray
+    -- Do not export for non-exposed defs at exported/server levels
+    let exported := s.filter (fun n _ => (env.setExporting true).find? n |>.any (·.hasValue)) |>.toArray
+    { exported, server := exported, «private» := all })
 
 public def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedParamPerms : FixedParamPerms)
     (argsPacker : ArgsPacker) : MetaM Unit := do

src/Lean/Elab/Print.lean

@@ -243,10 +243,6 @@ private def printAxiomsOf (constName : Name) : CommandElabM Unit := do
 
 @[builtin_command_elab «printAxioms»] def elabPrintAxioms : CommandElab
   | `(#print%$tk axioms $id) => withRef tk do
-    if (← getEnv).header.isModule then
-      throwError "cannot use `#print axioms` in a `module`; consider temporarily removing the \
-        `module` header or placing the command in a separate file"
-
     let cs ← liftCoreM <| realizeGlobalConstWithInfos id
     cs.forM printAxiomsOf
   | _ => throwUnsupportedSyntax

src/Lean/Elab/RecommendedSpelling.lean

@@ -31,7 +31,7 @@ open Lean.Parser.Command
 def allRecommendedSpellings : MetaM (Array RecommendedSpelling) := do
   let all := recommendedSpellingExt.toEnvExtension.getState (← getEnv)
       |>.importedEntries
-      |>.push (recommendedSpellingExt.exportEntriesFn (← getEnv) (recommendedSpellingExt.getState (← getEnv)) .exported)
+      |>.push ((recommendedSpellingExt.exportEntriesFn (← getEnv) (recommendedSpellingExt.getState (← getEnv))).exported)
   return all.flatMap id
 
 end Lean.Elab.Term.Doc

src/Lean/Elab/Tactic/Do/Attr.lean

@@ -256,15 +256,15 @@ Marks a type as an invariant type for the `mvcgen` tactic.
 Goals whose type is an application of a tagged type will be classified
 as invariants rather than verification conditions.
 -/
-builtin_initialize mvcgenInvariantAttr : TagAttribute ←
-  registerTagAttribute `mvcgen_invariant_type
+builtin_initialize specInvariantAttr : TagAttribute ←
+  registerTagAttribute `spec_invariant_type
     "marks a type as an invariant type for the `mvcgen` tactic"
 
 /--
-Returns `true` if `ty` is an application of a type tagged with `@[mvcgen_invariant_type]`.
+Returns `true` if `ty` is an application of a type tagged with `@[spec_invariant_type]`.
 -/
-def isMVCGenInvariantType (env : Environment) (ty : Expr) : Bool :=
+def isSpecInvariantType (env : Environment) (ty : Expr) : Bool :=
   if let .const name .. := ty.getAppFn then
-    mvcgenInvariantAttr.hasTag env name
+    specInvariantAttr.hasTag env name
   else
     false

src/Lean/Elab/Tactic/Do/Spec.lean

@@ -75,7 +75,7 @@ def elabSpec (stx? : Option (TSyntax `term)) (wp : Expr) : TacticM SpecTheorem :
   | none => findSpec (← getSpecTheorems) wp
   | some stx => elabTermIntoSpecTheorem stx expectedTy
 
-variable {n} [Monad n] [MonadControlT MetaM n] [MonadLiftT MetaM n]
+variable {n} [Monad n] [MonadControlT MetaM n] [MonadLiftT MetaM n] [MonadEnv n]
 
 private def mkProj' (n : Name) (i : Nat) (Q : Expr) : MetaM Expr := do
   return (← projectCore? Q i).getD (mkProj n i Q)
@@ -181,11 +181,12 @@ public def mSpec (goal : MGoal) (elabSpecAtWP : Expr → n SpecTheorem) (goalTag
   -- Instantiation creates `.natural` MVars, which possibly get instantiated by the def eq checks
   -- below when they occur in `P` or `Q`.
   -- That's good for many such as MVars ("schematic variables"), but problematic for MVars
-  -- corresponding to `Invariant`s, which should end up as user goals.
-  -- To prevent accidental instantiation, we mark all `Invariant` MVars as synthetic opaque.
+  -- corresponding to invariant types, which should end up as user goals.
+  -- To prevent accidental instantiation, we mark all invariant MVars as synthetic opaque.
+  let env ← getEnv
   for mvar in mvars do
     let ty ← mvar.mvarId!.getType
-    if ty.isAppOf ``Invariant then mvar.mvarId!.setKind .syntheticOpaque
+    if isSpecInvariantType env ty then mvar.mvarId!.setKind .syntheticOpaque
 
   -- Apply the spec to the excess arguments of the `wp⟦e⟧ Q` application
   let T := goal.target.consumeMData

src/Lean/Elab/Tactic/Do/VCGen.lean

@@ -364,7 +364,7 @@ def elabInvariants (stx : Syntax) (invariants : Array MVarId) (suggestInvariant
     for h : n in 0...alts.size do
       let alt := alts[n]
       match alt with
-      | `(goalDotAlt| · $rhs) =>
+      | `(invariantDotAlt| · $rhs) =>
         if dotOrCase matches .false then
           logErrorAt alt m!"Alternation between labelled and bulleted invariants is not supported."
           break
@@ -374,7 +374,7 @@ def elabInvariants (stx : Syntax) (invariants : Array MVarId) (suggestInvariant
           continue
         withRef rhs do
         discard <| evalTacticAt (← `(tactic| exact $rhs)) mv
-      | `(goalCaseAlt| | $tag $args* => $rhs) =>
+      | `(invariantCaseAlt| | $tag $args* => $rhs) =>
         if dotOrCase matches .true then
           logErrorAt alt m!"Alternation between labelled and bulleted invariants is not supported."
           break
@@ -391,7 +391,7 @@ def elabInvariants (stx : Syntax) (invariants : Array MVarId) (suggestInvariant
           continue
         withRef rhs do
         discard <| evalTacticAt (← `(tactic| rename_i $args*; exact $rhs)) mv
-      | _ => logErrorAt alt m!"Expected `goalDotAlt`, got {alt}"
+      | _ => logErrorAt alt m!"Expected `invariantDotAlt`, got {alt}"
 
     if let `(invariantsKW| invariants) := invariantsKW then
       if alts.size < invariants.size then
@@ -405,7 +405,7 @@ def elabInvariants (stx : Syntax) (invariants : Array MVarId) (suggestInvariant
         if ← mv.isAssigned then
           continue
         let invariant ← suggestInvariant mv
-        suggestions := suggestions.push (← `(goalDotAlt| · $invariant))
+        suggestions := suggestions.push (← `(invariantDotAlt| · $invariant))
       let alts' := alts ++ suggestions
       let stx' ← `(invariantAlts|invariants $alts'*)
       if suggestions.size > 0 then

src/Lean/Elab/Tactic/Do/VCGen/Basic.lean

@@ -104,7 +104,7 @@ def addSubGoalAsVC (goal : MVarId) : VCGenM PUnit := do
   -- VC to the user as-is, without abstracting any variables in the local context.
   -- This only makes sense for synthetic opaque metavariables.
   goal.setKind .syntheticOpaque
-  if isMVCGenInvariantType (← getEnv) ty then
+  if isSpecInvariantType (← getEnv) ty then
     modify fun s => { s with invariants := s.invariants.push goal }
   else
     modify fun s => { s with vcs := s.vcs.push goal }

src/Lean/Elab/Tactic/Doc.lean

@@ -52,7 +52,7 @@ def firstTacticTokens [Monad m] [MonadEnv m] : m (NameMap String) := do
   let mut firstTokens : NameMap String :=
     tacticNameExt.toEnvExtension.getState env
       |>.importedEntries
-      |>.push (tacticNameExt.exportEntriesFn env (tacticNameExt.getState env) .exported)
+      |>.push ((tacticNameExt.exportEntriesFn env (tacticNameExt.getState env)).exported)
       |>.foldl (init := {}) fun names inMods =>
         inMods.foldl (init := names) fun names (k, n) =>
           names.insert k n
@@ -108,7 +108,7 @@ Displays all available tactic tags, with documentation.
 @[builtin_command_elab printTacTags] def elabPrintTacTags : CommandElab := fun _stx => do
   let all :=
     tacticTagExt.toEnvExtension.getState (← getEnv)
-      |>.importedEntries |>.push (tacticTagExt.exportEntriesFn (← getEnv) (tacticTagExt.getState (← getEnv)) .exported)
+      |>.importedEntries |>.push ((tacticTagExt.exportEntriesFn (← getEnv) (tacticTagExt.getState (← getEnv))).exported)
   let mut mapping : NameMap NameSet := {}
   for arr in all do
     for (tac, tag) in arr do
@@ -160,7 +160,7 @@ def allTacticDocs (includeUnnamed : Bool := true) : MetaM (Array TacticDoc) := d
   let env ← getEnv
   let allTags :=
     tacticTagExt.toEnvExtension.getState env |>.importedEntries
-      |>.push (tacticTagExt.exportEntriesFn env (tacticTagExt.getState env) .exported)
+      |>.push ((tacticTagExt.exportEntriesFn env (tacticTagExt.getState env)).exported)
   let mut tacTags : NameMap NameSet := {}
   for arr in allTags do
     for (tac, tag) in arr do

src/Lean/EnvExtension.lean

@@ -26,7 +26,7 @@ structure SimplePersistentEnvExtensionDescr (α σ : Type) where
   addImportedFn : Array (Array α) → σ
   toArrayFn     : List α → Array α := fun es => es.toArray
   exportEntriesFnEx? :
-    Option (Environment → σ → List α → OLeanLevel → Array α) := none
+    Option (Environment → σ → List α → OLeanEntries (Array α)) := none
   asyncMode     : EnvExtension.AsyncMode := .mainOnly
   replay?       : Option ((newEntries : List α) → (newState : σ) → σ → List α × σ) := none
 
@@ -48,9 +48,9 @@ def registerSimplePersistentEnvExtension {α σ : Type} [Inhabited σ] (descr :
     addImportedFn   := fun as => pure ([], descr.addImportedFn as),
     addEntryFn      := fun s e => match s with
       | (entries, s) => (e::entries, descr.addEntryFn s e),
-    exportEntriesFnEx env s level := match descr.exportEntriesFnEx? with
-      | some fn => fn env s.2 s.1.reverse level
-      | none    => descr.toArrayFn s.1.reverse
+    exportEntriesFnEx env s := match descr.exportEntriesFnEx? with
+      | some fn => fn env s.2 s.1.reverse
+      | none    => .uniform (descr.toArrayFn s.1.reverse)
     statsFn := fun s => format "number of local entries: " ++ format s.1.length
     asyncMode := descr.asyncMode
     replay? := descr.replay?.map fun replay oldState newState _ (entries, s) =>
@@ -131,16 +131,18 @@ deriving Inhabited
 
 def mkMapDeclarationExtension (name : Name := by exact decl_name%)
     (asyncMode : EnvExtension.AsyncMode := .async .mainEnv)
-    (exportEntriesFn : Environment → NameMap α → OLeanLevel → Array (Name × α) :=
+    (exportEntriesFn : Environment → NameMap α → OLeanEntries (Array (Name × α)) :=
       -- Do not export info for private defs by default
-      fun env s _ => s.toArray.filter (fun (n, _) => env.contains (skipRealize := false) n)) :
+      fun env s =>
+        let all := s.toArray.filter (fun (n, _) => env.contains (skipRealize := false) n)
+        .uniform all) :
     IO (MapDeclarationExtension α) :=
   .mk <$> registerPersistentEnvExtension {
     name            := name,
     mkInitial       := pure {}
     addImportedFn   := fun _ => pure {}
     addEntryFn      := fun s (n, v) => s.insert n v
-    exportEntriesFnEx env s level := exportEntriesFn env s level
+    exportEntriesFnEx env s := exportEntriesFn env s
     asyncMode
     replay?         := some fun _ newState newConsts s =>
       newConsts.foldl (init := s) fun s c =>

src/Lean/Environment.lean

@@ -1540,6 +1540,23 @@ deriving DecidableEq, Ord, Repr
 instance : LE OLeanLevel := leOfOrd
 instance : LT OLeanLevel := ltOfOrd
 
+/-- Data computed once per extension for all three olean levels. Avoids calling the export function
+    three separate times so that expensive computations can be shared. -/
+structure OLeanEntries (α : Type) where
+  exported : α
+  server   : α
+  «private» : α
+  deriving Inhabited
+
+/-- Create `OLeanEntries` with the same value for all levels. -/
+def OLeanEntries.uniform (a : α) : OLeanEntries α := ⟨a, a, a⟩
+
+/-- Look up the entry for a given level. -/
+def OLeanEntries.get (e : OLeanEntries α) : OLeanLevel → α
+  | .exported => e.exported
+  | .server   => e.server
+  | .private  => e.private
+
 /--
 An environment extension with support for storing/retrieving entries from a .olean file.
  - α is the type of the entries that are stored in .olean files.
@@ -1591,16 +1608,17 @@ structure PersistentEnvExtension (α : Type) (β : Type) (σ : Type) where
   addImportedFn   : Array (Array α) → ImportM σ
   addEntryFn      : σ → β → σ
   /--
-  Function to transform state into data that should be imported into other modules. When using the
+  Function to transform state into data that should be imported into other modules. Returns entries
+  for all three olean levels at once so that expensive computations can be shared. When using the
   module system without `import all`, `OLeanLevel.exported` is imported, else `OLeanLevel.private`.
   Additionally, when using the module system in the language server, the `OLeanLevel.server` data is
   accessible via `getModuleEntries (level := .server)`. By convention, each level should include all
   data of previous levels.
 
-  This function is run after elaborating the file and joining all asynchronous threads. It is run
-  once for each level when the module system is enabled, otherwise once for `private`.
+  This function is run once after elaborating the file and joining all asynchronous threads.
+  For non-module files, only the `private` field is used.
   -/
-  exportEntriesFn : Environment → σ → OLeanLevel → Array α
+  exportEntriesFn : Environment → σ → OLeanEntries (Array α)
   statsFn         : σ → Format
 
 instance {α σ} [Inhabited σ] : Inhabited (PersistentEnvExtensionState α σ) :=
@@ -1612,7 +1630,7 @@ instance {α β σ} [Inhabited σ] : Inhabited (PersistentEnvExtension α β σ)
      name := default,
      addImportedFn := fun _ => default,
      addEntryFn := fun s _ => s,
-     exportEntriesFn := fun _ _ _ => #[],
+     exportEntriesFn := fun _ _ => .uniform #[],
      statsFn := fun _ => Format.nil
   }
 
@@ -1668,7 +1686,7 @@ structure PersistentEnvExtensionDescrCore (α β σ : Type) where
   mkInitial         : IO σ
   addImportedFn     : Array (Array α) → ImportM σ
   addEntryFn        : σ → β → σ
-  exportEntriesFnEx : Environment → σ → OLeanLevel → Array α
+  exportEntriesFnEx : Environment → σ → OLeanEntries (Array α)
   statsFn           : σ → Format := fun _ => Format.nil
   asyncMode         : EnvExtension.AsyncMode := .mainOnly
   replay?           : Option (ReplayFn σ) := none
@@ -1687,11 +1705,11 @@ def useDefaultIfOtherFieldGiven (default : α) (_otherField : β) : α :=
 structure PersistentEnvExtensionDescr (α β σ : Type) extends PersistentEnvExtensionDescrCore α β σ where
   -- The cyclic default values force the user to specify at least one of the two following fields.
   /--
-  Obsolete simpler version of `exportEntriesFnEx`. Its value is ignored if the latter is also
-  specified.
+  Obsolete simpler version of `exportEntriesFnEx` that returns the same entries for all levels.
+  Its value is ignored if the latter is also specified.
   -/
   exportEntriesFn : σ → Array α := useDefaultIfOtherFieldGiven (fun _ => #[]) exportEntriesFnEx
-  exportEntriesFnEx := fun _ s _ => exportEntriesFn s
+  exportEntriesFnEx := fun _ s => .uniform (exportEntriesFn s)
 
 unsafe def registerPersistentEnvExtensionUnsafe {α β σ : Type} [Inhabited σ] (descr : PersistentEnvExtensionDescr α β σ) : IO (PersistentEnvExtension α β σ) := do
   let pExts ← persistentEnvExtensionsRef.get
@@ -1779,19 +1797,40 @@ set_option compiler.ignoreBorrowAnnotation true in
 @[extern "lean_get_ir_extra_const_names"]
 private opaque getIRExtraConstNames (env : Environment) (level : OLeanLevel) (includeDecls := false) : Array Name
 
-def mkModuleData (env : Environment) (level : OLeanLevel := .private) : IO ModuleData := do
-  let env := env.setExporting (level != .private)
+/--
+Compute extension entries for all levels at once by calling `exportEntriesFn` once per extension.
+Returns an `OLeanEntries` of arrays mapping extension names to their exported data.
+-/
+private def computeExtEntries (env : Environment) :
+    IO (OLeanEntries (Array (Name × Array EnvExtensionEntry))) := do
   let pExts ← persistentEnvExtensionsRef.get
-  let entries := pExts.filterMap fun pExt => do
-    -- get state from `checked` at the end if `async`; it would otherwise panic
-    let mut asyncMode := pExt.toEnvExtension.asyncMode
-    if asyncMode matches .async _ then
-      asyncMode := .sync
+  let allEntries := pExts.map fun pExt =>
+    let asyncMode := match pExt.toEnvExtension.asyncMode with
+      | .async _ => .sync
+      | m => m
     let state := pExt.getState (asyncMode := asyncMode) env
-    let ents := pExt.exportEntriesFn env state level
-    -- no need to export empty entries
-    guard !ents.isEmpty
-    return (pExt.name, ents)
+    let oe := pExt.exportEntriesFn env state
+    (pExt.name, oe)
+  let filterNonEmpty (level : OLeanLevel) :=
+    allEntries.filterMap fun (name, oe) => do
+      let ents := oe.get level
+      guard !ents.isEmpty
+      pure (name, ents)
+  return {
+    exported := filterNonEmpty .exported
+    server   := filterNonEmpty .server
+    «private» := filterNonEmpty .private
+  }
+
+def mkModuleData (env : Environment) (level : OLeanLevel := .private)
+    (extEntries? : Option (OLeanEntries (Array (Name × Array EnvExtensionEntry))) := none) :
+    IO ModuleData := do
+  let env := env.setExporting (level != .private)
+  let entries ← match extEntries? with
+    | some ee => pure (ee.get level)
+    | none => do
+      let ee ← computeExtEntries env
+      pure (ee.get level)
   let kenv := env.toKernelEnv
   let constNames := kenv.constants.foldStage2 (fun names name _ => names.push name) #[]
   -- not all kernel constants may be exported at `level < .private`
@@ -1828,8 +1867,9 @@ private def mkIRData (env : Environment) : ModuleData :=
 
 def writeModule (env : Environment) (fname : System.FilePath) (writeIR := true) : IO Unit := do
   if env.header.isModule then
+    let extEntries ← computeExtEntries env
     let mkPart (level : OLeanLevel) :=
-      return (level.adjustFileName fname, (← mkModuleData env level))
+      return (level.adjustFileName fname, (← mkModuleData env level extEntries))
     saveModuleDataParts env.mainModule #[
       (← mkPart .exported),
       (← mkPart .server),

src/Lean/Expr.lean

@@ -1751,6 +1751,12 @@ def isFalse (e : Expr) : Bool :=
 def isTrue (e : Expr) : Bool :=
   e.cleanupAnnotations.isConstOf ``True
 
+def isBoolFalse (e : Expr) : Bool :=
+  e.cleanupAnnotations.isConstOf ``false
+
+def isBoolTrue (e : Expr) : Bool :=
+  e.cleanupAnnotations.isConstOf ``true
+
 /--
 `getForallArity type` returns the arity of a `forall`-type. This function consumes nested annotations,
 and performs pending beta reductions. It does **not** use whnf.

src/Lean/ExtraModUses.lean

@@ -66,9 +66,8 @@ builtin_initialize extraModUses : SimplePersistentEnvExtension ExtraModUse (PHas
   registerSimplePersistentEnvExtension {
     addEntryFn m k := m.insert k
     addImportedFn _ := {}
-    exportEntriesFnEx? := some fun _ _ entries => fun
-      | .private => entries.toArray
-      | _        => #[]
+    exportEntriesFnEx? := some fun _ _ entries =>
+      { exported := #[], server := #[], «private» := entries.toArray }
     asyncMode := .sync
     replay? := some <| SimplePersistentEnvExtension.replayOfFilter (·.contains ·) (·.insert ·)
   }

src/Lean/LibrarySuggestions/SineQuaNon.lean

@@ -105,7 +105,9 @@ builtin_initialize sineQuaNonExt : PersistentEnvExtension (NameMap (List (Name
     addImportedFn   := fun mapss _ => pure mapss
     addEntryFn      := nofun
     -- TODO: it would be nice to avoid the `toArray` here, e.g. via iterators.
-    exportEntriesFnEx := fun env _ _ => unsafe env.unsafeRunMetaM do return #[← prepareTriggers (env.constants.map₂.toArray.map (·.1))]
+    exportEntriesFnEx := fun env _ => unsafe
+      let ents := env.unsafeRunMetaM do return #[← prepareTriggers (env.constants.map₂.toArray.map (·.1))]
+      .uniform ents
     statsFn         := fun _ => "sine qua non premise selection extension"
   }
 

src/Lean/LibrarySuggestions/SymbolFrequency.lean

@@ -86,7 +86,9 @@ builtin_initialize symbolFrequencyExt : PersistentEnvExtension (NameMap Nat) Emp
     mkInitial       := pure ∅
     addImportedFn   := fun mapss _ => pure mapss
     addEntryFn      := nofun
-    exportEntriesFnEx := fun env _ _ => unsafe env.unsafeRunMetaM do return #[← cachedLocalSymbolFrequencyMap]
+    exportEntriesFnEx := fun env _ => unsafe
+      let ents := env.unsafeRunMetaM do return #[← cachedLocalSymbolFrequencyMap]
+      .uniform ents
     statsFn         := fun _ => "symbol frequency extension"
   }
 

src/Lean/Meta/Basic.lean

@@ -717,20 +717,25 @@ def recordSynthPendingFailure (type : Expr) : MetaM Unit := do
       modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } =>
         { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures := synthPendingFailures.insert type msg }
 
+@[inline]
 def getLocalInstances : MetaM LocalInstances :=
   return (← read).localInstances
 
+@[inline]
 def getConfig : MetaM Config :=
   return (← read).config
 
+@[inline]
 def getConfigWithKey : MetaM ConfigWithKey :=
   return (← getConfig).toConfigWithKey
 
 /-- Return the array of postponed universe level constraints. -/
+@[inline]
 def getPostponed : MetaM (PersistentArray PostponedEntry) :=
   return (← get).postponed
 
 /-- Set the array of postponed universe level constraints. -/
+@[inline]
 def setPostponed (postponed : PersistentArray PostponedEntry) : MetaM Unit :=
   modify fun s => { s with postponed := postponed }
 
@@ -904,12 +909,15 @@ def mkConstWithFreshMVarLevels (declName : Name) : MetaM Expr := do
   return mkConst declName (← mkFreshLevelMVarsFor info)
 
 /-- Return current transparency setting/mode. -/
+@[inline]
 def getTransparency : MetaM TransparencyMode :=
   return (← getConfig).transparency
 
+@[inline]
 def shouldReduceAll : MetaM Bool :=
   return (← getTransparency) == TransparencyMode.all
 
+@[inline]
 def shouldReduceReducibleOnly : MetaM Bool :=
   return (← getTransparency) == TransparencyMode.reducible
 

src/Lean/Meta/Constructions/SparseCasesOn.lean

@@ -35,9 +35,11 @@ public structure SparseCasesOnInfo where
 deriving Inhabited
 
 private builtin_initialize sparseCasesOnInfoExt : MapDeclarationExtension SparseCasesOnInfo ←
-  mkMapDeclarationExtension (exportEntriesFn := fun env s _ =>
-    -- Do not export for non-exposed defs
-    s.filter (fun n _ => env.find? n |>.any (·.hasValue)) |>.toArray)
+  mkMapDeclarationExtension (exportEntriesFn := fun env s =>
+    let all := s.toArray
+    -- Do not export for non-exposed defs at exported/server levels
+    let exported := s.filter (fun n _ => (env.setExporting true).find? n |>.any (·.hasValue)) |>.toArray
+    { exported, server := exported, «private» := all })
 
 /--
 This module creates sparse variants of `casesOn` that have arms only for some of the constructors,

src/Lean/Meta/Match/MatcherInfo.lean

@@ -127,9 +127,11 @@ builtin_initialize extension : SimplePersistentEnvExtension Entry State ←
     addEntryFn    := State.addEntry
     addImportedFn := fun es => (mkStateFromImportedEntries State.addEntry {} es).switch
     asyncMode     := .async .mainEnv
-    exportEntriesFnEx? := some fun env _ entries _ =>
-      -- Do not export info for private defs
-      entries.filter (env.contains (skipRealize := false) ·.name) |>.toArray
+    exportEntriesFnEx? := some fun env _ entries =>
+      let all := entries.toArray
+      -- Do not export info for private defs at exported/server levels
+      let exported := all.filter ((env.setExporting true).contains (skipRealize := false) ·.name)
+      { exported, server := exported, «private» := all }
   }
 
 def addMatcherInfo (env : Environment) (matcherName : Name) (info : MatcherInfo) : Environment :=

src/Lean/Meta/Offset.lean

@@ -105,7 +105,7 @@ private def isNatZero (e : Expr) : MetaM Bool := do
   | some v => return v == 0
   | _      => return false
 
-private def mkOffset (e : Expr) (offset : Nat) : MetaM Expr := do
+def mkOffset (e : Expr) (offset : Nat) : MetaM Expr := do
   if offset == 0 then
     return e
   else if (← isNatZero e) then

src/Lean/Meta/Sym.lean

@@ -24,7 +24,9 @@ public import Lean.Meta.Sym.InferType
 public import Lean.Meta.Sym.Simp
 public import Lean.Meta.Sym.Util
 public import Lean.Meta.Sym.Eta
+public import Lean.Meta.Sym.Canon
 public import Lean.Meta.Sym.Grind
+public import Lean.Meta.Sym.SynthInstance
 
 /-!
 # Symbolic computation support.

src/Lean/Meta/Sym/Canon.lean

@@ -0,0 +1,433 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.SymM
+import Lean.Meta.Sym.ExprPtr
+import Lean.Meta.SynthInstance
+import Lean.Meta.Sym.SynthInstance
+import Lean.Meta.IntInstTesters
+import Lean.Meta.NatInstTesters
+import Lean.Meta.Sym.Eta
+import Lean.Meta.WHNF
+import Init.Grind.Util
+namespace Lean.Meta.Sym
+namespace Canon
+
+builtin_initialize registerTraceClass `sym.debug.canon
+
+/-!
+# Type-directed canonicalizer
+
+Canonicalizes expressions by normalizing types and instances. At the top level, it traverses
+applications, foralls, lambdas, and let-bindings, classifying each argument as a type, instance,
+implicit, or value using `shouldCanon`. Values are recursively visited but not normalized.
+Types and instances receive targeted reductions.
+
+## Reductions (applied only in type positions)
+
+- **Eta**: `fun x => f x` → `f`
+- **Projection**: `⟨a, b⟩.1` → `a` (structure projections, not class projections)
+- **Match/ite/cond**: reduced when discriminant is a constructor or literal
+- **Nat arithmetic**: ground evaluation (`2 + 1` → `3`) and offset normalization
+  (`n.succ + 1` → `n + 2`)
+
+## Instance canonicalization
+
+Instances are re-synthesized via `synthInstance`. The instance type is first normalized
+using the type-level reductions above, so that `OfNat (Fin (2+1)) 0` and `OfNat (Fin 3) 0`
+produce the same canonical instance.
+
+## Two caches
+
+The canonicalizer maintains separate caches for type-level and value-level contexts.
+The same expression may canonicalize differently depending on whether it appears in a
+type position (where reductions are applied) or a value position (where it is only traversed).
+Caches are keyed by `Expr` (structural equality), not pointer equality, because
+the canonicalizer runs before `shareCommon` and enters binders using locally nameless
+representation.
+
+## Future work
+
+If needed we should add support for user-defined extensions.
+-/
+
+structure Context where
+  /-- `true` if we are visiting a type. -/
+  insideType : Bool := false
+
+abbrev CanonM := ReaderT Context SymM
+
+/--
+Auxiliary function for normalizing the arguments of `OfNat.ofNat` during canonicalization.
+This is needed because satellite solvers create `Nat` and `Int` numerals using the
+APIs `mkNatLit` and `mkIntLit`, which produce terms of the form
+`@OfNat.ofNat Nat <num> inst` and `@OfNat.ofNat Int <num> inst`.
+This becomes a problem when a term in the input goal has already been canonicalized
+and its type is not exactly `Nat` or `Int`. For example, in issue #9477, we have:
+```
+structure T where
+upper_bound : Nat
+def T.range (a : T) := 0...a.upper_bound
+theorem range_lower (a : T) : a.range.lower = 0 := by rfl
+```
+Here, the `0` in `range_lower` is actually represented as:
+```
+(@OfNat.ofNat
+  (Std.PRange.Bound (Std.PRange.RangeShape.lower (Std.PRange.RangeShape.mk Std.PRange.BoundShape.closed Std.PRange.BoundShape.open)) Nat)
+  (nat_lit 0)
+  (instOfNatNat (nat_lit 0)))
+```
+Without this normalization step, the satellite solver would need to handle multiple
+representations for `(0 : Nat)` and `(0 : Int)`, complicating reasoning.
+-/
+-- Remark: This is not a great solution. We should consider writing a custom canonicalizer for
+-- `OfNat.ofNat` and other constants with built-in support in `grind`.
+private def normOfNatArgs? (args : Array Expr) : MetaM (Option (Array Expr)) := do
+  if h : args.size = 3 then
+    let mut args : Vector Expr 3 := h ▸ args.toVector
+    let mut modified := false
+    if args[1].isAppOf ``OfNat.ofNat then
+      -- If nested `OfNat.ofNat`, convert to raw nat literal
+      let some val ← getNatValue? args[1] | pure ()
+      args := args.set 1 (mkRawNatLit val)
+      modified := true
+    let inst := args[2]
+    if (← Structural.isInstOfNatNat inst) && !args[0].isConstOf ``Nat then
+      return some (args.set 0 Nat.mkType |>.toArray)
+    else if (← Structural.isInstOfNatInt inst) && !args[0].isConstOf ``Int then
+      return some (args.set 0 Int.mkType |>.toArray)
+    else if modified then
+      return some args.toArray
+  return none
+
+abbrev withCaching (e : Expr) (k : CanonM Expr) : CanonM Expr := do
+  if (← read).insideType then
+    if let some r := (← get).canon.cacheInType.get? e then
+      return r
+    else
+      let r ← k
+      modify fun s => { s with canon.cacheInType := s.canon.cacheInType.insert e r }
+      return r
+  else
+    if let some r := (← get).canon.cache.get? e then
+      return r
+    else
+      let r ← k
+      modify fun s => { s with canon.cache := s.canon.cache.insert e r }
+      return r
+
+def isTrueCond (e : Expr) : Bool :=
+  match_expr e with
+  | True => true
+  | Eq _ a b => a.isBoolTrue && b.isBoolTrue
+  | _ => false
+
+def isFalseCond (e : Expr) : Bool :=
+  match_expr e with
+  | False => true
+  | Eq _ a b => a.isBoolFalse && b.isBoolTrue
+  | _ => false
+
+/--
+Return type for the `shouldCanon` function.
+-/
+inductive ShouldCanonResult where
+  | /- Nested types (and type formers) are canonicalized. -/
+    canonType
+  | /- Nested instances are canonicalized. -/
+    canonInst
+  | /- Implicit argument that is not an instance nor a type. -/
+    canonImplicit
+  | /-
+    Term is not a proof, type (former), nor an instance.
+    Thus, it must be recursively visited by the canonicalizer.
+    -/
+    visit
+  deriving Inhabited
+
+instance : Repr ShouldCanonResult where
+  reprPrec r _ := private match r with
+    | .canonType => "canonType"
+    | .canonInst => "canonInst"
+    | .canonImplicit => "canonImplicit"
+    | .visit => "visit"
+
+/--
+See comments at `ShouldCanonResult`.
+-/
+def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM ShouldCanonResult := do
+  if h : i < pinfos.size then
+    let pinfo := pinfos[i]
+    if pinfo.isInstance then
+      return .canonInst
+    else if pinfo.isProp then
+      return .visit
+    else if pinfo.isImplicit then
+      if (← isTypeFormer arg) then
+        return .canonType
+      else
+        return .canonImplicit
+  if (← isProp arg) then
+    return .visit
+  else if (← isTypeFormer arg) then
+    return .canonType
+  else
+    return .visit
+
+/--
+Reduce a projection function application (e.g., `@Sigma.fst _ _ ⟨a, b⟩` → `a`).
+Class projections are not reduced — they are support elements handled by instance synthesis.
+-/
+def reduceProjFn? (info : ProjectionFunctionInfo) (e : Expr) : SymM (Option Expr) := do
+  if info.fromClass then
+    return none
+  let some e ← unfoldDefinition? e | return none
+  match (← reduceProj? e.getAppFn) with
+  | some f => return some <| mkAppN f e.getAppArgs
+  | none   => return none
+
+def isNat (e : Expr) := e.isConstOf ``Nat
+
+/-- Returns `true` if `e` is a Nat arithmetic expression that should be normalized
+(ground evaluation or offset normalization). -/
+def isNatArithApp (e : Expr) : Bool :=
+  match_expr e with
+  | Nat.zero => true
+  | Nat.succ _ => true
+  | HAdd.hAdd α _ _ _ _ _ => isNat α
+  | HMul.hMul α _ _ _ _ _ => isNat α
+  | HSub.hSub α _ _ _ _ _ => isNat α
+  | HDiv.hDiv α _ _ _ _ _ => isNat α
+  | HMod.hMod α _ _ _ _ _ => isNat α
+  | _ => false
+
+/-- Check that `e` is definitionally equal to `inst` at instance transparency.
+Returns `inst` on success, `e` with a reported issue on failure. -/
+def checkDefEqInst (e : Expr) (inst : Expr) : SymM Expr := do
+  unless (← isDefEqI e inst) do
+    reportIssue! "failed to canonicalize instance{indentExpr e}\nsynthesized instance is not definitionally equal{indentExpr inst}"
+    return e
+  return inst
+
+/-- Canonicalize `e`. Applies targeted reductions in type positions; recursively visits value positions. -/
+partial def canon (e : Expr) : CanonM Expr := do
+  match e with
+  | .forallE ..    => withCaching e <| canonForall #[] e
+  | .lam ..        => withCaching e <| canonLambda e
+  | .letE ..       => withCaching e <| canonLet #[] e
+  | .app ..        => withCaching e <| canonApp e
+  | .proj ..       => withCaching e <| canonProj e
+  | .mdata _ b     => return e.updateMData! (← canon b)
+  | _              => return e
+where
+  canonInsideType (e : Expr) : CanonM Expr := do
+    if (← read).insideType then
+      canon e
+    else if (← isProp e) then
+      /-
+      If the body is a proposition (like `a ∈ m → ...`), normalizing inside it could change the
+      shape of the proposition and confuse grind's proposition handling.
+      -/
+      canon e
+    else
+      withReader (fun ctx => { ctx with insideType := true }) <| canon e
+
+  /--
+  Similar to `canonInsideType`, but skips the `isProp` check.
+  Use only when `e` is known not to be a proposition.
+  -/
+  canonInsideType' (e : Expr) : CanonM Expr := do
+    if (← read).insideType then
+      canon e
+    else
+      withReader (fun ctx => { ctx with insideType := true }) <| canon e
+
+  canonInst (e : Expr) : CanonM Expr := do
+    if let some inst := (← get).canon.cacheInsts.get? e then
+      checkDefEqInst e inst
+    else
+      /-
+      We normalize the type to make sure `OfNat (Fin (2+1)) 1` and `OfNat (Fin 3) 1` will produce
+      the same instances.
+      -/
+      let type ← inferType e
+      let type' ← canonInsideType' type
+      let some inst ← Sym.synthInstance? type' |
+        reportIssue! "failed to canonicalize instance{indentExpr e}\nfailed to synthesize{indentExpr type'}"
+        return e
+      let inst ← checkDefEqInst e inst
+      -- Remark: we cache result using the type **before** canonicalization.
+      modify fun s => { s with canon.cacheInsts := s.canon.cacheInsts.insert e inst }
+      return inst
+
+  canonLambda (e : Expr) : CanonM Expr := do
+    if (← read).insideType then
+      canonLambdaLoop #[] (etaReduce e)
+    else
+      canonLambdaLoop #[] e
+
+  canonLambdaLoop (fvars : Array Expr) (e : Expr) : CanonM Expr := do
+    match e with
+    | .lam n d b c =>
+      withLocalDecl n c (← canonInsideType (d.instantiateRev fvars)) fun x =>
+        canonLambdaLoop (fvars.push x) b
+    | e =>
+      mkLambdaFVars fvars (← canon (e.instantiateRev fvars))
+
+  canonForall (fvars : Array Expr) (e : Expr) : CanonM Expr := do
+    match e with
+    | .forallE n d b c =>
+      withLocalDecl n c (← canonInsideType (d.instantiateRev fvars)) fun x =>
+        canonForall (fvars.push x) b
+    | e =>
+      mkForallFVars fvars (← canonInsideType (e.instantiateRev fvars))
+
+  canonLet (fvars : Array Expr) (e : Expr) : CanonM Expr := do
+    match e with
+    | .letE n t v b nondep =>
+      withLetDecl n (← canonInsideType (t.instantiateRev fvars)) (← canon (v.instantiateRev fvars)) (nondep := nondep) fun x =>
+        canonLet (fvars.push x) b
+    | e =>
+      mkLetFVars (generalizeNondepLet := false) fvars (← canon (e.instantiateRev fvars))
+
+  canonAppDefault (e : Expr) : CanonM Expr := e.withApp fun f args => do
+    if f.isConstOf ``Grind.nestedProof && args.size == 2 then
+      let prop := args[0]!
+      let prop' ← canon prop
+      let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
+      return e'
+    else if f.isConstOf ``Grind.nestedDecidable && args.size == 2 then
+      let prop := args[0]!
+      let prop' ← canon prop
+      let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
+      return e'
+    else
+      let mut modified := false
+      let args ← if f.isConstOf ``OfNat.ofNat then
+        let some args ← normOfNatArgs? args | pure args
+        modified := true
+        pure args
+      else
+        pure args
+      let mut f := f
+      let f' ← canon f
+      unless isSameExpr f f' do
+        f := f'
+        modified := true
+      let pinfos := (← getFunInfo f).paramInfo
+      let mut args := args.toVector
+      for h : i in *...args.size do
+        let arg := args[i]
+        trace[sym.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
+        let arg' ← match (← shouldCanon pinfos i arg) with
+          | .canonType =>
+            /-
+            The type may have nested propositions and terms that may need to be canonicalized too.
+            So, we must recurse over it. See issue #10232
+            -/
+            canonInsideType' arg
+          | .canonImplicit => canon arg
+          | .visit => canon arg
+          | .canonInst =>
+            if arg.isAppOfArity ``Grind.nestedDecidable 2 then
+              let prop := arg.appFn!.appArg!
+              let prop' ← canon prop
+              if isSameExpr prop prop' then pure arg else pure (mkApp2 arg.appFn!.appFn! prop' arg.appArg!)
+            else
+              canonInst arg
+        unless isSameExpr arg arg' do
+          args := args.set i arg'
+          modified := true
+      return if modified then mkAppN f args.toArray else e
+
+  canonIte (f : Expr) (α c inst a b : Expr) : CanonM Expr := do
+    let c ← canon c
+    if isTrueCond c then canon a
+    else if isFalseCond c then canon b
+    else return mkApp5 f (← canonInsideType α) c (← canonInst inst) (← canon a) (← canon b)
+
+  canonCond (f : Expr) (α c a b : Expr) : CanonM Expr := do
+    let c ← canon c
+    if c.isBoolTrue then canon a
+    else if c.isBoolFalse then canon b
+    else return mkApp4 f (← canonInsideType α) c (← canon a) (← canon b)
+
+  postReduce (e : Expr) : CanonM Expr := do
+    if isNatArithApp e then
+      if let some e ← evalNat e |>.run then
+        return mkNatLit e
+      else if let some (e, k) ← isOffset? e |>.run then
+        mkOffset e k
+      else
+        return e
+    else
+      let f := e.getAppFn
+      let .const declName _ := f | return e
+      if let some info ← getProjectionFnInfo? declName then
+        return (← reduceProjFn? info e).getD e
+      else
+        return e
+
+  /-- Canonicalize `e` and apply post reductions. -/
+  canonAppAndPost (e : Expr) : CanonM Expr := do
+    let e ← canonAppDefault e
+    postReduce e
+
+  canonMatch (e : Expr) : CanonM Expr := do
+    if let .reduced e ← reduceMatcher? e then
+      canon e
+    else
+      let e ← canonAppDefault e
+      -- Remark: try again, discriminants may have been simplified.
+      if let .reduced e ← reduceMatcher? e then
+        canon e
+      else
+        return e
+
+  canonApp (e : Expr) : CanonM Expr := do
+    if (← read).insideType then
+      match_expr e with
+      | f@ite α c i a b => canonIte f α c i a b
+      | f@cond α c a b => canonCond f α c a b
+      -- Remark: We currently don't normalize dependent-if-then-else occurring in types.
+      | _ =>
+        let f := e.getAppFn
+        let .const declName _ := f | canonAppAndPost e
+        if (← isMatcher declName) then
+          canonMatch e
+        else
+          canonAppAndPost e
+    else
+      canonAppDefault e
+
+  canonProj (e : Expr) : CanonM Expr := do
+    let e := e.updateProj! (← canon e.projExpr!)
+    if (← read).insideType then
+      return (← reduceProj? e).getD e
+    else
+      return e
+
+/--
+Returns `true` if `shouldCannon pinfos i arg` is not `.visit`.
+This is a helper function used to implement mbtc.
+-/
+public def isSupport (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Bool := do
+  let r ← Canon.shouldCanon pinfos i arg
+  return !r matches .visit
+
+end Canon
+
+/--
+Canonicalize `e` by normalizing types, instances, and support arguments.
+Types receive targeted reductions (eta, projection, match/ite, Nat arithmetic).
+Instances are re-synthesized. Values are traversed but not reduced.
+Runs at reducible transparency.
+-/
+public def canon (e : Expr) : SymM Expr := do profileitM Exception "sym canon" (← getOptions) do
+  withReducible do Canon.canon e {}
+
+end Lean.Meta.Sym

src/Lean/Meta/Sym/Eta.lean

@@ -41,13 +41,34 @@ where
 public def isEtaReducible (e : Expr) : Bool :=
   !isSameExpr e (etaReduce e)
 
+public partial def etaReduceWithCache (e : Expr) (c : Std.HashMap ExprPtr Expr) : CoreM (Expr × Std.HashMap ExprPtr Expr) := do
+  visit e |>.run c
+where
+  cache (e e' : Expr) : StateRefT (Std.HashMap ExprPtr Expr) CoreM Expr := do
+    modify fun s => s.insert { expr := e } e'
+    return e'
+
+  visit (e : Expr) : StateRefT (Std.HashMap ExprPtr Expr) CoreM Expr := withIncRecDepth do
+    if let some e' := (← get).get? { expr := e } then
+      return e'
+    match e with
+    | .forallE _ d b _ => cache e (e.updateForallE! (← visit d) (← visit b))
+    | .lam _ d b _ =>
+      let e' := etaReduce.go e e 0
+      if isSameExpr e e' then
+        cache e (e.updateLambdaE! (← visit d) (← visit b))
+      else
+        cache e (← visit e')
+    | .letE _ t v b _  => cache e (e.updateLetE! (← visit t) (← visit v) (← visit b))
+    | .app f a         => cache e (e.updateApp! (← visit f) (← visit a))
+    | .mdata _ b       => cache e (e.updateMData! (← visit b))
+    | .proj _ _ b      => cache e (e.updateProj! (← visit b))
+    | _                => return e
+
 /-- Applies `etaReduce` to all subexpressions. Returns `e` unchanged if no subexpression is eta-reducible. -/
-public def etaReduceAll (e : Expr) : MetaM Expr := do
+public def etaReduceAll (e : Expr) : CoreM Expr := do
   unless Option.isSome <| e.find? isEtaReducible do return e
-  let pre (e : Expr) : MetaM TransformStep := do
-    let e' := etaReduce e
-    if isSameExpr e e' then return .continue
-    else return .visit e'
-  Meta.transform e (pre := pre)
+  let (e, _) ← etaReduceWithCache e {}
+  return e
 
 end Lean.Meta.Sym

src/Lean/Meta/Sym/SymM.lean

@@ -147,6 +147,14 @@ structure Context where
   sharedExprs : SharedExprs
   config      : Config := {}
 
+structure Canon.State where
+  /-- Cache for value-level canonicalization (no type reductions applied). -/
+  cache       : Std.HashMap Expr Expr := {}
+  /-- Cache for type-level canonicalization (reductions applied). -/
+  cacheInType : Std.HashMap Expr Expr := {}
+  /-- Cache mapping instances to their canonical synthesized instances. -/
+  cacheInsts  : Std.HashMap Expr Expr := {}
+
 /-- Mutable state for the symbolic computation framework. -/
 structure State where
   /-- `ShareCommon` (aka `Hash-consing`) state. -/
@@ -191,6 +199,7 @@ structure State where
   within a `sym =>` block and reported when a tactic fails.
   -/
   issues : List MessageData := []
+  canon : Canon.State := {}
   debug : Bool := false
 
 abbrev SymM := ReaderT Context <| StateRefT State MetaM

src/Lean/Meta/Sym/SynthInstance.lean

@@ -0,0 +1,76 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.SymM
+import Lean.Meta.SynthInstance
+public section
+namespace Lean.Meta.Sym
+/--
+Some modules in grind use builtin instances defined directly in core (e.g., `lia`),
+while others synthesize them using `synthInstance` (e.g., `ring`).
+This inconsistency is problematic, as it may introduce mismatches and result in
+two different representations for the same term.
+
+The following table is used to bypass synthInstance for the builtin cases.
+-/
+private def builtinInsts : Std.HashMap Expr Expr :=
+  let nat := Nat.mkType
+  let int := Int.mkType
+  let us  := [Level.zero, Level.zero, Level.zero]
+  Std.HashMap.ofList [
+    (mkApp3 (mkConst ``HAdd us) nat nat nat, Nat.mkInstHAdd),
+    (mkApp3 (mkConst ``HSub us) nat nat nat, Nat.mkInstHSub),
+    (mkApp3 (mkConst ``HMul us) nat nat nat, Nat.mkInstHMul),
+    (mkApp3 (mkConst ``HDiv us) nat nat nat, Nat.mkInstHDiv),
+    (mkApp3 (mkConst ``HMod us) nat nat nat, Nat.mkInstHMod),
+    (mkApp3 (mkConst ``HPow us) nat nat nat, Nat.mkInstHPow),
+    (mkApp  (mkConst ``LT [0]) nat, Nat.mkInstLT),
+    (mkApp  (mkConst ``LE [0]) nat, Nat.mkInstLE),
+
+    (mkApp3 (mkConst ``HAdd us) int int int, Int.mkInstHAdd),
+    (mkApp3 (mkConst ``HSub us) int int int, Int.mkInstHSub),
+    (mkApp3 (mkConst ``HMul us) int int int, Int.mkInstHMul),
+    (mkApp3 (mkConst ``HDiv us) int int int, Int.mkInstHDiv),
+    (mkApp3 (mkConst ``HMod us) int int int, Int.mkInstHMod),
+    (mkApp3 (mkConst ``HPow us) int nat int, Int.mkInstHPow),
+    (mkApp  (mkConst ``LT [0]) int, Int.mkInstLT),
+    (mkApp  (mkConst ``LE [0]) int, Int.mkInstLE),
+  ]
+
+/--
+Some modules in grind use builtin instances defined directly in core (e.g., `lia`).
+Users may provide nonstandard instances that are definitionally equal to the ones in core.
+Given a type, such as `HAdd Int Int Int`, this function returns the instance defined in
+core.
+-/
+def getBuiltinInstance? (type : Expr) : Option Expr :=
+  builtinInsts[type]?
+
+def synthInstanceMeta? (type : Expr) : MetaM (Option Expr) := do profileitM Exception "sym typeclass inference" (← getOptions) (decl := type.getAppFn.constName?.getD .anonymous) do
+  if let some inst := getBuiltinInstance? type then
+    return inst
+  catchInternalId isDefEqStuckExceptionId
+    (synthInstanceCore? type none)
+    (fun _ => pure none)
+
+abbrev synthInstance? (type : Expr) : SymM (Option Expr) :=
+  synthInstanceMeta? type
+
+def synthInstance (type : Expr) : SymM Expr := do
+  let some inst ← synthInstance? type
+    | throwError "`sym` failed to find instance{indentExpr type}"
+  return inst
+
+/--
+Helper function for instantiating a type class `type`, and
+then using the result to perform `isDefEq x val`.
+-/
+def synthInstanceAndAssign (x type : Expr) : SymM Bool := do
+  let some val ← synthInstance? type | return false
+  isDefEq x val
+
+end Lean.Meta.Sym

src/Lean/Meta/Tactic/Grind.lean

@@ -12,7 +12,6 @@ public import Lean.Meta.Tactic.Grind.Util
 public import Lean.Meta.Tactic.Grind.Cases
 public import Lean.Meta.Tactic.Grind.Injection
 public import Lean.Meta.Tactic.Grind.Core
-public import Lean.Meta.Tactic.Grind.Canon
 public import Lean.Meta.Tactic.Grind.MarkNestedSubsingletons
 public import Lean.Meta.Tactic.Grind.Inv
 public import Lean.Meta.Tactic.Grind.Proof

src/Lean/Meta/Tactic/Grind/Arith/FieldNormNum.lean

@@ -6,8 +6,11 @@ Authors: Leonardo de Moura
 module
 prelude
 public import Lean.Meta.Basic
-import Lean.Meta.Tactic.Grind.SynthInstance
 import Init.Grind.FieldNormNum
+import Lean.Meta.Tactic.Grind.SynthInstance
+import Lean.Meta.AppBuilder
+import Lean.Meta.LitValues
+import Lean.Util.SafeExponentiation
 namespace Lean.Meta.Grind.Arith
 namespace FieldNormNum
 

src/Lean/Meta/Tactic/Grind/Arith/Simproc.lean

@@ -8,8 +8,13 @@ prelude
 public import Init.Grind.Ring.Basic
 public import Init.Simproc
 public import Lean.Meta.Tactic.Grind.SynthInstance
+public import Init.Simproc
+public import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Util
+import Lean.Meta.LitValues
 import Init.Grind.Ring.Field
+import Lean.Meta.DecLevel
 import Lean.Meta.Tactic.Grind.Arith.FieldNormNum
+import Lean.Util.SafeExponentiation
 public section
 namespace Lean.Meta.Grind.Arith
 

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

@@ -1,314 +0,0 @@
-/-
-Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
--/
-module
-prelude
-public import Lean.Meta.Tactic.Grind.Types
-import Init.Grind.Util
-import Lean.Meta.IntInstTesters
-import Lean.Meta.NatInstTesters
-import Lean.Meta.Tactic.Grind.SynthInstance
-public section
-namespace Lean.Meta.Grind
-namespace Canon
-
-/-!
-A canonicalizer module for the `grind` tactic. The canonicalizer defined in `Meta/Canonicalizer.lean` is
-not suitable for the `grind` tactic. It was designed for tactics such as `omega`, where the goal is
-to detect when two structurally different atoms are definitionally equal.
-
-The `grind` tactic, on the other hand, uses congruence closure. Moreover, types, type formers, proofs, and instances
-are considered supporting elements and are not factored into congruence detection.
-
-This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they are instances,
-types, or type formers and are the `i`-th arguments of two different `f`-applications. This approach is
-sufficient for the congruence closure procedure used by the `grind` tactic.
-
-To further optimize `isDefEq` checks, instances are compared using `TransparencyMode.instances`, which reduces
-the number of constants that need to be unfolded. If diagnostics are enabled, instances are compared using
-the default transparency mode too for sanity checking, and discrepancies are reported.
-Types and type formers are always checked using default transparency.
-
-Remark:
-The canonicalizer minimizes issues with non-canonical instances and structurally different but definitionally equal types,
-but it does not solve all problems. For example, consider a situation where we have `(a : BitVec n)`
-and `(b : BitVec m)`, along with instances `inst1 n : Add (BitVec n)` and `inst2 m : Add (BitVec m)` where `inst1`
-and `inst2` are structurally different. Now consider the terms `a + a` and `b + b`. After canonicalization, the two
-additions will still use structurally different (and definitionally different) instances: `inst1 n` and `inst2 m`.
-Furthermore, `grind` will not be able to infer that  `a + a ≍ b + b` even if we add the assumptions `n = m` and `a ≍ b`.
--/
-
-@[inline] private def get' : GoalM State :=
-  return (← get).canon
-
-@[inline] private def modify' (f : State → State) : GoalM Unit :=
-  modify fun s => { s with canon := f s.canon }
-
-/--
-Helper function for `canonElemCore`. It tries `isDefEq a b` with default transparency, but using
-at most `canonHeartbeats` heartbeats. It reports an issue if the threshold is reached.
-Remark: `parent` is use only to report an issue.
--/
-private def isDefEqBounded (a b : Expr) (parent : Expr) : GoalM Bool := do
-  withCurrHeartbeats do
-  let curr := (← getConfig).canonHeartbeats
-  tryCatchRuntimeEx
-    (withTheReader Core.Context (fun ctx => { ctx with maxHeartbeats := curr*1000 }) do
-      isDefEqD a b)
-    fun ex => do
-      if ex.isRuntime then
-        reportIssue! "failed to show that{indentExpr a}\nis definitionally equal to{indentExpr b}\nwhile canonicalizing{indentExpr parent}\nusing `{curr}*1000` heartbeats, `(canonHeartbeats := {curr})`"
-        return false
-      else
-        throw ex
-
-/--
-Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
-If `useIsDefEqBounded` is `true`, we try `isDefEqBounded` before returning false.
-
-Remark: `isInst` is `true` if element is an instance.
--/
-private def canonElemCore (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBounded : Bool) (isInst := false) : GoalM Expr := do
-  let s ← get'
-  let key := { f, i, arg := e : CanonArgKey }
-  /-
-  **Note**: We used to use `s.canon.find? e` instead of `s.canonArg.find? key`. This was incorrect.
-  First, for types and implicit arguments, we recursively visit `e` before invoking this function.
-  Thus, `s.canon.find? e` always returns some value `c`, causing us to miss possible canonicalization opportunities.
-  Moreover, `e` may be the argument of two different `f` functions.
-  -/
-  if let some c := s.canonArg.find? key then
-    return c
-  let c ← go
-  modify' fun s => { s with canonArg := s.canonArg.insert key c }
-  return c
-where
-  checkDefEq (e c : Expr) : GoalM Bool := do
-    if (← isDefEq e c) then
-      -- We used to check `c.fvarsSubset e` because it is not
-      -- in general safe to replace `e` with `c` if `c` has more free variables than `e`.
-      -- However, we don't revert previously canonicalized elements in the `grind` tactic.
-      -- Moreover, we store the canonicalizer state in the `Goal` because we case-split
-      -- and different locals are added in different branches.
-      modify' fun s => { s with canon := s.canon.insert e c }
-      trace_goal[grind.debug.canon] "found {e} ===> {c}"
-      return true
-    if useIsDefEqBounded then
-      -- If `e` and `c` are not types, we use `isDefEqBounded`
-      if (← isDefEqBounded e c parent) then
-        modify' fun s => { s with canon := s.canon.insert e c }
-        trace_goal[grind.debug.canon] "found using `isDefEqBounded`: {e} ===> {c}"
-        return true
-    return false
-
-  go : GoalM Expr := do
-    let eType ← inferType e
-    if isInst then
-      /-
-      **Note**: Recall that some `grind` modules (e.g., `lia`) rely on instances defined directly in core.
-      This test ensures we use them as the canonical representative.
-      -/
-      if let some c := getBuiltinInstance? eType then
-        if (← checkDefEq e c) then
-          return c
-    let s ← get'
-    let key := (f, i)
-    let cs := s.argMap.find? key |>.getD []
-    for (c, cType) in cs do
-      /-
-      We first check the types
-      The following checks are a performance bottleneck.
-      For example, in the test `grind_ite.lean`, there are many checks of the form:
-      ```
-      w_4 ∈ assign.insert v true → Prop =?= w_1 ∈ assign.insert v false → Prop
-      ```
-      where `grind` unfolds the definition of `DHashMap.insert` and `TreeMap.insert`.
-      -/
-      if (← isDefEqD eType cType) then
-        if (← checkDefEq e c) then
-          return c
-    trace_goal[grind.debug.canon] "({f}, {i}) ↦ {e}"
-    modify' fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key ((e, eType)::cs) }
-    return e
-
-private abbrev canonType (parent f : Expr) (i : Nat) (e : Expr) :=
-  withDefault <| canonElemCore parent f i e (useIsDefEqBounded := false)
-
-private abbrev canonInst (parent f : Expr) (i : Nat) (e : Expr) :=
-  withReducibleAndInstances <| canonElemCore parent f i e (useIsDefEqBounded := true) (isInst := true)
-
-private abbrev canonImplicit (parent f : Expr) (i : Nat) (e : Expr) :=
-  withReducible <| canonElemCore parent f i e (useIsDefEqBounded := true)
-
-/--
-Return type for the `shouldCanon` function.
--/
-private inductive ShouldCanonResult where
-  | /- Nested types (and type formers) are canonicalized. -/
-    canonType
-  | /- Nested instances are canonicalized. -/
-    canonInst
-  | /- Implicit argument that is not an instance nor a type. -/
-    canonImplicit
-  | /-
-    Term is not a proof, type (former), nor an instance.
-    Thus, it must be recursively visited by the canonicalizer.
-    -/
-    visit
-  deriving Inhabited
-
-private instance : Repr ShouldCanonResult where
-  reprPrec r _ := private match r with
-    | .canonType => "canonType"
-    | .canonInst => "canonInst"
-    | .canonImplicit => "canonImplicit"
-    | .visit => "visit"
-
-/--
-See comments at `ShouldCanonResult`.
--/
-private def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM ShouldCanonResult := do
-  if h : i < pinfos.size then
-    let pinfo := pinfos[i]
-    if pinfo.isInstance then
-      return .canonInst
-    else if pinfo.isProp then
-      return .visit
-    else if pinfo.isImplicit then
-      if (← isTypeFormer arg) then
-        return .canonType
-      else
-        return .canonImplicit
-  if (← isProp arg) then
-    return .visit
-  else if (← isTypeFormer arg) then
-    return .canonType
-  else
-    return .visit
-
-/--
-Returns `true` if `shouldCannon pinfos i arg` is not `.visit`.
-This is a helper function used to implement mbtc.
--/
-def isSupport (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Bool := do
-  let r ← shouldCanon pinfos i arg
-  return !r matches .visit
-
-/--
-Auxiliary function for normalizing the arguments of `OfNat.ofNat` during canonicalization.
-This is needed because satellite solvers create `Nat` and `Int` numerals using the
-APIs `mkNatLit` and `mkIntLit`, which produce terms of the form
-`@OfNat.ofNat Nat <num> inst` and `@OfNat.ofNat Int <num> inst`.
-This becomes a problem when a term in the input goal has already been canonicalized
-and its type is not exactly `Nat` or `Int`. For example, in issue #9477, we have:
-```
-structure T where
-upper_bound : Nat
-def T.range (a : T) := 0...a.upper_bound
-theorem range\_lower (a : T) : a.range.lower = 0 := by rfl
-```
-Here, the `0` in `range_lower` is actually represented as:
-```
-(@OfNat.ofNat
-  (Std.PRange.Bound (Std.PRange.RangeShape.lower (Std.PRange.RangeShape.mk Std.PRange.BoundShape.closed Std.PRange.BoundShape.open)) Nat)
-  (nat_lit 0)
-  (instOfNatNat (nat_lit 0)))
-```
-Without this normalization step, the satellite solver would need to handle multiple
-representations for `(0 : Nat)` and `(0 : Int)`, complicating reasoning.
--/
--- Remark: This is not a great solution. We should consider writing a custom canonicalizer for
--- `OfNat.ofNat` and other constants with built-in support in `grind`.
-private def normOfNatArgs? (args : Array Expr) : MetaM (Option (Array Expr)) := do
-  if h : args.size = 3 then
-    let mut args : Vector Expr 3 := h ▸ args.toVector
-    let mut modified := false
-    if args[1].isAppOf ``OfNat.ofNat then
-      -- If nested `OfNat.ofNat`, convert to raw nat literal
-      let some val ← getNatValue? args[1] | pure ()
-      args := args.set 1 (mkRawNatLit val)
-      modified := true
-    let inst := args[2]
-    if (← Structural.isInstOfNatNat inst) && !args[0].isConstOf ``Nat then
-      return some (args.set 0 Nat.mkType |>.toArray)
-    else if (← Structural.isInstOfNatInt inst) && !args[0].isConstOf ``Int then
-      return some (args.set 0 Int.mkType |>.toArray)
-    else if modified then
-      return some args.toArray
-  return none
-
-set_option compiler.ignoreBorrowAnnotation true in
-@[export lean_grind_canon]
-partial def canonImpl (e : Expr) : GoalM Expr := do profileitM Exception "grind canon" (← getOptions) do
-  trace_goal[grind.debug.canon] "{e}"
-  visit e |>.run' {}
-where
-  visit (e : Expr) : StateRefT (Std.HashMap ExprPtr Expr) GoalM Expr := do
-    unless e.isApp || e.isForall do return e
-    -- Check whether it is cached
-    if let some r := (← get).get? { expr := e } then
-      return r
-    let e' ← match e with
-      | .app .. => e.withApp fun f args => do
-        if f.isConstOf ``Grind.nestedProof && args.size == 2 then
-          let prop := args[0]!
-          let prop' ← visit prop
-          if let some r := (← get').proofCanon.find? prop' then
-            pure r
-          else
-            let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
-            modify' fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
-            pure e'
-        else if f.isConstOf ``Grind.nestedDecidable && args.size == 2 then
-          let prop := args[0]!
-          let prop' ← visit prop
-          let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
-          pure e'
-        else
-          let mut modified := false
-          let args ← if f.isConstOf ``OfNat.ofNat then
-            let some args ← normOfNatArgs? args | pure args
-            modified := true
-            pure args
-          else
-            pure args
-          let pinfos := (← getFunInfo f).paramInfo
-          let mut args := args.toVector
-          for h : i in *...args.size do
-            let arg := args[i]
-            trace_goal[grind.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
-            let arg' ← match (← shouldCanon pinfos i arg) with
-              | .canonType =>
-                /-
-                The type may have nested propositions and terms that may need to be canonicalized too.
-                So, we must recurse over it. See issue #10232
-                -/
-                canonType e f i (← visit arg)
-              | .canonImplicit => canonImplicit e f i (← visit arg)
-              | .visit => visit arg
-              | .canonInst =>
-                if arg.isAppOfArity ``Grind.nestedDecidable 2 then
-                  let prop := arg.appFn!.appArg!
-                  let prop' ← visit prop
-                  if isSameExpr prop prop' then pure arg else pure (mkApp2 arg.appFn!.appFn! prop' arg.appArg!)
-                else
-                  canonInst e f i arg
-            unless isSameExpr arg arg' do
-              args := args.set i arg'
-              modified := true
-          pure <| if modified then mkAppN f args.toArray else e
-      | .forallE _ d b _ =>
-        -- Recall that we have `ForallProp.lean`.
-        let d' ← visit d
-        -- Remark: users may not want to convert `p → q` into `¬p ∨ q`
-        let b' ← if b.hasLooseBVars then pure b else visit b
-        pure <| e.updateForallE! d' b'
-      | _ => unreachable!
-    modify fun s => s.insert { expr := e } e'
-    return e'
-
-end Canon
-
-end Lean.Meta.Grind

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

@@ -51,7 +51,7 @@ private def propagateCtorHomo (α : Expr) (a b : Expr) : GoalM Unit := do
     There is no guarantee that `inferType (← mkEqProof a b)` is structurally equal to `a = b`.
     -/
     let mask := mask.set! (n-1) (some (← mkExpectedTypeHint (← mkEqProof a b) (← mkEq a b)))
-    let injLemma ← mkAppOptM injDeclName mask
+    let injLemma ← withDefault <| mkAppOptM injDeclName mask
     let injLemmaType ← inferType injLemma
     let gen := max (← getGeneration a) (← getGeneration b)
     propagateInjEqs injLemmaType injLemma gen

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

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
 module
 prelude
 public import Lean.Meta.Tactic.Grind.Types
-import Lean.Meta.Tactic.Grind.Canon
 import Lean.Meta.Tactic.Grind.CastLike
 public section
 namespace Lean.Meta.Grind
@@ -66,7 +65,7 @@ private def mkKey (e : Expr) (i : Nat) : MetaM Key :=
       let arg := args[j]
       if i == j then
         args := args.set j mainMark
-      else if !(← Canon.isSupport info.paramInfo j arg) then
+      else if !(← Sym.Canon.isSupport info.paramInfo j arg) then
         args := args.set j otherMark
     let mask := mkAppN f args.toArray
     return { mask }

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

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
 -/
 module
 prelude
-public import Lean.Meta.Tactic.Grind.SynthInstance
+public import Lean.Meta.Tactic.Grind.Types
 public section
 namespace Lean.Meta.Grind
 /-!

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

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 module
 prelude
 public import Lean.Meta.Tactic.Grind.Types
+import Init.Grind.Util
 import Lean.Meta.Tactic.Grind.Simp
 public section
 namespace Lean.Meta.Grind
@@ -112,6 +113,9 @@ private partial def abstractGroundMismatches? (lhs rhs : Expr) : GoalM (Option (
   if s.lhss.isEmpty then
     return none
   let f := mkLambdaWithBodyAndVarType s.varTypes f
+  let fType ← inferType f
+  let u ← getLevel fType
+  let f := mkApp2 (.const ``Grind.abstractFn [u]) fType f
   return some (mkAppN f s.lhss, mkAppN f s.rhss)
 where
   goCore (lhs rhs : Expr) : AbstractM Expr := do

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

@@ -5,71 +5,10 @@ Authors: Leonardo de Moura
 -/
 module
 prelude
-public import Lean.Meta.Tactic.Grind.Types
+public import Lean.Meta.Sym.SynthInstance
 public section
 namespace Lean.Meta.Grind
-/--
-Some modules in grind use builtin instances defined directly in core (e.g., `lia`),
-while others synthesize them using `synthInstance` (e.g., `ring`).
-This inconsistency is problematic, as it may introduce mismatches and result in
-two different representations for the same term.
 
-The following table is used to bypass synthInstance for the builtin cases.
--/
-private def builtinInsts : Std.HashMap Expr Expr :=
-  let nat := Nat.mkType
-  let int := Int.mkType
-  let us  := [Level.zero, Level.zero, Level.zero]
-  Std.HashMap.ofList [
-    (mkApp3 (mkConst ``HAdd us) nat nat nat, Nat.mkInstHAdd),
-    (mkApp3 (mkConst ``HSub us) nat nat nat, Nat.mkInstHSub),
-    (mkApp3 (mkConst ``HMul us) nat nat nat, Nat.mkInstHMul),
-    (mkApp3 (mkConst ``HDiv us) nat nat nat, Nat.mkInstHDiv),
-    (mkApp3 (mkConst ``HMod us) nat nat nat, Nat.mkInstHMod),
-    (mkApp3 (mkConst ``HPow us) nat nat nat, Nat.mkInstHPow),
-    (mkApp  (mkConst ``LT [0]) nat, Nat.mkInstLT),
-    (mkApp  (mkConst ``LE [0]) nat, Nat.mkInstLE),
-
-    (mkApp3 (mkConst ``HAdd us) int int int, Int.mkInstHAdd),
-    (mkApp3 (mkConst ``HSub us) int int int, Int.mkInstHSub),
-    (mkApp3 (mkConst ``HMul us) int int int, Int.mkInstHMul),
-    (mkApp3 (mkConst ``HDiv us) int int int, Int.mkInstHDiv),
-    (mkApp3 (mkConst ``HMod us) int int int, Int.mkInstHMod),
-    (mkApp3 (mkConst ``HPow us) int nat int, Int.mkInstHPow),
-    (mkApp  (mkConst ``LT [0]) int, Int.mkInstLT),
-    (mkApp  (mkConst ``LE [0]) int, Int.mkInstLE),
-  ]
-
-/--
-Some modules in grind use builtin instances defined directly in core (e.g., `lia`).
-Users may provide nonstandard instances that are definitionally equal to the ones in core.
-Given a type, such as `HAdd Int Int Int`, this function returns the instance defined in
-core.
--/
-def getBuiltinInstance? (type : Expr) : Option Expr :=
-  builtinInsts[type]?
-
-def synthInstanceMeta? (type : Expr) : MetaM (Option Expr) := do profileitM Exception "grind typeclass inference" (← getOptions) (decl := type.getAppFn.constName?.getD .anonymous) do
-  if let some inst := getBuiltinInstance? type then
-    return inst
-  catchInternalId isDefEqStuckExceptionId
-    (synthInstanceCore? type none)
-    (fun _ => pure none)
-
-abbrev synthInstance? (type : Expr) : GoalM (Option Expr) :=
-  synthInstanceMeta? type
-
-def synthInstance (type : Expr) : GoalM Expr := do
-  let some inst ← synthInstance? type
-    | throwError "`grind` failed to find instance{indentExpr type}"
-  return inst
-
-/--
-Helper function for instantiating a type class `type`, and
-then using the result to perform `isDefEq x val`.
--/
-def synthInstanceAndAssign (x type : Expr) : GoalM Bool := do
-  let some val ← synthInstance? type | return false
-  isDefEq x val
+export Sym (synthInstance synthInstance? synthInstanceMeta? synthInstanceAndAssign)
 
 end Lean.Meta.Grind

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

@@ -5,15 +5,16 @@ Authors: Leonardo de Moura
 -/
 module
 prelude
+public import Init.Data.Queue
+public import Init.Grind.Config
 public import Lean.Meta.Sym.SymM
 public import Lean.Meta.Tactic.Grind.Attr
 public import Lean.Meta.Tactic.Grind.CheckResult
-public import Init.Data.Queue
+public import Lean.Meta.Sym.Canon
+meta import Init.Data.String.Basic
 import Lean.Meta.AbstractNestedProofs
 import Lean.Meta.Match.MatchEqsExt
-public import Init.Grind.Config
 import Init.Data.Nat.Linear
-meta import Init.Data.String.Basic
 import Init.Omega
 import Lean.Util.ShareCommon
 public section
@@ -715,14 +716,6 @@ structure CanonArgKey where
   arg : Expr
   deriving BEq, Hashable
 
-/-- Canonicalizer state. See `Canon.lean` for additional details. -/
-structure Canon.State where
-  argMap     : PHashMap (Expr × Nat) (List (Expr × Expr)) := {}
-  canon      : PHashMap Expr Expr := {}
-  proofCanon : PHashMap Expr Expr := {}
-  canonArg   : PHashMap CanonArgKey Expr := {}
-  deriving Inhabited
-
 /-- Trace information for a case split. -/
 structure CaseTrace where
   expr   : Expr
@@ -922,7 +915,6 @@ accumulated facts.
 structure GoalState where
   /-- Next local declaration index to process. -/
   nextDeclIdx  : Nat := 0
-  canon        : Canon.State := {}
   enodeMap     : ENodeMap := default
   exprs        : PArray Expr := {}
   parents      : ParentMap := {}
@@ -1735,10 +1727,7 @@ def withoutModifyingState (x : GoalM α) : GoalM α := do
   finally
     set saved
 
-set_option compiler.ignoreBorrowAnnotation true in
-/-- Canonicalizes nested types, type formers, and instances in `e`. -/
-@[extern "lean_grind_canon"] -- Forward definition
-opaque canon (e : Expr) : GoalM Expr
+export Sym (canon)
 
 /-!
 `Action` is the *control interface* for `grind`’s search steps. It is defined in

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

@@ -445,27 +445,33 @@ unsafe def MethodsRef.toMethodsImpl (m : MethodsRef) : Methods :=
 @[implemented_by MethodsRef.toMethodsImpl]
 opaque MethodsRef.toMethods (m : MethodsRef) : Methods
 
+@[inline]
 def getMethods : SimpM Methods :=
   return MethodsRef.toMethods (← read)
 
+@[inline]
 def pre (e : Expr) : SimpM Step := do
   (← getMethods).pre e
 
+@[inline]
 def post (e : Expr) : SimpM Step := do
   (← getMethods).post e
 
 @[inline] def getContext : SimpM Context :=
   readThe Context
 
+@[inline]
 def getConfig : SimpM Config :=
   return (← getContext).config
 
 @[inline] def withParent (parent : Expr) (f : SimpM α) : SimpM α :=
   withTheReader Context (fun ctx => { ctx with parent? := parent }) f
 
+@[inline]
 def getSimpTheorems : SimpM SimpTheoremsArray :=
   return (← readThe Context).simpTheorems
 
+@[inline]
 def getSimpCongrTheorems : SimpM SimpCongrTheorems :=
   return (← readThe Context).congrTheorems
 
@@ -473,6 +479,7 @@ def getSimpCongrTheorems : SimpM SimpCongrTheorems :=
 Returns `true` if `simp` is in `dsimp` mode.
 That is, only transformations that preserve definitional equality should be applied.
 -/
+@[inline]
 def inDSimp : SimpM Bool :=
   return (← readThe Context).inDSimp
 

src/Lean/Parser/Command.lean

@@ -592,6 +592,8 @@ See also: `#reduce e` for evaluation by term reduction.
   "#print " >> (ident <|> strLit)
 @[builtin_command_parser] def printSig       := leading_parser
   "#print " >> nonReservedSymbol "sig " >> ident
+/-- Prints the axioms used by a declaration, directly or indirectly.
+Please consult [the reference manual](lean-manual://section/validating-proofs) to understand the significance of the output. -/
 @[builtin_command_parser] def printAxioms    := leading_parser
   "#print " >> nonReservedSymbol "axioms " >> ident
 @[builtin_command_parser] def printEqns      := leading_parser

src/Lean/Parser/Term.lean

@@ -774,15 +774,35 @@ In particular, it is like a unary operation with a fixed parameter `b`, where on
 @[builtin_term_parser] def noImplicitLambda := leading_parser
   "no_implicit_lambda% " >> termParser maxPrec
 /--
-`inferInstanceAs α` synthesizes an instance of type `α`, transporting it from a
-definitionally equal type if necessary. This is useful when `α` is definitionally equal to
-some `α'` for which instances are registered, as it prevents leaking the definition's RHS
-at lower transparencies.
+`inferInstanceAs α` synthesizes an instance of type `α` and then adjusts it to conform to the
+expected type `β`, which must be inferable from context.
 
-`inferInstanceAs` requires an expected type from context. If you just need to synthesize an
-instance without transporting between types, use `inferInstance` instead.
+Example:
+```
+def D := Nat
+instance : Inhabited D := inferInstanceAs (Inhabited Nat)
+```
 
-See `Lean.Meta.WrapInstance` for details.
+The adjustment will make sure that when the resulting instance will not "leak" the RHS `Nat` when
+reduced at transparency levels below `semireducible`, i.e. where `D` would not be unfolded either,
+preventing "defeq abuse".
+
+More specifically, given the "source type" (the argument) and "target type" (the expected type),
+`inferInstanceAs` synthesizes an instance for the source type and then unfolds and rewraps its
+components (fields, nested instances) as necessary to make them compatible with the target type. The
+individual steps are represented by the following options, which all default to enabled and can be
+disabled to help with porting:
+
+* `backward.inferInstanceAs.wrap`: master switch for instance adjustment in both `inferInstanceAs`
+  and the default deriving handler
+* `backward.inferInstanceAs.wrap.reuseSubInstances`: reuse existing instances for the target type
+  for sub-instance fields to avoid non-defeq instance diamonds
+* `backward.inferInstanceAs.wrap.instances`: wrap non-reducible instances in auxiliary definitions
+* `backward.inferInstanceAs.wrap.data`: wrap data fields in auxiliary definitions (proof fields are
+  always wrapped)
+
+If you just need to synthesize an instance without transporting between types, use `inferInstance`
+instead, potentially with a type annotation for the expected type.
 -/
 @[builtin_term_parser] def «inferInstanceAs» := leading_parser
   "inferInstanceAs" >> (((" $ " <|> " <| ") >> termParser minPrec) <|> (ppSpace >> termParser argPrec))

src/Lean/ScopedEnvExtension.lean

@@ -93,10 +93,12 @@ def addEntryFn (descr : Descr α β σ) (s : StateStack α β σ) (e : Entry β)
             s
       }
 
-def exportEntriesFn (descr : Descr α β σ) (level : OLeanLevel) (s : StateStack α β σ) : Array (Entry α) :=
-  s.newEntries.toArray.reverse.filterMap fun
-    | .global e => .global <$> descr.exportEntry? level e
-    | .scoped ns e => .scoped ns <$> descr.exportEntry? level e
+def exportEntriesFn (descr : Descr α β σ) (s : StateStack α β σ) : OLeanEntries (Array (Entry α)) :=
+  let forLevel (level : OLeanLevel) :=
+    s.newEntries.toArray.reverse.filterMap fun
+      | .global e => .global <$> descr.exportEntry? level e
+      | .scoped ns e => .scoped ns <$> descr.exportEntry? level e
+  { exported := forLevel .exported, server := forLevel .server, «private» := forLevel .private }
 
 end ScopedEnvExtension
 
@@ -115,7 +117,7 @@ unsafe def registerScopedEnvExtensionUnsafe (descr : Descr α β σ) : IO (Scope
     mkInitial       := mkInitial descr
     addImportedFn   := addImportedFn descr
     addEntryFn      := addEntryFn descr
-    exportEntriesFnEx := fun _ s level => exportEntriesFn descr level s
+    exportEntriesFnEx := fun _ s => exportEntriesFn descr s
     statsFn         := fun s => format "number of local entries: " ++ format s.newEntries.length
     -- We restrict addition of global and `scoped` entries to the main thread but allow addition of
     -- scopes and local entries in any thread, which are visible only in that thread (see uses of

src/Lean/Util/CollectAxioms.lean

@@ -8,44 +8,149 @@ module
 prelude
 public import Lean.MonadEnv
 
-public section
-
 namespace Lean
 
 namespace CollectAxioms
 
 structure State where
-  visited : NameSet    := {}
-  axioms  : Array Name := #[]
+  /-- Cache mapping constants to their (sorted) axiom dependencies. -/
+  seen   : NameMap (Array Name) := {}
+  /-- Axioms accumulated for the current constant being processed. -/
+  axioms : NameSet := {}
 
 abbrev M := ReaderT Environment $ StateM State
 
-partial def collect (c : Name) : M Unit := do
-  let collectExpr (e : Expr) : M Unit := e.getUsedConstants.forM collect
+def runM (env : Environment) (x : M α) : α :=
+  x.run env |>.run' {}
+
+private def insertArray (s : NameSet) (axs : Array Name) : NameSet :=
+  axs.foldl (init := s) fun acc ax => acc.insert ax
+
+/--
+Collect axioms reachable from constant `c`, using `extFind?` to look up pre-computed axioms
+for imported declarations. Results are cached in `State.seen`.
+
+When processing a constant not found in `extFind?` or the cache, the function temporarily
+clears the axiom accumulator, recurses into the constant's dependencies, caches the result
+in `seen`, and merges the collected axioms back.
+-/
+private partial def collect
+    (extFind? : Environment → Name → Option (Array Name))
+    (c : Name) : M Unit := do
+  let env ← read
+  -- Check extension for pre-computed axioms (imported declarations)
+  if let some axs := extFind? env c then
+    modify fun s => { s with axioms := insertArray s.axioms axs, seen := s.seen.insert c axs }
+    return
+  -- Check local cache
   let s ← get
-  unless s.visited.contains c do
-    modify fun s => { s with visited := s.visited.insert c }
-    let env ← read
-    -- We should take the constant from the kernel env, which may differ from the one in the elab
-    -- env in case of (async) errors.
-    match env.checked.get.find? c with
-    | some (ConstantInfo.axiomInfo v)  =>
-        modify fun s => { s with axioms := (s.axioms.push c) }
-        collectExpr v.type
-    | some (ConstantInfo.defnInfo v)   => collectExpr v.type *> collectExpr v.value
-    | some (ConstantInfo.thmInfo v)    => collectExpr v.type *> collectExpr v.value
-    | some (ConstantInfo.opaqueInfo v) => collectExpr v.type *> collectExpr v.value
-    | some (ConstantInfo.quotInfo _)   => pure ()
-    | some (ConstantInfo.ctorInfo v)   => collectExpr v.type
-    | some (ConstantInfo.recInfo v)    => collectExpr v.type
-    | some (ConstantInfo.inductInfo v) => collectExpr v.type *> v.ctors.forM collect
-    | none                             => pure ()
+  if let some axs := s.seen.find? c then
+    modify fun s => { s with axioms := insertArray s.axioms axs }
+    return
+  -- Recurse: temporarily clear axioms to isolate this constant's contribution.
+  -- Insert sentinel to prevent infinite recursion (e.g., inductives ↔ constructors).
+  let savedAxioms := s.axioms
+  modify fun s => { s with axioms := {}, seen := s.seen.insert c #[] }
+  let collectExpr (e : Expr) : M Unit := e.getUsedConstants.forM (collect extFind?)
+  -- Take constants from the kernel env, which may differ from the elab env for (async) errors.
+  match env.checked.get.find? c with
+  | some (.axiomInfo v)  =>
+      modify fun s => { s with axioms := s.axioms.insert c }
+      collectExpr v.type
+  | some (.defnInfo v)   => collectExpr v.type *> collectExpr v.value
+  | some (.thmInfo v)    => collectExpr v.type *> collectExpr v.value
+  | some (.opaqueInfo v) => collectExpr v.type *> collectExpr v.value
+  | some (.quotInfo _)   => pure ()
+  | some (.ctorInfo v)   => collectExpr v.type
+  | some (.recInfo v)    => collectExpr v.type
+  | some (.inductInfo v) => collectExpr v.type *> v.ctors.forM (collect extFind?)
+  | none                 => pure ()
+  -- Cache result (sorted for canonical order) and merge back into saved axioms
+  let collected := (← get).axioms
+  let result := collected.toArray.qsort Name.lt
+  modify fun s => { s with
+    seen   := s.seen.insert c result
+    axioms := insertArray savedAxioms result
+  }
+
+/-- Collect axioms for `c` and return its sorted axiom list from the cache. -/
+private def collectAndGet
+    (extFind? : Environment → Name → Option (Array Name))
+    (c : Name) : M (Array Name) := do
+  collect extFind? c
+  let some axs := (← get).seen.find? c | panic! s!"collectAndGet: '{c}' not in seen after collect"
+  return axs
 
 end CollectAxioms
 
-def collectAxioms [Monad m] [MonadEnv m] (constName : Name) : m (Array Name) := do
+/--
+Extension state holding imported module entries for efficient lookup of
+pre-computed axiom data.
+
+We use `registerPersistentEnvExtension` with manual lookup instead of `MapDeclarationExtension`
+because `exportEntriesFnEx` needs to call `collect`, which needs the extension's `find?`, but
+`exportEntriesFnEx` is defined inside the `builtin_initialize` that creates the extension and
+thus cannot reference it. This state replicates `MapDeclarationExtension.find?`'s per-module
+binary search without requiring the extension object.
+-/
+private structure ExportedAxiomsState where
+  importedModuleEntries : Array (Array (Name × Array Name)) := #[]
+
+instance : Inhabited ExportedAxiomsState := ⟨{}⟩
+
+/-- Look up pre-computed axioms for an imported declaration. -/
+private def ExportedAxiomsState.find? (s : ExportedAxiomsState) (env : Environment)
+    (c : Name) : Option (Array Name) :=
+  match env.getModuleIdxFor? c with
+  | some modIdx =>
+    if h : modIdx.toNat < s.importedModuleEntries.size then
+      match s.importedModuleEntries[modIdx].binSearch (c, #[]) (fun a b => Name.quickLt a.1 b.1) with
+      | some entry => some entry.2
+      | none       => none
+    else none
+  | none => none
+
+/--
+Environment extension that records axiom dependencies for all declarations in a module.
+Entries are computed once by `beforeExportFn` when the olean is serialized, not during
+elaboration. During elaboration, `collectAxioms` walks bodies directly. Downstream modules
+look up pre-computed entries for imported declarations, so axiom collection never crosses
+module boundaries.
+-/
+private builtin_initialize exportedAxiomsExt :
+    PersistentEnvExtension (Name × Array Name) (Name × Array Name) ExportedAxiomsState ←
+  registerPersistentEnvExtension {
+    mkInitial     := pure {}
+    addImportedFn := fun importedEntries => pure { importedModuleEntries := importedEntries }
+    addEntryFn    := fun s _ => s
+    exportEntriesFnEx := fun env s =>
+      let exportedEnv := env.setExporting true
+      let privateEnv := env.setExporting false
+      -- Collect current-module declarations visible in the exported view.
+      -- By pre-computing axiom data for every exported declaration, downstream modules can
+      -- look up any imported declaration without walking its body, keeping collection
+      -- module-local.
+      let allNames := env.checked.get.constants.foldStage2
+        (fun names name _ =>
+          if (exportedEnv.find? name).isSome then names.push name
+          else names) #[]
+      -- Compute axioms within a shared state (for caching across declarations).
+      -- Use `privateEnv` so that `collect` can see all constant bodies.
+      let entries := CollectAxioms.runM privateEnv do
+        allNames.mapM fun name =>
+          return (name, ← CollectAxioms.collectAndGet s.find? name)
+      -- Sort by name for binary search at import time.
+      let entries := entries.qsort fun a b => Name.quickLt a.1 b.1
+      .uniform entries
+    asyncMode     := .mainOnly
+  }
+
+/-- Collect all axioms transitively used by a constant. -/
+public def collectAxioms [Monad m] [MonadEnv m] (constName : Name) : m (Array Name) := do
   let env ← getEnv
-  let (_, s) := ((CollectAxioms.collect constName).run env).run {}
-  pure s.axioms
+  let privateEnv := env.setExporting false
+  let s := exportedAxiomsExt.getState (asyncMode := .mainOnly) env
+  return CollectAxioms.runM privateEnv do
+    CollectAxioms.collectAndGet s.find? constName
 
 end Lean

src/Lean/Util/Trace.lean

@@ -114,6 +114,7 @@ where
       false
 
 /-- Determine if tracing is available for a given class, checking ancestor classes if appropriate. -/
+@[inline]
 def isTracingEnabledFor (cls : Name) : m Bool := do
   return checkTraceOption (← MonadTrace.getInheritedTraceOptions) (← getOptions) cls
 

src/Std/Data/TreeMap/Iterator.lean

@@ -26,7 +26,7 @@ The iterator yields the elements of the map in order and then terminates.
 * `Finite` instance: always
 * `Productive` instance: always
 -/
-@[inline]
+@[inline, cbv_opaque]
 public def iter {α : Type u} {β : Type v}
     {cmp : α → α → Ordering} (m : TreeMap α β cmp) :=
   (m.inner.iter.map fun e => (e.1, e.2) : Iter (α × β))
@@ -63,7 +63,7 @@ public def valuesIter {α : Type u} {β : Type u} {cmp : α → α → Ordering}
     (m : TreeMap α β cmp) :=
   m.inner.valuesIter
 
-@[simp]
+@[simp, cbv_eval]
 public theorem toList_iter {cmp : α → α → Ordering} (m : TreeMap α β cmp) :
     m.iter.toList = m.toList := by
   simp only [iter, Iter.toList_map, DTreeMap.toList_iter, DTreeMap.toList,

src/Std/Do/Triple/SpecLemmas.lean

@@ -697,7 +697,7 @@ After leaving the loop, the cursor's prefix is `xs` and the suffix is empty.
 During the induction step, the invariant holds for a suffix with head element `x`.
 After running the loop body, the invariant then holds after shifting `x` to the prefix.
 -/
-@[mvcgen_invariant_type]
+@[spec_invariant_type]
 abbrev Invariant {α : Type u₁} (xs : List α) (β : Type u₂) (ps : PostShape.{max u₁ u₂}) :=
   PostCond (List.Cursor xs × β) ps
 
@@ -2027,7 +2027,7 @@ A loop invariant is a `PostCond` that takes as parameters
 * A state tuple of type `β`, which will be a nesting of `MProd`s representing the elaboration of
   `let mut` variables and early return.
 -/
-@[mvcgen_invariant_type]
+@[spec_invariant_type]
 abbrev StringInvariant (s : String) (β : Type u) (ps : PostShape.{u}) :=
   PostCond (s.Pos × β) ps
 
@@ -2112,7 +2112,7 @@ A loop invariant is a `PostCond` that takes as parameters
 * A state tuple of type `β`, which will be a nesting of `MProd`s representing the elaboration of
   `let mut` variables and early return.
 -/
-@[mvcgen_invariant_type]
+@[spec_invariant_type]
 abbrev StringSliceInvariant (s : String.Slice) (β : Type u) (ps : PostShape.{u}) :=
   PostCond (s.Pos × β) ps
 

src/Std/Internal/Http/Data.lean

@@ -14,6 +14,7 @@ public import Std.Internal.Http.Data.Status
 public import Std.Internal.Http.Data.Chunk
 public import Std.Internal.Http.Data.Headers
 public import Std.Internal.Http.Data.URI
+public import Std.Internal.Http.Data.Body
 
 /-!
 # HTTP Data Types

src/Std/Internal/Http/Data/Body.lean

@@ -0,0 +1,24 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Std.Internal.Http.Data.Body.Basic
+public import Std.Internal.Http.Data.Body.Length
+public import Std.Internal.Http.Data.Body.Any
+public import Std.Internal.Http.Data.Body.Stream
+public import Std.Internal.Http.Data.Body.Empty
+public import Std.Internal.Http.Data.Body.Full
+
+public section
+
+/-!
+# Body
+
+This module re-exports all HTTP body types: `Body.Empty`, `Body.Full`, `Body.Stream`,
+`Body.Any`, and `Body.Length`, along with the `Http.Body` typeclass and conversion
+utilities (`ToByteArray`, `FromByteArray`).
+-/

src/Std/Internal/Http/Data/Body/Any.lean

@@ -0,0 +1,83 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Std.Internal.Http.Data.Body.Basic
+
+public section
+
+/-!
+# Body.Any
+
+A type-erased body backed by closures. Implements `Http.Body` and can be constructed from any
+type that also implements `Http.Body`. Used as the default handler response body type.
+-/
+
+namespace Std.Http.Body
+open Std Internal IO Async
+
+set_option linter.all true
+
+/--
+A type-erased body handle. Operations are stored as closures, making it open to any body type
+that implements `Http.Body`.
+-/
+structure Any where
+
+  /--
+  Receives the next body chunk. Returns `none` at end-of-stream.
+  -/
+  recv : Async (Option Chunk)
+
+  /--
+  Closes the body stream.
+  -/
+  close : Async Unit
+
+  /--
+  Returns `true` when the body stream is closed.
+  -/
+  isClosed : Async Bool
+
+  /--
+  Selector that resolves when a chunk is available or EOF is reached.
+  -/
+  recvSelector : Selector (Option Chunk)
+
+  /--
+  Returns the declared size.
+  -/
+  getKnownSize : Async (Option Body.Length)
+
+  /--
+  Sets the size of the body.
+  -/
+  setKnownSize : Option Body.Length → Async Unit
+namespace Any
+
+/--
+Erases a body of any `Http.Body` instance into a `Body.Any`.
+-/
+def ofBody [Http.Body α] (body : α) : Any where
+  recv := Http.Body.recv body
+  close := Http.Body.close body
+  isClosed := Http.Body.isClosed body
+  recvSelector := Http.Body.recvSelector body
+  getKnownSize := Http.Body.getKnownSize body
+  setKnownSize := Http.Body.setKnownSize body
+
+end Any
+
+instance : Http.Body Any where
+  recv := Any.recv
+  close := Any.close
+  isClosed := Any.isClosed
+  recvSelector := Any.recvSelector
+  getKnownSize := Any.getKnownSize
+  setKnownSize := Any.setKnownSize
+
+end Std.Http.Body

src/Std/Internal/Http/Data/Body/Basic.lean

@@ -0,0 +1,102 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Std.Internal.Async
+public import Std.Internal.Async.ContextAsync
+public import Std.Internal.Http.Data.Chunk
+public import Std.Internal.Http.Data.Headers
+public import Std.Internal.Http.Data.Body.Length
+
+public section
+
+/-!
+# Body.Basic
+
+This module defines the `Body` typeclass for HTTP body streams, and shared conversion types
+`ToByteArray` and `FromByteArray` used for encoding and decoding body content.
+-/
+
+namespace Std.Http
+open Std Internal IO Async
+
+set_option linter.all true
+
+/--
+Typeclass for values that can be read as HTTP body streams.
+-/
+class Body (α : Type) where
+  /--
+  Receives the next body chunk. Returns `none` at end-of-stream.
+  -/
+  recv : α → Async (Option Chunk)
+
+  /--
+  Closes the body stream.
+  -/
+  close : α → Async Unit
+
+  /--
+  Returns `true` when the body stream is closed.
+  -/
+  isClosed : α → Async Bool
+
+  /--
+  Selector that resolves when a chunk is available or EOF is reached.
+  -/
+  recvSelector : α → Selector (Option Chunk)
+
+  /--
+  Gets the declared size of the body.
+  -/
+  getKnownSize : α → Async (Option Body.Length)
+
+  /--
+  Sets the declared size of a body.
+  -/
+  setKnownSize : α → Option Body.Length → Async Unit
+end Std.Http
+
+namespace Std.Http.Body
+
+/--
+Typeclass for types that can be converted to a `ByteArray`.
+-/
+class ToByteArray (α : Type) where
+
+  /--
+  Transforms into a `ByteArray`.
+  -/
+  toByteArray : α → ByteArray
+
+instance : ToByteArray ByteArray where
+  toByteArray := id
+
+instance : ToByteArray String where
+  toByteArray := String.toUTF8
+
+/--
+Typeclass for types that can be decoded from a `ByteArray`. The conversion may fail with an error
+message if the bytes are not valid for the target type.
+-/
+class FromByteArray (α : Type) where
+
+  /--
+  Attempts to decode a `ByteArray` into the target type, returning an error message on failure.
+  -/
+  fromByteArray : ByteArray → Except String α
+
+instance : FromByteArray ByteArray where
+  fromByteArray := .ok
+
+instance : FromByteArray String where
+  fromByteArray bs :=
+    match String.fromUTF8? bs with
+    | some s => .ok s
+    | none => .error "invalid UTF-8 encoding"
+
+end Std.Http.Body

src/Std/Internal/Http/Data/Body/Empty.lean

@@ -0,0 +1,116 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Std.Internal.Http.Data.Request
+public import Std.Internal.Http.Data.Response
+public import Std.Internal.Http.Data.Body.Any
+
+public section
+
+/-!
+# Body.Empty
+
+Represents an always-empty, already-closed body handle.
+-/
+
+namespace Std.Http.Body
+open Std Internal IO Async
+
+set_option linter.all true
+
+/--
+An empty body handle.
+-/
+structure Empty where
+deriving Inhabited, BEq
+
+namespace Empty
+
+/--
+Receives from an empty body, always returning end-of-stream.
+-/
+@[inline]
+def recv (_ : Empty) : Async (Option Chunk) :=
+  pure none
+
+/--
+Closes an empty body (no-op).
+-/
+@[inline]
+def close (_ : Empty) : Async Unit :=
+  pure ()
+
+/--
+Empty bodies are always closed for reading.
+-/
+@[inline]
+def isClosed (_ : Empty) : Async Bool :=
+  pure true
+
+/--
+Selector that immediately resolves with end-of-stream for an empty body.
+-/
+@[inline]
+def recvSelector (_ : Empty) : Selector (Option Chunk) where
+  tryFn := pure (some none)
+  registerFn waiter := do
+    let lose := pure ()
+    let win promise := do
+      promise.resolve (.ok none)
+    waiter.race lose win
+  unregisterFn := pure ()
+
+end Empty
+
+instance : Http.Body Empty where
+  recv := Empty.recv
+  close := Empty.close
+  isClosed := Empty.isClosed
+  recvSelector := Empty.recvSelector
+  getKnownSize _ := pure (some <| .fixed 0)
+  setKnownSize _ _ := pure ()
+
+
+instance : Coe Empty Any := ⟨Any.ofBody⟩
+
+instance : Coe (Response Empty) (Response Any) where
+  coe f := { f with }
+
+instance : Coe (ContextAsync (Response Empty)) (ContextAsync (Response Any)) where
+  coe action := do
+    let response ← action
+    pure (response : Response Any)
+
+instance : Coe (Async (Response Empty)) (ContextAsync (Response Any)) where
+  coe action := do
+    let response ← action
+    pure (response : Response Any)
+
+end Body
+
+namespace Request.Builder
+open Internal.IO.Async
+
+/--
+Builds a request with no body.
+-/
+def empty (builder : Builder) : Async (Request Body.Empty) :=
+  pure <| builder.body {}
+
+end Request.Builder
+
+namespace Response.Builder
+open Internal.IO.Async
+
+/--
+Builds a response with no body.
+-/
+def empty (builder : Builder) : Async (Response Body.Empty) :=
+  pure <| builder.body {}
+
+end Response.Builder

src/Std/Internal/Http/Data/Body/Full.lean

@@ -0,0 +1,232 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Std.Sync
+public import Std.Internal.Http.Data.Request
+public import Std.Internal.Http.Data.Response
+public import Std.Internal.Http.Data.Body.Any
+public import Init.Data.ByteArray
+
+public section
+
+/-!
+# Body.Full
+
+A body backed by a fixed `ByteArray` held in a `Mutex`.
+
+The byte array is consumed at most once: the first call to `recv` atomically takes the data
+and returns it as a single chunk; subsequent calls return `none` (end-of-stream).
+Closing the body discards any unconsumed data.
+-/
+
+namespace Std.Http.Body
+open Std Internal IO Async
+
+set_option linter.all true
+
+/--
+A body backed by a fixed, mutex-protected `ByteArray`.
+
+The data is consumed on the first read. Once consumed (or explicitly closed), the body
+behaves as a closed, empty channel.
+-/
+structure Full where
+  private mk ::
+  private state : Mutex (Option ByteArray)
+deriving Nonempty
+
+namespace Full
+
+private def takeChunk : AtomicT (Option ByteArray) Async (Option Chunk) := do
+  match ← get with
+  | none =>
+    pure none
+  | some data =>
+    set (none : Option ByteArray)
+    if data.isEmpty then
+      pure none
+    else
+      pure (some (Chunk.ofByteArray data))
+
+/--
+Creates a `Full` body from a `ByteArray`.
+-/
+def ofByteArray (data : ByteArray) : Async Full := do
+  let state ← Mutex.new (some data)
+  return { state }
+
+/--
+Creates a `Full` body from a `String`.
+-/
+def ofString (data : String) : Async Full := do
+  let state ← Mutex.new (some data.toUTF8)
+  return { state }
+
+/--
+Receives the body data. Returns the full byte array on the first call as a single chunk,
+then `none` on all subsequent calls.
+-/
+def recv (full : Full) : Async (Option Chunk) :=
+  full.state.atomically do
+    takeChunk
+
+/--
+Closes the body, discarding any unconsumed data.
+-/
+def close (full : Full) : Async Unit :=
+  full.state.atomically do
+    set (none : Option ByteArray)
+
+/--
+Returns `true` when the data has been consumed or the body has been closed.
+-/
+def isClosed (full : Full) : Async Bool :=
+  full.state.atomically do
+    return (← get).isNone
+
+/--
+Returns the known size of the remaining data.
+Returns `some (.fixed n)` with the current byte count, or `some (.fixed 0)` if the body has
+already been consumed or closed.
+-/
+def getKnownSize (full : Full) : Async (Option Body.Length) :=
+  full.state.atomically do
+    match ← get with
+    | none => pure (some (.fixed 0))
+    | some data => pure (some (.fixed data.size))
+
+/--
+Selector that immediately resolves to the remaining chunk (or EOF).
+-/
+def recvSelector (full : Full) : Selector (Option Chunk) where
+  tryFn := do
+    let chunk ← full.state.atomically do
+      takeChunk
+    pure (some chunk)
+
+  registerFn waiter := do
+    full.state.atomically do
+      let lose := pure ()
+
+      let win promise := do
+        let chunk ← takeChunk
+        promise.resolve (.ok chunk)
+
+      waiter.race lose win
+
+  unregisterFn := pure ()
+
+end Full
+
+instance : Http.Body Full where
+  recv := Full.recv
+  close := Full.close
+  isClosed := Full.isClosed
+  recvSelector := Full.recvSelector
+  getKnownSize := Full.getKnownSize
+  setKnownSize _ _ := pure ()
+
+instance : Coe Full Any := ⟨Any.ofBody⟩
+
+instance : Coe (Response Full) (Response Any) where
+  coe f := { f with }
+
+instance : Coe (ContextAsync (Response Full)) (ContextAsync (Response Any)) where
+  coe action := do
+    let response ← action
+    pure (response : Response Any)
+
+instance : Coe (Async (Response Full)) (ContextAsync (Response Any)) where
+  coe action := do
+    let response ← action
+    pure (response : Response Any)
+
+end Body
+
+namespace Request.Builder
+
+open Internal.IO.Async
+
+/--
+Builds a request body from raw bytes without setting any headers.
+Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
+-/
+def fromBytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) := do
+  return builder.body (← Body.Full.ofByteArray content)
+
+/--
+Builds a request with a binary body.
+Sets `Content-Type: application/octet-stream`.
+Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
+-/
+def bytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
+
+/--
+Builds a request with a text body.
+Sets `Content-Type: text/plain; charset=utf-8`.
+-/
+def text (builder : Builder) (content : String) : Async (Request Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
+
+/--
+Builds a request with a JSON body.
+Sets `Content-Type: application/json`.
+-/
+def json (builder : Builder) (content : String) : Async (Request Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
+
+/--
+Builds a request with an HTML body.
+Sets `Content-Type: text/html; charset=utf-8`.
+-/
+def html (builder : Builder) (content : String) : Async (Request Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
+
+end Request.Builder
+
+namespace Response.Builder
+open Internal.IO.Async
+
+/--
+Builds a response body from raw bytes without setting any headers.
+Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
+-/
+def fromBytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) := do
+  return builder.body (← Body.Full.ofByteArray content)
+
+/--
+Builds a response with a binary body.
+Sets `Content-Type: application/octet-stream`.
+Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
+-/
+def bytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
+
+/--
+Builds a response with a text body.
+Sets `Content-Type: text/plain; charset=utf-8`.
+-/
+def text (builder : Builder) (content : String) : Async (Response Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
+
+/--
+Builds a response with a JSON body.
+Sets `Content-Type: application/json`.
+-/
+def json (builder : Builder) (content : String) : Async (Response Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
+
+/--
+Builds a response with an HTML body.
+Sets `Content-Type: text/html; charset=utf-8`.
+-/
+def html (builder : Builder) (content : String) : Async (Response Body.Full) :=
+  fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
+
+end Response.Builder

src/Std/Internal/Http/Data/Body/Length.lean

@@ -0,0 +1,60 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+module
+
+prelude
+public import Init.Data.Repr
+
+public section
+
+/-!
+# Body.Length
+
+This module defines the `Length` type, that represents the Content-Length or Transfer-Encoding
+of an HTTP request or response.
+-/
+
+namespace Std.Http.Body
+
+set_option linter.all true
+
+/--
+Size of the body of a response or request.
+-/
+inductive Length
+  /--
+  Indicates that the HTTP message body uses **chunked transfer encoding**.
+  -/
+  | chunked
+
+  /--
+  Indicates that the HTTP message body has a **fixed, known length**, as specified by the
+  `Content-Length` header.
+  -/
+  | fixed (n : Nat)
+deriving Repr, BEq
+
+namespace Length
+
+/--
+Checks if the `Length` is chunked.
+-/
+@[inline]
+def isChunked : Length → Bool
+  | .chunked => true
+  | _ => false
+
+/--
+Checks if the `Length` is a fixed size.
+-/
+@[inline]
+def isFixed : Length → Bool
+  | .fixed _ => true
+  | _ => false
+
+end Length
+
+end Std.Http.Body