chore: fix tests

This PR adds typeclasses for `grind` to embed types into `Int`, for
cutsat. This allows, for example, treating `Fin n`, or Mathlib's `ℕ+` in
a uniform and extensible way.

There is a primary typeclass that carries the `toInt` function, and a
description of the interval the type embeds in. There are then
individual typeclasses describing how arithmetic/order operations
interact with the embedding.

src/Init/Data/Array/Lemmas.lean

@@ -133,7 +133,6 @@ grind_pattern Array.getElem?_eq_none => xs.size ≤ i, xs[i]?
 theorem getElem?_eq_some_iff {xs : Array α} : xs[i]? = some b ↔ ∃ h : i < xs.size, xs[i] = b :=
   _root_.getElem?_eq_some_iff
 
-@[grind →]
 theorem getElem_of_getElem? {xs : Array α} : xs[i]? = some a → ∃ h : i < xs.size, xs[i] = a :=
   getElem?_eq_some_iff.mp
 
@@ -176,7 +175,7 @@ theorem getElem_push_lt {xs : Array α} {x : α} {i : Nat} (h : i < xs.size) :
   simp only [push, ← getElem_toList, List.concat_eq_append]
   rw [List.getElem_append_right] <;> simp [← getElem_toList, Nat.zero_lt_one]
 
-theorem getElem_push {xs : Array α} {x : α} {i : Nat} (h : i < (xs.push x).size) :
+@[grind =] theorem getElem_push {xs : Array α} {x : α} {i : Nat} (h : i < (xs.push x).size) :
     (xs.push x)[i] = if h : i < xs.size then xs[i] else x := by
   by_cases h' : i < xs.size
   · simp [getElem_push_lt, h']
@@ -954,6 +953,13 @@ theorem set_push {xs : Array α} {x y : α} {h} :
         · simp at h
           omega
 
+@[grind _=_]
+theorem set_pop {xs : Array α} {x : α} {i : Nat} (h : i < xs.pop.size) :
+    xs.pop.set i x h = (xs.set i x (by simp at h; omega)).pop := by
+  ext i h₁ h₂
+  · simp
+  · simp [getElem_set]
+
 @[simp] theorem set_eq_empty_iff {xs : Array α} {i : Nat} {a : α} {h : i < xs.size} :
     xs.set i a = #[] ↔ xs = #[] := by
   cases xs <;> cases i <;> simp [set]
@@ -986,7 +992,11 @@ theorem mem_or_eq_of_mem_set
 @[simp, grind] theorem setIfInBounds_empty {i : Nat} {a : α} :
     #[].setIfInBounds i a = #[] := rfl
 
-@[simp] theorem set!_eq_setIfInBounds : @set! = @setIfInBounds := rfl
+@[simp, grind =] theorem set!_eq_setIfInBounds : set! xs i v = setIfInBounds xs i v := rfl
+
+@[grind]
+theorem setIfInBounds_def (xs : Array α) (i : Nat) (a : α) :
+    xs.setIfInBounds i a = if h : i < xs.size then xs.set i a else xs := rfl
 
 @[deprecated set!_eq_setIfInBounds (since := "2024-12-12")]
 abbrev set!_is_setIfInBounds := @set!_eq_setIfInBounds
@@ -1078,7 +1088,7 @@ theorem mem_or_eq_of_mem_setIfInBounds
   by_cases h : i < xs.size <;>
     simp [setIfInBounds, Nat.not_lt_of_le, h,  getD_getElem?]
 
-@[simp] theorem toList_setIfInBounds {xs : Array α} {i : Nat} {x : α} :
+@[simp, grind =] theorem toList_setIfInBounds {xs : Array α} {i : Nat} {x : α} :
     (xs.setIfInBounds i x).toList = xs.toList.set i x := by
   simp only [setIfInBounds]
   split <;> rename_i h
@@ -2997,6 +3007,10 @@ theorem extract_empty_of_size_le_start {xs : Array α} {start stop : Nat} (h : x
   apply ext'
   simp
 
+theorem _root_.List.toArray_drop {l : List α} {k : Nat} :
+    (l.drop k).toArray = l.toArray.extract k := by
+  rw [List.drop_eq_extract, List.extract_toArray, List.size_toArray]
+
 @[deprecated extract_size (since := "2025-02-27")]
 theorem take_size {xs : Array α} : xs.take xs.size = xs := by
   cases xs

src/Init/Data/BitVec/Lemmas.lean

@@ -319,6 +319,7 @@ theorem ofFin_ofNat (n : Nat) :
 @[simp] theorem ofFin_neg {x : Fin (2 ^ w)} : ofFin (-x) = -(ofFin x) := by
   rfl
 
+open Fin.NatCast in
 @[simp, norm_cast] theorem ofFin_natCast (n : Nat) : ofFin (n : Fin (2^w)) = (n : BitVec w) := by
   rfl
 
@@ -337,6 +338,7 @@ theorem toFin_zero : toFin (0 : BitVec w) = 0 := rfl
 theorem toFin_one  : toFin (1 : BitVec w) = 1 := by
   rw [toFin_inj]; simp only [ofNat_eq_ofNat, ofFin_ofNat]
 
+open Fin.NatCast in
 @[simp, norm_cast] theorem toFin_natCast (n : Nat) : toFin (n : BitVec w) = (n : Fin (2^w)) := by
   rfl
 

src/Init/Data/Fin/Lemmas.lean

@@ -102,9 +102,30 @@ theorem dite_val {n : Nat} {c : Prop} [Decidable c] {x y : Fin n} :
     (if c then x else y).val = if c then x.val else y.val := by
   by_cases c <;> simp [*]
 
-instance (n : Nat) [NeZero n] : NatCast (Fin n) where
+namespace NatCast
+
+/--
+This is not a global instance, but may be activated locally via `open Fin.NatCast in ...`.
+
+This is not an instance because the `binop%` elaborator assumes that
+there are no non-trivial coercion loops,
+but this introduces a coercion from `Nat` to `Fin n` and back.
+
+Non-trivial loops lead to undesirable and counterintuitive elaboration behavior.
+For example, for `x : Fin k` and `n : Nat`,
+it causes `x < n` to be elaborated as `x < ↑n` rather than `↑x < n`,
+silently introducing wraparound arithmetic.
+
+Note: as of 2025-06-03, Mathlib has such a coercion for `Fin n` anyway!
+-/
+@[expose]
+def instNatCast (n : Nat) [NeZero n] : NatCast (Fin n) where
   natCast a := Fin.ofNat n a
 
+attribute [scoped instance] instNatCast
+
+end NatCast
+
 @[expose]
 def intCast [NeZero n] (a : Int) : Fin n :=
   if 0 ≤ a then
@@ -112,9 +133,22 @@ def intCast [NeZero n] (a : Int) : Fin n :=
   else
     - Fin.ofNat n a.natAbs
 
-instance (n : Nat) [NeZero n] : IntCast (Fin n) where
+namespace IntCast
+
+/--
+This is not a global instance, but may be activated locally via `open Fin.IntCast in ...`.
+
+See the doc-string for `Fin.NatCast.instNatCast` for more details.
+-/
+@[expose]
+def instIntCast (n : Nat) [NeZero n] : IntCast (Fin n) where
   intCast := Fin.intCast
 
+attribute [scoped instance] instIntCast
+
+end IntCast
+
+open IntCast in
 theorem intCast_def {n : Nat} [NeZero n] (x : Int) :
     (x : Fin n) = if 0 ≤ x then Fin.ofNat n x.natAbs else -Fin.ofNat n x.natAbs := rfl
 

src/Init/Data/List/Pairwise.lean

@@ -279,7 +279,7 @@ theorem nodup_nil : @Nodup α [] :=
 theorem nodup_cons {a : α} {l : List α} : Nodup (a :: l) ↔ a ∉ l ∧ Nodup l := by
   simp only [Nodup, pairwise_cons, forall_mem_ne]
 
-theorem Nodup.sublist : l₁ <+ l₂ → Nodup l₂ → Nodup l₁ :=
+@[grind →] theorem Nodup.sublist : l₁ <+ l₂ → Nodup l₂ → Nodup l₁ :=
   Pairwise.sublist
 
 grind_pattern Nodup.sublist => l₁ <+ l₂, Nodup l₁

src/Init/Data/List/TakeDrop.lean

@@ -257,6 +257,17 @@ theorem dropLast_eq_take {l : List α} : l.dropLast = l.take (l.length - 1) := b
     dsimp
     rw [map_drop]
 
+theorem drop_eq_extract {l : List α} {k : Nat} :
+    l.drop k = l.extract k := by
+  induction l generalizing k
+  case nil => simp
+  case cons _ _ ih =>
+    match k with
+    | 0 => simp
+    | _ + 1 =>
+      simp only [List.drop_succ_cons, List.length_cons, ih]
+      simp only [List.extract_eq_drop_take, List.drop_succ_cons, Nat.succ_sub_succ]
+
 /-! ### takeWhile and dropWhile -/
 
 theorem takeWhile_cons {p : α → Bool} {a : α} {l : List α} :

src/Init/GetElem.lean

@@ -164,25 +164,25 @@ export LawfulGetElem (getElem?_def getElem!_def)
 instance (priority := low) [GetElem coll idx elem valid] [∀ xs i, Decidable (valid xs i)] :
     LawfulGetElem coll idx elem valid where
 
-@[simp] theorem getElem?_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
+@[simp, grind] theorem getElem?_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     (c : cont) (i : idx) (h : dom c i) : c[i]? = some (c[i]'h) := by
   have : Decidable (dom c i) := .isTrue h
   rw [getElem?_def]
   exact dif_pos h
 
-@[simp] theorem getElem?_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
+@[simp, grind] theorem getElem?_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     (c : cont) (i : idx) (h : ¬dom c i) : c[i]? = none := by
   have : Decidable (dom c i) := .isFalse h
   rw [getElem?_def]
   exact dif_neg h
 
-@[simp] theorem getElem!_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
+@[simp, grind] theorem getElem!_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     [Inhabited elem] (c : cont) (i : idx) (h : dom c i) :
     c[i]! = c[i]'h := by
   have : Decidable (dom c i) := .isTrue h
   simp [getElem!_def, getElem?_def, h]
 
-@[simp] theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
+@[simp, grind] theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     [Inhabited elem] (c : cont) (i : idx) (h : ¬dom c i) : c[i]! = default := by
   have : Decidable (dom c i) := .isFalse h
   simp [getElem!_def, getElem?_def, h]
@@ -193,7 +193,7 @@ instance (priority := low) [GetElem coll idx elem valid] [∀ xs i, Decidable (v
   simp only [getElem?_def] at h ⊢
   split <;> simp_all
 
-@[simp, grind =] theorem getElem?_eq_none_iff [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
+@[simp] theorem getElem?_eq_none_iff [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     (c : cont) (i : idx) [Decidable (dom c i)] : c[i]? = none ↔ ¬dom c i := by
   simp only [getElem?_def]
   split <;> simp_all
@@ -238,8 +238,6 @@ theorem getElem_of_getElem? [GetElem? cont idx elem dom] [LawfulGetElem cont idx
     {c : cont} {i : idx} [Decidable (dom c i)] (h : c[i]? = some e) : Exists fun h : dom c i => c[i] = e :=
   getElem?_eq_some_iff.mp h
 
-grind_pattern getElem_of_getElem? => c[i]?, some e
-
 @[simp] theorem some_getElem_eq_getElem?_iff [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     {c : cont} {i : idx} [Decidable (dom c i)] (h : dom c i):
     (some c[i] = c[i]?) ↔ True := by
@@ -275,12 +273,12 @@ instance [GetElem? cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
   getElem?_def _c _i _d := h.getElem?_def ..
   getElem!_def _c _i := h.getElem!_def ..
 
-@[simp] theorem getElem_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
+@[simp, grind =] theorem getElem_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
     a[i] = a[i.1] := rfl
 
-@[simp] theorem getElem?_fin [h : GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) : a[i]? = a[i.1]? := rfl
+@[simp, grind =] theorem getElem?_fin [h : GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) : a[i]? = a[i.1]? := rfl
 
-@[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Inhabited Elem] : a[i]! = a[i.1]! := rfl
+@[simp, grind =] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Inhabited Elem] : a[i]! = a[i.1]! := rfl
 
 macro_rules
   | `(tactic| get_elem_tactic_trivial) => `(tactic| (with_reducible apply Fin.val_lt_of_le); get_elem_tactic_trivial; done)

src/Init/Grind.lean

@@ -18,3 +18,5 @@ import Init.Grind.CommRing
 import Init.Grind.Module
 import Init.Grind.Ordered
 import Init.Grind.Ext
+import Init.Grind.ToInt
+import Init.Data.Int.OfNat -- This may not have otherwise been imported, breaking `grind` proofs.

src/Init/Grind/CommRing/Basic.lean

@@ -71,7 +71,9 @@ class CommRing (α : Type u) extends Ring α, CommSemiring α
 attribute [instance 100] Semiring.toAdd Semiring.toMul Semiring.toHPow Ring.toNeg Ring.toSub
 
 -- This is a low-priority instance, to avoid conflicts with existing `OfNat`, `NatCast`, and `IntCast` instances.
-attribute [instance 100] Semiring.ofNat Semiring.natCast Ring.intCast
+attribute [instance 100] Semiring.ofNat
+
+attribute [local instance] Semiring.natCast Ring.intCast
 
 namespace Semiring
 

src/Init/Grind/CommRing/Fin.lean

@@ -14,22 +14,6 @@ namespace Lean.Grind
 
 namespace Fin
 
-instance (n : Nat) [NeZero n] : NatCast (Fin n) where
-  natCast a := Fin.ofNat n a
-
-@[expose]
-def intCast [NeZero n] (a : Int) : Fin n :=
-  if 0 ≤ a then
-    Fin.ofNat n a.natAbs
-  else
-    - Fin.ofNat n a.natAbs
-
-instance (n : Nat) [NeZero n] : IntCast (Fin n) where
-  intCast := Fin.intCast
-
-theorem intCast_def {n : Nat} [NeZero n] (x : Int) :
-    (x : Fin n) = if 0 ≤ x then Fin.ofNat n x.natAbs else -Fin.ofNat n x.natAbs := rfl
-
 -- TODO: we should replace this at runtime with either repeated squaring,
 -- or a GMP accelerated function.
 @[expose]
@@ -78,18 +62,22 @@ theorem sub_eq_add_neg [NeZero n] (a b : Fin n) : a - b = a + -b := by
   cases a; cases b; simp [Fin.neg_def, Fin.sub_def, Fin.add_def, Nat.add_comm]
 
 private theorem neg_neg [NeZero n] (a : Fin n) : - - a = a := by
-  cases a; simp [Fin.neg_def, Fin.sub_def];
+  cases a; simp [Fin.neg_def, Fin.sub_def]
   next a h => cases a; simp; next a =>
    rw [Nat.self_sub_mod n (a+1)]
    have : NeZero (n - (a + 1)) := ⟨by omega⟩
    rw [Nat.self_sub_mod, Nat.sub_sub_eq_min, Nat.min_eq_right (Nat.le_of_lt h)]
 
+open Fin.NatCast Fin.IntCast in
 theorem intCast_neg [NeZero n] (i : Int) : Int.cast (R := Fin n) (-i) = - Int.cast (R := Fin n) i := by
-  simp [Int.cast, IntCast.intCast, Fin.intCast]; split <;> split <;> try omega
+  simp [Int.cast, IntCast.intCast, Fin.intCast]
+  split <;> split <;> try omega
   next h₁ h₂ => simp [Int.le_antisymm h₁ h₂, Fin.neg_def]
   next => simp [Fin.neg_neg]
 
 instance (n : Nat) [NeZero n] : CommRing (Fin n) where
+  natCast := Fin.NatCast.instNatCast n
+  intCast := Fin.IntCast.instIntCast n
   add_assoc := Fin.add_assoc
   add_comm := Fin.add_comm
   add_zero := Fin.add_zero

src/Init/Grind/CommRing/Poly.lean

@@ -15,6 +15,9 @@ import Init.Grind.CommRing.Basic
 namespace Lean.Grind
 namespace CommRing
 
+-- These are no longer global instances, so we need to turn them on here.
+attribute [local instance] Semiring.natCast Ring.intCast
+
 abbrev Var := Nat
 
 inductive Expr where

src/Init/Grind/ToInt.lean

@@ -0,0 +1,329 @@
+/-
+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: Kim Morrison
+-/
+module
+
+prelude
+
+import Init.Data.Int.DivMod.Basic
+import Init.Data.Int.Lemmas
+import Init.Data.Int.Order
+import Init.Data.Fin.Lemmas
+import Init.Data.UInt.Lemmas
+import Init.Data.SInt.Lemmas
+
+/-!
+# Typeclasses for types that can be embedded into an interval of `Int`.
+
+The typeclass `ToInt α lo? hi?` carries the data of a function `ToInt.toInt : α → Int`
+which is injective, lands between the (optional) lower and upper bounds `lo?` and `hi?`.
+
+The function `ToInt.wrap` is the identity if either bound is `none`,
+and otherwise wraps the integers into the interval `[lo, hi)`.
+
+The typeclass `ToInt.Add α lo? hi?` then asserts that `toInt (x + y) = wrap lo? hi? (toInt x + toInt y)`.
+There are many variants for other operations.
+
+These typeclasses are used solely in the `grind` tactic to lift linear inequalities into `Int`.
+
+-- TODO: instances for `ToInt.Mod` (only exists for `Fin n` so far)
+-- TODO: typeclasses for LT, and other algebraic operations.
+-/
+
+namespace Lean.Grind
+
+class ToInt (α : Type u) (lo? hi? : outParam (Option Int)) where
+  toInt : α → Int
+  toInt_inj : ∀ x y, toInt x = toInt y → x = y
+  le_toInt : lo? = some lo → lo ≤ toInt x
+  toInt_lt : hi? = some hi → toInt x < hi
+
+@[simp 500]
+def ToInt.wrap (lo? hi? : Option Int) (x : Int) : Int :=
+  match lo?, hi? with
+  | some lo, some hi => (x - lo) % (hi - lo) + lo
+  | _, _ => x
+
+theorem ToInt.wrap_eq_bmod {i : Int} (h : 0 ≤ i) :
+    ToInt.wrap (some (-i)) (some i) x = x.bmod ((2 * i).toNat) := by
+  match i, h with
+  | (i : Nat), _ =>
+    have : (2 * (i : Int)).toNat = 2 * i := by omega
+    simp only [this]
+    simp [Int.bmod_eq_emod, ← Int.two_mul]
+    have : (2 * (i : Int) + 1) / 2 = i := by omega
+    simp only [this]
+    by_cases h : i = 0
+    · simp [h]
+    split
+    · rw [← Int.sub_eq_add_neg, Int.sub_eq_iff_eq_add, Nat.two_mul, Int.natCast_add,
+        ← Int.sub_sub, Int.sub_add_cancel]
+      rw [Int.emod_eq_iff (by omega)]
+      refine ⟨?_, ?_, ?_⟩
+      · omega
+      · have := Int.emod_lt x (b := 2 * (i : Int)) (by omega)
+        omega
+      · rw [Int.emod_def]
+        have : x - 2 * ↑i * (x / (2 * ↑i)) - ↑i - (x + ↑i) = (2 * (i : Int)) * (- (x / (2 * i)) - 1) := by
+          simp only [Int.mul_sub, Int.mul_neg]
+          omega
+        simp only [this]
+        exact Int.dvd_mul_right ..
+    · rw [← Int.sub_eq_add_neg, Int.sub_eq_iff_eq_add, Int.natCast_zero, Int.sub_zero]
+      rw [Int.emod_eq_iff (by omega)]
+      refine ⟨?_, ?_, ?_⟩
+      · have := Int.emod_nonneg x (b := 2 * (i : Int)) (by omega)
+        omega
+      · omega
+      · rw [Int.emod_def]
+        have : x - 2 * ↑i * (x / (2 * ↑i)) + ↑i - (x + ↑i) = (2 * (i : Int)) * (- (x / (2 * i))) := by
+          simp only [Int.mul_neg]
+          omega
+        simp only [this]
+        exact Int.dvd_mul_right ..
+
+class ToInt.Add (α : Type u) [Add α] (lo? hi? : Option Int) [ToInt α lo? hi?] where
+  toInt_add : ∀ x y : α, toInt (x + y) = wrap lo? hi? (toInt x + toInt y)
+
+class ToInt.Mod (α : Type u) [Mod α] (lo? hi? : Option Int) [ToInt α lo? hi?] where
+  toInt_mod : ∀ x y : α, toInt (x % y) = wrap lo? hi? (toInt x % toInt y)
+
+class ToInt.LE (α : Type u) [LE α] (lo? hi? : Option Int) [ToInt α lo? hi?] where
+  le_iff : ∀ x y : α, x ≤ y ↔ toInt x ≤ toInt y
+
+instance : ToInt Int none none where
+  toInt := id
+  toInt_inj := by simp
+  le_toInt := by simp
+  toInt_lt := by simp
+
+@[simp] theorem toInt_int (x : Int) : ToInt.toInt x = x := rfl
+
+instance : ToInt.Add Int none none where
+  toInt_add := by simp
+
+instance : ToInt.LE Int none none where
+  le_iff x y := by simp
+
+instance : ToInt Nat (some 0) none where
+  toInt := Nat.cast
+  toInt_inj x y := Int.ofNat_inj.mp
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x
+  toInt_lt := by simp
+
+@[simp] theorem toInt_nat (x : Nat) : ToInt.toInt x = (x : Int) := rfl
+
+instance : ToInt.Add Nat (some 0) none where
+  toInt_add := by simp
+
+instance : ToInt.LE Nat (some 0) none where
+  le_iff x y := by simp
+
+-- Mathlib will add a `ToInt ℕ+ (some 1) none` instance.
+
+instance : ToInt (Fin n) (some 0) (some n) where
+  toInt x := x.val
+  toInt_inj x y w := Fin.eq_of_val_eq (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.natCast_nonneg x
+  toInt_lt {hi x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.ofNat_lt.mpr x.isLt
+
+@[simp] theorem toInt_fin (x : Fin n) : ToInt.toInt x = (x.val : Int) := rfl
+
+instance : ToInt.Add (Fin n) (some 0) (some n) where
+  toInt_add x y := by rfl
+
+instance : ToInt.Mod (Fin n) (some 0) (some n) where
+  toInt_mod x y := by
+    simp only [toInt_fin, Fin.mod_val, Int.natCast_emod, ToInt.wrap, Int.sub_zero, Int.add_zero]
+    rw [Int.emod_eq_of_lt (b := n)]
+    · omega
+    · rw [Int.ofNat_mod_ofNat, ← Fin.mod_val]
+      exact Int.ofNat_lt.mpr (x % y).isLt
+
+instance : ToInt.LE (Fin n) (some 0) (some n) where
+  le_iff x y := by simpa using Fin.le_def
+
+instance : ToInt UInt8 (some 0) (some (2^8)) where
+  toInt x := (x.toNat : Int)
+  toInt_inj x y w := UInt8.toNat_inj.mp (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt8.toNat_lt x)
+
+@[simp] theorem toInt_uint8 (x : UInt8) : ToInt.toInt x = (x.toNat : Int) := rfl
+
+instance : ToInt.Add UInt8 (some 0) (some (2^8)) where
+  toInt_add x y := by simp
+
+instance : ToInt.LE UInt8 (some 0) (some (2^8)) where
+  le_iff x y := by simpa using UInt8.le_iff_toBitVec_le
+
+instance : ToInt UInt16 (some 0) (some (2^16)) where
+  toInt x := (x.toNat : Int)
+  toInt_inj x y w := UInt16.toNat_inj.mp (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt16.toNat_lt x)
+
+@[simp] theorem toInt_uint16 (x : UInt16) : ToInt.toInt x = (x.toNat : Int) := rfl
+
+instance : ToInt.Add UInt16 (some 0) (some (2^16)) where
+  toInt_add x y := by simp
+
+instance : ToInt.LE UInt16 (some 0) (some (2^16)) where
+  le_iff x y := by simpa using UInt16.le_iff_toBitVec_le
+
+instance : ToInt UInt32 (some 0) (some (2^32)) where
+  toInt x := (x.toNat : Int)
+  toInt_inj x y w := UInt32.toNat_inj.mp (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt32.toNat_lt x)
+
+@[simp] theorem toInt_uint32 (x : UInt32) : ToInt.toInt x = (x.toNat : Int) := rfl
+
+instance : ToInt.Add UInt32 (some 0) (some (2^32)) where
+  toInt_add x y := by simp
+
+instance : ToInt.LE UInt32 (some 0) (some (2^32)) where
+  le_iff x y := by simpa using UInt32.le_iff_toBitVec_le
+
+instance : ToInt UInt64 (some 0) (some (2^64)) where
+  toInt x := (x.toNat : Int)
+  toInt_inj x y w := UInt64.toNat_inj.mp (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt64.toNat_lt x)
+
+@[simp] theorem toInt_uint64 (x : UInt64) : ToInt.toInt x = (x.toNat : Int) := rfl
+
+instance : ToInt.Add UInt64 (some 0) (some (2^64)) where
+  toInt_add x y := by simp
+
+instance : ToInt.LE UInt64 (some 0) (some (2^64)) where
+  le_iff x y := by simpa using UInt64.le_iff_toBitVec_le
+
+instance : ToInt USize (some 0) (some (2^System.Platform.numBits)) where
+  toInt x := (x.toNat : Int)
+  toInt_inj x y w := USize.toNat_inj.mp (Int.ofNat_inj.mp w)
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
+  toInt_lt {hi x} w := by
+    simp at w; subst w
+    rw [show (2 : Int) ^ System.Platform.numBits = (2 ^ System.Platform.numBits : Nat) by simp,
+      Int.ofNat_lt]
+    exact USize.toNat_lt_two_pow_numBits x
+
+@[simp] theorem toInt_usize (x : USize) : ToInt.toInt x = (x.toNat : Int) := rfl
+
+instance : ToInt.Add USize (some 0) (some (2^System.Platform.numBits)) where
+  toInt_add x y := by simp
+
+instance : ToInt.LE USize (some 0) (some (2^System.Platform.numBits)) where
+  le_iff x y := by simpa using USize.le_iff_toBitVec_le
+
+instance : ToInt Int8 (some (-2^7)) (some (2^7)) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int8.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact Int8.le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int8.toInt_lt x
+
+@[simp] theorem toInt_int8 (x : Int8) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Add Int8 (some (-2^7)) (some (2^7)) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.LE Int8 (some (-2^7)) (some (2^7)) where
+  le_iff x y := by simpa using Int8.le_iff_toInt_le
+
+instance : ToInt Int16 (some (-2^15)) (some (2^15)) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int16.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact Int16.le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int16.toInt_lt x
+
+@[simp] theorem toInt_int16 (x : Int16) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Add Int16 (some (-2^15)) (some (2^15)) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.LE Int16 (some (-2^15)) (some (2^15)) where
+  le_iff x y := by simpa using Int16.le_iff_toInt_le
+
+instance : ToInt Int32 (some (-2^31)) (some (2^31)) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int32.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact Int32.le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int32.toInt_lt x
+
+@[simp] theorem toInt_int32 (x : Int32) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Add Int32 (some (-2^31)) (some (2^31)) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.LE Int32 (some (-2^31)) (some (2^31)) where
+  le_iff x y := by simpa using Int32.le_iff_toInt_le
+
+instance : ToInt Int64 (some (-2^63)) (some (2^63)) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int64.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact Int64.le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int64.toInt_lt x
+
+@[simp] theorem toInt_int64 (x : Int64) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Add Int64 (some (-2^63)) (some (2^63)) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.LE Int64 (some (-2^63)) (some (2^63)) where
+  le_iff x y := by simpa using Int64.le_iff_toInt_le
+
+instance : ToInt (BitVec 0) (some 0) (some 1) where
+  toInt x := 0
+  toInt_inj x y w := by simp at w; exact BitVec.eq_of_zero_length rfl
+  le_toInt {lo x} w := by simp at w; subst w; exact Int.zero_le_ofNat 0
+  toInt_lt {hi x} w := by simp at w; subst w; exact Int.one_pos
+
+@[simp] theorem toInt_bitVec_0 (x : BitVec 0) : ToInt.toInt x = 0 := rfl
+
+instance [NeZero v] : ToInt (BitVec v) (some (-2^(v-1))) (some (2^(v-1))) where
+  toInt x := x.toInt
+  toInt_inj x y w := BitVec.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact BitVec.le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact BitVec.toInt_lt
+
+@[simp] theorem toInt_bitVec [NeZero v] (x : BitVec v) : ToInt.toInt x = x.toInt := rfl
+
+instance [i : NeZero v] : ToInt.Add (BitVec v) (some (-2^(v-1))) (some (2^(v-1))) where
+  toInt_add x y := by
+    rw [toInt_bitVec, BitVec.toInt_add, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
+    have : ((2 : Int) * 2 ^ (v - 1)).toNat = 2 ^ v := by
+      match v, i with | v + 1, _ => simp [← Int.pow_succ', Int.toNat_pow_of_nonneg]
+    simp [this]
+
+instance : ToInt ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+  toInt x := x.toInt
+  toInt_inj x y w := ISize.toInt_inj.mp w
+  le_toInt {lo x} w := by simp at w; subst w; exact ISize.two_pow_numBits_le_toInt x
+  toInt_lt {hi x} w := by simp at w; subst w; exact ISize.toInt_lt_two_pow_numBits x
+
+@[simp] theorem toInt_isize (x : ISize) : ToInt.toInt x = x.toInt := rfl
+
+instance : ToInt.Add ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+  toInt_add x y := by
+    rw [toInt_isize, ISize.toInt_add, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
+    have p₁ : (2 : Int) * 2 ^ (System.Platform.numBits - 1) = 2 ^ System.Platform.numBits := by
+      have := System.Platform.numBits_pos
+      have : System.Platform.numBits - 1 + 1 = System.Platform.numBits := by omega
+      simp [← Int.pow_succ', this]
+    have p₂ : ((2 : Int) ^ System.Platform.numBits).toNat = 2 ^ System.Platform.numBits := by
+      rw [Int.toNat_pow_of_nonneg (by decide)]
+      simp
+    simp [p₁, p₂]
+
+end Lean.Grind

src/Init/Notation.lean

@@ -531,8 +531,21 @@ is interpreted as `f (g x)` rather than `(f g) x`.
 syntax:min term " <| " term:min : term
 
 macro_rules
-  | `($f $args* <| $a) => `($f $args* $a)
-  | `($f <| $a) => `($f $a)
+  | `($f $args* <| $a) =>
+    if a.raw.isMissing then
+      -- Ensures that `$f $args* <|` is elaborated as `$f $args*`, not `$f $args* sorry`.
+      -- For the latter, the elaborator produces `TermInfo` where the missing argument has already
+      -- been applied as `sorry`, which inhibits some language server functionality that relies
+      -- on this `TermInfo` (e.g. signature help).
+      -- The parser will still produce an error for `$f $args* <|` in this case.
+      `($f $args*)
+    else
+      `($f $args* $a)
+  | `($f <| $a) =>
+    if a.raw.isMissing then
+      `($f)
+    else
+      `($f $a)
 
 /--
 Haskell-like pipe operator `|>`. `x |> f` means the same as the same as `f x`,
@@ -553,8 +566,21 @@ is interpreted as `f (g x)` rather than `(f g) x`.
 syntax:min term atomic(" $" ws) term:min : term
 
 macro_rules
-  | `($f $args* $ $a) => `($f $args* $a)
-  | `($f $ $a) => `($f $a)
+  | `($f $args* $ $a) =>
+    if a.raw.isMissing then
+      -- Ensures that `$f $args* $` is elaborated as `$f $args*`, not `$f $args* sorry`.
+      -- For the latter, the elaborator produces `TermInfo` where the missing argument has already
+      -- been applied as `sorry`, which inhibits some language server functionality that relies
+      -- on this `TermInfo` (e.g. signature help).
+      -- The parser will still produce an error for `$f $args* <|` in this case.
+      `($f $args*)
+    else
+      `($f $args* $a)
+  | `($f $ $a) =>
+    if a.raw.isMissing then
+      `($f)
+    else
+      `($f $a)
 
 @[inherit_doc Subtype] syntax "{ " withoutPosition(ident (" : " term)? " // " term) " }" : term
 

src/Lean/AddDecl.lean

@@ -84,9 +84,6 @@ def addDecl (decl : Declaration) : CoreM Unit := do
   -- namespaces
   modifyEnv (decl.getNames.foldl registerNamePrefixes)
 
-  if !Elab.async.get (← getOptions) then
-    return (← addSynchronously)
-
   -- convert `Declaration` to `ConstantInfo` to use as a preliminary value in the environment until
   -- kernel checking has finished; not all cases are supported yet
   let mut exportedInfo? := none
@@ -106,7 +103,7 @@ def addDecl (decl : Declaration) : CoreM Unit := do
         exportedInfo? := some <| .axiomInfo { defn with isUnsafe := defn.safety == .unsafe }
       pure (defn.name, .defnInfo defn, .defn)
     | .axiomDecl ax => pure (ax.name, .axiomInfo ax, .axiom)
-    | _ => return (← addSynchronously)
+    | _ => return (← doAdd)
 
   if decl.getTopLevelNames.all isPrivateName then
     exportedInfo? := none
@@ -125,30 +122,26 @@ def addDecl (decl : Declaration) : CoreM Unit := do
   -- report preliminary constant info immediately
   async.commitConst async.asyncEnv (some info) (exportedInfo? <|> info)
   setEnv async.mainEnv
-  let cancelTk ← IO.CancelToken.new
-  let checkAct ← Core.wrapAsyncAsSnapshot (cancelTk? := cancelTk) fun _ => do
+
+  let doAddAndCommit := do
     setEnv async.asyncEnv
     try
       doAdd
     finally
       async.commitCheckEnv (← getEnv)
-  let t ← BaseIO.mapTask checkAct env.checked
-  let endRange? := (← getRef).getTailPos?.map fun pos => ⟨pos, pos⟩
-  Core.logSnapshotTask { stx? := none, reportingRange? := endRange?, task := t, cancelTk? := cancelTk }
+
+  if Elab.async.get (← getOptions) then
+    let cancelTk ← IO.CancelToken.new
+    let checkAct ← Core.wrapAsyncAsSnapshot (cancelTk? := cancelTk) fun _ => doAddAndCommit
+    let t ← BaseIO.mapTask checkAct env.checked
+    let endRange? := (← getRef).getTailPos?.map fun pos => ⟨pos, pos⟩
+    Core.logSnapshotTask { stx? := none, reportingRange? := endRange?, task := t, cancelTk? := cancelTk }
+  else
+    try
+      doAddAndCommit
+    finally
+      setEnv async.mainEnv
 where
-  addSynchronously := do
-    doAdd
-    -- make constants known to the elaborator; in the synchronous case, we can simply read them from
-    -- the kernel env
-    for n in decl.getNames do
-      let env ← getEnv
-      let some info := env.checked.get.find? n | unreachable!
-      -- do *not* report extensions in synchronous case at this point as they are usually set only
-      -- after adding the constant itself
-      let res ← env.addConstAsync (reportExts := false) n (.ofConstantInfo info)
-      res.commitConst env (info? := info)
-      res.commitCheckEnv res.asyncEnv
-      setEnv res.mainEnv
   doAdd := do
     profileitM Exception "type checking" (← getOptions) do
       withTraceNode `Kernel (fun _ => return m!"typechecking declarations {decl.getTopLevelNames}") do

src/Lean/Compiler/LCNF/ExtractClosed.lean

@@ -148,8 +148,13 @@ partial def Decl.extractClosed (decl : Decl) (sccDecls : Array Decl) : CompilerM
 def extractClosed : Pass where
   phase := .mono
   name := `extractClosed
-  run := fun decls =>
-    decls.foldlM (init := #[]) fun newDecls decl => return newDecls ++ (← decl.extractClosed decls)
+  run := fun decls => do
+    -- Reuse the option from the old compiler for now.
+    if (← getOptions).getBool `compiler.extract_closed true then
+      decls.foldlM (init := #[]) fun newDecls decl =>
+        return newDecls ++ (← decl.extractClosed decls)
+    else
+      return decls
 
 builtin_initialize registerTraceClass `Compiler.extractClosed (inherited := true)
 

src/Lean/Compiler/LCNF/Simp/ConstantFold.lean

@@ -308,6 +308,18 @@ def higherOrderLiteralFolders : List (Name × Folder) := [
 def Folder.mulShift [Literal α] [BEq α] (shiftLeft : Name) (pow2 : α → α) (log2 : α → α) : Folder :=
   Folder.first #[Folder.mulLhsShift shiftLeft pow2 log2, Folder.mulRhsShift shiftLeft pow2 log2]
 
+-- TODO: add option for controlling the limit
+def natPowThreshold := 256
+
+def foldNatPow (args : Array Arg): FolderM (Option LetValue) := do
+  let #[.fvar fvarId₁, .fvar fvarId₂] := args | return none
+  let some value₁ ← getNatLit fvarId₁ | return none
+  let some value₂ ← getNatLit fvarId₂ | return none
+  if value₂ < natPowThreshold then
+    return .some (.lit (.nat (value₁ ^ value₂)))
+  else
+    return none
+
 /--
 Folder for ofNat operations on fixed-sized integer types.
 -/
@@ -316,6 +328,13 @@ def Folder.ofNat (f : Nat → LitValue) (args : Array Arg): FolderM (Option LetV
   let some value ← getNatLit fvarId | return none
   return some (.lit (f value))
 
+def Folder.toNat (args : Array Arg): FolderM (Option LetValue) := do
+  let #[.fvar fvarId] := args | return none
+  let some (.lit lit) ← findLetValue? fvarId | return none
+  match lit with
+  | .uint8 v | .uint16 v | .uint32 v | .uint64 v | .usize v => return some (.lit (.nat v.toNat))
+  | .nat _ | .str _ => return none
+
 /--
 All arithmetic folders.
 -/
@@ -341,7 +360,9 @@ def arithmeticFolders : List (Name × Folder) := [
   (``UInt8.div,  Folder.first #[Folder.mkBinary UInt8.div, Folder.rightNeutral (1 : UInt8), Folder.divShift ``UInt8.shiftRight (UInt8.shiftLeft 1 ·) UInt8.log2]),
   (``UInt16.div,  Folder.first #[Folder.mkBinary UInt16.div, Folder.rightNeutral (1 : UInt16), Folder.divShift ``UInt16.shiftRight (UInt16.shiftLeft 1 ·) UInt16.log2]),
   (``UInt32.div,  Folder.first #[Folder.mkBinary UInt32.div, Folder.rightNeutral (1 : UInt32), Folder.divShift ``UInt32.shiftRight (UInt32.shiftLeft 1 ·) UInt32.log2]),
-  (``UInt64.div,  Folder.first #[Folder.mkBinary UInt64.div, Folder.rightNeutral (1 : UInt64), Folder.divShift ``UInt64.shiftRight (UInt64.shiftLeft 1 ·) UInt64.log2])
+  (``UInt64.div,  Folder.first #[Folder.mkBinary UInt64.div, Folder.rightNeutral (1 : UInt64), Folder.divShift ``UInt64.shiftRight (UInt64.shiftLeft 1 ·) UInt64.log2]),
+  (``Nat.pow, foldNatPow),
+  (``Nat.nextPowerOfTwo, Folder.mkUnary Nat.nextPowerOfTwo),
 ]
 
 def relationFolders : List (Name × Folder) := [
@@ -370,6 +391,11 @@ def conversionFolders : List (Name × Folder) := [
   (``UInt32.ofNat, Folder.ofNat (fun v => .uint32 (UInt32.ofNat v))),
   (``UInt64.ofNat, Folder.ofNat (fun v => .uint64 (UInt64.ofNat v))),
   (``USize.ofNat, Folder.ofNat (fun v => .usize (UInt64.ofNat v))),
+  (``UInt8.toNat, Folder.toNat),
+  (``UInt16.toNat, Folder.toNat),
+  (``UInt32.toNat, Folder.toNat),
+  (``UInt64.toNat, Folder.toNat),
+  (``USize.toNat, Folder.toNat),
 ]
 
 /--

src/Lean/CoreM.lean

@@ -102,14 +102,23 @@ partial def mkUniqueName (env : Environment) (g : DeclNameGenerator) («infix»
   let «infix» := if g.namePrefix.hasMacroScopes && infix.hasMacroScopes then infix.eraseMacroScopes else «infix»
   let base := g.namePrefix ++ «infix»
   let mut g := g
+  while isConflict (curr g base) do
+    g := g.next
+  return (curr g base, g)
+where
+  -- Check whether the name conflicts with an existing one. Conflicts ignore privacy.
   -- NOTE: We only check the current branch and rely on the documented invariant instead because we
   -- do not want to block here and because it would not solve the issue for completely separated
   -- threads of elaboration such as in Aesop's backtracking search.
-  while env.containsOnBranch (curr g base) do
-    g := g.next
-  return (curr g base, g)
-where curr (g : DeclNameGenerator) (base : Name) : Name :=
-  g.idxs.foldr (fun i n => n.appendIndexAfter i) base
+  isConflict (n : Name) : Bool :=
+    (env.setExporting false).containsOnBranch n ||
+    isPrivateName n && (env.setExporting false).containsOnBranch (privateToUserName n) ||
+    !isPrivateName n && (env.setExporting false).containsOnBranch (mkPrivateName env n)
+  curr (g : DeclNameGenerator) (base : Name) : Name := Id.run do
+    let mut n := g.idxs.foldr (fun i n => n.appendIndexAfter i) base
+    if env.header.isModule && !env.isExporting && !isPrivateName n then
+      n := mkPrivateName env n
+    return n
 
 def mkChild (g : DeclNameGenerator) : DeclNameGenerator × DeclNameGenerator :=
   ({ g with parentIdxs := g.idx :: g.parentIdxs, idx := 1 },

src/Lean/Data/Lsp/Capabilities.lean

@@ -100,6 +100,7 @@ structure ServerCapabilities where
   semanticTokensProvider?   : Option SemanticTokensOptions   := none
   codeActionProvider?       : Option CodeActionOptions       := none
   inlayHintProvider?        : Option InlayHintOptions        := none
+  signatureHelpProvider?    : Option SignatureHelpOptions    := none
   deriving ToJson, FromJson
 
 end Lsp

src/Lean/Data/Lsp/LanguageFeatures.lean

@@ -521,5 +521,73 @@ structure InlayHintOptions extends WorkDoneProgressOptions where
   resolveProvider? : Option Bool := none
   deriving FromJson, ToJson
 
+inductive ParameterInformationLabel
+  | name (name : String)
+  | range (startUtf16Offset endUtf16Offset : Nat)
+
+instance : FromJson ParameterInformationLabel where
+  fromJson?
+    | .str name => .ok <| .name name
+    | .arr #[startUtf16OffsetJson, endUtf16OffsetJson] => do
+      return .range (← fromJson? startUtf16OffsetJson) (← fromJson? endUtf16OffsetJson)
+    | _ => .error "unexpected JSON for `ParameterInformationLabel`"
+
+instance : ToJson ParameterInformationLabel where
+  toJson
+    | .name name => .str name
+    | .range startUtf16Offset endUtf16Offset => .arr #[startUtf16Offset, endUtf16Offset]
+
+structure ParameterInformation where
+  label : ParameterInformationLabel
+  documentation? : Option MarkupContent := none
+  deriving FromJson, ToJson
+
+structure SignatureInformation where
+  label : String
+  documentation? : Option MarkupContent := none
+  parameters? : Option (Array ParameterInformation) := none
+  activeParameter? : Option Nat := none
+  deriving FromJson, ToJson
+
+structure SignatureHelp where
+  signatures : Array SignatureInformation
+  activeSignature? : Option Nat := none
+  activeParameter? : Option Nat := none
+  deriving FromJson, ToJson
+
+inductive SignatureHelpTriggerKind where
+  | invoked
+  | triggerCharacter
+  | contentChange
+
+instance : FromJson SignatureHelpTriggerKind where
+  fromJson?
+    | (1 : Nat) => .ok .invoked
+    | (2 : Nat) => .ok .triggerCharacter
+    | (3 : Nat) => .ok .contentChange
+    | _ => .error "Unexpected JSON in `SignatureHelpTriggerKind`"
+
+instance : ToJson SignatureHelpTriggerKind where
+  toJson
+    | .invoked => 1
+    | .triggerCharacter => 2
+    | .contentChange => 3
+
+structure SignatureHelpContext where
+  triggerKind : SignatureHelpTriggerKind
+  triggerCharacter? : Option String := none
+  isRetrigger : Bool
+  activeSignatureHelp? : Option SignatureHelp := none
+  deriving FromJson, ToJson
+
+structure SignatureHelpParams extends TextDocumentPositionParams, WorkDoneProgressParams where
+  context? : Option SignatureHelpContext := none
+  deriving FromJson, ToJson
+
+structure SignatureHelpOptions extends WorkDoneProgressOptions where
+  triggerCharacters? : Option (Array String) := none
+  retriggerCharacters? : Option (Array String) := none
+  deriving FromJson, ToJson
+
 end Lsp
 end Lean

src/Lean/Elab/AuxDef.lean

@@ -27,7 +27,8 @@ def elabAuxDef : CommandElab
     -- We use a new generator here because we want more control over the name; the default would
     -- create a private name that then breaks the macro below. We assume that `aux_def` is not used
     -- with the same arguments in parallel contexts.
-    let (id, _) := { namePrefix := ns : DeclNameGenerator }.mkUniqueName (← getEnv) («infix» := Name.mkSimple id)
+    let env := (← getEnv).setExporting true
+    let (id, _) := { namePrefix := ns : DeclNameGenerator }.mkUniqueName env («infix» := Name.mkSimple id)
     let id := id.replacePrefix ns Name.anonymous -- TODO: replace with def _root_.id
     elabCommand <|
       ← `($[$doc?:docComment]? $[$attrs?:attributes]?

src/Lean/Elab/DeclModifiers.lean

@@ -28,7 +28,7 @@ def checkNotAlreadyDeclared {m} [Monad m] [MonadEnv m] [MonadError m] [MonadInfo
     match privateToUserName? declName with
     | none          => throwError "'{.ofConstName declName true}' has already been declared"
     | some declName => throwError "private declaration '{.ofConstName declName true}' has already been declared"
-  if isReservedName env declName then
+  if isReservedName env (privateToUserName declName) || isReservedName env (mkPrivateName (← getEnv) declName) then
     throwError "'{declName}' is a reserved name"
   if env.contains (mkPrivateName env declName) then
     addInfo (mkPrivateName env declName)

src/Lean/Elab/GuardMsgs.lean

@@ -17,7 +17,7 @@ See the docstring on the `#guard_msgs` command.
 open Lean Parser.Tactic Elab Command
 
 register_builtin_option guard_msgs.diff : Bool := {
-  defValue := false
+  defValue := true
   descr := "When true, show a diff between expected and actual messages if they don't match. "
 }
 

src/Lean/Elab/InfoTree/Main.lean

@@ -72,7 +72,7 @@ def CompletionInfo.lctx : CompletionInfo → LocalContext
   | _                   => .empty
 
 def CustomInfo.format : CustomInfo → Format
-  | i => f!"CustomInfo({i.value.typeName})"
+  | i => f!"[CustomInfo({i.value.typeName})]"
 
 instance : ToFormat CustomInfo := ⟨CustomInfo.format⟩
 
@@ -155,26 +155,26 @@ def TermInfo.format (ctx : ContextInfo) (info : TermInfo) : IO Format := do
         Meta.ppExpr (← Meta.inferType info.expr)
       catch _ =>
         pure "<failed-to-infer-type>"
-    return f!"{← Meta.ppExpr info.expr} {if info.isBinder then "(isBinder := true) " else ""}: {ty} @ {formatElabInfo ctx info.toElabInfo}"
+    return f!"[Term] {← Meta.ppExpr info.expr} {if info.isBinder then "(isBinder := true) " else ""}: {ty} @ {formatElabInfo ctx info.toElabInfo}"
 
 def PartialTermInfo.format (ctx : ContextInfo) (info : PartialTermInfo) : Format :=
-  f!"Partial term @ {formatElabInfo ctx info.toElabInfo}"
+  f!"[PartialTerm] @ {formatElabInfo ctx info.toElabInfo}"
 
 def CompletionInfo.format (ctx : ContextInfo) (info : CompletionInfo) : IO Format :=
   match info with
-  | .dot i (expectedType? := expectedType?) .. => return f!"[.] {← i.format ctx} : {expectedType?}"
-  | .id stx _ _ lctx expectedType? => ctx.runMetaM lctx do return f!"[.] {← ctx.ppSyntax lctx stx} : {expectedType?} @ {formatStxRange ctx info.stx}"
-  | _ => return f!"[.] {info.stx} @ {formatStxRange ctx info.stx}"
+  | .dot i (expectedType? := expectedType?) .. => return f!"[Completion-Dot] {← i.format ctx} : {expectedType?}"
+  | .id stx _ _ lctx expectedType? => ctx.runMetaM lctx do return f!"[Completion-Id] {← ctx.ppSyntax lctx stx} : {expectedType?} @ {formatStxRange ctx info.stx}"
+  | _ => return f!"[Completion] {info.stx} @ {formatStxRange ctx info.stx}"
 
 def CommandInfo.format (ctx : ContextInfo) (info : CommandInfo) : IO Format := do
-  return f!"command @ {formatElabInfo ctx info.toElabInfo}"
+  return f!"[Command] @ {formatElabInfo ctx info.toElabInfo}"
 
 def OptionInfo.format (ctx : ContextInfo) (info : OptionInfo) : IO Format := do
-  return f!"option {info.optionName} @ {formatStxRange ctx info.stx}"
+  return f!"[Option] {info.optionName} @ {formatStxRange ctx info.stx}"
 
 def FieldInfo.format (ctx : ContextInfo) (info : FieldInfo) : IO Format := do
   ctx.runMetaM info.lctx do
-    return f!"{info.fieldName} : {← Meta.ppExpr (← Meta.inferType info.val)} := {← Meta.ppExpr info.val} @ {formatStxRange ctx info.stx}"
+    return f!"[Field] {info.fieldName} : {← Meta.ppExpr (← Meta.inferType info.val)} := {← Meta.ppExpr info.val} @ {formatStxRange ctx info.stx}"
 
 def ContextInfo.ppGoals (ctx : ContextInfo) (goals : List MVarId) : IO Format :=
   if goals.isEmpty then
@@ -187,31 +187,31 @@ def TacticInfo.format (ctx : ContextInfo) (info : TacticInfo) : IO Format := do
   let ctxA := { ctx with mctx := info.mctxAfter }
   let goalsBefore ← ctxB.ppGoals info.goalsBefore
   let goalsAfter  ← ctxA.ppGoals info.goalsAfter
-  return f!"Tactic @ {formatElabInfo ctx info.toElabInfo}\n{info.stx}\nbefore {goalsBefore}\nafter {goalsAfter}"
+  return f!"[Tactic] @ {formatElabInfo ctx info.toElabInfo}\n{info.stx}\nbefore {goalsBefore}\nafter {goalsAfter}"
 
 def MacroExpansionInfo.format (ctx : ContextInfo) (info : MacroExpansionInfo) : IO Format := do
   let stx    ← ctx.ppSyntax info.lctx info.stx
   let output ← ctx.ppSyntax info.lctx info.output
-  return f!"Macro expansion\n{stx}\n===>\n{output}"
+  return f!"[MacroExpansion]\n{stx}\n===>\n{output}"
 
 def UserWidgetInfo.format (info : UserWidgetInfo) : Format :=
-  f!"UserWidget {info.id}\n{Std.ToFormat.format <| info.props.run' {}}"
+  f!"[UserWidget] {info.id}\n{Std.ToFormat.format <| info.props.run' {}}"
 
 def FVarAliasInfo.format (info : FVarAliasInfo) : Format :=
-  f!"FVarAlias {info.userName.eraseMacroScopes}: {info.id.name} -> {info.baseId.name}"
+  f!"[FVarAlias] {info.userName.eraseMacroScopes}: {info.id.name} -> {info.baseId.name}"
 
 def FieldRedeclInfo.format (ctx : ContextInfo) (info : FieldRedeclInfo) : Format :=
-  f!"FieldRedecl @ {formatStxRange ctx info.stx}"
+  f!"[FieldRedecl] @ {formatStxRange ctx info.stx}"
 
 def DelabTermInfo.format (ctx : ContextInfo) (info : DelabTermInfo) : IO Format := do
   let loc := if let some loc := info.location? then f!"{loc.module} {loc.range.pos}-{loc.range.endPos}" else "none"
-  return f!"DelabTermInfo @ {← TermInfo.format ctx info.toTermInfo}\n\
+  return f!"[DelabTerm] @ {← TermInfo.format ctx info.toTermInfo}\n\
     Location: {loc}\n\
     Docstring: {repr info.docString?}\n\
     Explicit: {info.explicit}"
 
 def ChoiceInfo.format (ctx : ContextInfo) (info : ChoiceInfo) : Format :=
-  f!"Choice @ {formatElabInfo ctx info.toElabInfo}"
+  f!"[Choice] @ {formatElabInfo ctx info.toElabInfo}"
 
 def Info.format (ctx : ContextInfo) : Info → IO Format
   | ofTacticInfo i         => i.format ctx

src/Lean/Elab/InfoTree/Types.lean

@@ -96,7 +96,6 @@ inductive CompletionInfo where
   | option (stx : Syntax)
   | endSection (stx : Syntax) (scopeNames : List String)
   | tactic (stx : Syntax)
-  -- TODO `import`
 
 /-- Info for an option reference (e.g. in `set_option`). -/
 structure OptionInfo where

src/Lean/Elab/PreDefinition/EqUnfold.lean

@@ -23,8 +23,9 @@ This is not extensible, and always builds on the unfold theorem (`f.eq_def`).
 -/
 def getConstUnfoldEqnFor? (declName : Name) : MetaM (Option Name) := do
   if (← getUnfoldEqnFor? (nonRec := true) declName).isNone then
+    trace[ReservedNameAction] "getConstUnfoldEqnFor? {declName} failed, no unfold theorem available"
     return none
-  let name := .str declName eqUnfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) declName eqUnfoldThmSuffix
   realizeConst declName name do
     -- we have to call `getUnfoldEqnFor?` again to make `unfoldEqnName` available in this context
     let some unfoldEqnName ← getUnfoldEqnFor? (nonRec := true) declName | unreachable!
@@ -58,9 +59,11 @@ def getConstUnfoldEqnFor? (declName : Name) : MetaM (Option Name) := do
 builtin_initialize
   registerReservedNameAction fun name => do
     let .str p s := name | return false
-    unless (← getEnv).isSafeDefinition p do return false
     if s == eqUnfoldThmSuffix then
-      return (← MetaM.run' <| getConstUnfoldEqnFor? p).isSome
+      let env := (← getEnv).setExporting false
+      for p in [p, privateToUserName p] do
+        if env.isSafeDefinition p then
+          return (← MetaM.run' <| getConstUnfoldEqnFor? p).isSome
     return false
 
 end Lean.Meta

src/Lean/Elab/PreDefinition/Eqns.lean

@@ -401,6 +401,7 @@ This is currently used for non-recursive functions, well-founded recursion and p
 but not for structural recursion.
 -/
 def mkEqns (declName : Name) (declNames : Array Name) (tryRefl := true): MetaM (Array Name) := do
+  trace[Elab.definition.eqns] "mkEqns: {declName}"
   let info ← getConstInfoDefn declName
   let us := info.levelParams.map mkLevelParam
   withOptions (tactic.hygienic.set · false) do
@@ -414,7 +415,7 @@ def mkEqns (declName : Name) (declNames : Array Name) (tryRefl := true): MetaM (
   for h : i in [: eqnTypes.size] do
     let type := eqnTypes[i]
     trace[Elab.definition.eqns] "eqnType[{i}]: {eqnTypes[i]}"
-    let name := mkEqnThmName declName (i+1)
+    let name := mkEqLikeNameFor (← getEnv) declName s!"{eqnThmSuffixBasePrefix}{i+1}"
     thmNames := thmNames.push name
     -- determinism: `type` should be independent of the environment changes since `baseName` was
     -- added

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

@@ -18,11 +18,10 @@ open Eqns
 /--
 Simple, coarse-grained equation theorem for nonrecursive definitions.
 -/
-private def mkSimpleEqThm (declName : Name) (suffix := Name.mkSimple unfoldThmSuffix) : MetaM (Option Name) := do
+private def mkSimpleEqThm (declName : Name) : MetaM (Option Name) := do
   if let some (.defnInfo info) := (← getEnv).find? declName then
-    let name := declName ++ suffix
-    -- determinism: `name` and `info` are dependent only on `declName`, not any later env
-    -- modifications
+    let name := mkEqLikeNameFor (← getEnv) declName eqn1ThmSuffix
+    trace[Elab.definition.eqns] "mkSimpleEqnThm: {name}"
     realizeConst declName name (doRealize name info)
     return some name
   else

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

@@ -72,7 +72,7 @@ private def rwFixEq (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
 
 /-- Generate the "unfold" lemma for `declName`. -/
 def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := do
-  let name := Name.str declName unfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) declName unfoldThmSuffix
   realizeConst declName name (doRealize name)
   return name
 where
@@ -104,7 +104,7 @@ where
       }
 
 def getUnfoldFor? (declName : Name) : MetaM (Option Name) := do
-  let name := Name.str declName unfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) declName unfoldThmSuffix
   let env ← getEnv
   if env.contains name then return name
   let some info := eqnInfoExt.find? env declName | return none

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

@@ -68,12 +68,11 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
     let target ← mkEq (mkAppN (Lean.mkConst info.declName us) xs) body
     let goal ← mkFreshExprSyntheticOpaqueMVar target
     mkEqnTypes info.declNames goal.mvarId!
-  let baseName := info.declName
   let mut thmNames := #[]
   for h : i in [: eqnTypes.size] do
     let type := eqnTypes[i]
     trace[Elab.definition.structural.eqns] "eqnType {i}: {type}"
-    let name := mkEqnThmName baseName (i+1)
+    let name := mkEqLikeNameFor (← getEnv) info.declName s!"{eqnThmSuffixBasePrefix}{i+1}"
     thmNames := thmNames.push name
     -- determinism: `type` should be independent of the environment changes since `baseName` was
     -- added
@@ -104,7 +103,7 @@ def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
 
 /-- Generate the "unfold" lemma for `declName`. -/
 def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := do
-  let name := Name.str declName unfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) info.declName unfoldThmSuffix
   realizeConst info.declNames[0]! name (doRealize name)
   return name
 where

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

@@ -51,4 +51,32 @@ def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
 builtin_initialize
   registerGetEqnsFn getEqnsFor?
 
+
+/--
+This is a hack to fix fallout from #8519, where a non-exposed wfrec definition `foo`
+in a module would cause `foo.eq_def` to be defined eagerly and privately,
+but it should still be visible from non-mudule files.
+
+So we create a unfold equation generator that aliases an existing private `eq_def` to
+wherever the current module expects it.
+-/
+def copyPrivateUnfoldTheorem : GetUnfoldEqnFn := fun declName => do
+  withTraceNode `ReservedNameAction (pure m!"{exceptOptionEmoji ·} copyPrivateUnfoldTheorem running for {declName}") do
+  let name := mkEqLikeNameFor (← getEnv) declName unfoldThmSuffix
+  if let some mod ← findModuleOf? declName then
+    let unfoldName' := mkPrivateNameCore mod (.str declName unfoldThmSuffix)
+    if let some (.thmInfo info) := (← getEnv).find? unfoldName' then
+      realizeConst declName name do
+        addDecl <| Declaration.thmDecl {
+          name,
+          type := info.type,
+          value := .const unfoldName' (info.levelParams.map mkLevelParam),
+          levelParams := info.levelParams
+        }
+      return name
+  return none
+
+builtin_initialize
+  registerGetUnfoldEqnFn copyPrivateUnfoldTheorem
+
 end Lean.Elab.WF

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

@@ -74,6 +74,7 @@ def wfRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (Option T
   let unaryPreDef ← Mutual.cleanPreDef (cacheProofs := false) unaryPreDef
   let preDefs ← preDefs.mapM (Mutual.cleanPreDef (cacheProofs := false) ·)
   registerEqnsInfo preDefs preDefNonRec.declName fixedParamPerms argsPacker
+  markAsRecursive unaryPreDef.declName
   unless (← isProp unaryPreDef.type) do
     WF.mkUnfoldEq unaryPreDef preDefNonRec.declName wfPreprocessProof
   for preDef in preDefs do

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

@@ -73,8 +73,7 @@ private partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Un
         throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
 
 def mkUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) (wfPreprocessProof : Simp.Result) : MetaM Unit := do
-  let baseName := preDef.declName
-  let name := Name.str baseName unfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) preDef.declName unfoldThmSuffix
   prependError m!"Cannot derive {name}" do
   withOptions (tactic.hygienic.set · false) do
     lambdaTelescope preDef.value fun xs body => do
@@ -106,9 +105,8 @@ theorem of `foo._unary` or `foo._binary`.
 It should just be a specialization of that one, due to defeq.
 -/
 def mkBinaryUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) : MetaM Unit := do
-  let baseName := preDef.declName
-  let name := Name.str baseName unfoldThmSuffix
-  let unaryEqName := Name.str unaryPreDefName unfoldThmSuffix
+  let name := mkEqLikeNameFor (← getEnv) preDef.declName unfoldThmSuffix
+  let unaryEqName:= mkEqLikeNameFor (← getEnv) unaryPreDefName unfoldThmSuffix
   prependError m!"Cannot derive {name} from {unaryEqName}" do
   withOptions (tactic.hygienic.set · false) do
     lambdaTelescope preDef.value fun xs body => do

src/Lean/Elab/SyntheticMVars.lean

@@ -347,8 +347,9 @@ mutual
   If `report := false`, then `runTactic` will not capture exceptions nor will report unsolved goals. Unsolved goals become exceptions.
   -/
   partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (kind : TacticMVarKind) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
+    let wasExporting := (← getEnv).isExporting
     -- exit exporting context if entering proof
-    let isNoLongerExporting ← pure (← getEnv).isExporting <&&> do
+    let isNoLongerExporting ← pure wasExporting <&&> do
       mvarId.withContext do
         isProp (← mvarId.getType)
     instantiateMVarDeclMVars mvarId
@@ -359,7 +360,7 @@ mutual
     if isNoLongerExporting then
       let mvarDecl ← getMVarDecl mvarId
       mvarId' := (← mkFreshExprMVarAt mvarDecl.lctx mvarDecl.localInstances mvarDecl.type mvarDecl.kind).mvarId!
-    withExporting (isExporting := (← getEnv).isExporting && !isNoLongerExporting) do
+    withExporting (isExporting := wasExporting && !isNoLongerExporting) do
     /-
     TODO: consider using `runPendingTacticsAt` at `mvarId` local context and target type.
     Issue #1380 demonstrates that the goal may still contain pending metavariables.
@@ -395,7 +396,8 @@ mutual
             let mut e ← instantiateExprMVars (.mvar mvarId')
             if !e.isFVar then
               e ← mvarId'.withContext do
-                abstractProof e
+                withExporting (isExporting := wasExporting) do
+                  abstractProof e
             mvarId.assign e)
       fun ex => do
         if report then

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

@@ -355,6 +355,9 @@ builtin_initialize
 builtin_initialize
   registerReservedNameAction fun name => do
     let .str p s := name | return false
+    unless s == enumToBitVecSuffix ||
+           s == eqIffEnumToBitVecEqSuffix ||
+           s == enumToBitVecLeSuffix do return false
     if ← isEnumType p then
       if s == enumToBitVecSuffix then
         discard <| MetaM.run' (getEnumToBitVecFor p)

src/Lean/EnvExtension.lean

@@ -150,8 +150,10 @@ namespace MapDeclarationExtension
 def insert (ext : MapDeclarationExtension α) (env : Environment) (declName : Name) (val : α) : Environment :=
   have : Inhabited Environment := ⟨env⟩
   assert! env.getModuleIdxFor? declName |>.isNone -- See comment at `MapDeclarationExtension`
-  assert! env.asyncMayContain declName
-  ext.addEntry env (declName, val)
+  if !env.asyncMayContain declName then
+    panic! s!"MapDeclarationExtension.insert: cannot insert {declName} into {ext.name}, it is not contined in {env.asyncPrefix?}"
+  else
+    ext.addEntry env (declName, val)
 
 def find? [Inhabited α] (ext : MapDeclarationExtension α) (env : Environment) (declName : Name)
     (includeServer := false) : Option α :=

src/Lean/Environment.lean

@@ -676,11 +676,31 @@ def addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declarati
     if let some n := decl.getTopLevelNames.find? (!ctx.mayContain ·) then
       throw <| .other s!"cannot add declaration {n} to environment as it is restricted to the \
         prefix {ctx.declPrefix}"
-  if doCheck then
+  let mut env ← if doCheck then
     addDeclCheck env maxHeartbeats decl cancelTk?
   else
     addDeclWithoutChecking env decl
 
+  -- Let the elaborator know about the new constants. This uses the same constant for both
+  -- visibility scopes but the caller can still customize the public one on the main elaboration
+  -- branch by use of `addConstAsync` as is the case for `Lean.addDecl`.
+  for n in decl.getNames do
+    let some info := env.checked.get.find? n | unreachable!
+    env := { env with asyncConstsMap.private := env.asyncConstsMap.private.add {
+      constInfo := .ofConstantInfo info
+      exts? := none
+      consts := .pure <| .mk (α := AsyncConsts) default
+    } }
+    -- TODO
+    if true /- !isPrivateName n-/ then
+      env := { env with asyncConstsMap.public := env.asyncConstsMap.public.add {
+        constInfo := .ofConstantInfo info
+        exts? := none
+        consts := .pure <| .mk (α := AsyncConsts) default
+      } }
+
+  return env
+
 @[inherit_doc Kernel.Environment.constants]
 def constants (env : Environment) : ConstMap :=
   env.toKernelEnv.constants

src/Lean/Meta/AbstractNestedProofs.lean

@@ -11,9 +11,9 @@ import Lean.Meta.Transform
 namespace Lean.Meta
 
 /-- Abstracts the given proof into an auxiliary theorem, suitably pre-processing its type. -/
-def abstractProof [Monad m] [MonadLiftT MetaM m] (proof : Expr) (cache := true)
-    (postprocessType : Expr → m Expr := pure) : m Expr := do
-  let type ← inferType proof
+def abstractProof [Monad m] [MonadLiftT MetaM m] [MonadEnv m] [MonadOptions m] [MonadFinally m]
+    (proof : Expr) (cache := true) (postprocessType : Expr → m Expr := pure) : m Expr := do
+  let type ← withoutExporting do inferType proof
   let type ← (Core.betaReduce type : MetaM _)
   let type ← zetaReduce type
   let type ← postprocessType type
@@ -66,7 +66,7 @@ partial def visit (e : Expr) : M Expr := do
         lctx := lctx.modifyLocalDecl xFVarId fun _ => localDecl
       withLCtx lctx localInstances k
     checkCache { val := e : ExprStructEq } fun _ => do
-      if (← isNonTrivialProof e) then
+      if (← withoutExporting do isNonTrivialProof e) then
         /- Ensure proofs nested in type are also abstracted -/
         abstractProof e (← read).cache visit
       else match e with

src/Lean/Meta/Eqns.lean

@@ -62,9 +62,6 @@ def eqnThmSuffixBasePrefix := eqnThmSuffixBase ++ "_"
 def eqn1ThmSuffix := eqnThmSuffixBasePrefix ++ "1"
 example : eqn1ThmSuffix = "eq_1" := rfl
 
-def mkEqnThmName (declName : Name) (idx : Nat) : Name :=
-  Name.str declName eqnThmSuffixBase |>.appendIndexAfter idx
-
 /-- Returns `true` if `s` is of the form `eq_<idx>` -/
 def isEqnReservedNameSuffix (s : String) : Bool :=
   eqnThmSuffixBasePrefix.isPrefixOf s && (s.drop 3).isNat
@@ -72,6 +69,28 @@ def isEqnReservedNameSuffix (s : String) : Bool :=
 def unfoldThmSuffix := "eq_def"
 def eqUnfoldThmSuffix := "eq_unfold"
 
+def isEqnLikeSuffix (s : String) : Bool :=
+  s == unfoldThmSuffix || s == eqUnfoldThmSuffix || isEqnReservedNameSuffix s
+
+/--
+The equational theorem for a definition can be private even if the definition itself is not.
+So un-private the name here when looking for a declaration
+-/
+def declFromEqLikeName (env : Environment) (name : Name) : Option (Name × String) := Id.run do
+  if let .str p s := name then
+    if isEqnLikeSuffix s then
+      for p in [p, privateToUserName p] do
+        -- Remark: `f.match_<idx>.eq_<idx>` are handled separately in `Lean.Meta.Match.MatchEqs`.
+        if (env.setExporting false).isSafeDefinition p && !isMatcherCore env p then
+          return some (p, s)
+  return none
+
+def mkEqLikeNameFor (env : Environment) (declName : Name) (suffix : String) : Name :=
+  let isExposed := !env.header.isModule || ((env.setExporting true).find? declName).elim false (·.hasValue)
+  let name := .str declName suffix
+  let name := if isExposed then name else mkPrivateName env name
+  name
+
 /--
 Throw an error if names for equation theorems for `declName` are not available.
 -/
@@ -85,16 +104,14 @@ def ensureEqnReservedNamesAvailable (declName : Name) : CoreM Unit := do
 /--
 Ensures that `f.eq_def`, `f.unfold` and `f.eq_<idx>` are reserved names if `f` is a safe definition.
 -/
-builtin_initialize registerReservedNamePredicate fun env n =>
-  match n with
-  | .str p s =>
-    (isEqnReservedNameSuffix s || s == unfoldThmSuffix || s == eqUnfoldThmSuffix)
-    -- Make equation theorems accessible even when body should not be visible for compatibility.
-    -- TODO: Make them private instead.
-    && (env.setExporting false).isSafeDefinition p
-    -- Remark: `f.match_<idx>.eq_<idx>` are handled separately in `Lean.Meta.Match.MatchEqs`.
-    && !isMatcherCore env p
-  | _ => false
+builtin_initialize registerReservedNamePredicate fun env n => Id.run do
+  if let some (declName, suffix) := declFromEqLikeName env n then
+    -- The reserved name predicate has to be precise, as `resolveExact`
+    -- will believe it. So make sure that `n` is exactly the name we expect,
+    -- including the privat prefix.
+    n == mkEqLikeNameFor env declName suffix
+  else
+    false
 
 def GetEqnsFn := Name → MetaM (Option (Array Name))
 
@@ -137,21 +154,21 @@ private def shouldGenerateEqnThms (declName : Name) : MetaM Bool := do
   else
     return false
 
+/-- A mapping from equational theorem to the declaration it was derived from.  -/
 structure EqnsExtState where
-  map    : PHashMap Name (Array Name) := {}
-  mapInv : PHashMap Name Name := {} -- TODO: delete?
+  mapInv : PHashMap Name Name := {}
   deriving Inhabited
 
-/- We generate the equations on demand. -/
+/-- A mapping from equational theorem to the declaration it was derived from.  -/
 builtin_initialize eqnsExt : EnvExtension EqnsExtState ←
   registerEnvExtension (pure {}) (asyncMode := .local)
 
 /--
 Simple equation theorem for nonrecursive definitions.
 -/
-private def mkSimpleEqThm (declName : Name) (suffix := Name.mkSimple unfoldThmSuffix) : MetaM (Option Name) := do
+private def mkSimpleEqThm (declName : Name) : MetaM (Option Name) := do
   if let some (.defnInfo info) := (← getEnv).find? declName then
-    let name := declName ++ suffix
+    let name := mkEqLikeNameFor (← getEnv) declName unfoldThmSuffix
     realizeConst declName name (doRealize name info)
     return some name
   else
@@ -183,7 +200,6 @@ Stores in the `eqnsExt` environment extension that `eqThms` are the equational t
 -/
 private def registerEqnThms (declName : Name) (eqThms : Array Name) : CoreM Unit := do
   modifyEnv fun env => eqnsExt.modifyState env fun s => { s with
-    map := s.map.insert declName eqThms
     mapInv := eqThms.foldl (init := s.mapInv) fun mapInv eqThm => mapInv.insert eqThm declName
   }
 
@@ -192,23 +208,21 @@ Equation theorems are generated on demand, check whether they were generated in
 -/
 private partial def alreadyGenerated? (declName : Name) : MetaM (Option (Array Name)) := do
   let env ← getEnv
-  let eq1 := Name.str declName eqn1ThmSuffix
+  let eq1 := mkEqLikeNameFor env declName eqn1ThmSuffix
   if env.contains eq1 then
     let rec loop (idx : Nat) (eqs : Array Name) : MetaM (Array Name) := do
-      let nextEq := mkEqnThmName declName idx
-      if env.contains nextEq then
+      let nextEq := mkEqLikeNameFor env declName s!"{eqnThmSuffixBasePrefix}{idx+1}"
+      if env.containsOnBranch nextEq then
         loop (idx+1) (eqs.push nextEq)
       else
         return eqs
-    let eqs ← loop 2 #[eq1]
+    let eqs ← loop 1 #[eq1]
     registerEqnThms declName eqs
     return some eqs
   else
     return none
 
 private def getEqnsFor?Core (declName : Name) : MetaM (Option (Array Name)) := withLCtx {} {} do
-  if let some eqs := eqnsExt.getState (← getEnv) |>.map.find? declName then
-    return some eqs
   if !(← shouldGenerateEqnThms declName) then
     return none
   if let some eqs ← alreadyGenerated? declName then
@@ -223,7 +237,7 @@ private def getEqnsFor?Core (declName : Name) : MetaM (Option (Array Name)) := w
 Returns equation theorems for the given declaration.
 -/
 def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := withLCtx {} {} do
-  -- This is the entry point for lazy equaion generation. Ignore the current value
+  -- This is the entry point for lazy equation generation. Ignore the current value
   -- of the options, and revert to the default.
   withOptions (eqnAffectingOptions.foldl fun os o => o.set os o.defValue) do
     getEqnsFor?Core declName
@@ -234,6 +248,7 @@ If any equation theorem affecting option is not the default value, create the eq
 def generateEagerEqns (declName : Name) : MetaM Unit := do
   let opts ← getOptions
   if eqnAffectingOptions.any fun o => o.get opts != o.defValue then
+    trace[Elab.definition.eqns] "generating eager equations for {declName}"
     let _ ← getEqnsFor?Core declName
 
 def GetUnfoldEqnFn := Name → MetaM (Option Name)
@@ -276,28 +291,35 @@ By default, we do not create unfold theorems for nonrecursive definitions.
 You can use `nonRec := true` to override this behavior.
 -/
 def getUnfoldEqnFor? (declName : Name) (nonRec := false) : MetaM (Option Name) := withLCtx {} {} do
-  let env ← getEnv
-  let unfoldName := Name.str declName unfoldThmSuffix
-  if env.contains unfoldName then
-    return some unfoldName
-  if (← shouldGenerateEqnThms declName) then
-    for f in (← getUnfoldEqnFnsRef.get) do
-      if let some r ← f declName then
-        unless r == unfoldName do
-          throwError "invalid unfold theorem name `{r}` has been generated expected `{unfoldName}`"
-        return some r
-    if nonRec then
-      return (← mkSimpleEqThm declName)
-   return none
+  let unfoldName := mkEqLikeNameFor (← getEnv) declName unfoldThmSuffix
+  let r? ← withoutExporting do
+    let env := (← getEnv)
+
+    if env.contains unfoldName then
+      return some unfoldName
+    if (← shouldGenerateEqnThms declName) then
+      if (← isRecursiveDefinition declName) then
+        for f in (← getUnfoldEqnFnsRef.get) do
+          if let some r ← f declName then
+            return some r
+      else
+        if nonRec then
+          return (← mkSimpleEqThm declName)
+    return none
+  if let some r := r? then
+    unless r == unfoldName do
+      throwError "invalid unfold theorem name `{r}` has been generated expected `{unfoldName}`"
+  return r?
 
 builtin_initialize
   registerReservedNameAction fun name => do
-    let .str p s := name | return false
-    unless (← getEnv).isSafeDefinition p && !isMatcherCore (← getEnv) p do return false
-    if isEqnReservedNameSuffix s then
-      return (← MetaM.run' <| getEqnsFor? p).isSome
-    if s == unfoldThmSuffix then
-      return (← MetaM.run' <| getUnfoldEqnFor? p (nonRec := true)).isSome
-    return false
+    withTraceNode `ReservedNameAction (pure m!"{exceptBoolEmoji ·} Lean.Meta.Eqns reserved name action for {name}") do
+      if let some (declName, suffix) := declFromEqLikeName (← getEnv) name then
+        if name == mkEqLikeNameFor (← getEnv) declName suffix then
+          if isEqnReservedNameSuffix suffix then
+            return (← MetaM.run' <| getEqnsFor? declName).isSome
+          if suffix == unfoldThmSuffix then
+            return (← MetaM.run' <| getUnfoldEqnFor? declName (nonRec := true)).isSome
+      return false
 
 end Lean.Meta

src/Lean/Meta/Match/MatchEqs.lean

@@ -762,7 +762,7 @@ where go baseName splitterName := withConfig (fun c => { c with etaStruct := .no
     let mut altArgMasks := #[] -- masks produced by `forallAltTelescope`
     for i in [:alts.size] do
       let altNumParams := matchInfo.altNumParams[i]!
-      let thmName := mkEqnThmName baseName idx
+      let thmName := Name.str baseName eqnThmSuffixBase |>.appendIndexAfter idx
       eqnNames := eqnNames.push thmName
       let (notAlt, splitterAltType, splitterAltNumParam, argMask) ←
           forallAltTelescope (← inferType alts[i]!) altNumParams numDiscrEqs

src/Lean/Meta/Tactic/FunInd.lean

@@ -1680,12 +1680,14 @@ def isFunInductName (env : Environment) (name : Name) : Bool := Id.run do
   match s with
   | "induct"
   | "induct_unfolding" =>
+    unless env.isSafeDefinition p do return false
     if let some eqnInfo := WF.eqnInfoExt.find? env p then
       return true
     if (Structural.eqnInfoExt.find? env p).isSome then return true
     return false
   | "mutual_induct"
   | "mutual_induct_unfolding" =>
+    unless env.isSafeDefinition p do return false
     if let some eqnInfo := WF.eqnInfoExt.find? env p then
       if h : eqnInfo.declNames.size > 1 then
         return eqnInfo.declNames[0] = p
@@ -1701,12 +1703,8 @@ def isFunCasesName (env : Environment) (name : Name) : Bool := Id.run do
   match s with
   | "fun_cases"
   | "fun_cases_unfolding" =>
-    if (WF.eqnInfoExt.find? env p).isSome then return true
-    if (Structural.eqnInfoExt.find? env p).isSome then return true
-    if let some ci := env.find? p then
-      if ci.hasValue then
-        return true
-    return false
+    unless env.isSafeDefinition p do return false
+    return true
   | _ => return false
 
 builtin_initialize
@@ -1716,11 +1714,13 @@ builtin_initialize
   registerReservedNameAction fun name => do
     if isFunInductName (← getEnv) name then
       let .str p s := name | return false
+      unless (← getEnv).isSafeDefinition p do return false
       let unfolding := s.endsWith "_unfolding"
       MetaM.run' <| deriveInduction unfolding p
       return true
     if isFunCasesName (← getEnv) name then
       let .str p s := name | return false
+      unless (← getEnv).isSafeDefinition p do return false
       let unfolding := s == "fun_cases_unfolding"
       MetaM.run' <| deriveCases unfolding p
       return true

src/Lean/Meta/Tactic/Grind/Arith/CommRing/RingId.lean

@@ -58,21 +58,37 @@ private def getPowFn (type : Expr) (u : Level) (semiringInst : Expr) : GoalM Exp
   internalizeFn <| mkApp4 (mkConst ``HPow.hPow [u, 0, u]) type Nat.mkType type inst
 
 private def getIntCastFn (type : Expr) (u : Level) (ringInst : Expr) : GoalM Expr := do
-  let instType := mkApp (mkConst ``IntCast [u]) type
-  let .some inst ← trySynthInstance instType |
-    throwError "failed to find instance for ring intCast{indentExpr instType}"
   let inst' := mkApp2 (mkConst ``Grind.Ring.intCast [u]) type ringInst
-  unless (← withDefault <| isDefEq inst inst') do
-    throwError "instance for intCast{indentExpr inst}\nis not definitionally equal to the `Grind.Ring` one{indentExpr inst'}"
+  let instType := mkApp (mkConst ``IntCast [u]) type
+  -- Note that `Ring.intCast` is not registered as a global instance
+  -- (to avoid introducing unwanted coercions)
+  -- so merely having a `Ring α` instance
+  -- does not guarantee that an `IntCast α` will be available.
+  -- When both are present we verify that they are defeq,
+  -- and otherwise fall back to the field of the `Ring α` instance that we already have.
+  let inst ← match (← trySynthInstance instType).toOption with
+  | none => pure inst'
+  | some inst =>
+    unless (← withDefault <| isDefEq inst inst') do
+      throwError "instance for intCast{indentExpr inst}\nis not definitionally equal to the `Grind.Ring` one{indentExpr inst'}"
+    pure inst
   internalizeFn <| mkApp2 (mkConst ``IntCast.intCast [u]) type inst
 
 private def getNatCastFn (type : Expr) (u : Level) (semiringInst : Expr) : GoalM Expr := do
-  let instType := mkApp (mkConst ``NatCast [u]) type
-  let .some inst ← trySynthInstance instType |
-    throwError "failed to find instance for ring natCast{indentExpr instType}"
   let inst' := mkApp2 (mkConst ``Grind.Semiring.natCast [u]) type semiringInst
-  unless (← withDefault <| isDefEq inst inst') do
-    throwError "instance for natCast{indentExpr inst}\nis not definitionally equal to the `Grind.Semiring` one{indentExpr inst'}"
+  let instType := mkApp (mkConst ``NatCast [u]) type
+  -- Note that `Semiring.natCast` is not registered as a global instance
+  -- (to avoid introducing unwanted coercions)
+  -- so merely having a `Semiring α` instance
+  -- does not guarantee that an `NatCast α` will be available.
+  -- When both are present we verify that they are defeq,
+  -- and otherwise fall back to the field of the `Semiring α` instance that we already have.
+  let inst ← match (← trySynthInstance instType).toOption with
+  | none => pure inst'
+  | some inst =>
+    unless (← withDefault <| isDefEq inst inst') do
+      throwError "instance for natCast{indentExpr inst}\nis not definitionally equal to the `Grind.Semiring` one{indentExpr inst'}"
+    pure inst
   internalizeFn <| mkApp2 (mkConst ``NatCast.natCast [u]) type inst
 
 /--

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

@@ -45,7 +45,7 @@ def propagateBetaEqs (lams : Array Expr) (f : Expr) (args : Array Expr) : GoalM
           h ← mkCongrFun h arg
         let eq ← mkEq lhs rhs
         trace_goal[grind.beta] "{eq}, using {lam}"
-        addNewRawFact h eq (gen+1)
+        addNewRawFact h eq (gen+1) (.beta lam)
 
 private def isPropagateBetaTarget (e : Expr) : GoalM Bool := do
   let .app f _ := e | return false

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

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Meta.Tactic.Grind.Types
+import Lean.Meta.Tactic.Grind.ProveEq
 
 namespace Lean.Meta.Grind
 
@@ -16,9 +17,9 @@ private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit :=
     propagateInjEqs left (.proj ``And 0 proof)
     propagateInjEqs right (.proj ``And 1 proof)
   | Eq _ lhs rhs    =>
-    pushEq (← shareCommon lhs) (← shareCommon rhs) proof
+    pushEq (← preprocessLight lhs) (← preprocessLight rhs) proof
   | HEq _ lhs _ rhs =>
-    pushHEq (← shareCommon lhs) (← shareCommon rhs) proof
+    pushHEq (← preprocessLight lhs) (← preprocessLight rhs) proof
   | _ =>
    reportIssue! "unexpected injectivity theorem result type{indentExpr eqs}"
    return ()

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

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Meta.AppBuilder
 import Lean.Meta.MatchUtil
+import Lean.Util.ForEachExpr
 
 namespace Lean.Meta.Grind
 /-! A basic "equality resolution" procedure. -/
@@ -21,6 +22,67 @@ private def forallMetaTelescopeReducingAndUnfoldingNot (prop : Expr) : MetaM (Ar
     return (ms.push m, mkConst ``False)
   return (ms, type)
 
+structure TopSort.State where
+  tempMark  : Std.HashSet Expr := {}
+  permMark  : Std.HashSet Expr := {}
+  result : Array Expr := #[]
+
+abbrev TopSortM := OptionT $ StateT TopSort.State MetaM
+
+/--
+Sorts metavariables `ms` using topological sort.
+There is an "edge" from `m₁` to `m₂` if type of `m₁` contains `m₂`.
+We use this function to ensure that after applying equality resolution to
+```
+∀ x : Nat, p x a → ∀ y : Nat, p y b → x = y → False
+```
+we produce
+```
+∀ y, p y a → p y b → False
+```
+instead of
+```
+p ?y a → ∀ y, p y b → False
+```
+Recall that in equality resolution we create a meta-variable for each hypothesis.
+Thus, we initially have
+```
+?x : Nat, ?h₁ : p ?x a, ?y : Nat, ?h₂ : p ?y b, ?h₃ : ?x = ?y
+```
+Then, we resolve `?h₃ : ?x = ?y` as `?y := ?x` and `?h₃ := Eq.refl ?y`.
+But `?h₁` occurs before `?y`. We use topological sort to address this situation.
+If a cycle is detected, it returns `none`.
+-/
+private partial def topsortMVars? (ms : Array Expr) : MetaM (Option (Array Expr)) := do
+  let (some _, s) ← go.run.run {} | return none
+  return some s.result
+where
+  go : TopSortM Unit := do
+    for m in ms do
+      visit m
+
+  visit (m : Expr) : TopSortM Unit := do
+    if (← get).permMark.contains m then
+      return ()
+    if (← get).tempMark.contains m then
+      failure
+    modify fun s => { s with tempMark := s.tempMark.insert m }
+    visitTypeOf m
+    modify fun s => { s with
+      result := s.result.push m
+      permMark := s.permMark.insert m
+    }
+
+  visitTypeOf (m : Expr) : TopSortM Unit := do
+    let type ← instantiateMVars (← inferType m)
+    type.forEach' fun e => do
+      if e.hasExprMVar then
+        if e.isMVar && ms.contains e then
+          visit e
+        return true
+      else
+        return false
+
 private def eqResCore (prop proof : Expr) : MetaM (Option (Expr × Expr)) := withNewMCtxDepth do
   /-
   We use `forallMetaTelescopeReducingAndUnfoldingNot` because we want to treat
@@ -51,6 +113,7 @@ private def eqResCore (prop proof : Expr) : MetaM (Option (Expr × Expr)) := wit
   let prop' ← instantiateMVars type
   let proof' ← instantiateMVars (mkAppN proof ms)
   let ms ← ms.filterM fun m => return !(← m.mvarId!.isAssigned)
+  let some ms ← topsortMVars? ms | return none
   let prop' ← mkForallFVars ms prop' (binderInfoForMVars := .default)
   let proof' ← mkLambdaFVars ms proof'
   return some (prop', proof')

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

@@ -36,6 +36,6 @@ def instantiateExtTheorem (thm : Ext.ExtTheorem) (e : Expr) : GoalM Unit := with
     reportIssue! "failed to apply extensionality theorem `{thm.declName}` for {indentExpr e}\nresulting terms contain metavariables"
     return ()
   trace[grind.ext] "{thm.declName}: {prop'}"
-  addNewRawFact proof' prop' ((← getGeneration e) + 1)
+  addNewRawFact proof' prop' ((← getGeneration e) + 1) (.ext thm.declName)
 
 end Lean.Meta.Grind

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

@@ -94,7 +94,7 @@ def propagateForallPropDown (e : Expr) : GoalM Unit := do
       let u ← getLevel α
       let prop := mkApp2 (mkConst ``Exists [u]) α (mkLambda n bi α (mkNot p))
       let proof := mkApp3 (mkConst ``Grind.of_forall_eq_false [u]) α (mkLambda n bi α p) (← mkEqFalseProof e)
-      addNewRawFact proof prop (← getGeneration e)
+      addNewRawFact proof prop (← getGeneration e) (.forallProp e)
     else
       let h ← mkEqFalseProof e
       pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_imp_eq_false) a b h
@@ -104,7 +104,7 @@ def propagateForallPropDown (e : Expr) : GoalM Unit := do
       trace_goal[grind.eqResolution] "{e}, {e'}"
       let h := mkOfEqTrueCore e (← mkEqTrueProof e)
       let h' := mkApp h' h
-      addNewRawFact h' e' (← getGeneration e)
+      addNewRawFact h' e' (← getGeneration e) (.forallProp e)
     else
       if b.hasLooseBVars then
         addLocalEMatchTheorems e
@@ -121,6 +121,6 @@ builtin_grind_propagator propagateExistsDown ↓Exists := fun e => do
     let notP := mkApp (mkConst ``Not) (mkApp p (.bvar 0) |>.headBeta)
     let prop := mkForall `x .default α notP
     let proof := mkApp3 (mkConst ``forall_not_of_not_exists u) α p (mkOfEqFalseCore e (← mkEqFalseProof e))
-    addNewRawFact proof prop (← getGeneration e)
+    addNewRawFact proof prop (← getGeneration e) (.existsProp e)
 
 end Lean.Meta.Grind

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

@@ -50,6 +50,7 @@ private def updateAppMap (e : Expr) : GoalM Unit := do
     else
       s.appMap.insert key [e]
   }
+  saveAppOf key
 
 private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
 
@@ -58,15 +59,21 @@ def isMorallyIff (e : Expr) : Bool :=
   let_expr Eq α _ _ := e | false
   α.isProp
 
+private def mkDefaultSplitInfo (e : Expr) : GrindM SplitInfo :=
+  return .default e (← readThe Context).splitSource
+
+private def addDefaultSplitCandidate (e : Expr) : GoalM Unit := do
+  addSplitCandidate (← mkDefaultSplitInfo e)
+
 /-- Inserts `e` into the list of case-split candidates if applicable. -/
 private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
   match h : e with
   | .app .. =>
     if (← getConfig).splitIte && (isIte e || isDIte e) then
-      addSplitCandidate (.default e)
+      addDefaultSplitCandidate e
       return ()
     if isMorallyIff e then
-      addSplitCandidate (.default e)
+      addDefaultSplitCandidate e
       return ()
     if (← getConfig).splitMatch then
       if (← isMatcherApp e) then
@@ -75,7 +82,7 @@ private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
           -- and consequently don't need to be split.
           return ()
         else
-          addSplitCandidate (.default e)
+          addDefaultSplitCandidate e
           return ()
     let .const declName _  := e.getAppFn | return ()
       if forbiddenSplitTypes.contains declName then
@@ -83,24 +90,25 @@ private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
       unless (← isInductivePredicate declName) do
         return ()
       if (← get).split.casesTypes.isSplit declName then
-        addSplitCandidate (.default e)
+        addDefaultSplitCandidate e
       else if (← getConfig).splitIndPred then
-        addSplitCandidate (.default e)
+        addDefaultSplitCandidate e
   | .fvar .. =>
     let .const declName _ := (← whnf (← inferType e)).getAppFn | return ()
     if (← get).split.casesTypes.isSplit declName then
-      addSplitCandidate (.default e)
+      addDefaultSplitCandidate e
   | .forallE _ d _ _ =>
+    let currSplitSource := (← readThe Context).splitSource
     if (← getConfig).splitImp then
       if (← isProp d) then
-        addSplitCandidate (.imp e (h ▸ rfl))
+        addSplitCandidate (.imp e (h ▸ rfl) currSplitSource)
     else if Arith.isRelevantPred d then
       -- TODO: should we keep lookahead after we implement non-chronological backtracking?
       if (← getConfig).lookahead then
-        addLookaheadCandidate (.imp e (h ▸ rfl))
+        addLookaheadCandidate (.imp e (h ▸ rfl) currSplitSource)
       -- We used to add the `split` only if `lookahead := false`, but it was counterintuitive
       -- to make `grind` "stronger" by disabling a feature.
-      addSplitCandidate (.imp e (h ▸ rfl))
+      addSplitCandidate (.imp e (h ▸ rfl) currSplitSource)
   | _ => pure ()
 
 /--
@@ -272,7 +280,8 @@ where
         -- if (← getConfig).lookahead then
         --   addLookaheadCandidate (.arg other.app parent i eq)
         -- else
-        addSplitCandidate (.arg other.app parent i eq)
+        let currSplitSource := (← readThe Context).splitSource
+        addSplitCandidate (.arg other.app parent i eq currSplitSource)
     modify fun s => { s with split.argsAt := s.split.argsAt.insert (f, i) ({ arg, type, app := parent } :: others) }
     return ()
 

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

@@ -258,7 +258,7 @@ def intros' (generation : Nat) : SearchM Bool := do
   return true
 
 /-- Asserts a new fact `prop` with proof `proof` to the given `goal`. -/
-def assertAt (proof : Expr) (prop : Expr) (generation : Nat) : SearchM Unit := do
+private def assertAt (proof : Expr) (prop : Expr) (generation : Nat) : SearchM Unit := do
   if isEagerCasesCandidate (← getGoal) prop then
     let goal ← getGoal
     let mvarId ← goal.mvarId.assert (← mkFreshUserName `h) prop proof
@@ -280,8 +280,10 @@ def assertNext : SearchM Bool := do
   let some (fact, newRawFacts) := goal.newRawFacts.dequeue?
     | return false
   setGoal { goal with newRawFacts }
-  assertAt fact.proof fact.prop fact.generation
-  return true
+  withSplitSource fact.splitSource do
+    -- Remark: we should probably add `withGeneration`
+    assertAt fact.proof fact.prop fact.generation
+    return true
 
 /--
 Asserts all facts in the `goal` fact queue.

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

@@ -45,7 +45,7 @@ private def mkCandidate (a b : ArgInfo) (i : Nat) : GoalM SplitInfo := do
     (b.arg, a.arg)
   let eq ← mkEq lhs rhs
   let eq ← shareCommon (← canon eq)
-  return .arg a.app b.app i eq
+  return .arg a.app b.app i eq (.mbtc a.app b.app i)
 
 /-- Model-based theory combination. -/
 def mbtc (ctx : MBTC.Context) : GoalM Bool := do
@@ -84,7 +84,7 @@ def mbtc (ctx : MBTC.Context) : GoalM Bool := do
   let result ← result.filterMapM fun info => do
     if (← isKnownCaseSplit info) then
       return none
-    let .arg a b _ eq := info | return none
+    let .arg a b _ eq _ := info | return none
     internalize eq (Nat.max (← getGeneration a) (← getGeneration b))
     return some info
   if result.isEmpty then

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

@@ -76,8 +76,8 @@ def GrindM.run (x : GrindM α) (params : Params) (fallback : Fallback) : MetaM
   let simpMethods := Simp.mkMethods simprocs discharge? (wellBehavedDischarge := true)
   let simp := params.norm
   let config := params.config
-  x (← mkMethods fallback).toMethodsRef { config, simpMethods, simp }
-    |>.run' { scState, trueExpr, falseExpr, natZExpr, btrueExpr, bfalseExpr }
+  x (← mkMethods fallback).toMethodsRef { config, simpMethods, simp, trueExpr, falseExpr, natZExpr, btrueExpr, bfalseExpr }
+    |>.run' { scState }
 
 private def mkCleanState (mvarId : MVarId) (params : Params) : MetaM Clean.State := mvarId.withContext do
   unless params.config.clean do return {}
@@ -106,12 +106,13 @@ private def mkGoal (mvarId : MVarId) (params : Params) : GrindM Goal := do
       activateTheorem thm 0
 
 structure Result where
-  failure? : Option Goal
-  issues   : List MessageData
-  config   : Grind.Config
-  trace    : Trace
-  counters : Counters
-  simp     : Simp.Stats
+  failure?   : Option Goal
+  issues     : List MessageData
+  config     : Grind.Config
+  trace      : Trace
+  counters   : Counters
+  simp       : Simp.Stats
+  splitDiags : PArray SplitDiagInfo
 
 private def countersToMessageData (header : String) (cls : Name) (data : Array (Name × Nat)) : MetaM MessageData := do
   let data := data.qsort fun (d₁, c₁) (d₂, c₂) => if c₁ == c₂ then Name.lt d₁ d₂ else c₁ > c₂
@@ -119,8 +120,22 @@ private def countersToMessageData (header : String) (cls : Name) (data : Array (
     return .trace { cls } m!"{.ofConst (← mkConstWithLevelParams declName)} ↦ {counter}" #[]
   return .trace { cls } header data
 
+private def splitDiagInfoToMessageData (ss : Array SplitDiagInfo) : MetaM MessageData := do
+  let env  ← getEnv
+  let mctx ← getMCtx
+  let opts ← getOptions
+  let cls := `split
+  let data ← ss.mapM fun { c, lctx, numCases, gen, splitSource } => do
+    let header := m!"{c}"
+    return MessageData.withContext { env, mctx, lctx, opts } <| .trace { cls } header #[
+      .trace { cls } m!"source: {← splitSource.toMessageData}" #[],
+      .trace { cls } m!"generation: {gen}" #[],
+      .trace { cls } m!"# cases: {numCases}" #[]
+    ]
+  return .trace { cls } "Case splits" data
+
 -- Diagnostics information for the whole search
-private def mkGlobalDiag (cs : Counters) (simp : Simp.Stats) : MetaM (Option MessageData) := do
+private def mkGlobalDiag (cs : Counters) (simp : Simp.Stats) (ss : PArray SplitDiagInfo) : MetaM (Option MessageData) := do
   let thms := cs.thm.toList.toArray.filterMap fun (origin, c) =>
     match origin with
     | .decl declName => some (declName, c)
@@ -130,8 +145,13 @@ private def mkGlobalDiag (cs : Counters) (simp : Simp.Stats) : MetaM (Option Mes
   let mut msgs := #[]
   unless thms.isEmpty do
     msgs := msgs.push <| (← countersToMessageData "E-Matching instances" `thm thms)
+  let ss := ss.toArray.filter fun { numCases, .. } => numCases > 1
+  unless ss.isEmpty do
+    msgs := msgs.push <| (← splitDiagInfoToMessageData ss)
   unless cases.isEmpty do
     msgs := msgs.push <| (← countersToMessageData "Cases instances" `cases cases)
+  unless cs.apps.isEmpty do
+    msgs := msgs.push <| (← countersToMessageData "Applications" `app cs.apps.toList.toArray)
   let simpMsgs ← Simp.mkDiagMessages simp.diag
   unless simpMsgs.isEmpty do
     msgs := msgs.push <| .trace { cls := `grind} "Simplifier" simpMsgs
@@ -155,7 +175,7 @@ def Result.toMessageData (result : Result) : MetaM MessageData := do
     -/
     unless issues.isEmpty do
       msgs := msgs ++ [.trace { cls := `grind } "Issues" issues.reverse.toArray]
-    if let some msg ← mkGlobalDiag result.counters result.simp then
+    if let some msg ← mkGlobalDiag result.counters result.simp result.splitDiags then
       msgs := msgs ++ [msg]
   return MessageData.joinSep msgs m!"\n"
 
@@ -172,21 +192,22 @@ def main (mvarId : MVarId) (params : Params) (fallback : Fallback) : MetaM Resul
   if debug.terminalTacticsAsSorry.get (← getOptions) then
     mvarId.admit
     return {
-        failure? := none, issues := [], config := params.config, trace := {}, counters := {}, simp := {}
+        failure? := none, issues := [], config := params.config, trace := {}, counters := {}, simp := {}, splitDiags := {}
     }
   let go : GrindM Result := withReducible do
-    let goal ← initCore mvarId params
-    let failure? ← solve goal
-    let issues   := (← get).issues
-    let trace    := (← get).trace
-    let counters := (← get).counters
-    let simp     := { (← get).simp with }
+    let goal       ← initCore mvarId params
+    let failure?   ← solve goal
+    let issues     := (← get).issues
+    let trace      := (← get).trace
+    let counters   := (← get).counters
+    let splitDiags := (← get).splitDiags
+    let simp       := { (← get).simp with }
     if failure?.isNone then
       -- If there are no failures and diagnostics are enabled, we still report the performance counters.
       if (← isDiagnosticsEnabled) then
-        if let some msg ← mkGlobalDiag counters simp then
+        if let some msg ← mkGlobalDiag counters simp splitDiags then
           logInfo msg
-    return { failure?, issues, config := params.config, trace, counters, simp }
+    return { failure?, issues, config := params.config, trace, counters, simp, splitDiags }
   go.run params fallback
 
 end Lean.Meta.Grind

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

@@ -172,8 +172,10 @@ private def ppCasesTrace : M Unit := do
   let goal ← read
   unless goal.split.trace.isEmpty do
     let mut msgs := #[]
-    for { expr, i , num } in goal.split.trace.reverse do
-      msgs := msgs.push <| .trace { cls := `cases } m!"[{i+1}/{num}]: {expr}" #[]
+    for { expr, i , num, source } in goal.split.trace.reverse do
+      msgs := msgs.push <| .trace { cls := `cases } m!"[{i+1}/{num}]: {expr}" #[
+        .trace { cls := `cases } m!"source: {← source.toMessageData}" #[]
+      ]
     pushMsg <| .trace { cls := `cases } "Case analyses" msgs
 
 def goalToMessageData (goal : Goal) (config : Grind.Config) : MetaM MessageData := goal.mvarId.withContext do

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

@@ -156,9 +156,9 @@ private def checkForallStatus (imp : Expr) (h : imp.isForall) : GoalM SplitStatu
 
 def checkSplitStatus (s : SplitInfo) : GoalM SplitStatus := do
   match s with
-  | .default e => checkDefaultSplitStatus e
-  | .imp e h => checkForallStatus e h
-  | .arg a b _ eq => checkSplitInfoArgStatus a b eq
+  | .default e _    => checkDefaultSplitStatus e
+  | .imp e h _      => checkForallStatus e h
+  | .arg a b _ eq _ => checkSplitInfoArgStatus a b eq
 
 private inductive SplitCandidate where
   | none
@@ -249,10 +249,11 @@ def splitNext : SearchM Bool := withCurrGoalContext do
   let cExpr := c.getExpr
   let gen ← getGeneration cExpr
   let genNew := if numCases > 1 || isRec then gen+1 else gen
+  saveSplitDiagInfo cExpr genNew numCases c.source
   markCaseSplitAsResolved cExpr
   trace_goal[grind.split] "{cExpr}, generation: {gen}"
   let mvarId ← mkAuxMVarForCurrGoal
-  let mvarIds ← if let .imp e h := c then
+  let mvarIds ← if let .imp e h _ := c then
     casesWithTrace mvarId (mkGrindEM (e.forallDomain h))
   else if (← isMatcherApp cExpr) then
     casesMatch mvarId cExpr
@@ -262,7 +263,7 @@ def splitNext : SearchM Bool := withCurrGoalContext do
   let numSubgoals := mvarIds.length
   let goals := mvarIds.mapIdx fun i mvarId => { goal with
     mvarId
-    split.trace := { expr := cExpr, i, num := numSubgoals } :: goal.split.trace
+    split.trace := { expr := cExpr, i, num := numSubgoals, source := c.source } :: goal.split.trace
   }
   mkChoice (mkMVar mvarId) goals genNew
   intros genNew

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

@@ -53,6 +53,36 @@ register_builtin_option grind.warning : Bool := {
   descr    := "disable `grind` usage warning"
 }
 
+/--
+Case-split source. That is, where it came from.
+We store the current source in the `grind` context.
+-/
+inductive SplitSource where
+  | /-- Generated while instantiating a theorem using E-matching. -/
+    ematch (origin : Origin)
+  | /-- Generated while instantiating an extensionality theorem with name `declName` -/
+    ext (declName : Name)
+  | /-- Model-based theory combination equality coming from the i-th argument of applications `a` and `b` -/
+    mbtc (a b : Expr) (i : Nat)
+  | /-- Beta-reduction. -/
+    beta (e : Expr)
+  | /-- Forall-propagator. -/
+    forallProp (e : Expr)
+  | /-- Exists-propagator. -/
+    existsProp (e : Expr)
+  | /-- Input goal -/
+    input
+  deriving Inhabited
+
+def SplitSource.toMessageData : SplitSource → MetaM MessageData
+  | .ematch origin => return m!"E-matching {← origin.pp}"
+  | .ext declName => return m!"Extensionality {declName}"
+  | .mbtc a b i => return m!"Model-based theory combination at argument #{i} of{indentExpr a}\nand{indentExpr b}"
+  | .beta e => return m!"Beta-reduction of{indentExpr e}"
+  | .forallProp e => return m!"Forall propagation at{indentExpr e}"
+  | .existsProp e => return m!"Exists propagation at{indentExpr e}"
+  | .input => return m!"Initial goal"
+
 /-- Context for `GrindM` monad. -/
 structure Context where
   simp         : Simp.Context
@@ -74,6 +104,13 @@ structure Context where
   user with "false-alarms". If the instantiation fails, we produce a more informative issue anyways.
   -/
   reportMVarIssue : Bool := true
+  /-- Current source of case-splits. -/
+  splitSource  : SplitSource := .input
+  trueExpr     : Expr
+  falseExpr    : Expr
+  natZExpr     : Expr
+  btrueExpr    : Expr
+  bfalseExpr   : Expr
 
 /-- Key for the congruence theorem cache. -/
 structure CongrTheoremCacheKey where
@@ -110,10 +147,20 @@ structure Counters where
   thm  : PHashMap Origin Nat := {}
   /-- Number of times a `cases` has been performed on an inductive type/predicate -/
   case : PHashMap Name Nat := {}
+  /-- Number of applications per function symbol. This information is only collected if `set_option diagnostics true` -/
+  apps : PHashMap Name Nat := {}
   deriving Inhabited
 
 private def emptySC : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
 
+/-- Case-split diagnostic information -/
+structure SplitDiagInfo where
+  lctx        : LocalContext
+  c           : Expr
+  gen         : Nat
+  numCases    : Nat
+  splitSource : SplitSource
+
 /-- State for the `GrindM` monad. -/
 structure State where
   /-- `ShareCommon` (aka `Hashconsing`) state. -/
@@ -125,11 +172,6 @@ structure State where
   -/
   congrThms  : PHashMap CongrTheoremCacheKey CongrTheorem := {}
   simp       : Simp.State := {}
-  trueExpr   : Expr
-  falseExpr  : Expr
-  natZExpr   : Expr
-  btrueExpr  : Expr
-  bfalseExpr : Expr
   /--
   Used to generate trace messages of the for `[grind] working on <tag>`,
   and implement the macro `trace_goal`.
@@ -144,6 +186,8 @@ structure State where
   trace      : Trace := {}
   /-- Performance counters -/
   counters   : Counters := {}
+  /-- Split diagnostic information. This information is only collected when `set_option diagnostics true` -/
+  splitDiags : PArray SplitDiagInfo := {}
 
 private opaque MethodsRefPointed : NonemptyType.{0}
 private def MethodsRef : Type := MethodsRefPointed.type
@@ -161,29 +205,36 @@ See comment at `Grind.Context.reportMVarIssue` for additional details.
 def withoutReportingMVarIssues [MonadControlT GrindM m] [Monad m] : m α → m α :=
   mapGrindM <| withTheReader Grind.Context fun ctx => { ctx with reportMVarIssue := false }
 
+/--
+`withSplitSource s x` executes `x` and uses `s` as the split source for any case-split
+registered.
+-/
+def withSplitSource [MonadControlT GrindM m] [Monad m] (splitSource : SplitSource) : m α → m α :=
+  mapGrindM <| withTheReader Grind.Context fun ctx => { ctx with splitSource }
+
 /-- Returns the user-defined configuration options -/
 def getConfig : GrindM Grind.Config :=
   return (← readThe Context).config
 
 /-- Returns the internalized `True` constant.  -/
 def getTrueExpr : GrindM Expr := do
-  return (← get).trueExpr
+  return (← readThe Context).trueExpr
 
 /-- Returns the internalized `False` constant.  -/
 def getFalseExpr : GrindM Expr := do
-  return (← get).falseExpr
+  return (← readThe Context).falseExpr
 
 /-- Returns the internalized `Bool.true`.  -/
 def getBoolTrueExpr : GrindM Expr := do
-  return (← get).btrueExpr
+  return (← readThe Context).btrueExpr
 
 /-- Returns the internalized `Bool.false`.  -/
 def getBoolFalseExpr : GrindM Expr := do
-  return (← get).bfalseExpr
+  return (← readThe Context).bfalseExpr
 
 /-- Returns the internalized `0 : Nat` numeral.  -/
 def getNatZeroExpr : GrindM Expr := do
-  return (← get).natZExpr
+  return (← readThe Context).natZExpr
 
 def cheapCasesOnly : GrindM Bool :=
   return (← readThe Context).cheapCases
@@ -197,16 +248,17 @@ Returns `true` if `declName` is the name of a `match` equation or a `match` cong
 def isMatchEqLikeDeclName (declName : Name) : CoreM Bool := do
   return (← isMatchCongrEqDeclName declName) || Match.isMatchEqnTheorem (← getEnv) declName
 
-def saveEMatchTheorem (thm : EMatchTheorem) : GrindM Unit := do
+private def incCounter [Hashable α] [BEq α] (s : PHashMap α Nat) (k : α) : PHashMap α Nat :=
+  if let some n := s.find? k then
+      s.insert k (n+1)
+    else
+      s.insert k 1
+
+private def saveEMatchTheorem (thm : EMatchTheorem) : GrindM Unit := do
   if (← getConfig).trace then
     unless (← isMatchEqLikeDeclName thm.origin.key) do
       modify fun s => { s with trace.thms := s.trace.thms.insert { origin := thm.origin, kind := thm.kind } }
-  modify fun s => { s with
-    counters.thm := if let some n := s.counters.thm.find? thm.origin then
-      s.counters.thm.insert thm.origin (n+1)
-    else
-      s.counters.thm.insert thm.origin 1
-  }
+  modify fun s => { s with counters.thm := incCounter s.counters.thm thm.origin }
 
 def saveCases (declName : Name) (eager : Bool) : GrindM Unit := do
   if (← getConfig).trace then
@@ -214,12 +266,17 @@ def saveCases (declName : Name) (eager : Bool) : GrindM Unit := do
       modify fun s => { s with trace.eagerCases := s.trace.eagerCases.insert declName }
     else
       modify fun s => { s with trace.cases := s.trace.cases.insert declName }
-  modify fun s => { s with
-    counters.case := if let some n := s.counters.case.find? declName then
-      s.counters.case.insert declName (n+1)
-    else
-      s.counters.case.insert declName 1
-  }
+  modify fun s => { s with counters.case := incCounter s.counters.case declName }
+
+def saveAppOf (h : HeadIndex) : GrindM Unit := do
+  if (← isDiagnosticsEnabled) then
+    let .const declName := h | return ()
+    modify fun s => { s with counters.apps := incCounter s.counters.apps declName }
+
+def saveSplitDiagInfo (c : Expr) (gen : Nat) (numCases : Nat) (splitSource : SplitSource) : GrindM Unit := do
+  if (← isDiagnosticsEnabled) then
+    let lctx ← getLCtx
+    modify fun s => { s with splitDiags := s.splitDiags.push { c, gen, lctx, numCases, splitSource } }
 
 @[inline] def getMethodsRef : GrindM MethodsRef :=
   read
@@ -478,9 +535,11 @@ abbrev PreInstanceSet := PHashSet PreInstance
 
 /-- New raw fact to be preprocessed, and then asserted. -/
 structure NewRawFact where
-  proof      : Expr
-  prop       : Expr
-  generation : Nat
+  proof        : Expr
+  prop         : Expr
+  generation   : Nat
+  /-- `splitSource` to use when internalizing this fact. -/
+  splitSource  : SplitSource
   deriving Inhabited
 
 /-- Canonicalizer state. See `Canon.lean` for additional details. -/
@@ -492,9 +551,10 @@ structure Canon.State where
 
 /-- Trace information for a case split. -/
 structure CaseTrace where
-  expr : Expr
-  i    : Nat
-  num  : Nat
+  expr   : Expr
+  i      : Nat
+  num    : Nat
+  source : SplitSource
   deriving Inhabited
 
 /-- E-matching related fields for the `grind` goal. -/
@@ -527,38 +587,51 @@ inductive SplitInfo where
   | /--
     Term `e` may be an inductive predicate, `match`-expression, `if`-expression, implication, etc.
     -/
-    default (e : Expr)
+    default (e : Expr) (source : SplitSource)
   /-- `e` is an implication and we want to split on its antecedent. -/
-  | imp (e : Expr) (h : e.isForall)
+  | imp (e : Expr) (h : e.isForall) (source : SplitSource)
   | /--
     Given applications `a` and `b`, case-split on whether the corresponding
     `i`-th arguments are equal or not. The split is only performed if all other
     arguments are already known to be equal or are also tagged as split candidates.
     -/
-    arg (a b : Expr) (i : Nat) (eq : Expr)
-  deriving Hashable, Inhabited
+    arg (a b : Expr) (i : Nat) (eq : Expr) (source :SplitSource)
+  deriving Inhabited
+
+protected def SplitInfo.hash : SplitInfo → UInt64
+ | .default e _ => hash e
+ | .imp e _ _   => hash e
+ | .arg _ _ _ e _ => hash e
+
+instance : Hashable SplitInfo where
+  hash := SplitInfo.hash
 
 def SplitInfo.beq : SplitInfo → SplitInfo → Bool
- | .default e₁, .default e₂ => e₁ == e₂
- | .imp e₁ _, .imp e₂ _ => e₁ == e₂
- | .arg a₁ b₁ i₁ eq₁, arg a₂ b₂ i₂ eq₂ => a₁ == a₂ && b₁ == b₂ && i₁ == i₂ && eq₁ == eq₂
+ | .default e₁ _, .default e₂ _ => e₁ == e₂
+ | .imp e₁ _ _, .imp e₂ _ _=> e₁ == e₂
+ | .arg a₁ b₁ i₁ eq₁ _, arg a₂ b₂ i₂ eq₂ _ => a₁ == a₂ && b₁ == b₂ && i₁ == i₂ && eq₁ == eq₂
  | _, _ => false
 
 instance : BEq SplitInfo where
   beq := SplitInfo.beq
 
 def SplitInfo.getExpr : SplitInfo → Expr
-  | .default e => e
-  | .imp e h => e.forallDomain h
-  | .arg _ _ _ eq => eq
+  | .default e _ => e
+  | .imp e h _ => e.forallDomain h
+  | .arg _ _ _ eq _ => eq
+
+def SplitInfo.source : SplitInfo → SplitSource
+  | .default _ s   => s
+  | .imp _ _ s     => s
+  | .arg _ _ _ _ s => s
 
 def SplitInfo.lt : SplitInfo → SplitInfo → Bool
-  | .default e₁, .default e₂     => e₁.lt e₂
-  | .imp e₁ _, .imp e₂ _         => e₁.lt e₂
-  | .arg _ _ _ e₁, .arg _ _ _ e₂ => e₁.lt e₂
-  | .default .., _               => true
-  | .imp .., _                   => true
-  | _, _                         => false
+  | .default e₁ _, .default e₂ _     => e₁.lt e₂
+  | .imp e₁ _ _, .imp e₂ _ _         => e₁.lt e₂
+  | .arg _ _ _ e₁ _, .arg _ _ _ e₂ _ => e₁.lt e₂
+  | .default .., _                   => true
+  | .imp .., _                       => true
+  | _, _                             => false
 
 /-- Argument `arg : type` of an application `app` in `SplitInfo`. -/
 structure SplitArg where
@@ -696,18 +769,18 @@ def markTheoremInstance (proof : Expr) (assignment : Array Expr) : GoalM Bool :=
   return true
 
 /-- Adds a new fact `prop` with proof `proof` to the queue for preprocessing and the assertion. -/
-def addNewRawFact (proof : Expr) (prop : Expr) (generation : Nat) : GoalM Unit := do
+def addNewRawFact (proof : Expr) (prop : Expr) (generation : Nat) (splitSource : SplitSource) : GoalM Unit := do
   if grind.debug.get (← getOptions) then
     unless (← withReducible <| isDefEq (← inferType proof) prop) do
       throwError "`grind` internal error, trying to assert{indentExpr prop}\n\
         with proof{indentExpr proof}\nwhich has type{indentExpr (← inferType proof)}\n\
         which is not definitionally equal with `reducible` transparency setting}"
-  modify fun s => { s with newRawFacts := s.newRawFacts.enqueue { proof, prop, generation } }
+  modify fun s => { s with newRawFacts := s.newRawFacts.enqueue { proof, prop, generation, splitSource } }
 
 /-- Adds a new theorem instance produced using E-matching. -/
 def addTheoremInstance (thm : EMatchTheorem) (proof : Expr) (prop : Expr) (generation : Nat) : GoalM Unit := do
   saveEMatchTheorem thm
-  addNewRawFact proof prop generation
+  addNewRawFact proof prop generation (.ematch thm.origin)
   modify fun s => { s with ematch.numInstances := s.ematch.numInstances + 1 }
 
 /-- Returns `true` if the maximum number of instances has been reached. -/
@@ -840,6 +913,10 @@ Otherwise, it pushes `HEq lhs rhs`.
 -/
 def pushEqCore (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit := do
   if grind.debug.get (← getOptions) then
+    unless (← alreadyInternalized lhs) do
+      throwError "`grind` internal error, lhs of new equality has not been internalized{indentExpr lhs}"
+    unless (← alreadyInternalized rhs) do
+      throwError "`grind` internal error, rhs of new equality has not been internalized{indentExpr rhs}"
     unless proof == congrPlaceholderProof do
       let expectedType ← if isHEq then mkHEq lhs rhs else mkEq lhs rhs
       unless (← withReducible <| isDefEq (← inferType proof) expectedType) do
@@ -1334,7 +1411,7 @@ def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
     modify fun s => { s with split.resolved := s.split.resolved.insert { expr := e } }
 
 private def updateSplitArgPosMap (sinfo : SplitInfo) : GoalM Unit := do
-  let .arg a b i _ := sinfo | return ()
+  let .arg a b i _ _ := sinfo | return ()
   let key := (a, b)
   let is := (← get).split.argPosMap[key]? |>.getD []
   modify fun s => { s with

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

@@ -439,11 +439,11 @@ private def mkSimpTheoremsFromConst (declName : Name) (post : Bool) (inv : Bool)
     if inv || (← shouldPreprocess type) then
       let mut r := #[]
       for (val, type) in (← preprocess val type inv (isGlobal := true)) do
-        let auxName ← mkAuxLemma cinfo.levelParams type val
-        r := r.push <| (← mkSimpTheoremCore origin (mkConst auxName us) #[] (mkConst auxName) post prio (noIndexAtArgs := false))
+        let auxName ← mkAuxLemma (kind? := `_simp) cinfo.levelParams type val
+        r := r.push <| (← withoutExporting do mkSimpTheoremCore origin (mkConst auxName us) #[] (mkConst auxName) post prio (noIndexAtArgs := false))
       return r
     else
-      return #[← mkSimpTheoremCore origin (mkConst declName us) #[] (mkConst declName) post prio (noIndexAtArgs := false)]
+      return #[← withoutExporting do mkSimpTheoremCore origin (mkConst declName us) #[] (mkConst declName) post prio (noIndexAtArgs := false)]
 
 inductive SimpEntry where
   | thm      : SimpTheorem → SimpEntry
@@ -463,7 +463,7 @@ def SimpExtension.getTheorems (ext : SimpExtension) : CoreM SimpTheorems :=
   return ext.getState (← getEnv)
 
 def addSimpTheorem (ext : SimpExtension) (declName : Name) (post : Bool) (inv : Bool) (attrKind : AttributeKind) (prio : Nat) : MetaM Unit := do
-  let simpThms ← mkSimpTheoremsFromConst declName post inv prio
+  let simpThms ← withExporting (isExporting := !isPrivateName declName) do mkSimpTheoremsFromConst declName post inv prio
   for simpThm in simpThms do
     ext.add (SimpEntry.thm simpThm) attrKind
 

src/Lean/PrettyPrinter/Delaborator/Builtins.lean

@@ -93,32 +93,23 @@ Rather, it is called through the `app` delaborator.
 -/
 def delabConst : Delab := do
   let Expr.const c₀ ls ← getExpr | unreachable!
-  let mut c₀ := c₀
-  let mut c  := c₀
-  if let some n := privateToUserName? c₀ then
+  let unresolveName (n : Name) : DelabM Name := do
+    unresolveNameGlobalAvoidingLocals n (fullNames := ← getPPOption getPPFullNames)
+  let mut c := c₀
+  if isPrivateName c₀ then
     unless (← getPPOption getPPPrivateNames) do
-      if c₀ == mkPrivateName (← getEnv) n then
-        -- The name is defined in this module, so use `n` as the name and unresolve like any other name.
-        c₀ := n
-        c ← unresolveNameGlobal n (fullNames := ← getPPOption getPPFullNames)
-      else
-        -- The name is not defined in this module, so make inaccessible. Unresolving does not make sense to do.
+      c ← unresolveName c
+      if let some n := privateToUserName? c then
+        -- The private name could not be made non-private, so make the result inaccessible
         c ← withFreshMacroScope <| MonadQuotation.addMacroScope n
   else
-    c ← unresolveNameGlobal c (fullNames := ← getPPOption getPPFullNames)
+    c ← unresolveName c
   let stx ←
-    if ls.isEmpty || !(← getPPOption getPPUniverses) then
-      if (← getLCtx).usesUserName c then
-        -- `c` is also a local declaration
-        if c == c₀ && !(← read).inPattern then
-          -- `c` is the fully qualified named. So, we append the `_root_` prefix
-          c := `_root_ ++ c
-        else
-          c := c₀
-      pure <| mkIdent c
-    else
+    if !ls.isEmpty && (← getPPOption getPPUniverses) then
       let mvars ← getPPOption getPPMVarsLevels
       `($(mkIdent c).{$[$(ls.toArray.map (Level.quote · (prec := 0) (mvars := mvars)))],*})
+    else
+      pure <| mkIdent c
 
   let stx ← maybeAddBlockImplicit stx
   if (← getPPOption getPPTagAppFns) then
@@ -1411,18 +1402,12 @@ private unsafe def evalSyntaxConstantUnsafe (env : Environment) (opts : Options)
 private opaque evalSyntaxConstant (env : Environment) (opts : Options) (constName : Name) : ExceptT String Id Syntax := throw ""
 
 /--
-Pretty-prints a constant `c` as `c.{<levels>} <params> : <type>`.
-
-If `universes` is `false`, then the universe level parameters are omitted.
+Pretty-prints the parameters of a `forall`. The pretty-printed parameters are passed to
+`delabForall` at the end.
 -/
-partial def delabConstWithSignature (universes : Bool := true) : Delab := do
-  let e ← getExpr
-  -- use virtual expression node of arity 2 to separate name and type info
-  let idStx ← descend e 0 <|
-    withOptions (pp.universes.set · universes |> (pp.fullNames.set · true)) <|
-      delabConst
-  descend (← inferType e) 1 <|
-    delabParams {} idStx #[]
+partial def delabForallParamsWithSignature
+    (delabForall : (groups : TSyntaxArray ``bracketedBinder) → (type : Term) → DelabM α) : DelabM α := do
+  delabParams {} #[]
 where
   /--
   For types in the signature, we want to be sure pi binder types are pretty printed.
@@ -1434,7 +1419,7 @@ where
   Once it reaches a binder with an inaccessible name, or a name that has already been used,
   the remaining binders appear in pi types after the `:` of the declaration.
   -/
-  delabParams (bindingNames : NameSet) (idStx : Ident) (groups : TSyntaxArray ``bracketedBinder) := do
+  delabParams (bindingNames : NameSet) (groups : TSyntaxArray ``bracketedBinder) := do
     let e ← getExpr
     if e.isForall && e.binderInfo.isInstImplicit && e.bindingName!.hasMacroScopes then
       -- Assumption: this instance can be found by instance search, so it does not need to be named.
@@ -1442,14 +1427,14 @@ where
       -- We could check to see whether the instance appears in the type and avoid omitting the instance name,
       -- but this would be the usual case.
       let group ← withBindingDomain do `(bracketedBinderF|[$(← delabTy)])
-      withBindingBody e.bindingName! <| delabParams bindingNames idStx (groups.push group)
+      withBindingBody e.bindingName! <| delabParams bindingNames (groups.push group)
     else if e.isForall && (!e.isArrow || !(e.bindingName!.hasMacroScopes || bindingNames.contains e.bindingName!)) then
-      delabParamsAux bindingNames idStx groups #[]
+      delabParamsAux bindingNames groups #[]
     else
       let (opts', e') ← processSpine {} (← readThe SubExpr)
       withReader (fun ctx => {ctx with optionsPerPos := opts', subExpr := { ctx.subExpr with expr := e' }}) do
         let type ← delabTy
-        `(declSigWithId| $idStx:ident $groups* : $type)
+        delabForall groups type
   /--
   Inner loop for `delabParams`, collecting binders.
   Invariants:
@@ -1457,13 +1442,13 @@ where
   - It has a name that's not inaccessible.
   - It has a name that hasn't been used yet.
   -/
-  delabParamsAux (bindingNames : NameSet) (idStx : Ident) (groups : TSyntaxArray ``bracketedBinder) (curIds : Array Ident) := do
+  delabParamsAux (bindingNames : NameSet) (groups : TSyntaxArray ``bracketedBinder) (curIds : Array Ident) := do
     let e@(.forallE n d e' i) ← getExpr | unreachable!
     let n ← if bindingNames.contains n then withFreshMacroScope <| MonadQuotation.addMacroScope n else pure n
     let bindingNames := bindingNames.insert n
     if shouldGroupWithNext bindingNames e e' then
       withBindingBody' n (mkAnnotatedIdent n) fun stxN =>
-        delabParamsAux bindingNames idStx groups (curIds.push stxN)
+        delabParamsAux bindingNames groups (curIds.push stxN)
     else
       /-
       `mkGroup` constructs binder syntax for the binder names `curIds : Array Ident`, which all have the same type and binder info.
@@ -1492,7 +1477,7 @@ where
       withBindingBody' n (mkAnnotatedIdent n) fun stxN => do
         let curIds := curIds.push stxN
         let group ← mkGroup curIds
-        delabParams bindingNames idStx (groups.push group)
+        delabParams bindingNames (groups.push group)
   /-
   Given the forall `e` with body `e'`, determines if the binder from `e'` (if it is a forall) should be grouped with `e`'s binder.
   -/
@@ -1528,4 +1513,31 @@ where
     else
       return (opts, subExpr.expr)
 
+/--
+Pretty-prints a `forall` similarly to `delabForall`, but explicitly denotes all named parameters.
+-/
+partial def delabForallWithSignature : Delab := do
+  let isProp ← try isProp (← getExpr) catch _ => pure false
+  delabForallParamsWithSignature fun groups type => do
+    if groups.isEmpty then
+      return type
+    else if isProp && (← getPPOption getPPForalls) then
+      `(∀ $groups*, $type)
+    else
+      groups.foldrM (fun group acc => `(depArrow| $group → $acc)) type
+
+/--
+Pretty-prints a constant `c` as `c.{<levels>} <params> : <type>`.
+
+If `universes` is `false`, then the universe level parameters are omitted.
+-/
+partial def delabConstWithSignature (universes : Bool := true) : Delab := do
+  let e ← getExpr
+  -- use virtual expression node of arity 2 to separate name and type info
+  let idStx ← descend e 0 <|
+    withOptions (pp.universes.set · universes |> (pp.fullNames.set · true)) <|
+      delabConst
+  descend (← inferType e) 1 <|
+    delabForallParamsWithSignature fun groups type => `(declSigWithId| $idStx:ident $groups* : $type)
+
 end Lean.PrettyPrinter.Delaborator

src/Lean/ReservedNameAction.lean

@@ -31,7 +31,9 @@ Execute a registered reserved action for the given reserved name.
 Note that the handler can throw an exception.
 -/
 def executeReservedNameAction (name : Name) : CoreM Unit := do
-  let _ ← (← reservedNameActionsRef.get).anyM (· name)
+  discard <|
+    withTraceNode `ReservedNameAction (pure m!"{exceptBoolEmoji ·} executeReservedNameAction for {name}") do
+      (← reservedNameActionsRef.get).anyM (· name)
 
 /--
 Similar to `resolveGlobalName`, but also executes reserved name actions.
@@ -83,4 +85,8 @@ name's info on hover.
 def realizeGlobalConstNoOverload (id : Syntax) : CoreM Name := do
   ensureNonAmbiguous id (← realizeGlobalConst id)
 
+
+builtin_initialize
+  registerTraceClass `ReservedNameAction
+
 end Lean

src/Lean/ResolveName.lean

@@ -127,7 +127,7 @@ private def resolveExact (env : Environment) (id : Name) : Option Name :=
     let resolvedId := id.replacePrefix rootNamespace Name.anonymous
     if containsDeclOrReserved env resolvedId then some resolvedId
     else
-      -- We also allow `_root` when accessing private declarations.
+      -- We also allow `_root_` when accessing private declarations.
       -- If we change our minds, we should just replace `resolvedId` with `id`
       let resolvedIdPrv := mkPrivateName env resolvedId
       if containsDeclOrReserved env resolvedIdPrv then some resolvedIdPrv
@@ -574,26 +574,52 @@ The assumption is that non-horizontal aliases are "API exports" (i.e., intention
 
 This function is meant to be used for pretty printing.
 If `n₀` is an accessible name, then the result will be an accessible name.
+
+The name `n₀` may be private.
 -/
 def unresolveNameGlobal [Monad m] [MonadResolveName m] [MonadEnv m]
     (n₀ : Name) (fullNames := false) (allowHorizAliases := false)
     (filter : Name → m Bool := fun _ => pure true) : m Name := do
   if n₀.hasMacroScopes then return n₀
+  -- `n₁` is the name without any private prefix, and `qn₁?` is a valid fully-qualified name.
+  let (n₁, qn₁?) := if let some n := privateToUserName? n₀ then
+    if n₀ == mkPrivateName (← getEnv) n then
+      -- The private name is for the current module. `ResolveName.resolveExact` allows `_root_` for such names.
+      (n, some (rootNamespace ++ n))
+    else
+      (n, none)
+  else
+    (n₀, some (rootNamespace ++ n₀))
   if fullNames then
-    match (← resolveGlobalName n₀) with
-      | [(potentialMatch, _)] => if (privateToUserName? potentialMatch).getD potentialMatch == n₀ then return n₀ else return rootNamespace ++ n₀
-      | _ => return n₀ -- if can't resolve, return the original
+    if let [(potentialMatch, _)] ← resolveGlobalName n₁ then
+      if (← pure (potentialMatch == n₀) <&&> filter n₁) then
+        return n₁
+    if let some qn₁ := qn₁? then
+      -- We assume that the fully-qualified name resolves.
+      return qn₁
+    else
+      -- This is the imported private name case. Return the original private name.
+      return n₀
+  -- `initialNames` is an array of names to try taking suffixes of.
+  -- First are all the names that have `n₀` as an alias.
+  -- If horizontal aliases are not allowed, then any aliases that aren't from a parent namespace are filtered out.
   let mut initialNames := (getRevAliases (← getEnv) n₀).toArray
   unless allowHorizAliases do
-    initialNames := initialNames.filter fun n => n.getPrefix.isPrefixOf n₀.getPrefix
-  initialNames := initialNames.push (rootNamespace ++ n₀)
+    initialNames := initialNames.filter fun n => n.getPrefix.isPrefixOf n₁.getPrefix
+  -- After aliases is the fully-qualified name.
+  if let some qn₁ := qn₁? then
+    initialNames := initialNames.push qn₁
   for initialName in initialNames do
     if let some n ← unresolveNameCore initialName then
       return n
-  return n₀ -- if can't resolve, return the original
+  -- Both non-private names and current-module private names should be handled already,
+  -- but as a backup we return the original name.
+  -- Imported private names will often get to this point.
+  return n₀
 where
   unresolveNameCore (n : Name) : m (Option Name) := do
     if n.hasMacroScopes then return none
+    let n := privateToUserName n
     let mut revComponents := n.componentsRev
     let mut candidate := Name.anonymous
     for cmpt in revComponents do

src/Lean/Server/FileSource.lean

@@ -103,4 +103,7 @@ instance : FileSource CodeActionParams where
 instance : FileSource InlayHintParams where
   fileSource p := fileSource p.textDocument
 
+instance : FileSource SignatureHelpParams where
+  fileSource p := fileSource p.textDocument
+
 end Lean.Lsp

src/Lean/Server/FileWorker/RequestHandling.lean

@@ -8,6 +8,7 @@ prelude
 import Lean.Server.FileWorker.ExampleHover
 import Lean.Server.FileWorker.InlayHints
 import Lean.Server.FileWorker.SemanticHighlighting
+import Lean.Server.FileWorker.SignatureHelp
 import Lean.Server.Completion
 import Lean.Server.References
 
@@ -346,7 +347,7 @@ def getInteractiveTermGoal (p : Lsp.PlainTermGoalParams)
     let goal ← ci.runMetaM lctx' do
       Widget.goalToInteractive (← Meta.mkFreshExprMVar ty).mvarId!
     let range := if let some r := i.range? then r.toLspRange text else ⟨p.position, p.position⟩
-    return some { goal with range, term := ⟨ti⟩ }
+    return some { goal with range, term := ← WithRpcRef.mk ti }
 
 def handlePlainTermGoal (p : PlainTermGoalParams)
     : RequestM (RequestTask (Option PlainTermGoal)) := do
@@ -562,6 +563,15 @@ partial def handleFoldingRange (_ : FoldingRangeParams)
               endLine := endP.line
               kind? := some kind }
 
+def handleSignatureHelp (p : SignatureHelpParams) : RequestM (RequestTask (Option SignatureHelp)) := do
+  let doc ← readDoc
+  let text := doc.meta.text
+  let requestedPos := text.lspPosToUtf8Pos p.position
+  mapTaskCostly (findCmdDataAtPos doc requestedPos (includeStop := false)) fun cmdData? => do
+    let some (cmdStx, tree) := cmdData?
+      | return none
+    SignatureHelp.findSignatureHelp? text p.context? cmdStx tree requestedPos
+
 partial def handleWaitForDiagnostics (p : WaitForDiagnosticsParams)
     : RequestM (RequestTask WaitForDiagnostics) := do
   let rec waitLoop : RequestM EditableDocument := do
@@ -627,6 +637,11 @@ builtin_initialize
     FoldingRangeParams
     (Array FoldingRange)
     handleFoldingRange
+  registerLspRequestHandler
+    "textDocument/signatureHelp"
+    SignatureHelpParams
+    (Option SignatureHelp)
+    handleSignatureHelp
   registerLspRequestHandler
     "$/lean/plainGoal"
     PlainGoalParams

src/Lean/Server/FileWorker/SignatureHelp.lean

@@ -0,0 +1,205 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Marc Huisinga
+-/
+prelude
+import Lean.Server.InfoUtils
+import Lean.Data.Lsp
+import Init.Data.List.Sort.Basic
+
+namespace Lean.Server.FileWorker.SignatureHelp
+
+open Lean
+
+def determineSignatureHelp (tree : Elab.InfoTree) (appStx : Syntax)
+    : IO (Option Lsp.SignatureHelp) := do
+  let some (appCtx, .ofTermInfo appInfo) := tree.smallestInfo? fun
+      | .ofTermInfo ti =>
+        -- HACK: Use range of syntax to figure out corresponding `TermInfo`.
+        -- This is necessary because in order to accurately determine which `Syntax` to use,
+        -- we have to use the original command syntax before macro expansions,
+        -- whereas the `Syntax` in the `InfoTree` is always from some stage of elaboration.
+        ti.stx.getRangeWithTrailing? == appStx.getRangeWithTrailing?
+      | _ => false
+    | return none
+  let app := appInfo.expr
+  let some fmt ← appCtx.runMetaM appInfo.lctx do
+      let appType ← instantiateMVars <| ← Meta.inferType app
+      if ! appType.isForall then
+        return none
+      let (stx, _) ← PrettyPrinter.delabCore appType
+        (delab := PrettyPrinter.Delaborator.delabForallWithSignature)
+      return some <| ← PrettyPrinter.ppTerm ⟨stx⟩
+    | return none
+  return some {
+    signatures := #[{ label := toString fmt : Lsp.SignatureInformation }]
+    activeSignature? := some 0
+    -- We do not mark the active parameter at all, as this would require retaining parameter indices
+    -- through the delaborator.
+    -- However, since we display the signature help using the `TermInfo` of the application,
+    -- not the function itself, this is not a problem:
+    -- The parameters keeps reducing as one adds arguments to the function, and the active
+    -- parameter is then always the first explicit one.
+    -- This feels very intuitive, so we don't need to thread any additional information
+    -- through the delaborator for highlighting the active parameter.
+    activeParameter? := none
+  }
+
+inductive CandidateKind where
+  /--
+  Cursor is in the position of the argument to a pipe, like `<|` or `$`. Low precedence.
+  Ensures that `fun <| otherFun <cursor>` yields the signature help of `otherFun`, not `fun`.
+  -/
+  | pipeArg
+  /--
+  Cursor is in the position of the trailing whitespace of some term. Medium precedence.
+  Ensures that `fun otherFun <cursor>` yields the signature help of `fun`, not `otherFun`.
+  -/
+  | termArg
+  /--
+  Cursor is in the position of the argument to a function that already has other arguments applied
+  to it. High precedence.
+  -/
+  | appArg
+
+def CandidateKind.prio : CandidateKind → Nat
+  | .pipeArg => 0
+  | .termArg => 1
+  | .appArg  => 2
+
+structure Candidate where
+  kind   : CandidateKind
+  appStx : Syntax
+
+inductive SearchControl where
+  /-- In a syntax stack, keep searching upwards, continuing with the parent of the current term. -/
+  | continue
+  /-- Stop the search through a syntax stack. -/
+  | stop
+
+private def lineCommentPosition? (s : String) : Option String.Pos := Id.run do
+  let mut it := s.mkIterator
+  while h : it.hasNext do
+    let pos := it.pos
+    let c₁ := it.curr' h
+    it := it.next' h
+    if c₁ == '-' then
+      if h' : it.hasNext then
+        let c₂ := it.curr' h'
+        it := it.next' h'
+        if c₂ == '-' then
+          return some pos
+  return none
+
+private def isPositionInLineComment (text : FileMap) (pos : String.Pos) : Bool := Id.run do
+  let requestedLineNumber := text.toPosition pos |>.line
+  let lineStartPos := text.lineStart requestedLineNumber
+  let lineEndPos := text.lineStart (requestedLineNumber + 1)
+  let line := text.source.extract lineStartPos lineEndPos
+  let some lineCommentPos := lineCommentPosition? line
+    | return false
+  return pos >= lineStartPos + lineCommentPos
+
+open CandidateKind in
+def findSignatureHelp? (text : FileMap) (ctx? : Option Lsp.SignatureHelpContext) (cmdStx : Syntax)
+    (tree : Elab.InfoTree) (requestedPos : String.Pos) : IO (Option Lsp.SignatureHelp) := do
+  -- HACK: Since comments are whitespace, the signature help can trigger on comments.
+  -- This is especially annoying on end-of-line comments, as the signature help will trigger on
+  -- every space in the comment.
+  -- This branch avoids this particular annoyance, but doesn't prevent the signature help from
+  -- triggering on other comment kinds.
+  if isPositionInLineComment text requestedPos then
+    return none
+  let stack? := cmdStx.findStack? fun stx => Id.run do
+    let some range := stx.getRangeWithTrailing? (canonicalOnly := true)
+      | return false
+    return range.contains requestedPos (includeStop := true)
+  let some stack := stack?
+    | return none
+  let stack := stack.toArray.map (·.1)
+  let mut candidates : Array Candidate := #[]
+  for h:i in [0:stack.size] do
+    let stx := stack[i]
+    let parent := stack[i+1]?.getD .missing
+    let (kind?, control) := determineCandidateKind stx parent
+    if let some kind := kind? then
+      candidates := candidates.push ⟨kind, stx⟩
+    if control matches .stop then
+      break
+  -- Uses a stable sort so that we prefer inner candidates over outer candidates.
+  candidates := candidates.toList.mergeSort (fun c1 c2 => c1.kind.prio >= c2.kind.prio) |>.toArray
+  -- Look through all candidates until we find a signature help.
+  -- This helps in cases where the priority puts terms without `TermInfo` or ones that are not
+  -- applications of a `forall` in front of ones that do.
+  -- This usually happens when `.termArg` candidates overshadow `.pipeArg` candidates,
+  -- but the `.termArg` candidates are not semantically valid left-hand sides of applications.
+  for candidate in candidates do
+    if let some signatureHelp ← determineSignatureHelp tree candidate.appStx then
+      return some signatureHelp
+  return none
+where
+  determineCandidateKind (stx : Syntax) (parent : Syntax)
+      : Option CandidateKind × SearchControl := Id.run do
+    let c kind? : Option CandidateKind × SearchControl := (kind?, .continue)
+    let some tailPos := stx.getTailPos? (canonicalOnly := true)
+      | return (none, .continue)
+    -- If the cursor is not in the trailing range of the syntax, then we don't display a signature
+    -- help. This prevents two undesirable scenarios:
+    -- - Since for applications `f 0 0 0`, the `InfoTree` only contains `TermInfo` for
+    --   `f` and `f 0 0 0`, we can't display accurate signature help for the sub-applications
+    --   `f 0` or `f 0 0`. Hence, we only display the signature help after `f` and `f 0 0 0`,
+    --   i.e. in the trailing range of the syntax of a candidate.
+    -- - When the search through the syntax stack passes through a node with more than one child
+    --   that is not an application, terminating the search if the cursor is on the interior of the
+    --   syntax ensures that we do not display signature help for functions way outside of the
+    --   current term that is being edited.
+    --   We still want to display it for such complex terms if we are in the trailing range of the
+    --   term since the complex term might produce a function for which we want to display a
+    --   signature help.
+    -- If we are ever on the interior of a term, then we will also be on the interior of terms
+    -- further up in the syntax stack, as these subsume the inner term, and so we terminate
+    -- the search early in this case.
+    if requestedPos < tailPos then
+      return (none, .stop)
+    let isManualTrigger := ctx?.any (·.triggerKind matches .invoked)
+    let isRetrigger := ctx?.any (·.isRetrigger)
+    let isCursorAfterTailPosLine :=
+      (text.toPosition requestedPos).line != (text.toPosition tailPos).line
+    -- Application arguments are allowed anywhere in the trailing whitespace of a function,
+    -- e.g. on successive lines, but displaying the signature help in all of those lines
+    -- can be annoying (e.g. when `#check`ing a function and typing in the lines after it).
+    -- Hence, we only display the signature help automatically when the cursor is on the same line
+    -- as the tail position of the syntax, but allow users to display it by manually triggering
+    -- the signature help (`Ctrl+Shift+Space` in VS Code). We also display it in successive lines
+    -- if the user never closed it in the meantime, i.e. when the signature help was simply
+    -- retriggered.
+    if ! isManualTrigger && ! isRetrigger && isCursorAfterTailPosLine then
+      return (none, .continue)
+    if stx matches .ident .. then
+      match parent with
+      -- Do not yield a candidate `f` for `_ |>.f <cursor>`, `_.f <cursor>` or `.f <cursor>`.
+      -- Since `f` is an `identArg` candidate, has a `TermInfo` of its own and is a subterm of
+      -- these dot notations, we need to avoid picking its `TermInfo` by accident.
+      | `($_ |>.$_:ident $_*) => return c none
+      | `($_.$_:ident) => return c none
+      | `(.$_:ident) => return c none
+      | _ => return c termArg
+    let .node (kind := kind) (args := args) .. := stx
+      | return c none
+    -- `nullKind` is usually used for grouping together arguments, so we just skip it until
+    -- we have more tangible nodes at hand.
+    if kind == nullKind then
+      return c none
+    if kind == ``Parser.Term.app then
+      return c appArg
+    match stx with
+    | `($_ <| $_) => return c pipeArg
+    | `($_ $ $_) => return c pipeArg
+    | `($_ |>.$_:ident $_*) => return c pipeArg
+    | `(.$_:ident) => return c termArg
+    | `($_.$_:ident) => return c termArg
+    | _ =>
+      if args.size <= 1 then
+        return c none
+      return c termArg

src/Lean/Server/FileWorker/WidgetRequests.lean

@@ -28,7 +28,7 @@ builtin_initialize
     `Lean.Widget.InteractiveDiagnostics.msgToInteractive
     MsgToInteractive
     (TaggedText MsgEmbed)
-    fun ⟨⟨m⟩, i⟩ => RequestM.pureTask do msgToInteractive m i (hasWidgets := true)
+    fun ⟨m, i⟩ => RequestM.pureTask do msgToInteractive m.val i (hasWidgets := true)
 
 /-- The information that the infoview uses to render a popup
 for when the user hovers over an expression.
@@ -48,7 +48,8 @@ The intended usage of this is for the infoview to pass the `InfoWithCtx` which
 was stored for a particular `SubexprInfo` tag in a `TaggedText` generated with `ppExprTagged`.
  -/
 def makePopup : WithRpcRef InfoWithCtx → RequestM (RequestTask InfoPopup)
-  | ⟨i⟩ => RequestM.pureTask do
+  | i => RequestM.pureTask do
+    let i := i.val
     i.ctx.runMetaM i.info.lctx do
       let type? ← match (← i.info.type?) with
         | some type => some <$> ppExprTagged type
@@ -124,7 +125,8 @@ builtin_initialize
     `Lean.Widget.getGoToLocation
     GetGoToLocationParams
     (Array Lsp.LocationLink)
-    fun ⟨kind, ⟨i⟩⟩ => RequestM.pureTask do
+    fun ⟨kind, i⟩ => RequestM.pureTask do
+      let i := i.val
       let rc ← read
       let ls ← FileWorker.locationLinksOfInfo kind i
       if !ls.isEmpty then return ls
@@ -138,9 +140,9 @@ builtin_initialize
 def lazyTraceChildrenToInteractive (children : WithRpcRef LazyTraceChildren) :
     RequestM (RequestTask (Array (TaggedText MsgEmbed))) :=
   RequestM.pureTask do
-    let ⟨indent, children⟩ := children
-    children.mapM fun ⟨child⟩ =>
-      msgToInteractive child (hasWidgets := true) (indent := indent)
+    let ⟨indent, children⟩ := children.val
+    children.mapM fun child =>
+      msgToInteractive child.val (hasWidgets := true) (indent := indent)
 
 builtin_initialize registerBuiltinRpcProcedure ``lazyTraceChildrenToInteractive _ _ lazyTraceChildrenToInteractive
 

src/Lean/Server/InfoUtils.lean

@@ -229,9 +229,9 @@ def Info.occursInOrOnBoundary (i : Info) (hoverPos : String.Pos) : Bool := Id.ru
 def InfoTree.smallestInfo? (p : Info → Bool) (t : InfoTree) : Option (ContextInfo × Info) :=
   let ts := t.deepestNodes fun ctx i _ => if p i then some (ctx, i) else none
 
-  let infos := ts.map fun (ci, i) =>
-    let diff := i.tailPos?.get! - i.pos?.get!
-    (diff, ci, i)
+  let infos := ts.filterMap fun (ci, i) => do
+    let diff := (← i.tailPos?) - (← i.pos?)
+    return (diff, ci, i)
 
   infos.toArray.getMax? (fun a b => a.1 > b.1) |>.map fun (_, ci, i) => (ci, i)
 
@@ -240,7 +240,7 @@ partial def InfoTree.hoverableInfoAt? (t : InfoTree) (hoverPos : String.Pos) (in
   let results := (← t.visitM (postNode := fun ctx info children results => do
     let mut results := results.flatMap (·.getD [])
     if omitAppFns && info.stx.isOfKind ``Parser.Term.app && info.stx[0].isIdent then
-        results := results.filter (·.2.info.stx != info.stx[0])
+      results := results.filter (·.2.info.stx != info.stx[0])
     if omitIdentApps && info.stx.isIdent then
       -- if an identifier stands for an application (e.g. in the case of a typeclass projection), prefer the application
       if let .ofTermInfo ti := info then

src/Lean/Server/Rpc/Basic.lean

@@ -19,12 +19,19 @@ first connect to the session using `$/lean/rpc/connect`. -/
 
 namespace Lean.Lsp
 
-/-- An object which RPC clients can refer to without marshalling. -/
+/--
+An object which RPC clients can refer to without marshalling.
+
+The language server may serve the same `RpcRef` multiple times and maintains a reference count
+to track how many times it has served the reference.
+If clients want to release the object associated with an `RpcRef`,
+they must release the reference as many times as they have received it from the server.
+-/
 structure RpcRef where
   /- NOTE(WN): It is important for this to be a single-field structure
   in order to deserialize as an `Object` on the JS side. -/
   p : USize
-  deriving BEq, Hashable, FromJson, ToJson
+  deriving Inhabited, BEq, Hashable, FromJson, ToJson
 
 instance : ToString RpcRef where
   toString r := toString r.p
@@ -33,38 +40,100 @@ end Lean.Lsp
 
 namespace Lean.Server
 
+/--
+Marks values to be encoded as opaque references in RPC packets.
+Two `WithRpcRef`s with the same `id` will yield the same client-side reference.
+
+See also the docstring for `RpcEncodable`.
+-/
+structure WithRpcRef (α : Type u) where
+  private mk' ::
+    val : α
+    private id : USize
+  deriving Inhabited
+
+builtin_initialize freshWithRpcRefId : IO.Ref USize ← IO.mkRef 1
+
+/--
+Creates an `WithRpcRef` instance with a unique `id`.
+As long as the client holds at least one reference to this `WithRpcRef`,
+serving it again will yield the same client-side reference.
+Thus, when used as React deps,
+client-side references can help preserve UI state across RPC requests.
+-/
+def WithRpcRef.mk (val : α) : BaseIO (WithRpcRef α) := do
+  let id ← freshWithRpcRefId.modifyGet fun id => (id, id + 1)
+  return { val, id }
+
+structure ReferencedObject where
+  obj : Dynamic
+  id  : USize
+  rc  : Nat
+
 structure RpcObjectStore : Type where
-  /-- Objects that are being kept alive for the RPC client, together with their type names,
+  /--
+  Objects that are being kept alive for the RPC client, together with their type names,
   mapped to by their RPC reference.
+  -/
+  aliveRefs : PersistentHashMap Lsp.RpcRef ReferencedObject := {}
+  /--
+  Unique `RpcRef` for the ID of an object that is being referenced through RPC.
+  We store this mapping so that we can reuse `RpcRef`s for the same object.
+  Reusing `RpcRef`s is helpful because it enables clients to reuse their UI state.
+  -/
+  refsById : PersistentHashMap USize Lsp.RpcRef := {}
+  /--
+  Value to use for the next fresh `RpcRef`, monotonically increasing.
+  -/
+  nextRef : USize := 0
 
-  Note that we may currently have multiple references to the same object. It is only disposed
-  of once all of those are gone. This simplifies the client a bit as it can drop every reference
-  received separately. -/
-  aliveRefs : PersistentHashMap Lsp.RpcRef Dynamic := {}
-  /-- Value to use for the next `RpcRef`. It is monotonically increasing to avoid any possible
-  bugs resulting from its reuse. -/
-  nextRef   : USize := 0
-
-def rpcStoreRef (any : Dynamic) : StateM RpcObjectStore Lsp.RpcRef := do
+def rpcStoreRef [TypeName α] (obj : WithRpcRef α) : StateM RpcObjectStore Lsp.RpcRef := do
   let st ← get
-  set { st with
-    aliveRefs := st.aliveRefs.insert ⟨st.nextRef⟩ any
-    nextRef := st.nextRef + 1
-  }
-  return ⟨st.nextRef⟩
+  let reusableRef? : Option Lsp.RpcRef := st.refsById.find? obj.id
+  match reusableRef? with
+  | some ref =>
+    -- Reuse `RpcRef` for this `obj` so that clients can reuse their UI state for it.
+    -- We maintain a reference count so that we only free `obj` when the client has released
+    -- all of its instances of the `RpcRef` for `obj`.
+    let some referencedObj := st.aliveRefs.find? ref
+      | return panic! "Found object ID in `refsById` but not in `aliveRefs`."
+    let referencedObj := { referencedObj with rc := referencedObj.rc + 1 }
+    set { st with aliveRefs := st.aliveRefs.insert ref referencedObj }
+    return ref
+  | none =>
+    let ref : Lsp.RpcRef := ⟨st.nextRef⟩
+    set { st with
+      aliveRefs := st.aliveRefs.insert ref ⟨.mk obj.val, obj.id, 1⟩
+      refsById := st.refsById.insert obj.id ref
+      nextRef := st.nextRef + 1
+    }
+    return ref
 
-def rpcGetRef (r : Lsp.RpcRef) : ReaderT RpcObjectStore Id (Option Dynamic) :=
-  return (← read).aliveRefs.find? r
+def rpcGetRef (α) [TypeName α] (r : Lsp.RpcRef)
+    : ReaderT RpcObjectStore (ExceptT String Id) (WithRpcRef α) := do
+  let some referencedObj := (← read).aliveRefs.find? r
+    | throw s!"RPC reference '{r}' is not valid"
+  let some val := referencedObj.obj.get? α
+    | throw <| s!"RPC call type mismatch in reference '{r}'\nexpected '{TypeName.typeName α}', " ++
+        s!"got '{referencedObj.obj.typeName}'"
+  return { val, id := referencedObj.id }
 
 def rpcReleaseRef (r : Lsp.RpcRef) : StateM RpcObjectStore Bool := do
   let st ← get
-  if st.aliveRefs.contains r then
-    set { st with aliveRefs := st.aliveRefs.erase r }
-    return true
+  let some referencedObj := st.aliveRefs.find? r
+    | return false
+  let referencedObj := { referencedObj with rc := referencedObj.rc - 1 }
+  if referencedObj.rc == 0 then
+    set { st with
+      aliveRefs := st.aliveRefs.erase r
+      refsById := st.refsById.erase referencedObj.id
+    }
   else
-    return false
+    set { st with aliveRefs := st.aliveRefs.insert r referencedObj }
+  return true
 
-/-- `RpcEncodable α` means that `α` can be deserialized from and serialized into JSON
+/--
+`RpcEncodable α` means that `α` can be deserialized from and serialized into JSON
 for the purpose of receiving arguments to and sending return values from
 Remote Procedure Calls (RPCs).
 
@@ -79,13 +148,15 @@ For such data, we use the `WithRpcRef` marker.
 Note that for `WithRpcRef α` to be `RpcEncodable`,
 `α` must have a `TypeName` instance
 
-On the server side, `WithRpcRef α` is just a structure
-containing a value of type `α`.
+On the server side, `WithRpcRef α` is a structure containing a value of type `α` and an associated
+`id`.
 On the client side, it is an opaque reference of (structural) type `Lsp.RpcRef`.
 Thus, `WithRpcRef α` is cheap to transmit over the network
 but may only be accessed on the server side.
 In practice, it is used by the client to pass data
-between various RPC methods provided by the server. -/
+between various RPC methods provided by the server.
+Two `WithRpcRef`s with the same `id` will yield the same client-side reference.
+-/
 -- TODO(WN): for Lean.js, compile `WithRpcRef` to "opaque reference" on the client
 class RpcEncodable (α : Type) where
   rpcEncode : α → StateM RpcObjectStore Json
@@ -121,26 +192,11 @@ instance [RpcEncodable α] : RpcEncodable (StateM RpcObjectStore α) where
     let a : α ← rpcDecode j
     return return a
 
-/-- Marks values to be encoded as opaque references in RPC packets.
-
-See the docstring for `RpcEncodable`. -/
-structure WithRpcRef (α : Type u) where
-  val : α
-  deriving Inhabited
-
 instance [TypeName α] : RpcEncodable (WithRpcRef α) :=
   { rpcEncode, rpcDecode }
 where
   -- separate definitions to prevent inlining
-  rpcEncode r := toJson <$> rpcStoreRef (.mk r.val)
-  rpcDecode j := do
-    let r ← fromJson? j
-    match (← rpcGetRef r) with
-      | none => throw s!"RPC reference '{r}' is not valid"
-      | some any =>
-        if let some obj := any.get? α then
-          return ⟨obj⟩
-        else
-          throw s!"RPC call type mismatch in reference '{r}'\nexpected '{TypeName.typeName α}', got '{any.typeName}'"
+  rpcEncode r := toJson <$> rpcStoreRef r
+  rpcDecode j := do rpcGetRef α (← fromJson? j)
 
 end Lean.Server

src/Lean/Server/Watchdog.lean

@@ -1440,6 +1440,9 @@ def mkLeanServerCapabilities : ServerCapabilities := {
   inlayHintProvider? := some {
     resolveProvider? := false
   }
+  signatureHelpProvider? := some {
+    triggerCharacters? := some #[" "]
+  }
 }
 
 def initAndRunWatchdogAux : ServerM Unit := do

src/Lean/Widget/InteractiveCode.lean

@@ -59,19 +59,19 @@ def SubexprInfo.withDiffTag (tag : DiffTag) (c : SubexprInfo) : SubexprInfo :=
 
 /-- Tags pretty-printed code with infos from the delaborator. -/
 partial def tagCodeInfos (ctx : Elab.ContextInfo) (infos : SubExpr.PosMap Elab.Info) (tt : TaggedText (Nat × Nat))
-    : CodeWithInfos :=
+    : BaseIO CodeWithInfos :=
   go tt
 where
-  go (tt : TaggedText (Nat × Nat)) :=
-    tt.rewrite fun (n, _) subTt =>
+  go (tt : TaggedText (Nat × Nat)) : BaseIO (TaggedText SubexprInfo) :=
+    tt.rewriteM fun (n, _) subTt => do
       match infos.find? n with
       | none   => go subTt
       | some i =>
         let t : SubexprInfo := {
-          info := WithRpcRef.mk { ctx, info := i, children := .empty }
+          info := ← WithRpcRef.mk { ctx, info := i, children := .empty }
           subexprPos := n
         }
-        TaggedText.tag t (go subTt)
+        return TaggedText.tag t (← go subTt)
 
 open PrettyPrinter Delaborator in
 /--
@@ -93,6 +93,6 @@ def ppExprTagged (e : Expr) (delab : Delab := Delaborator.delab) : MetaM CodeWit
     fileMap       := default
     ngen          := (← getNGen)
   }
-  return tagCodeInfos ctx infos tt
+  tagCodeInfos ctx infos tt
 
 end Lean.Widget

src/Lean/Widget/InteractiveDiagnostic.lean

@@ -192,8 +192,8 @@ partial def msgToInteractive (msgData : MessageData) (hasWidgets : Bool) (indent
   let rec fmtToTT (fmt : Format) (indent : Nat) : IO (TaggedText MsgEmbed) :=
     (TaggedText.prettyTagged fmt indent).rewriteM fun (n, col) tt =>
       match embeds[n]! with
-        | .code ctx infos =>
-          return .tag (.expr (tagCodeInfos ctx infos tt)) default
+        | .code ctx infos => do
+          return .tag (.expr (← tagCodeInfos ctx infos tt)) default
         | .goal ctx lctx g =>
           ctx.runMetaM lctx do
             return .tag (.goal (← goalToInteractive g)) default
@@ -205,7 +205,10 @@ partial def msgToInteractive (msgData : MessageData) (hasWidgets : Bool) (indent
           let col := indent + col
           let children ←
             match children with
-              | .lazy children => pure <| .lazy ⟨{indent := col+2, children := children.map .mk}⟩
+              | .lazy children => pure <| .lazy <| ← WithRpcRef.mk {
+                  indent := col+2
+                  children := ← children.mapM (WithRpcRef.mk ·)
+                }
               | .strict children => pure <| .strict (← children.mapM (fmtToTT · (col+2)))
           return .tag (.trace indent cls (← fmtToTT msg col) collapsed children) default
         | .ignoreTags => return .text tt.stripTags

src/Lean/Widget/InteractiveGoal.lean

@@ -205,7 +205,7 @@ def goalToInteractive (mvarId : MVarId) : MetaM InteractiveGoal := do
     return {
       hyps
       type := goalFmt
-      ctx := ⟨{← Elab.CommandContextInfo.save with }⟩
+      ctx := ← WithRpcRef.mk {← Elab.CommandContextInfo.save with }
       userName?
       goalPrefix := getGoalPrefix mvarDecl
       mvarId

src/Std/Data/Iterators/Combinators.lean

@@ -7,6 +7,7 @@ prelude
 import Std.Data.Iterators.Combinators.Monadic
 import Std.Data.Iterators.Combinators.Take
 import Std.Data.Iterators.Combinators.TakeWhile
+import Std.Data.Iterators.Combinators.Drop
 import Std.Data.Iterators.Combinators.DropWhile
 import Std.Data.Iterators.Combinators.FilterMap
 import Std.Data.Iterators.Combinators.Zip

src/Std/Data/Iterators/Combinators/Drop.lean

@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Drop
+
+namespace Std.Iterators
+
+/--
+Given an iterator `it` and a natural number `n`, `it.drop n` is an iterator that forwards all of
+`it`'s output values except for the first `n`.
+
+**Marble diagram:**
+
+```text
+it          ---a----b---c--d-e--⊥
+it.drop 3   ---------------d-e--⊥
+
+it          ---a--⊥
+it.drop 3   ------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+**Performance:**
+
+Currently, this combinator incurs an additional O(1) cost with each output of `it`, even when the iterator
+does not drop any elements anymore.
+-/
+@[always_inline, inline]
+def Iter.drop {α : Type w} {β : Type w} (n : Nat) (it : Iter (α := α) β) :
+    Iter (α := Drop α Id β) β :=
+  it.toIterM.drop n |>.toIter
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic.lean

@@ -6,6 +6,7 @@ Authors: Paul Reichert
 prelude
 import Std.Data.Iterators.Combinators.Monadic.Take
 import Std.Data.Iterators.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Combinators.Monadic.Drop
 import Std.Data.Iterators.Combinators.Monadic.DropWhile
 import Std.Data.Iterators.Combinators.Monadic.FilterMap
 import Std.Data.Iterators.Combinators.Monadic.Zip

src/Std/Data/Iterators/Combinators/Monadic/Drop.lean

@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Collect
+import Std.Data.Iterators.Consumers.Loop
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+This file provides the iterator combinator `IterM.drop`.
+-/
+
+namespace Std.Iterators
+
+variable {α : Type w} {m : Type w → Type w'} {β : Type w}
+
+/--
+The internal state of the `IterM.drop` combinator.
+-/
+@[unbox]
+structure Drop (α : Type w) (m : Type w → Type w') (β : Type w) where
+  /-- Internal implementation detail of the iterator library -/
+  remaining : Nat
+  /-- Internal implementation detail of the iterator library -/
+  inner : IterM (α := α) m β
+
+/--
+Given an iterator `it` and a natural number `n`, `it.drop n` is an iterator that forwards all of
+`it`'s output values except for the first `n`.
+
+**Marble diagram:**
+
+```text
+it          ---a----b---c--d-e--⊥
+it.drop 3   ---------------d-e--⊥
+
+it          ---a--⊥
+it.drop 3   ------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+**Performance:**
+
+Currently, this combinator incurs an additional O(1) cost with each output of `it`, even when the iterator
+does not drop any elements anymore.
+-/
+def IterM.drop (n : Nat) (it : IterM (α := α) m β) :=
+  toIterM (Drop.mk n it) m β
+
+inductive Drop.PlausibleStep [Iterator α m β] (it : IterM (α := Drop α m β) m β) :
+    (step : IterStep (IterM (α := Drop α m β) m β) β) → Prop where
+  | drop : ∀ {it' out k}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.remaining = k + 1 → PlausibleStep it (.skip (it'.drop k))
+  | skip : ∀ {it'}, it.internalState.inner.IsPlausibleStep (.skip it') →
+      PlausibleStep it (.skip (it'.drop it.internalState.remaining))
+  | done : it.internalState.inner.IsPlausibleStep .done → PlausibleStep it .done
+  | yield : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.remaining = 0 → PlausibleStep it (.yield (it'.drop 0) out)
+
+instance Drop.instIterator [Monad m] [Iterator α m β] : Iterator (Drop α m β) m β where
+  IsPlausibleStep := Drop.PlausibleStep
+  step it := do
+    match ← it.internalState.inner.step with
+    | .yield it' out h =>
+      match h' : it.internalState.remaining with
+      | 0 => pure <| .yield (it'.drop 0) out (.yield h h')
+      | k + 1 => pure <| .skip (it'.drop k) (.drop h h')
+    | .skip it' h =>
+      pure <| .skip (it'.drop it.internalState.remaining) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)
+
+private def Drop.FiniteRel (m : Type w → Type w') [Iterator α m β] [Finite α m] :
+    IterM (α := Drop α m β) m β → IterM (α := Drop α m β) m β → Prop :=
+  InvImage IterM.TerminationMeasures.Finite.Rel
+    (IterM.finitelyManySteps ∘ Drop.inner ∘ IterM.internalState)
+
+private def Drop.instFinitenessRelation [Iterator α m β] [Monad m]
+    [Finite α m] :
+    FinitenessRelation (Drop α m β) m where
+  rel := Drop.FiniteRel m
+  wf := by
+    apply InvImage.wf
+    exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case drop it' h' _ =>
+      cases h
+      apply IterM.TerminationMeasures.Finite.rel_of_yield
+      exact h'
+    case skip it' h' =>
+      cases h
+      apply IterM.TerminationMeasures.Finite.rel_of_skip
+      exact h'
+    case done h' =>
+      cases h
+    case yield it' out h' h'' =>
+      cases h
+      apply IterM.TerminationMeasures.Finite.rel_of_yield
+      exact h'
+
+instance Drop.instFinite [Iterator α m β] [Monad m] [Finite α m] :
+    Finite (Drop α m β) m :=
+  Finite.of_finitenessRelation instFinitenessRelation
+
+private def Drop.ProductiveRel (m : Type w → Type w') [Iterator α m β] [Productive α m] :
+    IterM (α := Drop α m β) m β → IterM (α := Drop α m β) m β → Prop :=
+  InvImage (Prod.Lex Nat.lt_wfRel.rel IterM.TerminationMeasures.Productive.Rel)
+    (fun it => (it.internalState.remaining, it.internalState.inner.finitelyManySkips))
+
+private theorem Drop.productiveRel_of_remaining [Monad m] [Iterator α m β] [Productive α m]
+    {it it' : IterM (α := Drop α m β) m β}
+    (h : it'.internalState.remaining < it.internalState.remaining) : Drop.ProductiveRel m it' it :=
+  Prod.Lex.left _ _ h
+
+private theorem Drop.productiveRel_of_inner [Monad m] [Iterator α m β] [Productive α m] {remaining : Nat}
+    {it it' : IterM (α := α) m β}
+    (h : it'.finitelyManySkips.Rel it.finitelyManySkips) :
+    Drop.ProductiveRel m (it'.drop remaining) (it.drop remaining) :=
+  Prod.Lex.right _ h
+
+private def Drop.instProductivenessRelation [Iterator α m β] [Monad m]
+    [Productive α m] :
+    ProductivenessRelation (Drop α m β) m where
+  rel := Drop.ProductiveRel m
+  wf := by
+    apply InvImage.wf
+    exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    rw [IterM.IsPlausibleSkipSuccessorOf] at h
+    cases h
+    case drop it' out k h h' =>
+      apply productiveRel_of_remaining
+      simp [h', IterM.drop]
+    case skip it' h =>
+      apply productiveRel_of_inner
+      apply IterM.TerminationMeasures.Productive.rel_of_skip
+      exact h
+
+instance Drop.instProductive [Iterator α m β] [Monad m] [Productive α m] :
+    Productive (Drop α m β) m :=
+  Productive.of_productivenessRelation instProductivenessRelation
+
+instance Drop.instIteratorCollect [Monad m] [Monad n] [Iterator α m β] [Finite α m] :
+    IteratorCollect (Drop α m β) m n :=
+  .defaultImplementation
+
+instance Drop.instIteratorCollectPartial [Monad m] [Monad n] [Iterator α m β] :
+    IteratorCollectPartial (Drop α m β) m n :=
+  .defaultImplementation
+
+instance Drop.instIteratorLoop [Monad m] [Monad n] [Iterator α m β] :
+    IteratorLoop (Drop α m β) m n :=
+  .defaultImplementation
+
+instance Drop.instIteratorLoopPartial [Monad m] [Monad n] [Iterator α m β] :
+    IteratorLoopPartial (Drop α m β) m n :=
+  .defaultImplementation
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic/Take.lean

@@ -168,21 +168,10 @@ private def Take.wellFounded_plausibleForInStep {α β : Type w} {m : Type w →
       apply InvImage.wf
       exact WellFoundedRelation.wf
 
-instance Take.instIteratorFor [Monad m] [Monad n] [Iterator α m β]
+instance Take.instIteratorLoop [Monad m] [Monad n] [Iterator α m β]
     [IteratorLoop α m n] [MonadLiftT m n] :
-    IteratorLoop (Take α m β) m n where
-  forIn lift {γ} Plausible wf it init f := by
-    refine Prod.fst <$> IteratorLoop.forIn lift (γ := γ × Nat)
-        (PlausibleForInStep Plausible)
-        (wellFounded_plausibleForInStep wf)
-        it.internalState.inner
-        (init, it.internalState.remaining)
-        fun out acc =>
-          match h : acc.snd with
-          | 0 => pure <| ⟨.done acc, True.intro⟩
-          | n + 1 => (fun
-              | ⟨.yield x, hp⟩ => ⟨.yield ⟨x, n⟩, ⟨h, hp⟩⟩
-              | ⟨.done x ,hp⟩ => ⟨.done ⟨x, n⟩, .intro⟩) <$> f out acc.fst
+    IteratorLoop (Take α m β) m n :=
+  .defaultImplementation
 
 instance Take.instIteratorForPartial [Monad m] [Monad n] [Iterator α m β]
     [IteratorLoopPartial α m n] [MonadLiftT m n] :

src/Std/Data/Iterators/Lemmas/Combinators.lean

@@ -7,6 +7,7 @@ prelude
 import Std.Data.Iterators.Lemmas.Combinators.Monadic
 import Std.Data.Iterators.Lemmas.Combinators.Take
 import Std.Data.Iterators.Lemmas.Combinators.TakeWhile
+import Std.Data.Iterators.Lemmas.Combinators.Drop
 import Std.Data.Iterators.Lemmas.Combinators.DropWhile
 import Std.Data.Iterators.Lemmas.Combinators.FilterMap
 import Std.Data.Iterators.Lemmas.Combinators.Zip

src/Std/Data/Iterators/Lemmas/Combinators/Drop.lean

@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Drop
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Drop
+import Std.Data.Iterators.Lemmas.Combinators.Take
+import Std.Data.Iterators.Lemmas.Consumers
+
+namespace Std.Iterators
+
+theorem Iter.drop_eq {α β} [Iterator α Id β] {n : Nat}
+    {it : Iter (α := α) β} :
+    it.drop n = (it.toIterM.drop n).toIter :=
+  rfl
+
+theorem Iter.step_drop {α β} [Iterator α Id β] {n : Nat}
+    {it : Iter (α := α) β} :
+    (it.drop n).step = (match it.step with
+    | .yield it' out h =>
+      match n with
+      | 0 => .yield (it'.drop 0) out (.yield h rfl)
+      | k + 1 => .skip (it'.drop k) (.drop h rfl)
+    | .skip it' h => .skip (it'.drop n) (.skip h)
+    | .done h => .done (.done h)) := by
+  simp only [drop_eq, step, toIterM_toIter, IterM.step_drop, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  obtain ⟨step, h⟩ := step
+  cases step <;> cases n <;>
+    simp [PlausibleIterStep.yield, PlausibleIterStep.skip, PlausibleIterStep.done]
+
+theorem Iter.atIdxSlow?_drop {α β}
+    [Iterator α Id β] [Productive α Id] {k l : Nat}
+    {it : Iter (α := α) β} :
+    (it.drop k).atIdxSlow? l = it.atIdxSlow? (l + k) := by
+  induction k generalizing it <;> induction l generalizing it
+  all_goals
+    induction it using Iter.inductSkips with | step it ih =>
+    rw [atIdxSlow?.eq_def, atIdxSlow?.eq_def, step_drop]
+    cases it.step using PlausibleIterStep.casesOn <;> simp [*]
+
+@[simp]
+theorem Iter.toList_drop {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.drop n).toList = it.toList.drop n := by
+  ext
+  simp only [getElem?_toList_eq_atIdxSlow?, List.getElem?_drop, atIdxSlow?_drop]
+  rw [Nat.add_comm]
+
+@[simp]
+theorem Iter.toListRev_drop {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.drop n).toListRev = (it.toList.reverse.take (it.toList.length - n)) := by
+  rw [toListRev_eq, toList_drop, List.reverse_drop]
+
+theorem List.drop_eq_extract {l : List α} {k : Nat} :
+    l.drop k = l.extract k := by
+  induction l generalizing k
+  case nil => simp
+  case cons _ _ ih =>
+    match k with
+    | 0 => simp
+    | _ + 1 =>
+      simp only [List.drop_succ_cons, List.length_cons, Nat.reduceSubDiff, ih]
+      simp only [List.extract_eq_drop_take, Nat.reduceSubDiff, List.drop_succ_cons]
+
+@[simp]
+theorem Iter.toArray_drop {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.drop n).toArray = it.toArray.extract n := by
+  rw [← toArray_toList, ← toArray_toList, ← List.toArray_drop, toList_drop]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic.lean

@@ -6,6 +6,7 @@ Authors: Paul Reichert
 prelude
 import Std.Data.Iterators.Lemmas.Combinators.Monadic.Take
 import Std.Data.Iterators.Lemmas.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Drop
 import Std.Data.Iterators.Lemmas.Combinators.Monadic.DropWhile
 import Std.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
 import Std.Data.Iterators.Lemmas.Combinators.Monadic.Zip

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Drop.lean

@@ -0,0 +1,31 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Drop
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+
+namespace Std.Iterators
+
+theorem IterM.step_drop {α m β} [Monad m] [Iterator α m β] {n : Nat}
+    {it : IterM (α := α) m β} :
+    (it.drop n).step = (do
+      match ← it.step with
+      | .yield it' out h =>
+        match n with
+        | 0 => pure <| .yield (it'.drop 0) out (.yield h rfl)
+        | k + 1 => pure <| .skip (it'.drop k) (.drop h rfl)
+      | .skip it' h => pure <| .skip (it'.drop n) (.skip h)
+      | .done h => pure <| .done (.done h)) := by
+  simp only [drop, step, Iterator.step, internalState_toIterM, Nat.succ_eq_add_one]
+  apply bind_congr
+  intro step
+  obtain ⟨step, h⟩ := step
+  cases step
+  · cases n <;> rfl
+  · rfl
+  · rfl
+
+end Std.Iterators

src/Std/Data/Iterators/Producers/Repeat.lean

@@ -10,8 +10,8 @@ import Std.Data.Iterators.Internal.Termination
 /-!
 # Function-unfolding iterator
 
-This module provides an infinite iterator that given an initial value `init`  function `f` emits
-the iterates `init`, `f init`, `f (f init)`, ... .
+This module provides an infinite iterator that, given an initial value `init` and a function `f`,
+emits the iterates `init`, `f init`, `f (f init)`, and so on.
 -/
 
 namespace Std.Iterators
@@ -39,7 +39,7 @@ instance : Iterator (RepeatIterator α f) Id α where
 /--
 Creates an infinite iterator from an initial value `init` and a function `f : α → α`.
 First it yields `init`, and in each successive step, the iterator applies `f` to the previous value.
-So the iterator just emitted `a`, in the next step it will yield `f a`. In other words, the
+So if the iterator just emitted `a`, in the next step it will yield `f a`. In other words, the
 `n`-th value is `Nat.repeat f n init`.
 
 For example, if `f := (· + 1)` and `init := 0`, then the iterator emits all natural numbers in

src/Std/Sat/CNF/Literal.lean

@@ -21,7 +21,7 @@ namespace Literal
 /--
 Flip the polarity of `l`.
 -/
-@[inline]
+@[inline, grind =]
 def negate (l : Literal α) : Literal α := (l.1, !l.2)
 
 end Literal

src/Std/Tactic/BVDecide/LRAT/Internal/Assignment.lean

@@ -7,6 +7,9 @@ prelude
 import Init.ByCases
 import Std.Tactic.BVDecide.LRAT.Internal.Entails
 import Std.Tactic.BVDecide.LRAT.Internal.PosFin
+import Init.Grind
+
+set_option grind.warning false
 
 namespace Std.Tactic.BVDecide
 namespace LRAT
@@ -38,6 +41,8 @@ deriving Inhabited, DecidableEq, BEq
 
 namespace Assignment
 
+attribute [local grind cases] Assignment
+
 instance : ToString Assignment where
   toString := fun a =>
     match a with
@@ -108,102 +113,77 @@ def removeNegAssignment (oldAssignment : Assignment) : Assignment :=
   | both => pos
   | unassigned => unassigned -- Note: This case should not occur
 
-def addAssignment (b : Bool) : Assignment → Assignment :=
-  if b then
-    addPosAssignment
-  else
-    addNegAssignment
+attribute [local grind] hasPosAssignment hasNegAssignment addNegAssignment addPosAssignment
+  removePosAssignment removeNegAssignment
 
-def removeAssignment (b : Bool) : Assignment → Assignment :=
+def addAssignment (b : Bool) (a : Assignment) : Assignment :=
   if b then
-    removePosAssignment
+    addPosAssignment a
   else
-    removeNegAssignment
+    addNegAssignment a
 
-def hasAssignment (b : Bool) : Assignment → Bool :=
+def removeAssignment (b : Bool) (a : Assignment) : Assignment :=
   if b then
-    hasPosAssignment
+    removePosAssignment a
   else
-    hasNegAssignment
+    removeNegAssignment a
+
+def hasAssignment (b : Bool) (a : Assignment) : Bool :=
+  if b then
+    hasPosAssignment a
+  else
+    hasNegAssignment a
+
+attribute [local grind] addAssignment removeAssignment hasAssignment
 
 theorem removePos_addPos_cancel {assignment : Assignment} (h : ¬(hasPosAssignment assignment)) :
-  removePosAssignment (addPosAssignment assignment) = assignment := by
-  cases assignment <;> simp_all [removePosAssignment, addPosAssignment, hasPosAssignment]
+  removePosAssignment (addPosAssignment assignment) = assignment := by grind
 
 theorem removeNeg_addNeg_cancel {assignment : Assignment} (h : ¬(hasNegAssignment assignment)) :
-  removeNegAssignment (addNegAssignment assignment) = assignment := by
-  cases assignment <;> simp_all [removeNegAssignment, addNegAssignment, hasNegAssignment]
+  removeNegAssignment (addNegAssignment assignment) = assignment := by grind
 
 theorem remove_add_cancel {assignment : Assignment} {b : Bool} (h : ¬(hasAssignment b assignment)) :
-  removeAssignment b (addAssignment b assignment) = assignment := by
-  by_cases hb : b
-  · simp only [removeAssignment, hb, addAssignment, ite_true]
-    simp only [hasAssignment, hb, ite_true] at h
-    exact removePos_addPos_cancel h
-  · simp only [removeAssignment, hb, addAssignment, ite_true]
-    simp only [hasAssignment, hb, ite_false] at h
-    exact removeNeg_addNeg_cancel h
+  removeAssignment b (addAssignment b assignment) = assignment := by grind
 
-theorem add_both_eq_both (b : Bool) : addAssignment b both = both := by
-  rw [addAssignment]
-  split <;> decide
+theorem add_both_eq_both (b : Bool) : addAssignment b both = both := by grind
 
-theorem has_both (b : Bool) : hasAssignment b both = true := by
-  rw [hasAssignment]
-  split <;> decide
+theorem has_both (b : Bool) : hasAssignment b both = true := by grind
 
 theorem has_add (assignment : Assignment) (b : Bool) :
-    hasAssignment b (addAssignment b assignment) := by
-  by_cases b <;> cases assignment <;> simp_all [hasAssignment, hasPosAssignment, addAssignment,
-    addPosAssignment, addNegAssignment, hasNegAssignment]
+    hasAssignment b (addAssignment b assignment) := by grind
 
 theorem not_hasPos_removePos (assignment : Assignment) :
-    ¬hasPosAssignment (removePosAssignment assignment) := by
-  cases assignment <;> simp [removePosAssignment, hasPosAssignment]
+    ¬hasPosAssignment (removePosAssignment assignment) := by grind
 
 theorem not_hasNeg_removeNeg (assignment : Assignment) :
-    ¬hasNegAssignment (removeNegAssignment assignment) := by
-  cases assignment <;> simp [removeNegAssignment, hasNegAssignment]
+    ¬hasNegAssignment (removeNegAssignment assignment) := by grind
 
 theorem not_has_remove (assignment : Assignment) (b : Bool) :
-    ¬hasAssignment b (removeAssignment b assignment) := by
-  by_cases b <;> cases assignment <;> simp_all [hasAssignment, removeAssignment,
-    removePosAssignment, hasPosAssignment, removeNegAssignment, hasNegAssignment]
+    ¬hasAssignment b (removeAssignment b assignment) := by grind
 
 theorem has_remove_irrelevant (assignment : Assignment) (b : Bool) :
-    hasAssignment b (removeAssignment (!b) assignment) → hasAssignment b assignment := by
-  by_cases hb : b
-  · simp only [hb, removeAssignment, Bool.not_true, ite_false, hasAssignment, ite_true]
-    cases assignment <;> decide
-  · simp only [Bool.not_eq_true] at hb
-    simp only [hb, removeAssignment, Bool.not_true, ite_false, hasAssignment, ite_true]
-    cases assignment <;> decide
+    hasAssignment b (removeAssignment (!b) assignment) → hasAssignment b assignment := by grind
 
 theorem unassigned_of_has_neither (assignment : Assignment) (lacks_pos : ¬(hasPosAssignment assignment))
   (lacks_neg : ¬(hasNegAssignment assignment)) :
-  assignment = unassigned := by
-  simp only [hasPosAssignment, Bool.not_eq_true] at lacks_pos
-  split at lacks_pos <;> simp_all +decide
+  assignment = unassigned := by grind
 
+@[local grind =]
 theorem hasPos_addNeg (assignment : Assignment) :
-    hasPosAssignment (addNegAssignment assignment) = hasPosAssignment assignment := by
-  cases assignment <;> simp [hasPosAssignment, addNegAssignment]
+    hasPosAssignment (addNegAssignment assignment) = hasPosAssignment assignment := by grind
 
+@[local grind =]
 theorem hasNeg_addPos (assignment : Assignment) :
-    hasNegAssignment (addPosAssignment assignment) = hasNegAssignment assignment := by
-  cases assignment <;> simp [hasNegAssignment, addPosAssignment]
+    hasNegAssignment (addPosAssignment assignment) = hasNegAssignment assignment := by grind
 
 theorem has_iff_has_add_complement (assignment : Assignment) (b : Bool) :
-    hasAssignment b assignment ↔ hasAssignment b (addAssignment (¬b) assignment) := by
-  by_cases hb : b <;> simp [hb, hasAssignment, addAssignment, hasPos_addNeg, hasNeg_addPos]
+    hasAssignment b assignment ↔ hasAssignment b (addAssignment (¬b) assignment) := by grind
 
 theorem addPos_addNeg_eq_both (assignment : Assignment) :
-    addPosAssignment (addNegAssignment assignment) = both := by
-  cases assignment <;> simp [addPosAssignment, addNegAssignment]
+    addPosAssignment (addNegAssignment assignment) = both := by grind
 
 theorem addNeg_addPos_eq_both (assignment : Assignment) :
-    addNegAssignment (addPosAssignment assignment) = both := by
-  cases assignment <;> simp [addNegAssignment, addPosAssignment]
+    addNegAssignment (addPosAssignment assignment) = both := by grind
 
 instance {n : Nat} : Entails (PosFin n) (Array Assignment) where
   eval := fun p arr => ∀ i : PosFin n, ¬(hasAssignment (¬p i) arr[i.1]!)

src/Std/Tactic/BVDecide/LRAT/Internal/CNF.lean

@@ -6,6 +6,8 @@ Authors: Josh Clune
 prelude
 import Std.Tactic.BVDecide.LRAT.Internal.Formula.Class
 
+set_option grind.warning false
+
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -14,18 +16,10 @@ open Clause Formula Std Sat
 
 namespace Literal
 
-theorem sat_iff (p : α → Bool) (a : α) (b : Bool) : p ⊨ (a, b) ↔ (p a) = b := by
-  simp only [Entails.eval]
+theorem sat_iff (p : α → Bool) (a : α) (b : Bool) : p ⊨ (a, b) ↔ (p a) = b := Iff.rfl
 
 theorem sat_negate_iff_not_sat {p : α → Bool} {l : Literal α} : p ⊨ Literal.negate l ↔ p ⊭ l := by
-  simp only [Literal.negate, sat_iff]
-  constructor
-  · intro h pl
-    rw [sat_iff, h] at pl
-    simp at pl
-  · intro h
-    rw [sat_iff] at h
-    cases h : p l.fst <;> simp_all
+  grind [sat_iff, cases Bool]
 
 theorem unsat_of_limplies_complement [Entails α t] (x : t) (l : Literal α) :
     Limplies α x l → Limplies α x (Literal.negate l) → Unsatisfiable α x := by
@@ -41,61 +35,25 @@ namespace Clause
 
 theorem sat_iff_exists [Clause α β] (p : α → Bool) (c : β) : p ⊨ c ↔ ∃ l ∈ toList c, p ⊨ l := by
   simp only [(· ⊨ ·), eval]
-  simp only [List.any_eq_true, decide_eq_true_eq, Prod.exists, Bool.exists_bool]
+  grind
 
 theorem limplies_iff_mem [DecidableEq α] [Clause α β] (l : Literal α) (c : β) :
     Limplies α l c ↔ l ∈ toList c := by
   simp only [Limplies, sat_iff_exists, Prod.exists, Bool.exists_bool]
   constructor
-  · intro h
+  · simp only [(· ⊨ ·)]
+    intro h
     -- Construct an assignment p such that p ⊨ l and p ⊭ c ∖ {l}
     let p := fun x : α => if x = l.1 then l.2 else (x, false) ∈ toList c
-    have pl : p ⊨ l := by simp only [(· ⊨ ·), ite_true, p]
-    specialize h p pl
-    rcases h with ⟨v, ⟨h1, h2⟩ | ⟨h1, h2⟩⟩
-    · simp only [(· ⊨ ·), p] at h2
-      split at h2
-      · next v_eq_l =>
-        cases l
-        simp_all
-      · next v_ne_l =>
-        simp only [decide_eq_false_iff_not] at h2
-        exfalso
-        exact h2 h1
-    · simp only [(· ⊨ ·), p] at h2
-      split at h2
-      · next v_eq_l =>
-        cases l
-        simp_all
-      · next v_ne_l =>
-        simp only [decide_eq_true_eq] at h2
-        exfalso
-        rcases not_tautology c (v, true) with v_not_in_c | negv_not_in_c
-        · exact v_not_in_c h1
-        · simp only [Literal.negate, Bool.not_true] at negv_not_in_c
-          exact negv_not_in_c h2
-  · intro h p pl
-    apply Exists.intro l.1
-    by_cases hl : l.2
-    · apply Or.inr
-      rw [← hl]
-      exact ⟨h, pl⟩
-    · apply Or.inl
-      simp only [Bool.not_eq_true] at hl
-      rw [← hl]
-      exact ⟨h, pl⟩
+    specialize h p
+    grind [not_tautology]
+  · grind [cases Bool]
 
 theorem entails_of_entails_delete [DecidableEq α] [Clause α β] {p : α → Bool} {c : β}
     {l : Literal α} :
     p ⊨ delete c l → p ⊨ c := by
-  intro h
-  simp only [(· ⊨ ·), eval, List.any_eq_true, decide_eq_true_eq, Prod.exists, Bool.exists_bool] at h
-  simp only [(· ⊨ ·), eval, List.any_eq_true, decide_eq_true_eq, Prod.exists, Bool.exists_bool]
-  rcases h with ⟨v, ⟨h1, h2⟩ | ⟨h1, h2⟩⟩
-  · simp only [delete_iff, ne_eq] at h1
-    exact Exists.intro v <| Or.inl ⟨h1.2, h2⟩
-  · simp only [delete_iff, ne_eq] at h1
-    exact Exists.intro v <| Or.inr ⟨h1.2, h2⟩
+  simp only [(· ⊨ ·), eval] at ⊢
+  grind
 
 end Clause
 
@@ -103,27 +61,18 @@ namespace Formula
 
 theorem sat_iff_forall [Clause α β] [Entails α σ] [Formula α β σ] (p : α → Bool) (f : σ) :
     p ⊨ f ↔ ∀ c : β, c ∈ toList f → p ⊨ c := by
-  simp only [(· ⊨ ·), formulaEntails_def p f]
-  simp only [List.all_eq_true, decide_eq_true_eq]
+  simp only [formulaEntails_def]
+  grind
 
 theorem limplies_insert [Clause α β] [Entails α σ] [Formula α β σ] {c : β} {f : σ} :
     Limplies α (insert f c) f := by
-  intro p
-  simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq]
-  intro h c' c'_in_f
-  have c'_in_fc : c' ∈ toList (insert f c) := by
-    simp only [insert_iff, List.toList_toArray, List.mem_singleton]
-    exact Or.inr c'_in_f
-  exact h c' c'_in_fc
+  simp only [Limplies, formulaEntails_def]
+  grind
 
 theorem limplies_delete [Clause α β] [Entails α σ] [Formula α β σ] {f : σ} {arr : Array Nat} :
     Limplies α f (delete f arr) := by
-  intro p
-  simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq]
-  intro h c c_in_f_del
-  have del_f_subset := delete_subset f arr
-  specialize del_f_subset c c_in_f_del
-  exact h c del_f_subset
+  simp only [Limplies, formulaEntails_def]
+  grind
 
 end Formula
 

src/Std/Tactic/BVDecide/LRAT/Internal/Clause.lean

@@ -10,7 +10,9 @@ import Std.Data.HashMap
 import Std.Sat.CNF.Basic
 import Std.Tactic.BVDecide.LRAT.Internal.PosFin
 import Std.Tactic.BVDecide.LRAT.Internal.Assignment
+import Init.Grind
 
+set_option grind.warning false
 
 namespace Std.Tactic.BVDecide
 namespace LRAT
@@ -55,6 +57,8 @@ class Clause (α : outParam (Type u)) (β : Type v) where
 
 namespace Clause
 
+attribute [grind] empty_eq unit_eq isUnit_iff negate_eq delete_iff contains_iff
+
 instance : Entails α (Literal α) where
   eval := fun p l => p l.1 = l.2
 
@@ -89,8 +93,8 @@ that it was needed.
 -/
 @[ext] structure DefaultClause (numVarsSucc : Nat) where
   clause : CNF.Clause (PosFin numVarsSucc)
-  nodupkey : ∀ l : PosFin numVarsSucc, (l, true) ∉ clause ∨ (l, false) ∉ clause
-  nodup : List.Nodup clause
+  nodupkey : ∀ l : PosFin numVarsSucc, (l, true) ∉ clause ∨ (l, false) ∉ clause := by grind
+  nodup : List.Nodup clause := by grind
   deriving BEq
 
 instance : ToString (DefaultClause n) where
@@ -98,45 +102,23 @@ instance : ToString (DefaultClause n) where
 
 namespace DefaultClause
 
-def toList (c : DefaultClause n) : CNF.Clause (PosFin n) := c.clause
+@[grind] def toList (c : DefaultClause n) : CNF.Clause (PosFin n) := c.clause
+
+attribute [local grind] DefaultClause.nodup DefaultClause.nodupkey
 
 theorem not_tautology (c : DefaultClause n) (l : Literal (PosFin n)) :
     l ∉ toList c ∨ ¬Literal.negate l ∈ toList c := by
-  simp only [toList, Literal.negate]
-  have h := c.nodupkey l.1
-  by_cases hl : l.2
-  · simp only [hl, Bool.not_true]
-    rwa [← hl] at h
-  · simp only [Bool.not_eq_true] at hl
-    simp only [hl, Bool.not_false]
-    apply Or.symm
-    rwa [← hl] at h
+  grind [cases Bool]
 
 @[inline]
-def empty : DefaultClause n :=
-  let clause := []
-  have nodupkey := by
-    simp only [clause, List.find?, List.not_mem_nil, not_false_eq_true, or_self, implies_true]
-  have nodup := by
-    simp only [clause, List.nodup_nil]
-  ⟨clause, nodupkey, nodup⟩
+def empty : DefaultClause n where
+  clause := []
 
 theorem empty_eq : toList (empty : DefaultClause n) = [] := rfl
 
 @[inline]
-def unit (l : Literal (PosFin n)) : DefaultClause n :=
-  let clause := [l]
-  have nodupkey : ∀ (l : PosFin n), ¬(l, true) ∈ clause ∨ ¬(l, false) ∈ clause := by
-    intro l'
-    by_cases l.2
-    · apply Or.inr
-      cases l
-      simp_all [clause]
-    · apply Or.inl
-      cases l
-      simp_all [clause]
-  have nodup : List.Nodup clause:= by simp [clause]
-  ⟨clause, nodupkey, nodup⟩
+def unit (l : Literal (PosFin n)) : DefaultClause n where
+  clause := [l]
 
 theorem unit_eq (l : Literal (PosFin n)) : toList (unit l) = [l] := rfl
 
@@ -148,54 +130,14 @@ def isUnit (c : DefaultClause n) : Option (Literal (PosFin n)) :=
 
 theorem isUnit_iff (c : DefaultClause n) (l : Literal (PosFin n)) :
     isUnit c = some l ↔ toList c = [l] := by
-  simp only [isUnit, toList]
-  split
-  · next l' heq => simp [heq]
-  · next hne =>
-    simp
-    apply hne
+  grind [isUnit]
 
 @[inline]
 def negate (c : DefaultClause n) : CNF.Clause (PosFin n) := c.clause.map Literal.negate
 
 theorem negate_eq (c : DefaultClause n) : negate c = (toList c).map Literal.negate := rfl
 
-def ofArray (ls : Array (Literal (PosFin n))) : Option (DefaultClause n) :=
-  let mapOption := ls.foldl folder (some (HashMap.emptyWithCapacity ls.size))
-  match mapOption with
-  | none => none
-  | some map =>
-   have mapnodup := map.distinct_keys
-    have nodupkey : ∀ (l : PosFin n), ¬(l, true) ∈ map.toList ∨ ¬(l, false) ∈ map.toList := by
-      intro l
-      apply Classical.byContradiction
-      simp_all
-    have nodup : map.toList.Nodup := by
-      rw [List.Nodup, List.pairwise_iff_forall_sublist]
-      simp only [ne_eq, Prod.forall, Bool.forall_bool, Prod.mk.injEq, not_and, Bool.not_eq_false,
-        Bool.not_eq_true, Bool.false_eq_true, imp_false, implies_true, and_true, Bool.true_eq_false,
-        true_and]
-      intro l1
-      constructor
-      . intros l2 h hl
-        rw [List.pairwise_iff_forall_sublist] at mapnodup
-        replace h : [l1, l2].Sublist map.keys := by
-          rw [← HashMap.map_fst_toList_eq_keys, List.sublist_map_iff]
-          apply Exists.intro [(l1, false), (l2, false)]
-          simp [h]
-        specialize mapnodup h
-        simp [hl] at mapnodup
-      . intros l2 h hl
-        rw [List.pairwise_iff_forall_sublist] at mapnodup
-        replace h : [l1, l2].Sublist map.keys := by
-          rw [← HashMap.map_fst_toList_eq_keys, List.sublist_map_iff]
-          apply Exists.intro [(l1, true), (l2, true)]
-          simp [h]
-        specialize mapnodup h
-        simp [hl] at mapnodup
-    some ⟨map.toList, nodupkey, nodup⟩
-where
-  folder (acc : Option (Std.HashMap (PosFin n) Bool)) (l : Literal (PosFin n)) :
+@[irreducible] def ofArray.folder (acc : Option (Std.HashMap (PosFin n) Bool)) (l : Literal (PosFin n)) :
       Option (Std.HashMap (PosFin n) Bool) :=
     match acc with
     | none => none
@@ -209,119 +151,58 @@ where
       else
         some map
 
+-- Recall `@[local grind]` doesn't work for theorems in namespaces,
+-- so we add the attribute after the fact.
+attribute [local grind] DefaultClause.ofArray.folder
+
+def ofArray (ls : Array (Literal (PosFin n))) : Option (DefaultClause n) :=
+  let mapOption := ls.foldl ofArray.folder (some (HashMap.emptyWithCapacity ls.size))
+  match mapOption with
+  | none => none
+  | some map =>
+    -- FIXME: Commenting this out gives an unknown metavariable error in `grind`!
+    -- reported as https://github.com/leanprover/lean4/pull/8607
+    have mapnodup := map.distinct_keys
+    some ⟨map.toList, by grind, by grind⟩
+
 @[simp]
 theorem ofArray.foldl_folder_none_eq_none : List.foldl ofArray.folder none ls = none := by
-  apply List.foldlRecOn (motive := (· = none))
-  · simp
-  · intro b hb a ha
-    unfold DefaultClause.ofArray.folder
-    simp [hb]
+  apply List.foldlRecOn (motive := (· = none)) <;> grind
+
+attribute [local grind] ofArray.foldl_folder_none_eq_none
 
 theorem ofArray.mem_of_mem_of_foldl_folder_eq_some
-    (h : List.foldl DefaultClause.ofArray.folder (some acc) ls = some acc') :
-    ∀ l ∈ acc.toList, l ∈ acc'.toList := by
-  intro l hl
-  induction ls generalizing acc with
-  | nil => simp_all
-  | cons x xs ih =>
-    rcases l with ⟨var, pol⟩
-    rw [List.foldl_cons, DefaultClause.ofArray.folder.eq_def] at h
-    split at h
-    · contradiction
-    · simp only [HashMap.getThenInsertIfNew?_fst, HashMap.get?_eq_getElem?, bne_iff_ne, ne_eq,
-        HashMap.getThenInsertIfNew?_snd, ite_not] at h
-      split at h
-      · split at h
-        · apply ih
-          · exact h
-          · rw [Std.HashMap.mem_toList_iff_getElem?_eq_some, Std.HashMap.getElem?_insertIfNew]
-            rename_i map _ _ _ _ _
-            have : x.fst ∈ map := by
-              apply Classical.byContradiction
-              intro h2
-              have := Std.HashMap.getElem?_eq_none h2
-              simp_all
-            simp [this]
-            rw [Std.HashMap.mem_toList_iff_getElem?_eq_some] at hl
-            simp_all
-        · simp at h
-      · apply ih
-        · exact h
-        · rw [Std.HashMap.mem_toList_iff_getElem?_eq_some, Std.HashMap.getElem?_insertIfNew]
-          simp_all
-          intros
-          cases pol <;> simp_all
+    (h : List.foldl DefaultClause.ofArray.folder (some acc) ls = some acc') (l) (h : l ∈ acc.toList) :
+      l ∈ acc'.toList := by
+  induction ls generalizing acc with grind (gen := 7)
+
+attribute [local grind] ofArray.mem_of_mem_of_foldl_folder_eq_some
 
 theorem ofArray.folder_foldl_mem_of_mem
     (h : List.foldl DefaultClause.ofArray.folder acc ls = some map) :
     ∀ l ∈ ls, l ∈ map.toList := by
   intro l hl
   induction ls generalizing acc with
-  | nil => simp at hl
+  | nil => grind
   | cons x xs ih =>
     simp at hl h
-    rcases hl with hl | hl
-    · rw [DefaultClause.ofArray.folder.eq_def] at h
-      simp at h
-      split at h
-      · simp at h
-      · split at h
-        · split at h
-          · apply mem_of_mem_of_foldl_folder_eq_some
-            · exact h
-            · rw [Std.HashMap.mem_toList_iff_getElem?_eq_some]
-              rw [Std.HashMap.getElem?_insertIfNew]
-              simp_all
-          · simp at h
-        · apply mem_of_mem_of_foldl_folder_eq_some
-          · exact h
-          · next hfoo =>
-            rw [hl]
-            cases x
-            simp [Std.HashMap.getElem_insertIfNew]
-            intro hbar
-            exfalso
-            apply hfoo
-            rw [Std.HashMap.getElem?_eq_some_getElem! hbar]
-    · exact ih h hl
+    rw [DefaultClause.ofArray.folder.eq_def] at h -- TODO why doesn't `grind` handle this?
+    rcases hl <;> grind (gen := 7)
 
-@[inline]
-def delete (c : DefaultClause n) (l : Literal (PosFin n)) : DefaultClause n :=
-  let clause := c.clause.erase l
-  let nodupkey : ∀ (l : PosFin n), ¬(l, true) ∈ clause ∨ ¬(l, false) ∈ clause := by
-    intro l'
-    simp only [clause]
-    rcases c.nodupkey l' with ih | ih
-    · apply Or.inl
-      intro h
-      exact ih <| List.mem_of_mem_erase h
-    · apply Or.inr
-      intro h
-      exact ih <| List.mem_of_mem_erase h
-  have nodup := by
-    simp only [clause]
-    exact List.Nodup.erase l c.nodup
-  ⟨clause, nodupkey, nodup⟩
+@[inline, local grind]
+def delete (c : DefaultClause n) (l : Literal (PosFin n)) : DefaultClause n where
+  clause := c.clause.erase l
 
 theorem delete_iff (c : DefaultClause n) (l l' : Literal (PosFin n)) :
     l' ∈ toList (delete c l) ↔ l' ≠ l ∧ l' ∈ toList c := by
-  simp only [toList, delete, ne_eq]
-  by_cases hl : l' = l
-  · simp only [hl, not_true, false_and, iff_false]
-    exact List.Nodup.not_mem_erase c.nodup
-  · simp only [hl, not_false_eq_true, true_and]
-    exact List.mem_erase_of_ne hl
+  grind
 
 @[inline]
 def contains (c : DefaultClause n) (l : Literal (PosFin n)) : Bool := c.clause.contains l
 
 theorem contains_iff :
     ∀ (c : DefaultClause n) (l : Literal (PosFin n)), contains c l = true ↔ l ∈ toList c := by
-  intro c l
-  simp only [contains, List.contains]
-  constructor
-  · exact List.mem_of_elem_eq_true
-  · exact List.elem_eq_true_of_mem
+  grind [contains]
 
 def reduce_fold_fn (assignments : Array Assignment) (acc : ReduceResult (PosFin n))
     (l : Literal (PosFin n)) :

src/Std/Tactic/BVDecide/LRAT/Internal/Convert.lean

@@ -111,7 +111,7 @@ theorem unsat_of_cons_none_unsat (clauses : List (Option (DefaultClause n))) :
   apply h assign
   simp only [Formula.formulaEntails_def, List.all_eq_true, decide_eq_true_eq] at *
   intro clause hclause
-  simp_all[DefaultFormula.ofArray, Formula.toList, DefaultFormula.toList]
+  simp_all [DefaultFormula.ofArray, Formula.toList, DefaultFormula.toList]
 
 theorem CNF.unsat_of_convertLRAT_unsat (cnf : CNF Nat) :
     Unsatisfiable (PosFin (cnf.numLiterals + 1)) (CNF.convertLRAT cnf)

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/Class.lean

@@ -56,6 +56,14 @@ class Formula (α : outParam (Type u)) (β : outParam (Type v)) [Clause α β] (
     ∀ f : σ, ∀ c : β, ∀ p : Literal α, ∀ rupHints : Array Nat, ∀ ratHints : Array (Nat × Array Nat), ∀ f' : σ,
     ReadyForRatAdd f → p ∈ Clause.toList c → performRatAdd f c p rupHints ratHints = (f', true) → Equisat α f f'
 
+open Formula
+
+attribute [grind] insert_iff readyForRupAdd_insert readyForRatAdd_insert
+  delete_subset readyForRupAdd_delete readyForRatAdd_delete
+
+attribute [grind →]
+  rupAdd_result rupAdd_sound ratAdd_result ratAdd_sound
+
 end Internal
 end LRAT
 end Std.Tactic.BVDecide

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/Lemmas.lean

@@ -7,6 +7,8 @@ prelude
 import Std.Tactic.BVDecide.LRAT.Internal.Formula.Implementation
 import Std.Tactic.BVDecide.LRAT.Internal.CNF
 
+set_option grind.warning false -- I've only made a partial effort to use grind here so far.
+
 /-!
 This module contains basic statements about the invariants that are satisfied by the LRAT checker
 implementation in `Implementation`.
@@ -21,6 +23,8 @@ namespace DefaultFormula
 open Std.Sat
 open DefaultClause DefaultFormula Assignment
 
+attribute [local grind] insert ofArray
+
 /--
 This invariant states that if the `assignments` field of a default formula `f` indicates that `f`
 contains an assignment `b` at index `i`, then the unit literal `(i, b)` must be included in `f`.
@@ -86,25 +90,23 @@ def ReadyForRatAdd {n : Nat} (f : DefaultFormula n) : Prop := f.ratUnits = #[]
 theorem rupUnits_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     (insert f c).rupUnits = f.rupUnits := by
   simp only [insert]
-  split <;> simp only
+  grind
 
 theorem ratUnits_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     (insert f c).ratUnits = f.ratUnits := by
   simp only [insert]
-  split <;> simp only
+  grind
 
 theorem size_ofArray_fold_fn {n : Nat} (assignments : Array Assignment)
     (cOpt : Option (DefaultClause n)) :
     (ofArray_fold_fn assignments cOpt).size = assignments.size := by
   rw [ofArray_fold_fn.eq_def]
-  split
-  · rfl
-  · split <;> simp [Array.size_modify]
+  grind
 
 theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))) :
     ReadyForRupAdd (ofArray arr) := by
   constructor
-  · simp only [ofArray]
+  · grind
   · have hsize : (ofArray arr).assignments.size = n := by
       simp only [ofArray, ← Array.foldl_toList]
       have hb : (Array.replicate n unassigned).size = n := by simp only [Array.size_replicate]
@@ -148,8 +150,7 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
               simp only [unit, b_eq_true, i_eq_l]
               have c_def : c = ⟨c.clause, c.nodupkey, c.nodup⟩ := rfl
               simp only [heq] at c_def
-              rw [c_def] at cOpt_in_arr
-              exact cOpt_in_arr
+              grind
             · next b_eq_false =>
               simp only [Bool.not_eq_true] at b_eq_false
               simp only [hasAssignment, b_eq_false, ite_false, hasNeg_addPos, reduceCtorEq] at h
@@ -157,9 +158,7 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
               simp only [hasAssignment, ite_false] at ih
               rw [b_eq_false, Subtype.ext i_eq_l]
               exact ih h
-          · next i_ne_l =>
-            simp only [Array.getElem_modify_of_ne (Ne.symm i_ne_l)] at h
-            exact ih i b h
+          · next i_ne_l => grind
         | some (l, false) =>
           simp only [heq] at h
           rcases ih with ⟨hsize, ih⟩
@@ -172,7 +171,7 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
               specialize ih l true
               simp only [hasAssignment, ite_false] at ih
               rw [b_eq_true, Subtype.ext i_eq_l]
-              exact ih h
+              grind
             · next b_eq_false =>
               rw [isUnit_iff, DefaultClause.toList] at heq
               simp only [toList, ofArray, List.map, List.append_nil, List.mem_filterMap, id_eq, exists_eq_right]
@@ -180,80 +179,32 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
               simp only [unit, b_eq_false, i_eq_l]
               have c_def : c = ⟨c.clause, c.nodupkey, c.nodup⟩ := rfl
               simp only [heq] at c_def
-              rw [c_def] at cOpt_in_arr
-              exact cOpt_in_arr
-          · next i_ne_l =>
-            simp only [Array.getElem_modify_of_ne (Ne.symm i_ne_l)] at h
-            exact ih i b h
+              grind
+          · next i_ne_l => grind
     rcases List.foldlRecOn arr.toList ofArray_fold_fn hb hl with ⟨_h_size, h'⟩
-    intro i b h
-    simp only [ofArray, ← Array.foldl_toList] at h
-    exact h' i b h
+    grind [ofArray]
 
 theorem readyForRatAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))) :
     ReadyForRatAdd (ofArray arr) := by
   constructor
-  · simp only [ofArray]
-  · exact readyForRupAdd_ofArray arr
+  · grind
+  · grind [readyForRupAdd_ofArray]
 
 theorem insert_iff {n : Nat} (f : DefaultFormula n) (c1 : DefaultClause n) (c2 : DefaultClause n) :
     c2 ∈ toList (insert f c1) ↔ c2 = c1 ∨ c2 ∈ toList f := by
-  simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq, exists_eq_right,
-    List.mem_map, Prod.exists, Bool.exists_bool]
-  by_cases c2 = c1
-  · next c2_eq_c1 =>
-    constructor
-    · intro _
-      exact Or.inl c2_eq_c1
-    · intro _
-      apply Or.inl
-      simp only [c2_eq_c1, insert]
-      split <;> simp
-  · next c2_ne_c1 =>
-    constructor
-    · intro h
-      apply Or.inr
-      rcases h with h | h | h
-      · apply Or.inl
-        simp only [insert] at h
-        split at h
-        all_goals
-          simp only [Array.toList_push, List.mem_append, List.mem_singleton, Option.some.injEq] at h
-          rcases h with h | h
-          · exact h
-          · exact False.elim <| c2_ne_c1 h
-      · rw [rupUnits_insert] at h
-        exact Or.inr <| Or.inl h
-      · rw [ratUnits_insert] at h
-        exact Or.inr <| Or.inr h
-    · intro h
-      rcases h with h | h | h | h
-      · exact False.elim <| c2_ne_c1 h
-      · apply Or.inl
-        simp only [insert]
-        split
-        all_goals
-          simp only [Array.toList_push, List.mem_append, List.mem_singleton, Option.some.injEq]
-          exact Or.inl h
-      · rw [rupUnits_insert]
-        exact Or.inr <| Or.inl h
-      · rw [ratUnits_insert]
-        exact Or.inr <| Or.inr h
+  simp only [toList, List.mem_append, List.mem_filterMap, id_eq, exists_eq_right]
+  simp only [insert]
+  grind
 
 theorem limplies_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     Limplies (PosFin n) (insert f c) f := by
-  intro p
-  simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq]
-  intro h c' c'_in_f
-  have c'_in_fc : c' ∈ toList (insert f c) := by
-    simp only [insert_iff, List.toList_toArray, List.mem_singleton]
-    exact Or.inr c'_in_f
-  exact h c' c'_in_fc
+  simp only [Limplies, formulaEntails_def, List.all_eq_true]
+  grind [insert_iff]
 
 theorem size_assignments_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     (insert f c).assignments.size = f.assignments.size := by
   simp only [insert]
-  split <;> simp only [Array.size_modify]
+  grind
 
 theorem readyForRupAdd_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     ReadyForRupAdd f → ReadyForRupAdd (insert f c) := by
@@ -263,13 +214,8 @@ theorem readyForRupAdd_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClaus
   · refine ⟨f_readyForRupAdd.1, f_readyForRupAdd.2.1, ?_⟩
     intro i b hb
     have hf := f_readyForRupAdd.2.2 i b hb
-    simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq, exists_eq_right,
-      List.mem_map, Prod.exists, Bool.exists_bool] at hf
-    simp only [toList, Array.toList_push, List.append_assoc, List.mem_append, List.mem_filterMap,
-      List.mem_singleton, id_eq, exists_eq_right, Option.some.injEq, List.mem_map, Prod.exists, Bool.exists_bool]
-    rcases hf with hf | hf
-    · exact (Or.inl ∘ Or.inl) hf
-    · exact Or.inr hf
+    simp only [toList] at hf ⊢
+    grind
   · next l hc =>
     have hsize : (Array.modify f.assignments l.1 addPosAssignment).size = n := by
       rw [Array.size_modify, f_readyForRupAdd.2.1]
@@ -294,22 +240,13 @@ theorem readyForRupAdd_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClaus
             by_cases b = true
             · next b_eq_true =>
               simp only [b_eq_true, Subtype.ext l_eq_i, not_true] at ib_ne_c
-            · next b_eq_false =>
-              simp only [Bool.not_eq_true] at b_eq_false
-              exact b_eq_false
+            · next b_eq_false => grind
           simp only [hasAssignment, b_eq_false, l_eq_i, Array.getElem_modify_self, ite_false, hasNeg_addPos, reduceCtorEq] at hb
-          simp only [hasAssignment, b_eq_false, ite_false, hb, reduceCtorEq]
-        · next l_ne_i =>
-          simp only [Array.getElem_modify_of_ne l_ne_i] at hb
-          exact hb
+          grind [hasAssignment]
+        · next l_ne_i => grind
       specialize hf hb'
-      simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq,
-        exists_eq_right, List.mem_map, Prod.exists, Bool.exists_bool] at hf
-      simp only [toList, Array.toList_push, List.append_assoc, List.mem_append, List.mem_filterMap,
-        List.mem_singleton, id_eq, exists_eq_right, Option.some.injEq, List.mem_map, Prod.exists, Bool.exists_bool]
-      rcases hf with hf | hf
-      · exact Or.inl <| Or.inl hf
-      · exact Or.inr hf
+      simp only [toList] at hf ⊢
+      grind
   · next l hc =>
     have hsize : (Array.modify f.assignments l.1 addNegAssignment).size = n := by
       rw [Array.size_modify, f_readyForRupAdd.2.1]
@@ -335,25 +272,18 @@ theorem readyForRupAdd_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClaus
             · assumption
             · next b_eq_false =>
               simp only [b_eq_false, Subtype.ext l_eq_i, not_true] at ib_ne_c
-          simp only [hasAssignment, b_eq_false, l_eq_i, Array.getElem_modify_self, ite_true, hasPos_addNeg] at hb
-          simp only [hasAssignment, b_eq_false, ite_true, hb]
-        · next l_ne_i =>
-          simp only [Array.getElem_modify_of_ne l_ne_i] at hb
-          exact hb
+          grind [hasAssignment, hasPos_addNeg]
+        · next l_ne_i => grind
       specialize hf hb'
-      simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq,
-        exists_eq_right, List.mem_map, Prod.exists, Bool.exists_bool] at hf
-      simp only [toList, Array.toList_push, List.append_assoc, List.mem_append, List.mem_filterMap,
-        List.mem_singleton, id_eq, exists_eq_right, Option.some.injEq, List.mem_map, Prod.exists, Bool.exists_bool]
-      rcases hf with hf | hf
-      · exact Or.inl <| Or.inl hf
-      · exact Or.inr hf
+      simp only [toList] at hf ⊢
+      grind
 
 theorem readyForRatAdd_insert {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) :
     ReadyForRatAdd f → ReadyForRatAdd (insert f c) := by
   intro h
   constructor
-  · simp only [insert, h.1] <;> split <;> rfl
+  · simp only [insert, h.1]
+    grind
   · exact readyForRupAdd_insert f c h.2
 
 theorem mem_of_insertRupUnits {n : Nat} (f : DefaultFormula n) (units : CNF.Clause (PosFin n))
@@ -363,36 +293,27 @@ theorem mem_of_insertRupUnits {n : Nat} (f : DefaultFormula n) (units : CNF.Clau
     List.mem_filterMap, id_eq, exists_eq_right, List.mem_map, Prod.exists, Bool.exists_bool]
   intro h
   have hb : ∀ l : Literal (PosFin n), l ∈ (f.rupUnits, f.assignments, false).1.toList → (l ∈ f.rupUnits.toList ∨ l ∈ units) := by
-    intro l hl
-    exact Or.inl hl
+    grind
   have hl (acc : Array (Literal (PosFin n)) × Array Assignment × Bool)
     (ih : ∀ l : Literal (PosFin n), l ∈ acc.1.toList → l ∈ f.rupUnits.toList ∨ l ∈ units)
     (unit : Literal (PosFin n)) (unit_in_units : unit ∈ units) :
     ∀ l : Literal (PosFin n), l ∈ (insertUnit acc unit).1.toList → (l ∈ f.rupUnits.toList ∨ l ∈ units) := by
     intro l hl
     rw [insertUnit.eq_def] at hl
-    dsimp at hl
-    split at hl
-    · exact ih l hl
-    · simp only [Array.toList_push, List.mem_append, List.mem_singleton] at hl
-      rcases hl with l_in_acc | l_eq_unit
-      · exact ih l l_in_acc
-      · rw [l_eq_unit]
-        exact Or.inr unit_in_units
+    grind
   have h_insertUnit_fold := List.foldlRecOn units insertUnit hb hl
   rcases h with h | ⟨i, ⟨h1, h2⟩ | ⟨h1, h2⟩⟩ | h
-  · exact Or.inr <| Or.inl h
+  · grind
   · rcases h_insertUnit_fold (i, false) h1 with h_insertUnit_fold | h_insertUnit_fold
     · apply Or.inr ∘ Or.inr ∘ Or.inl ∘ Exists.intro i ∘ Or.inl
-      exact ⟨h_insertUnit_fold, h2⟩
+      grind
     · apply Or.inl ∘ Exists.intro i ∘ Or.inl
-      exact ⟨h_insertUnit_fold, h2⟩
+      exact ⟨by grind, h2⟩
   · rcases h_insertUnit_fold (i, true) h1 with h_insertUnit_fold | h_insertUnit_fold
-    · apply Or.inr ∘ Or.inr ∘ Or.inl ∘ Exists.intro i ∘ Or.inr
-      exact ⟨h_insertUnit_fold, h2⟩
+    · grind
     · apply Or.inl ∘ Exists.intro i ∘ Or.inr
-      exact ⟨h_insertUnit_fold, h2⟩
-  · exact (Or.inr ∘ Or.inr ∘ Or.inr) h
+      exact ⟨by grind, h2⟩
+  · grind
 
 theorem mem_of_insertRatUnits {n : Nat} (f : DefaultFormula n) (units : CNF.Clause (PosFin n))
     (c : DefaultClause n) :
@@ -406,40 +327,29 @@ theorem mem_of_insertRatUnits {n : Nat} (f : DefaultFormula n) (units : CNF.Clau
     (ih : ∀ l : Literal (PosFin n), l ∈ acc.1.toList → l ∈ f.ratUnits.toList ∨ l ∈ units)
     (unit : Literal (PosFin n)) (unit_in_units : unit ∈ units) :
     ∀ l : Literal (PosFin n), l ∈ (insertUnit acc unit).1.toList → (l ∈ f.ratUnits.toList ∨ l ∈ units) := by
-    intro l hl
-    rw [insertUnit.eq_def] at hl
-    dsimp at hl
-    split at hl
-    · exact ih l hl
-    · simp only [Array.toList_push, List.mem_append, List.mem_singleton] at hl
-      rcases hl with l_in_acc | l_eq_unit
-      · exact ih l l_in_acc
-      · rw [l_eq_unit]
-        exact Or.inr unit_in_units
+    grind [insertUnit]
   have h_insertUnit_fold := List.foldlRecOn units insertUnit hb hl
   rcases h with h | h | ⟨i, ⟨h1, h2⟩ | ⟨h1, h2⟩⟩
-  · exact Or.inr <| Or.inl h
-  · exact (Or.inr ∘ Or.inr ∘ Or.inl) h
+  · grind
+  · grind
   · rcases h_insertUnit_fold (i, false) h1 with h_insertUnit_fold | h_insertUnit_fold
-    · apply Or.inr ∘ Or.inr ∘ Or.inr ∘ Exists.intro i ∘ Or.inl
-      exact ⟨h_insertUnit_fold, h2⟩
+    · grind
     · apply Or.inl ∘ Exists.intro i ∘ Or.inl
       exact ⟨h_insertUnit_fold, h2⟩
   · rcases h_insertUnit_fold (i, true) h1 with h_insertUnit_fold | h_insertUnit_fold
-    · apply Or.inr ∘ Or.inr ∘ Or.inr ∘ Exists.intro i ∘ Or.inr
-      exact ⟨h_insertUnit_fold, h2⟩
+    · grind
     · apply Or.inl ∘ Exists.intro i ∘ Or.inr
       exact ⟨h_insertUnit_fold, h2⟩
 
 theorem deleteOne_preserves_rupUnits {n : Nat} (f : DefaultFormula n) (id : Nat) :
     (deleteOne f id).rupUnits = f.rupUnits := by
   simp only [deleteOne]
-  split <;> simp only
+  grind
 
 theorem deleteOne_preserves_assignments_size {n : Nat} (f : DefaultFormula n) (id : Nat) :
     (deleteOne f id).assignments.size = f.assignments.size := by
   simp only [deleteOne]
-  split <;> simp only [Array.size_modify]
+  grind
 
 theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFormula n) (id : Nat) :
     StrongAssignmentsInvariant f → StrongAssignmentsInvariant (deleteOne f id) := by
@@ -466,11 +376,7 @@ theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFor
       by_cases l.1.1 = i.1
       · next l_eq_i =>
         simp only [l_eq_i, Array.getElem_modify_self] at hb
-        have l_ne_b : l.2 ≠ b := by
-          intro l_eq_b
-          rw [← l_eq_b] at hb
-          have hb' := not_has_remove f.assignments[i.1] l.2
-          simp [hb] at hb'
+        have l_ne_b : l.2 ≠ b := by grind [not_has_remove]
         replace l_ne_b := Bool.eq_not_of_ne l_ne_b
         simp only [l_ne_b] at hb
         have hb := has_remove_irrelevant f.assignments[i.1] b hb
@@ -484,25 +390,10 @@ theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFor
           simp only [Array.set!, Array.setIfInBounds]
           split
           · rcases List.getElem_of_mem hf with ⟨idx, hbound, hidx⟩
-            simp only [← hidx, Array.toList_set]
+            have idx_in_bounds : idx < List.length (List.set f.clauses.toList id none) := by grind
             rw [List.mem_iff_get]
-            have idx_in_bounds : idx < List.length (List.set f.clauses.toList id none) := by
-              simp only [List.length_set]
-              exact hbound
             apply Exists.intro ⟨idx, idx_in_bounds⟩
-            by_cases id = idx
-            · next id_eq_idx =>
-              exfalso
-              have idx_in_bounds2 : idx < f.clauses.size := by
-                conv => rhs; rw [List.size_toArray]
-                exact hbound
-              simp only [id_eq_idx, getElem!_def, idx_in_bounds2, Array.getElem?_eq_getElem, ←
-                Array.getElem_toList] at heq
-              rw [hidx, hl] at heq
-              simp only [unit, Option.some.injEq, DefaultClause.mk.injEq, List.cons.injEq, and_true] at heq
-              simp only [← heq] at l_ne_b
-              simp at l_ne_b
-            · next id_ne_idx => simp [id_ne_idx]
+            grind [unit]
           · exact hf
         · exact Or.inr hf
       · next l_ne_i =>
@@ -517,55 +408,19 @@ theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFor
           simp only [Array.set!, Array.setIfInBounds]
           split
           · rcases List.getElem_of_mem hf with ⟨idx, hbound, hidx⟩
-            simp only [← hidx, Array.toList_set]
             rw [List.mem_iff_get]
-            have idx_in_bounds : idx < List.length (List.set f.clauses.toList id none) := by
-              simp only [List.length_set]
-              exact hbound
+            have idx_in_bounds : idx < List.length (List.set f.clauses.toList id none) := by grind
             apply Exists.intro ⟨idx, idx_in_bounds⟩
-            by_cases id = idx
-            · next id_eq_idx =>
-              exfalso
-              have idx_in_bounds2 : idx < f.clauses.size := by
-                conv => rhs; rw [List.size_toArray]
-                exact hbound
-              simp only [id_eq_idx, getElem!_def, idx_in_bounds2, Array.getElem?_eq_getElem, ←
-                Array.getElem_toList] at heq
-              rw [hidx, hl] at heq
-              simp only [unit, Option.some.injEq, DefaultClause.mk.injEq, List.cons.injEq, and_true] at heq
-              have i_eq_l : i = l.1 := by rw [← heq]
-              simp only [i_eq_l, not_true] at l_ne_i
-            · next id_ne_idx => simp [id_ne_idx]
+            grind [unit]
           · exact hf
         · exact Or.inr hf
     · simp only [Prod.exists, Bool.exists_bool, not_exists, not_or, unit] at hl
       split
-      · next some_eq_none =>
-        simp at some_eq_none
-      · next l _ _ heq =>
-        simp only [Option.some.injEq] at heq
-        rw [heq] at hl
-        specialize hl l.1
-        simp only [DefaultClause.mk.injEq, List.cons.injEq, and_true] at hl
-        by_cases hl2 : l.2
-        · simp only [← hl2, not_true, and_false] at hl
-        · simp only [Bool.not_eq_true] at hl2
-          simp only [← hl2, not_true, false_and] at hl
+      · next some_eq_none => grind
+      · next l _ _ heq => grind [cases Bool]
       · have deleteOne_f_rw : deleteOne f id = ⟨Array.set! f.clauses id none, f.rupUnits, f.ratUnits, f.assignments⟩ := by
           simp only [deleteOne]
-          split
-          · next heq2 =>
-            simp [heq] at heq2
-          · next l _ _ heq2 =>
-            simp only [heq, Option.some.injEq] at heq2
-            rw [heq2] at hl
-            specialize hl l.1
-            simp only [DefaultClause.mk.injEq, List.cons.injEq, and_true] at hl
-            by_cases hl2 : l.2
-            · simp only [← hl2, not_true, and_false] at hl
-            · simp only [Bool.not_eq_true] at hl2
-              simp only [← hl2, not_true, false_and] at hl
-          · rfl
+          grind
         simp only [deleteOne_f_rw] at hb
         specialize hf i b hb
         simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq,
@@ -577,28 +432,11 @@ theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFor
           simp only [Array.set!, Array.setIfInBounds]
           split
           · rcases List.getElem_of_mem hf with ⟨idx, hbound, hidx⟩
-            simp only [← hidx, Array.toList_set]
             rw [List.mem_iff_get]
             have idx_in_bounds : idx < List.length (List.set f.clauses.toList id none) := by
-              simp only [List.length_set]
-              exact hbound
+              grind
             apply Exists.intro ⟨idx, idx_in_bounds⟩
-            by_cases id = idx
-            · next id_eq_idx =>
-              exfalso
-              have idx_in_bounds2 : idx < f.clauses.size := by
-                conv => rhs; rw [List.size_toArray]
-                exact hbound
-              simp only [id_eq_idx, getElem!_def, idx_in_bounds2, Array.getElem?_eq_getElem, ←
-                Array.getElem_toList] at heq
-              rw [hidx] at heq
-              simp only [Option.some.injEq] at heq
-              rw [← heq] at hl
-              specialize hl i
-              simp only [unit, DefaultClause.mk.injEq, List.cons.injEq, Prod.mk.injEq, true_and, and_true,
-                Bool.not_eq_false, Bool.not_eq_true] at hl
-              by_cases b_val : b <;> simp [b_val] at hl
-            · next id_ne_idx => simp [id_ne_idx]
+            grind [unit]
           · exact hf
         · exact Or.inr hf
 
@@ -611,59 +449,38 @@ theorem readyForRupAdd_delete {n : Nat} (f : DefaultFormula n) (arr : Array Nat)
     have hl (acc : DefaultFormula n) (ih : acc.rupUnits = #[]) (id : Nat) (_id_in_arr : id ∈ arr.toList) :
       (deleteOne acc id).rupUnits = #[] := by rw [deleteOne_preserves_rupUnits, ih]
     exact List.foldlRecOn arr.toList deleteOne hb hl
-  · have hb : StrongAssignmentsInvariant f := h.2
-    have hl (acc : DefaultFormula n) (ih : StrongAssignmentsInvariant acc) (id : Nat) (_id_in_arr : id ∈ arr.toList) :
+  · have hl (acc : DefaultFormula n) (ih : StrongAssignmentsInvariant acc) (id : Nat) (_id_in_arr : id ∈ arr.toList) :
       StrongAssignmentsInvariant (deleteOne acc id) := deleteOne_preserves_strongAssignmentsInvariant acc id ih
-    exact List.foldlRecOn arr.toList deleteOne hb hl
+    exact List.foldlRecOn arr.toList deleteOne h.2 hl
 
 theorem deleteOne_preserves_ratUnits {n : Nat} (f : DefaultFormula n) (id : Nat) :
     (deleteOne f id).ratUnits = f.ratUnits := by
   simp only [deleteOne]
-  split <;> simp only
+  grind
 
 theorem readyForRatAdd_delete {n : Nat} (f : DefaultFormula n) (arr : Array Nat) :
     ReadyForRatAdd f → ReadyForRatAdd (delete f arr) := by
   intro h
   constructor
   · rw [delete, ← Array.foldl_toList]
-    have hb : f.ratUnits = #[] := h.1
     have hl (acc : DefaultFormula n) (ih : acc.ratUnits = #[]) (id : Nat) (_id_in_arr : id ∈ arr.toList) :
-      (deleteOne acc id).ratUnits = #[] := by rw [deleteOne_preserves_ratUnits, ih]
-    exact List.foldlRecOn arr.toList deleteOne hb hl
+      (deleteOne acc id).ratUnits = #[] := by grind [deleteOne_preserves_ratUnits]
+    exact List.foldlRecOn arr.toList deleteOne h.1 hl
   · exact readyForRupAdd_delete f arr h.2
 
 theorem deleteOne_subset (f : DefaultFormula n) (id : Nat) (c : DefaultClause n) :
     c ∈ toList (deleteOne f id) → c ∈ toList f := by
   simp only [deleteOne]
   intro h1
-  split at h1 <;> first
-  | exact h1
-  | rw [toList, List.mem_append, List.mem_append, or_assoc] at h1
-    rw [toList, List.mem_append, List.mem_append, or_assoc]
-    rcases h1 with h1 | h1 | h1
-    · apply Or.inl
-      simp only [List.mem_filterMap, id_eq, exists_eq_right] at h1
-      simp only [List.mem_filterMap, id_eq, exists_eq_right]
-      rw [Array.set!, Array.setIfInBounds] at h1
-      split at h1
-      · simp only [Array.toList_set] at h1
-        rcases List.getElem_of_mem h1 with ⟨i, h, h4⟩
-        rw [List.getElem_set] at h4
-        split at h4
-        · simp at h4
-        · rw [← h4]
-          apply List.getElem_mem
-      · exact h1
-    · exact (Or.inr ∘ Or.inl) h1
-    · exact (Or.inr ∘ Or.inr) h1
+  rw [toList] at h1 ⊢
+  split at h1 <;> grind
 
 theorem delete_subset (f : DefaultFormula n) (arr : Array Nat) (c : DefaultClause n) :
     c ∈ toList (delete f arr) → c ∈ toList f := by
   simp only [delete, ← Array.foldl_toList]
-  have hb : c ∈ toList f → c ∈ toList f := id
   have hl (f' : DefaultFormula n) (ih : c ∈ toList f' → c ∈ toList f) (id : Nat) (_ : id ∈ arr.toList) :
-    c ∈ toList (deleteOne f' id) → c ∈ toList f := by intro h; exact ih <| deleteOne_subset f' id c h
-  exact List.foldlRecOn arr.toList deleteOne hb hl
+    c ∈ toList (deleteOne f' id) → c ∈ toList f := by grind [deleteOne_subset]
+  exact List.foldlRecOn arr.toList deleteOne id hl
 
 end DefaultFormula
 

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/RatAddResult.lean

@@ -11,6 +11,8 @@ This module contains the implementation of RAT-based clause adding for the defau
 implementation.
 -/
 
+set_option grind.warning false -- I've only made a partial effort to use grind here so far.
+
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -30,9 +32,7 @@ theorem insertRatUnits_postcondition {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ f.assignments.size = n)
     (units : CNF.Clause (PosFin n)) :
     let assignments := (insertRatUnits f units).fst.assignments
-    have hsize : assignments.size = n := by
-      rw [← hf.2]
-      exact size_assignments_insertRatUnits f units
+    have hsize : assignments.size = n := by grind [size_assignments_insertRatUnits]
     let ratUnits := (insertRatUnits f units).1.ratUnits
     InsertUnitInvariant f.assignments hf.2 ratUnits assignments hsize := by
   simp only [insertRatUnits]
@@ -50,65 +50,15 @@ theorem nodup_insertRatUnits {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ f.assignments.size = n) (units : CNF.Clause (PosFin n)) :
     ∀ i : Fin (f.insertRatUnits units).1.ratUnits.size, ∀ j : Fin (f.insertRatUnits units).1.ratUnits.size,
       i ≠ j → (f.insertRatUnits units).1.ratUnits[i] ≠ (f.insertRatUnits units).1.ratUnits[j] := by
-  intro i j i_ne_j
+  intro i
   rcases hi : (insertRatUnits f units).fst.ratUnits[i] with ⟨li, bi⟩
-  rcases hj : (insertRatUnits f units).fst.ratUnits[j] with ⟨lj, bj⟩
-  intro heq
-  cases heq
   have h := insertRatUnits_postcondition f hf units ⟨li.1, li.2.2⟩
-  simp only [ne_eq, Bool.not_eq_true, exists_and_right] at h
   rcases h with ⟨_, h2⟩ | ⟨k, b, _, _, _, h4⟩ | ⟨k1, k2, li_gt_zero, h1, h2, h3, h4, h5⟩
-  · specialize h2 j
-    rw [hj] at h2
-    contradiction
-  · by_cases i = k
-    · next i_eq_k =>
-      have j_ne_k : j ≠ k := by rw [← i_eq_k]; exact i_ne_j.symm
-      specialize h4 j j_ne_k
-      simp +decide only [hj] at h4
-    · next i_ne_k =>
-      specialize h4 i i_ne_k
-      simp +decide only [hi] at h4
+  · grind
+  · by_cases i = k <;> grind
   · by_cases bi
-    · next bi_eq_true =>
-      by_cases i = k1
-      · next i_eq_k1 =>
-        have j_ne_k1 : j ≠ k1 := by rw [← i_eq_k1]; exact i_ne_j.symm
-        by_cases j = k2
-        · next j_eq_k2 =>
-          rw [← j_eq_k2, hj, bi_eq_true] at h2
-          simp at h2
-        · next j_ne_k2 =>
-          specialize h5 j j_ne_k1 j_ne_k2
-          simp +decide only [hj] at h5
-      · next i_ne_k1 =>
-        by_cases i = k2
-        · next i_eq_k2 =>
-          rw [← i_eq_k2, hi, bi_eq_true] at h2
-          simp at h2
-        · next i_ne_k2 =>
-          specialize h5 i i_ne_k1 i_ne_k2
-          simp only [hi, not_true] at h5
-    · next bi_eq_false =>
-      simp only [Bool.not_eq_true] at bi_eq_false
-      by_cases i = k2
-      · next i_eq_k2 =>
-        have j_ne_k2 : j ≠ k2 := by rw [← i_eq_k2]; exact i_ne_j.symm
-        by_cases j = k1
-        · next j_eq_k1 =>
-          rw [← j_eq_k1, hj, bi_eq_false] at h1
-          simp at h1
-        · next j_ne_k1 =>
-          specialize h5 j j_ne_k1 j_ne_k2
-          simp +decide only [hj] at h5
-      · next i_ne_k2 =>
-        by_cases i = k1
-        · next i_eq_k1 =>
-          rw [← i_eq_k1, hi, bi_eq_false] at h1
-          simp at h1
-        · next i_ne_k1 =>
-          specialize h5 i i_ne_k1 i_ne_k2
-          simp +decide only [hi] at h5
+    · by_cases i = k1 <;> grind
+    · by_cases i = k2 <;> grind
 
 theorem clear_insertRat_base_case {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ f.assignments.size = n) (units : CNF.Clause (PosFin n)) :
@@ -128,7 +78,7 @@ theorem clear_insertRat {n : Nat} (f : DefaultFormula n)
   ext : 1
   · simp only [insertRatUnits]
   · simp only [insertRatUnits]
-  · rw [hf.1]
+  · grind
   · simp only
     let motive := ClearInsertInductionMotive f hf.2 (insertRatUnits f units).1.ratUnits
     have h_base : motive 0 (insertRatUnits f units).1.assignments := clear_insertRat_base_case f hf units
@@ -144,8 +94,8 @@ theorem clear_insertRat {n : Nat} (f : DefaultFormula n)
       specialize h ⟨i, i_lt_n⟩
       rcases h with h | h | h
       · exact h.1
-      · omega
-      · omega
+      · omega -- FIXME why can't `grind` do this?
+      · omega -- FIXME why can't `grind` do this?
 
 theorem formula_performRatCheck {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ f.assignments.size = n) (p : Literal (PosFin n))
@@ -166,7 +116,7 @@ theorem formula_performRatCheck {n : Nat} (f : DefaultFormula n)
       simp only [clauses_performRupCheck, rupUnits_performRupCheck, ratUnits_performRupCheck]
       rw [restoreAssignments_performRupCheck fc fc_assignments_size ratHint.2, ← insertRatUnits_rw,
         clear_insertRat f hf (negate (DefaultClause.delete c p))]
-      split <;> rfl
+      grind
   · rfl
 
 theorem performRatCheck_fold_formula_eq {n : Nat} (f : DefaultFormula n)
@@ -184,6 +134,8 @@ theorem performRatCheck_fold_formula_eq {n : Nat} (f : DefaultFormula n)
   have h_base : motive 0 (f, true) := rfl
   have h_inductive (idx : Fin ratHints.size) (acc : DefaultFormula n × Bool) :
     motive idx.1 acc → motive (idx.1 + 1) (if acc.2 then performRatCheck acc.1 p ratHints[idx] else (acc.1, false)) := by
+    -- FIXME: this causes an internal `grind` error:
+    -- grind [formula_performRatCheck]
     intro ih
     rw [ih]
     split
@@ -199,13 +151,13 @@ theorem ratAdd_result {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) (p
   simp only [Bool.not_eq_true'] at ratAddSuccess
   split at ratAddSuccess
   · split at ratAddSuccess
-    · simp at ratAddSuccess
+    · grind
     · split at ratAddSuccess
-      · simp at ratAddSuccess
+      · grind
       · split at ratAddSuccess
-        · simp at ratAddSuccess
+        · grind
         · split at ratAddSuccess
-          · simp at ratAddSuccess
+          · grind
           · next performRatCheck_fold_success =>
             simp only [Bool.not_eq_false] at performRatCheck_fold_success
             let fc := (insertRupUnits f (negate c)).1
@@ -228,7 +180,7 @@ theorem ratAdd_result {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) (p
               clauses_performRupCheck, rupUnits_performRupCheck, ratUnits_performRupCheck,
               restoreAssignments_performRupCheck fc fc_assignments_size, ← insertRupUnits_rw,
               clear_insertRup f f_readyForRatAdd.2 (negate c), fc, performRupCheck_res]
-  · simp at ratAddSuccess
+  · grind
 
 end DefaultFormula
 

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/RatAddSound.lean

@@ -11,6 +11,8 @@ This module contains the verification of RAT-based clause adding for the default
 implementation.
 -/
 
+set_option grind.warning false -- I've only made a partial effort to use grind here so far.
+
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -51,22 +53,12 @@ theorem entails_of_irrelevant_assignment {n : Nat} {p : (PosFin n) → Bool} {c
     left
     constructor
     · simp [Clause.toList, delete_iff, negl_ne_v, v_in_c_del_l]
-    · split
-      · next heq =>
-        simp only [heq, Literal.negate, ne_eq, Prod.mk.injEq, true_and] at negl_ne_v
-        simp_all
-      · next hne =>
-        exact pv
+    · grind
   · exists v
     right
     constructor
     · simp [Clause.toList, delete_iff, negl_ne_v, v_in_c_del_l]
-    · split
-      · next heq =>
-        simp only [heq, Literal.negate, ne_eq, Prod.mk.injEq, true_and] at negl_ne_v
-        simp_all
-      · next hne =>
-        exact pv
+    · grind
 
 theorem assignmentsInvariant_insertRatUnits {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ AssignmentsInvariant f) (units : CNF.Clause (PosFin n)) :
@@ -90,7 +82,7 @@ theorem assignmentsInvariant_insertRatUnits {n : Nat} (f : DefaultFormula n)
       exact hp
     · specialize hp c <| (Or.inr ∘ Or.inl) cf
       exact hp
-    · simp [hf.1] at cf
+    · grind
   rcases h ⟨i.1, i.2.2⟩ with ⟨h1, h2⟩ | ⟨j, b', i_gt_zero, h1, h2, h3, h4⟩ | ⟨j1, j2, i_gt_zero, h1, h2, _, _, _⟩
   · rw [h1] at hb
     exact hf.2.2 i b hb p pf
@@ -222,35 +214,25 @@ theorem sat_of_confirmRupHint_of_insertRat_fold {n : Nat} (f : DefaultFormula n)
       rcases v_in_neg_c with ⟨v', ⟨_, v'_eq_v⟩ | ⟨v'_in_c, v'_eq_v⟩⟩
       · simp [Literal.negate] at v'_eq_v
       · simp only [Literal.negate, Bool.not_true, Prod.mk.injEq, and_true] at v'_eq_v
-        simp only [(· ⊨ ·), Clause.eval, List.any_eq_true, decide_eq_true_eq, Prod.exists,
-          Bool.exists_bool, ← unsat_c_eq, not_exists, not_or, not_and] at p_unsat_c
-        specialize p_unsat_c v
-        rw [Clause.unit_eq] at p_unsat_c
-        simp only [List.mem_singleton, forall_const, Prod.mk.injEq, and_false, false_implies, and_true] at p_unsat_c
-        simp only [(· ⊨ ·), Bool.not_eq_false] at p_unsat_c
+        simp only [(· ⊨ ·), Clause.eval] at p_unsat_c
         specialize pc v
         rw [v'_eq_v] at v'_in_c
         have pv := pc.2 v'_in_c
-        simp only [(· ⊨ ·), Bool.not_eq_true] at pv
-        simp only [p_unsat_c] at pv
-        cases pv
+        grind
     · simp only [negate_eq, List.mem_map, Prod.exists, Bool.exists_bool] at v_in_neg_c
       rcases v_in_neg_c with ⟨v', ⟨v'_in_c, v'_eq_v⟩ | ⟨_, v'_eq_v⟩⟩
       · simp only [Literal.negate, Bool.not_false, Prod.mk.injEq, and_true] at v'_eq_v
-        simp only [(· ⊨ ·), Clause.eval, List.any_eq_true, decide_eq_true_eq, Prod.exists,
-          Bool.exists_bool, ← unsat_c_eq, not_exists, not_or, not_and] at p_unsat_c
+        simp only [(· ⊨ ·), Clause.eval, List.any_eq_true, Prod.exists, ← unsat_c_eq,
+          not_exists] at p_unsat_c
         specialize p_unsat_c v
         rw [Clause.unit_eq] at p_unsat_c
-        simp only [List.mem_singleton, forall_const, Prod.mk.injEq, and_false, false_implies, and_true] at p_unsat_c
+        simp only [List.mem_singleton] at p_unsat_c
         specialize pc v
         rw [v'_eq_v] at v'_in_c
         have pv := pc.1 v'_in_c
-        simp only [(· ⊨ ·), Bool.not_eq_true] at pv
-        simp only [p_unsat_c] at pv
-        cases pv
-      · simp [Literal.negate] at v'_eq_v
-    · simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq] at pf
-      exact p_unsat_c <| pf unsat_c unsat_c_in_f
+        grind
+      · grind
+    · grind [formulaEntails_def]
 
 theorem sat_of_insertRat {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ AssignmentsInvariant f) (c : DefaultClause n) (p : PosFin n → Bool)
@@ -389,28 +371,15 @@ theorem assignmentsInvariant_performRupCheck_of_assignmentsInvariant {n : Nat} (
       simp only [f_AssignmentsInvariant.1, in_bounds_motive]
     have in_bounds_inductive (idx : Fin rupHints.size) (acc : Array Assignment × CNF.Clause (PosFin n) × Bool × Bool)
       (ih : in_bounds_motive idx.1 acc) : in_bounds_motive (idx.1 + 1) (confirmRupHint f.clauses acc rupHints[idx]) := by
-      have h := size_assignemnts_confirmRupHint f.clauses acc.1 acc.2.1 acc.2.2.1 acc.2.2.2 rupHints[idx]
+      have h := size_assignments_confirmRupHint f.clauses acc.1 acc.2.1 acc.2.2.1 acc.2.2.2 rupHints[idx]
       have : (acc.fst, acc.snd.fst, acc.snd.snd.fst, acc.snd.snd.snd) = acc := rfl
       simp [this] at *
-      omega
+      omega -- FIXME `grind` fails here with an internal error
+      -- reported as https://github.com/leanprover/lean4/pull/8608
     rw [Array.foldl_induction in_bounds_motive in_bounds_base in_bounds_inductive]
     exact i.2.2
-  simp only [getElem!_def, i_in_bounds, Array.getElem?_eq_getElem] at h1
-  simp only [( · ⊨ ·), Entails.eval.eq_1]
-  by_cases hb : b
-  · rw [hb]
-    rw [hb] at h
-    by_cases pi : p i
-    · exact pi
-    · simp only at pi
-      simp [pi, h] at h1
-  · simp only [Bool.not_eq_true] at hb
-    rw [hb]
-    rw [hb] at h
-    by_cases pi : p i
-    · simp [pi, h] at h1
-    · simp at pi
-      exact pi
+  simp only [( · ⊨ ·)]
+  grind [cases Bool]
 
 theorem c_without_negPivot_of_performRatCheck_success {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ AssignmentsInvariant f) (negPivot : Literal (PosFin n))
@@ -442,22 +411,16 @@ theorem existsRatHint_of_ratHintsExhaustive {n : Nat} (f : DefaultFormula n)
   rw [List.mem_iff_getElem] at c'_in_f
   rcases c'_in_f with ⟨i, hi, c'_in_f⟩
   simp only [ratHintsExhaustive, getRatClauseIndices] at ratHintsExhaustive_eq_true
-  have i_in_bounds : i < Array.size (Array.range (Array.size f.clauses)) := by
-    rw [Array.size_range]
-    simpa using hi
-  have i_lt_f_clauses_size : i < f.clauses.size := by
-    rw [Array.size_range] at i_in_bounds
-    exact i_in_bounds
+  have i_in_bounds : i < Array.size (Array.range (Array.size f.clauses)) := by grind
+  have i_lt_f_clauses_size : i < f.clauses.size := by grind
   have h : i ∈ (ratHints.map (fun x => x.1)).toList := by
     rw [← of_decide_eq_true ratHintsExhaustive_eq_true]
-    have i_eq_range_i : i = (Array.range f.clauses.size)[i]'i_in_bounds := by
-      rw [Array.getElem_range]
+    have i_eq_range_i : i = (Array.range f.clauses.size)[i]'i_in_bounds := by grind
     rw [i_eq_range_i]
     rw [Array.mem_toList_iff]
     rw [Array.mem_filter]
     constructor
-    · rw [← Array.mem_toList_iff]
-      apply Array.getElem_mem_toList
+    · grind
     · rw [Array.getElem_toList] at c'_in_f
       simp only [Array.getElem_range, getElem!_def, i_lt_f_clauses_size, Array.getElem?_eq_getElem,
         c'_in_f, contains_iff]
@@ -465,14 +428,9 @@ theorem existsRatHint_of_ratHintsExhaustive {n : Nat} (f : DefaultFormula n)
   rcases List.get_of_mem h with ⟨j, h'⟩
   have j_in_bounds : j < ratHints.size := by
     have j_property := j.2
-    simp only [Array.toList_map, List.length_map] at j_property
-    dsimp at *
-    omega
-  simp only [List.get_eq_getElem, Array.toList_map, Array.length_toList, List.getElem_map] at h'
-  rw [Array.getElem_toList] at h'
-  rw [Array.getElem_toList] at c'_in_f
+    grind
   exists ⟨j.1, j_in_bounds⟩
-  simp [getElem!_def, h', i_lt_f_clauses_size, dite_true, c'_in_f]
+  grind
 
 theorem performRatCheck_success_of_performRatCheck_fold_success {n : Nat} (f : DefaultFormula n)
     (hf : f.ratUnits = #[] ∧ f.assignments.size = n) (p : Literal (PosFin n))
@@ -496,15 +454,16 @@ theorem performRatCheck_success_of_performRatCheck_fold_success {n : Nat} (f : D
     motive (idx.1 + 1) (fold_fn acc ratHints[idx]) := by
     constructor
     · simp only [Fin.getElem_fin, fold_fn_def, ih.1]
+      -- grind [formula_performRatCheck] -- FIXME: internal grind error
       split
-      · rw [formula_performRatCheck]
-        exact hf
+      · grind [formula_performRatCheck]
       · rfl
     · intro h i
       rw [fold_fn_def] at h
       split at h
       · next acc_eq_true =>
         have i_lt_or_eq_idx : i.1 < idx.1 ∨ i.1 = idx.1 := by
+          -- grind -- FIXME: internal grind error
           omega
         rcases i_lt_or_eq_idx with i_lt_idx | i_eq_idx
         · exact ih.2 acc_eq_true ⟨i.1, i_lt_idx⟩

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/RupAddResult.lean

@@ -11,6 +11,8 @@ This module contains the implementation of RUP-based clause adding for the defau
 implementation.
 -/
 
+set_option grind.warning false -- I've only made a partial effort to use grind here so far.
+
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -24,19 +26,12 @@ theorem size_insertUnit {n : Nat} (units : Array (Literal (PosFin n)))
     (assignments : Array Assignment) (b : Bool) (l : Literal (PosFin n)) :
     (insertUnit (units, assignments, b) l).2.1.size = assignments.size := by
   simp only [insertUnit]
-  split <;> simp
+  grind
 
 theorem size_insertUnit_fold :
     ∀ unitsAcc : Array (Literal (PosFin n)), ∀ assignments : Array Assignment, ∀ b : Bool,
       Array.size (List.foldl insertUnit (unitsAcc, assignments, b) units).2.1 = assignments.size := by
-  induction units
-  · simp only [List.foldl, forall_const]
-  · next hd tl ih =>
-    intro unitsAcc assignments b
-    simp only [List.foldl]
-    let hd_res := insertUnit (unitsAcc, assignments, b) hd
-    specialize ih hd_res.1 hd_res.2.1 hd_res.2.2
-    rw [ih, size_insertUnit]
+  induction units with grind [size_insertUnit]
 
 theorem size_assignments_insertRupUnits {n : Nat} (f : DefaultFormula n)
     (units : CNF.Clause (PosFin n)) :
@@ -104,9 +99,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
         apply Or.inr ∘ Or.inl
         have units_size_lt_updatedUnits_size : units.size < (insertUnit (units, assignments, foundContradiction) l).1.size := by
           simp only [insertUnit]
-          split
-          · contradiction
-          · simp only [Array.size_push, Nat.lt_succ_self]
+          grind
         let mostRecentUnitIdx : Fin (insertUnit (units, assignments, foundContradiction) l).1.size :=
           ⟨units.size, units_size_lt_updatedUnits_size⟩
         have i_gt_zero : i.1 > 0 := by rw [i_eq_l]; exact l.1.2.1
@@ -115,20 +108,14 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
         constructor
         · rfl
         · constructor
-          · rw [Array.getElem_modify_self]
-            simp only [← i_eq_l, h1]
+          · grind
           · constructor
-            · simp only [getElem!_def, l_in_bounds, Array.getElem?_eq_getElem,
-                Bool.not_eq_true] at h3
-              simp only [← i_eq_l, ← h1]
-              simp only [i_eq_l, h3]
+            · grind
             · intro k hk
               have k_in_bounds : k.1 < units.size := by
                 apply Nat.lt_of_le_of_ne
-                · apply Nat.le_of_lt_succ
-                  have k_property := k.2
-                  simp only [insertUnit, h3, ite_false, Array.size_push, reduceCtorEq] at k_property
-                  exact k_property
+                · have k_property := k.2
+                  grind
                 · intro h
                   simp only [← h, not_true, mostRecentUnitIdx] at hk
               rw [Array.getElem_push_lt k_in_bounds]
@@ -145,8 +132,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
           by_cases h : j.val < Array.size units
           · simp only [h, dite_true]
             exact h2 ⟨j.1, h⟩
-          · simp only [h, dite_false]
-            exact Ne.symm i_ne_l
+          · grind
   · by_cases hasAssignment l.2 assignments[l.1.1]!
     · next h5 =>
       apply Or.inr ∘ Or.inl
@@ -159,8 +145,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
       intro k k_ne_j
       have k_size : k.1 < units.size := by
         have k_property := k.2
-        simp only [insertUnit, h5, ite_true] at k_property
-        exact k_property
+        grind
       have k_ne_j : { val := k.val, isLt := k_size } ≠ j := by
         intro k_eq_j
         simp only [← Fin.val_eq_of_eq k_eq_j, not_true] at k_ne_j
@@ -171,9 +156,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
         apply Or.inr ∘ Or.inr
         have units_size_lt_updatedUnits_size : units.size < (insertUnit (units, assignments, foundContradiction) l).1.size := by
           simp only [insertUnit]
-          split
-          · contradiction
-          · simp only [Array.size_push, Nat.lt_succ_self]
+          grind
         let mostRecentUnitIdx : Fin (insertUnit (units, assignments, foundContradiction) l).1.size :=
           ⟨units.size, units_size_lt_updatedUnits_size⟩
         have j_lt_updatedUnits_size : j.1 < (insertUnit (units, assignments, foundContradiction) l).1.size := by
@@ -275,7 +258,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
         constructor
         · rw [Array.getElem_push_lt, h1]
         · constructor
-          · rw [Array.getElem_modify_of_ne (Ne.symm i_ne_l), h2]
+          · grind
           · constructor
             · exact h3
             · intro k k_ne_j
@@ -319,7 +302,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
               simp only [i_eq_l]
               rw [Array.getElem_modify_self]
               simp only [← i_eq_l, h3, add_both_eq_both]
-            · next i_ne_l => rw [Array.getElem_modify_of_ne (Ne.symm i_ne_l), h3]
+            · next i_ne_l => grind
         · constructor
           · exact h4
           · intro k k_ne_j1 k_ne_j2
@@ -340,21 +323,15 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
             · next k_not_lt_units_size =>
               split
               · next h =>
-                exfalso
                 have k_property := k.2
-                simp only [insertUnit, h, ite_true] at k_property
-                exact k_not_lt_units_size k_property
+                grind
               · next h =>
                 simp only
                 have k_eq_units_size : k.1 = units.size := by
                   have k_property := k.2
-                  simp only [insertUnit, h, ite_false, Array.size_push, reduceCtorEq] at k_property
-                  rcases Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ k_property with k_lt_units_size | k_eq_units_size
-                  · exfalso; exact k_not_lt_units_size k_lt_units_size
-                  · exact k_eq_units_size
-                simp only [k_eq_units_size, Array.getElem_push_eq, ne_eq]
-                intro l_eq_i
-                simp [getElem!_def, l_eq_i, i_in_bounds, h3, has_both] at h
+                  grind
+                simp only [k_eq_units_size, Array.getElem_push_eq]
+                grind [has_both]
 
 theorem insertUnitInvariant_insertUnit_fold {n : Nat} (assignments0 : Array Assignment)
     (assignments0_size : assignments0.size = n) (rupUnits : Array (Literal (PosFin n)))
@@ -408,63 +385,13 @@ theorem nodup_insertRupUnits {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd
   have h := insertUnitInvariant_insertRupUnits f f_readyForRupAdd units ⟨li.1, li.2.2⟩
   simp only [ne_eq, Bool.not_eq_true, exists_and_right] at h
   rcases h with ⟨_, h2⟩ | ⟨k, b, _, _, _, h4⟩ | ⟨k1, k2, li_gt_zero, h1, h2, h3, h4, h5⟩
-  · specialize h2 j
-    rw [hj, li_eq_lj] at h2
-    simp only [not_true] at h2
-  · by_cases i = k
-    · next i_eq_k =>
-      have j_ne_k : j ≠ k := by rw [← i_eq_k]; exact i_ne_j.symm
-      specialize h4 j j_ne_k
-      rw [hj, li_eq_lj] at h4
-      simp +decide only at h4
-    · next i_ne_k =>
-      specialize h4 i i_ne_k
-      rw [hi] at h4
-      simp only [not_true] at h4
+  · grind
+  · by_cases i = k <;> grind
   · by_cases bi
-    · next bi_eq_true =>
-      by_cases i = k1
-      · next i_eq_k1 =>
-        have j_ne_k1 : j ≠ k1 := by rw [← i_eq_k1]; exact i_ne_j.symm
-        by_cases j = k2
-        · next j_eq_k2 =>
-          rw [← j_eq_k2, hj, ← bi_eq_bj, bi_eq_true] at h2
-          simp at h2
-        · next j_ne_k2 =>
-          specialize h5 j j_ne_k1 j_ne_k2
-          rw [hj, li_eq_lj] at h5
-          simp +decide only at h5
-      · next i_ne_k1 =>
-        by_cases i = k2
-        · next i_eq_k2 =>
-          rw [← i_eq_k2, hi, bi_eq_true] at h2
-          simp at h2
-        · next i_ne_k2 =>
-          specialize h5 i i_ne_k1 i_ne_k2
-          rw [hi] at h5
-          simp only [not_true] at h5
-    · next bi_eq_false =>
-      simp only [Bool.not_eq_true] at bi_eq_false
-      by_cases i = k2
-      · next i_eq_k2 =>
-        have j_ne_k2 : j ≠ k2 := by rw [← i_eq_k2]; exact i_ne_j.symm
-        by_cases j = k1
-        · next j_eq_k1 =>
-          rw [← j_eq_k1, hj, ← bi_eq_bj, bi_eq_false] at h1
-          simp at h1
-        · next j_ne_k1 =>
-          specialize h5 j j_ne_k1 j_ne_k2
-          rw [hj, li_eq_lj] at h5
-          simp +decide only at h5
-      · next i_ne_k2 =>
-        by_cases i = k1
-        · next i_eq_k1 =>
-          rw [← i_eq_k1, hi, bi_eq_false] at h1
-          simp at h1
-        · next i_ne_k1 =>
-          specialize h5 i i_ne_k1 i_ne_k2
-          rw [hi] at h5
-          simp only [not_true] at h5
+    · by_cases i = k1
+      · by_cases j = k2 <;> grind
+      · by_cases i = k2 <;> grind
+    · by_cases i = k2 <;> grind
 
 theorem size_clearUnit (assignments : Array Assignment) (l : Literal (PosFin n)) :
     (clearUnit assignments l).size = assignments.size := by
@@ -534,9 +461,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
         rw [hsize]
         exact i.2
       have h := Array.getElem_modify_of_ne ih2 (removeAssignment units[idx.val].2) (by simpa using i_in_bounds)
-      simp only [Fin.getElem_fin] at h
-      rw [h]
-      exact ih1
+      grind
     · intro j j_ge_idx_add_one
       exact ih2 j (Nat.le_of_succ_le j_ge_idx_add_one)
   · by_cases idx = j
@@ -547,36 +472,25 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
         rw [Array.getElem_modify_self, ih2, remove_add_cancel]
         exact ih3
       · intro k k_ge_idx_add_one
-        have k_ge_idx : k.val ≥ idx.val := Nat.le_of_succ_le k_ge_idx_add_one
-        have k_ne_j : k ≠ j := by
-          intro k_eq_j
-          rw [k_eq_j, idx_eq_j] at k_ge_idx_add_one
-          exact Nat.not_succ_le_self j.val k_ge_idx_add_one
+        have k_ge_idx : k.val ≥ idx.val := by grind
+        have k_ne_j : k ≠ j := by grind
         exact ih4 k k_ge_idx k_ne_j
     · next idx_ne_j =>
       refine Or.inr <| Or.inl <| ⟨j,b,i_gt_zero,?_⟩
       constructor
-      · rw [← Nat.succ_eq_add_one]
-        apply Nat.succ_le_of_lt ∘ Nat.lt_of_le_of_ne j_ge_idx
-        intro idx_eq_j
-        exact idx_ne_j (Fin.eq_of_val_eq idx_eq_j)
+      · grind
       · constructor
         · exact ih1
         · constructor
           · simp only [clearUnit, Array.getInternal_eq_getElem]
-            specialize ih4 idx (Nat.le_refl idx.1) idx_ne_j
-            rw [Array.getElem_modify_of_ne ih4]
-            exact ih2
+            grind
           · constructor
             · exact ih3
             · intro k k_ge_idx_add_one k_ne_j
               exact ih4 k (Nat.le_of_succ_le k_ge_idx_add_one) k_ne_j
   · by_cases idx = j1
     · next idx_eq_j1 =>
-      have idx_ne_j2 : idx ≠ j2 := by
-        rw [idx_eq_j1]
-        intro j1_eq_j2
-        simp [j1_eq_j2, ih2] at ih1
+      have idx_ne_j2 : idx ≠ j2 := by grind
       refine Or.inr <| Or.inl <| ⟨j2, false, i_gt_zero, ?_⟩
       constructor
       · apply Nat.le_of_lt_succ
@@ -597,11 +511,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
               intro h1
               by_cases units[k.1].2
               · next h2 =>
-                have k_ne_j1 : k ≠ j1 := by
-                  rw [← idx_eq_j1]
-                  intro k_eq_idx
-                  rw [k_eq_idx] at k_ge_idx_add_one
-                  exact Nat.lt_irrefl idx.1 <| Nat.lt_of_succ_le k_ge_idx_add_one
+                have k_ne_j1 : k ≠ j1 := by grind
                 have h3 := units_nodup k j1 k_ne_j1
                 simp only [Fin.getElem_fin, ih1, ← h1, ← h2, ne_eq] at h3
                 exact h3 rfl
@@ -638,11 +548,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
                   simp only [Fin.getElem_fin, ih1, ← h1, ← h2, ne_eq] at h3
                   exact h3 rfl
                 · next h2 =>
-                  have k_ne_j2 : k ≠ j2 := by
-                    rw [← idx_eq_j2]
-                    intro k_eq_idx
-                    rw [k_eq_idx] at k_ge_idx_add_one
-                    exact Nat.lt_irrefl idx.1 <| Nat.lt_of_succ_le k_ge_idx_add_one
+                  have k_ne_j2 : k ≠ j2 := by grind
                   have h3 := units_nodup k j2 k_ne_j2
                   simp only [Bool.not_eq_true] at h2
                   simp only [Fin.getElem_fin, ih2, ← h1, ← h2, ne_eq] at h3
@@ -650,17 +556,9 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
       · next idx_ne_j2 =>
         refine Or.inr <| Or.inr <| ⟨j1, j2,i_gt_zero, ?_⟩
         constructor
-        · apply Nat.le_of_lt_succ
-          rw [← Nat.succ_eq_add_one]
-          apply Nat.succ_lt_succ ∘ Nat.lt_of_le_of_ne j1_ge_idx
-          intro idx_eq_j1
-          exact idx_ne_j1 (Fin.eq_of_val_eq idx_eq_j1)
+        · grind
         · constructor
-          · apply Nat.le_of_lt_succ
-            rw [← Nat.succ_eq_add_one]
-            apply Nat.succ_lt_succ ∘ Nat.lt_of_le_of_ne j2_ge_idx
-            intro idx_eq_j2
-            exact idx_ne_j2 (Fin.eq_of_val_eq idx_eq_j2)
+          · grind
           · constructor
             · simp only [Fin.getElem_fin]
               exact ih1
@@ -669,20 +567,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
                 exact ih2
               · constructor
                 · simp only [clearUnit, Array.getInternal_eq_getElem]
-                  have idx_res_ne_i : units[idx.1].1.1 ≠ i.1 := by
-                    intro h1
-                    by_cases units[idx.1].2
-                    · next h2 =>
-                      have h3 := units_nodup idx j1 idx_ne_j1
-                      simp only [Fin.getElem_fin, ih1, ← h1, ← h2, ne_eq] at h3
-                      exact h3 rfl
-                    · next h2 =>
-                      have h3 := units_nodup idx j2 idx_ne_j2
-                      simp only [Bool.not_eq_true] at h2
-                      simp only [Fin.getElem_fin, ih2, ← h1, ← h2, ne_eq] at h3
-                      exact h3 rfl
-                  rw [Array.getElem_modify_of_ne idx_res_ne_i]
-                  exact ih3
+                  grind
                 · constructor
                   · exact ih4
                   · intro k k_ge_idx_add_one
@@ -711,7 +596,7 @@ theorem clear_insertRup {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd : Rea
       specialize h ⟨i, i_lt_n⟩
       rcases h with ⟨h,_⟩
       · exact h
-      · omega
+      · omega -- FIXME: `grind` doesn't work here
 
 theorem clauses_performRupCheck {n : Nat} (f : DefaultFormula n) (rupHints : Array Nat) :
     (performRupCheck f rupHints).1.clauses = f.clauses := by
@@ -725,14 +610,11 @@ theorem ratUnits_performRupCheck {n : Nat} (f : DefaultFormula n) (rupHints : Ar
     (performRupCheck f rupHints).1.ratUnits = f.ratUnits := by
   simp only [performRupCheck]
 
-theorem size_assignemnts_confirmRupHint {n : Nat} (clauses : Array (Option (DefaultClause n)))
+theorem size_assignments_confirmRupHint {n : Nat} (clauses : Array (Option (DefaultClause n)))
     (assignments : Array Assignment) (derivedLits : CNF.Clause (PosFin n)) (b1 b2 : Bool) (id : Nat) :
     (confirmRupHint clauses (assignments, derivedLits, b1, b2) id).1.size = assignments.size := by
   simp only [confirmRupHint]
-  repeat first
-    | rfl
-    | simp only [Array.size_modify]
-    | split
+  grind
 
 theorem size_assignments_performRupCheck {n : Nat} (f : DefaultFormula n) (rupHints : Array Nat) :
     (performRupCheck f rupHints).1.assignments.size = f.assignments.size := by
@@ -741,11 +623,11 @@ theorem size_assignments_performRupCheck {n : Nat} (f : DefaultFormula n) (rupHi
   have hb : (f.assignments, ([] : CNF.Clause (PosFin n)), false, false).1.size = f.assignments.size := rfl
   have hl (acc : Array Assignment × CNF.Clause (PosFin n) × Bool × Bool) (hsize : acc.1.size = f.assignments.size)
     (id : Nat) (_ : id ∈ rupHints.toList) : (confirmRupHint f.clauses acc id).1.size = f.assignments.size := by
-    have h := size_assignemnts_confirmRupHint f.clauses acc.1 acc.2.1 acc.2.2.1 acc.2.2.2 id
+    have h := size_assignments_confirmRupHint f.clauses acc.1 acc.2.1 acc.2.2.1 acc.2.2.2 id
     rw [h, hsize]
   exact List.foldlRecOn rupHints.toList (confirmRupHint f.clauses) hb hl
 
-def DerivedLitsInvariant {n : Nat} (f : DefaultFormula n)
+@[local grind] def DerivedLitsInvariant {n : Nat} (f : DefaultFormula n)
     (fassignments_size : f.assignments.size = n) (assignments : Array Assignment)
     (assignments_size : assignments.size = n) (derivedLits : CNF.Clause (PosFin n)) :
     Prop :=
@@ -789,10 +671,7 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
       · constructor
         · simp only [l_eq_i, Array.getElem_modify_self, List.get, h1]
         · constructor
-          · simp only [List.get, Bool.not_eq_true]
-            simp only [getElem!_def, l_in_bounds, Array.getElem?_eq_getElem, Bool.not_eq_true] at h
-            simp only [l_eq_i, h1] at h
-            exact h
+          · grind
           · intro k k_ne_zero
             have k_eq_succ : ∃ k' : Nat, ∃ k'_succ_in_bounds : k' + 1 < (l :: acc.2.1).length, k = ⟨k' + 1, k'_succ_in_bounds⟩ := by
               have k_val_ne_zero : k.1 ≠ 0 := by
@@ -809,36 +688,18 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
               exact k_eq_k'_succ
             rcases k_eq_succ with ⟨k', k'_succ_in_bounds, k_eq_succ⟩
             rw [k_eq_succ, List.get_cons_succ]
-            have k'_in_bounds : k' < acc.2.1.length := by
-              simp only [List.length_cons, Nat.succ_eq_add_one] at k'_succ_in_bounds
-              exact Nat.lt_of_succ_lt_succ k'_succ_in_bounds
-            exact h2 (acc.2.1.get ⟨k', k'_in_bounds⟩) <| List.get_mem acc.snd.fst ⟨k', k'_in_bounds⟩
-    · next l_ne_i =>
-      apply Or.inl
-      constructor
-      · rw [Array.getElem_modify_of_ne l_ne_i]
-        exact h1
-      · intro l' l'_in_list
-        simp only [List.find?, List.mem_cons] at l'_in_list
-        rcases l'_in_list with l'_eq_l | l'_in_acc
-        · rw [l'_eq_l]
-          exact l_ne_i
-        · exact h2 l' l'_in_acc
+            have k'_in_bounds : k' < acc.2.1.length := by grind
+            exact h2 (acc.2.1.get ⟨k', k'_in_bounds⟩) (by grind)
+    · next l_ne_i => grind
   · let l' := acc.2.1.get j
-    have zero_in_bounds : 0 < (l :: acc.2.1).length := by
-      simp only [List.length_cons]
-      exact Nat.zero_lt_succ (List.length acc.snd.fst)
+    have zero_in_bounds : 0 < (l :: acc.2.1).length := by grind
     have j_succ_in_bounds : j.1 + 1 < (l :: acc.2.1).length := by
       simp only [List.length_cons, Nat.succ_eq_add_one]
       exact Nat.succ_lt_succ j.2
     by_cases l.1.1 = i.1
     · next l_eq_i =>
       apply Or.inr ∘ Or.inr
-      have l_ne_l' : l.2 ≠ l'.2 := by
-        intro l_eq_l'
-        rw [l_eq_i] at h
-        simp only [l'] at l_eq_l'
-        simp [getElem!_def, i_in_bounds, h1, l_eq_l', has_add] at h
+      have l_ne_l' : l.2 ≠ l'.2 := by grind [has_add]
       by_cases l.2
       · next l_eq_true =>
         rw [l_eq_true] at l_ne_l'
@@ -846,11 +707,9 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
         apply Exists.intro ⟨0, zero_in_bounds⟩
         apply Exists.intro ⟨j.1 + 1, j_succ_in_bounds⟩
         constructor
-        · simp only [List.get]
-          exact l_eq_i
+        · grind
         · constructor
-          · simp only [List.get, Nat.add_eq, Nat.add_zero]
-            exact j_eq_i
+          · grind
           · simp only [List.get, Nat.add_eq, Nat.add_zero, List.length_cons, ne_eq]
             apply And.intro l_eq_true ∘ And.intro l'_eq_false
             constructor
@@ -879,27 +738,18 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
                 rcases k_eq_succ with ⟨k', k'_succ_in_bounds, k_eq_succ⟩
                 rw [k_eq_succ]
                 simp only [List.get, Nat.add_eq, Nat.add_zero, ne_eq]
-                have k'_in_bounds : k' < acc.2.1.length := by
-                  simp only [List.length_cons, Nat.succ_eq_add_one] at k'_succ_in_bounds
-                  exact Nat.lt_of_succ_lt_succ k'_succ_in_bounds
-                have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by
-                  simp only [k_eq_succ, List.length_cons, Fin.mk.injEq, Nat.succ.injEq] at k_ne_j_succ
-                  exact Fin.ne_of_val_ne k_ne_j_succ
+                have k'_in_bounds : k' < acc.2.1.length := by grind
+                have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by grind
                 exact h3 ⟨k', k'_in_bounds⟩ k'_ne_j
       · next l_eq_false =>
         simp only [Bool.not_eq_true] at l_eq_false
         rw [l_eq_false] at l_ne_l'
-        have l'_eq_true : l'.2 = true := by
-          have l'_ne_false : l'.2 ≠ false := Ne.symm l_ne_l'
-          simp only [ne_eq, Bool.not_eq_false] at l'_ne_false
-          exact l'_ne_false
+        have l'_eq_true : l'.2 = true := by grind
         refine ⟨⟨j.1 + 1, j_succ_in_bounds⟩, ⟨0, zero_in_bounds⟩, ?_⟩
         constructor
-        · simp only [List.get, Nat.add_eq, Nat.add_zero]
-          exact j_eq_i
+        · grind
         · constructor
-          · simp only [List.get]
-            exact l_eq_i
+          · grind
           · simp only [List.get, Nat.add_eq, Nat.add_zero, List.length_cons, ne_eq]
             apply And.intro l'_eq_true ∘ And.intro l_eq_false
             constructor
@@ -928,12 +778,8 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
                 rcases k_eq_succ with ⟨k', k'_succ_in_bounds, k_eq_succ⟩
                 rw [k_eq_succ]
                 simp only [List.get, Nat.add_eq, Nat.add_zero, ne_eq]
-                have k'_in_bounds : k' < acc.2.1.length := by
-                  simp only [List.length_cons, Nat.succ_eq_add_one] at k'_succ_in_bounds
-                  exact Nat.lt_of_succ_lt_succ k'_succ_in_bounds
-                have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by
-                  simp only [k_eq_succ, List.length_cons, Fin.mk.injEq, Nat.succ.injEq] at k_ne_j_succ
-                  exact Fin.ne_of_val_ne k_ne_j_succ
+                have k'_in_bounds : k' < acc.2.1.length := by grind
+                have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by grind
                 exact h3 ⟨k', k'_in_bounds⟩ k'_ne_j
     · next l_ne_i =>
       apply Or.inr ∘ Or.inl ∘ Exists.intro ⟨j.1 + 1, j_succ_in_bounds⟩
@@ -941,8 +787,7 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
       constructor
       · exact j_eq_i
       · constructor
-        · rw [Array.getElem_modify_of_ne l_ne_i]
-          exact h1
+        · grind
         · apply And.intro h2
           intro k k_ne_j_succ
           by_cases k.1 = 0
@@ -955,9 +800,7 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
             exact l_ne_i
           · next k_ne_zero =>
             have k_eq_succ : ∃ k' : Nat, ∃ k'_succ_in_bounds : k' + 1 < (l :: acc.2.1).length, k = ⟨k' + 1, k'_succ_in_bounds⟩ := by
-              have k_val_ne_zero : k.1 ≠ 0 := by
-                intro k_eq_zero
-                simp only [List.length_cons, ← k_eq_zero, ne_eq, not_true] at k_ne_zero
+              have k_val_ne_zero : k.1 ≠ 0 := by grind
               rcases Nat.exists_eq_succ_of_ne_zero k_val_ne_zero with ⟨k', k_eq_k'_succ⟩
               rw [Nat.succ_eq_add_one] at k_eq_k'_succ
               have k'_succ_in_bounds : k' + 1 < (l :: acc.2.1).length := by rw [← k_eq_k'_succ]; exact k.2
@@ -967,13 +810,8 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
             rcases k_eq_succ with ⟨k', k'_succ_in_bounds, k_eq_succ⟩
             rw [k_eq_succ]
             simp only [List.get, Nat.add_eq, Nat.add_zero, ne_eq]
-            have k'_in_bounds : k' < acc.2.1.length := by
-              simp only [List.length_cons, Nat.succ_eq_add_one] at k'_succ_in_bounds
-              exact Nat.lt_of_succ_lt_succ k'_succ_in_bounds
-            have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by
-              simp only [List.length_cons] at k_eq_succ
-              simp only [List.length_cons, k_eq_succ, ne_eq, Fin.mk.injEq, Nat.succ.injEq] at k_ne_j_succ
-              exact Fin.ne_of_val_ne k_ne_j_succ
+            have k'_in_bounds : k' < acc.2.1.length := by grind
+            have k'_ne_j : ⟨k', k'_in_bounds⟩ ≠ j := by grind
             exact h3 ⟨k', k'_in_bounds⟩ k'_ne_j
   · have j1_succ_in_bounds : j1.1 + 1 < (l :: acc.2.1).length := by
       simp only [List.length_cons, Nat.succ_eq_add_one]
@@ -993,18 +831,13 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
       all_goals
         simp +decide [getElem!_def, l_eq_i, i_in_bounds, h1] at h
     constructor
-    · rw [Array.getElem_modify_of_ne l_ne_i]
-      exact h1
+    · grind
     · constructor
       · exact h2
       · intro k k_ne_j1_succ k_ne_j2_succ
-        have zero_in_bounds : 0 < (l :: acc.2.1).length := by
-          simp only [List.length_cons]
-          exact Nat.zero_lt_succ (List.length acc.snd.fst)
+        have zero_in_bounds : 0 < (l :: acc.2.1).length := by grind
         by_cases k = ⟨0, zero_in_bounds⟩
-        · next k_eq_zero =>
-          simp only [k_eq_zero, List.length_cons, List.get, ne_eq]
-          exact l_ne_i
+        · next k_eq_zero => grind
         · next k_ne_zero =>
           have k_eq_succ : ∃ k' : Nat, ∃ k'_succ_in_bounds : k' + 1 < (l :: acc.2.1).length, k = ⟨k' + 1, k'_succ_in_bounds⟩ := by
             have k_val_ne_zero : k.1 ≠ 0 := by
@@ -1019,15 +852,9 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
           rcases k_eq_succ with ⟨k', k'_succ_in_bounds, k_eq_succ⟩
           rw [k_eq_succ]
           simp only [List.get, Nat.add_eq, Nat.add_zero, ne_eq]
-          have k'_in_bounds : k' < acc.2.1.length := by
-            simp only [List.length_cons, Nat.succ_eq_add_one] at k'_succ_in_bounds
-            exact Nat.lt_of_succ_lt_succ k'_succ_in_bounds
-          have k'_ne_j1 : ⟨k', k'_in_bounds⟩ ≠ j1 := by
-            simp only [List.length_cons, k_eq_succ, ne_eq, Fin.mk.injEq, Nat.succ.injEq, j1_succ] at k_ne_j1_succ
-            exact Fin.ne_of_val_ne k_ne_j1_succ
-          have k'_ne_j2 : ⟨k', k'_in_bounds⟩ ≠ j2 := by
-            simp only [List.length_cons, k_eq_succ, ne_eq, Fin.mk.injEq, Nat.succ.injEq, j2_succ] at k_ne_j2_succ
-            exact Fin.ne_of_val_ne k_ne_j2_succ
+          have k'_in_bounds : k' < acc.2.1.length := by grind
+          have k'_ne_j1 : ⟨k', k'_in_bounds⟩ ≠ j1 := by grind
+          have k'_ne_j2 : ⟨k', k'_in_bounds⟩ ≠ j2 := by grind
           exact h3 ⟨k', k'_in_bounds⟩ k'_ne_j1 k'_ne_j2
 
 theorem derivedLitsInvariant_confirmRupHint {n : Nat} (f : DefaultFormula n) (f_assignments_size : f.assignments.size = n)
@@ -1038,8 +865,7 @@ theorem derivedLitsInvariant_confirmRupHint {n : Nat} (f : DefaultFormula n) (f_
     ∃ hsize : rupHint_res.1.size = n, DerivedLitsInvariant f f_assignments_size rupHint_res.1 hsize rupHint_res.2.1 := by
   rcases ih with ⟨hsize, ih⟩
   have hsize' : Array.size ((confirmRupHint f.clauses) acc rupHints[i]).1 = n := by
-    rw [size_assignemnts_confirmRupHint]
-    exact hsize
+    grind [size_assignments_confirmRupHint]
   apply Exists.intro hsize'
   simp only [confirmRupHint, Fin.getElem_fin]
   split
@@ -1051,10 +877,8 @@ theorem derivedLitsInvariant_confirmRupHint {n : Nat} (f : DefaultFormula n) (f_
       | some none => exact Or.inr <| Or.inl rfl
       | some (some c) => exact (Or.inr ∘ Or.inr ∘ Exists.intro c) rfl
     rcases rupHint_clause_options with rupHint_clause_eq_none | rupHint_clause_eq_some_none | ⟨c, rupHint_clause_eq_c⟩
-    · simp only [rupHint_clause_eq_none]
-      exact ih
-    · simp only [rupHint_clause_eq_some_none]
-      exact ih
+    · grind
+    · grind
     · simp only [rupHint_clause_eq_c]
       have reduce_c_options : reduce c acc.1 = ReduceResult.encounteredBoth ∨ reduce c acc.1 = ReduceResult.reducedToEmpty ∨
         (∃ l : Literal (PosFin n), reduce c acc.1 = ReduceResult.reducedToUnit l) ∨ reduce c acc.1 = ReduceResult.reducedToNonunit := by
@@ -1064,18 +888,14 @@ theorem derivedLitsInvariant_confirmRupHint {n : Nat} (f : DefaultFormula n) (f_
         | ReduceResult.reducedToUnit l => exact (Or.inr ∘ Or.inr ∘ Or.inl ∘ Exists.intro l) rfl
         | ReduceResult.reducedToNonunit => exact (Or.inr ∘ Or.inr ∘ Or.inr) rfl
       rcases reduce_c_options with hencounteredBoth | hreducedToEmpty | ⟨l, hreducedToUnit⟩ | hreducedToNonunit
-      · simp only [hencounteredBoth]
-        exact ih
-      · simp only [hreducedToEmpty]
-        exact ih
+      · grind
+      · grind
       · simp only [hreducedToUnit]
         by_cases h : hasAssignment l.snd acc.fst[l.fst.val]!
-        · simp only [h, ite_true]
-          exact ih
+        · grind
         · simp only [h, ite_false]
           exact confirmRupHint_preserves_invariant_helper f f_assignments_size acc hsize l ih h
-      · simp only [hreducedToNonunit]
-        exact ih
+      · grind
 
 theorem derivedLitsInvariant_performRupCheck {n : Nat} (f : DefaultFormula n) (f_assignments_size : f.assignments.size = n)
     (rupHints : Array Nat)
@@ -1084,14 +904,7 @@ theorem derivedLitsInvariant_performRupCheck {n : Nat} (f : DefaultFormula n) (f
     DerivedLitsInvariant f f_assignments_size rupCheckRes.1.assignments f'_assignments_size rupCheckRes.2.1 := by
   let motive := fun (_ : Nat) (acc : Array Assignment × CNF.Clause (PosFin n) × Bool × Bool) =>
     ∃ hsize : acc.1.size = n, DerivedLitsInvariant f f_assignments_size acc.1 hsize acc.2.1
-  have h_base : motive 0 (f.assignments, [], false, false) := by
-    apply Exists.intro f_assignments_size
-    intro i
-    apply Or.inl
-    constructor
-    · rfl
-    · intro l l_in_nil
-      simp only [List.find?, List.not_mem_nil] at l_in_nil
+  have h_base : motive 0 (f.assignments, [], false, false) := by grind
   have h_inductive (i : Fin rupHints.size) (acc : Array Assignment × CNF.Clause (PosFin n) × Bool × Bool)
     (ih : motive i.1 acc) := derivedLitsInvariant_confirmRupHint f f_assignments_size rupHints i acc ih
   rcases Array.foldl_induction motive h_base h_inductive with ⟨_, h⟩
@@ -1113,12 +926,10 @@ theorem nodup_derivedLits {n : Nat} (f : DefaultFormula n)
     simp [li, Array.getElem_mem]
   have i_in_bounds : i.1 < derivedLits.length := by
     have i_property := i.2
-    simp only [derivedLits_arr_def, List.size_toArray] at i_property
-    exact i_property
+    grind
   have j_in_bounds : j.1 < derivedLits.length := by
     have j_property := j.2
-    simp only [derivedLits_arr_def, List.size_toArray] at j_property
-    exact j_property
+    grind
   rcases derivedLits_satisfies_invariant ⟨li.1.1, li.1.2.2⟩ with ⟨_, h2⟩ | ⟨k, _, _, _, h3⟩ |
     ⟨k1, k2, _, _, k1_eq_true, k2_eq_false, _, _, h3⟩
   · exact h2 li li_in_derivedLits rfl
@@ -1135,7 +946,7 @@ theorem nodup_derivedLits {n : Nat} (f : DefaultFormula n)
     · next k_ne_i =>
       have i_ne_k : ⟨i.1, i_in_bounds⟩ ≠ k := by intro i_eq_k; simp only [← i_eq_k, not_true] at k_ne_i
       specialize h3 ⟨i.1, i_in_bounds⟩ i_ne_k
-      simp +decide [Fin.getElem_fin, derivedLits_arr_def, ne_eq, li] at h3
+      grind [Fin.getElem_fin]
   · by_cases li.2 = true
     · next li_eq_true =>
       have i_ne_k2 : ⟨i.1, i_in_bounds⟩ ≠ k2 := by
@@ -1210,8 +1021,8 @@ theorem restoreAssignments_performRupCheck_base_case {n : Nat} (f : DefaultFormu
     · intro j _
       have idx_in_list : derivedLits_arr[j] ∈ derivedLits := by
         simp only [derivedLits_arr_def, Fin.getElem_fin]
-        apply Array.getElem_mem_toList
-      exact h2 derivedLits_arr[j] idx_in_list
+        grind
+      grind
   · apply Or.inr ∘ Or.inl
     have j_lt_derivedLits_arr_size : j.1 < derivedLits_arr.size := by
       simp only [derivedLits_arr_def, List.size_toArray]
@@ -1227,8 +1038,7 @@ theorem restoreAssignments_performRupCheck_base_case {n : Nat} (f : DefaultFormu
         intro k _ k_ne_j
         have k_in_bounds : k < derivedLits.length := by
           have k_property := k.2
-          simp only [derivedLits_arr_def, List.size_toArray] at k_property
-          exact k_property
+          grind
         have k_ne_j : ⟨k.1, k_in_bounds⟩ ≠ j := by
           apply Fin.ne_of_val_ne
           simp only
@@ -1258,8 +1068,7 @@ theorem restoreAssignments_performRupCheck_base_case {n : Nat} (f : DefaultFormu
         intro k _ k_ne_j1 k_ne_j2
         have k_in_bounds : k < derivedLits.length := by
           have k_property := k.2
-          simp only [derivedLits_arr_def, List.size_toArray] at k_property
-          exact k_property
+          grind
         have k_ne_j1 : ⟨k.1, k_in_bounds⟩ ≠ j1 := by
           apply Fin.ne_of_val_ne
           simp only
@@ -1303,8 +1112,7 @@ theorem restoreAssignments_performRupCheck {n : Nat} (f : DefaultFormula n) (f_a
     rw [f_assignments_size] at hi2
     specialize h ⟨i, hi2⟩
     rcases h with ⟨h1, _⟩ | ⟨j, b, i_gt_zero, j_ge_derivedLits_size, _⟩ | ⟨j1, j2, i_gt_zero, j1_ge_derivedLits_size, _⟩
-    · simp only [← derivedLits_arr_def]
-      exact h1
+    · grind
     · exfalso
       exact (Nat.not_lt_of_le j_ge_derivedLits_size) j.2
     · exfalso
@@ -1319,9 +1127,9 @@ theorem rupAdd_result {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) (ru
   · simp only [clear_insertRup f f_readyForRupAdd (negate c), Prod.mk.injEq, and_true] at rupAddSuccess
     exact rupAddSuccess.symm
   · split at rupAddSuccess
-    · simp at rupAddSuccess
+    · grind
     · split at rupAddSuccess
-      · simp at rupAddSuccess
+      · grind
       · let fc := (insertRupUnits f (negate c)).1
         have fc_assignments_size : (insertRupUnits f (negate c)).1.assignments.size = n := by
           rw [size_assignments_insertRupUnits f (negate c)]

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/RupAddSound.lean

@@ -11,6 +11,7 @@ This module contains the verification of RUP-based clause adding for the default
 implementation.
 -/
 
+set_option grind.warning false -- I've only made a partial effort to use grind here so far.
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -98,26 +99,19 @@ theorem mem_insertUnit_units {n : Nat} (units : Array (Literal (PosFin n))) (ass
   intro insertUnit_res l' l'_in_insertUnit_res
   simp only [insertUnit_res] at *
   simp only [insertUnit] at l'_in_insertUnit_res
-  split at l'_in_insertUnit_res
-  · exact Or.inr l'_in_insertUnit_res
-  · simp only [Array.toList_push, List.mem_append, List.mem_singleton] at l'_in_insertUnit_res
-    exact Or.symm l'_in_insertUnit_res
+  grind
 
 theorem mem_insertUnit_fold_units {n : Nat} (units : Array (Literal (PosFin n))) (assignments : Array Assignment)
     (foundContradiction : Bool) (l : CNF.Clause (PosFin n)) :
     let insertUnit_fold_res := List.foldl insertUnit (units, assignments, foundContradiction) l
     ∀ l' : Literal (PosFin n), l' ∈ insertUnit_fold_res.1.toList → l' ∈ l ∨ l' ∈ units.toList := by
   have hb (l' : Literal (PosFin n)) : l' ∈ (units, assignments, foundContradiction).1.toList → l' ∈ l ∨ l' ∈ units.toList := by
-    intro h
-    exact Or.inr h
+    grind
   have hl (acc : Array (Literal (PosFin n)) × Array Assignment × Bool)
     (h : ∀ l' : Literal (PosFin n), l' ∈ acc.1.toList → l' ∈ l ∨ l' ∈ units.toList) (l'' : Literal (PosFin n))
     (l''_in_l : l'' ∈ l) : ∀ l' : Literal (PosFin n), l' ∈ (insertUnit acc l'').1.toList → l' ∈ l ∨ l' ∈ units.toList := by
     intro l' l'_in_res
-    rcases mem_insertUnit_units  acc.1 acc.2.1 acc.2.2 l'' l' l'_in_res with l'_eq_l'' | l'_in_acc
-    · rw [l'_eq_l'']
-      exact Or.inl l''_in_l
-    · exact h l' l'_in_acc
+    rcases mem_insertUnit_units  acc.1 acc.2.1 acc.2.2 l'' l' l'_in_res with l'_eq_l'' | l'_in_acc <;> grind
   exact List.foldlRecOn l insertUnit hb hl
 
 theorem sat_of_insertRup {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd : ReadyForRupAdd f) (c : DefaultClause n)
@@ -126,8 +120,7 @@ theorem sat_of_insertRup {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd : Re
   simp only [insertRupUnits]
   intro insertUnit_fold_success
   have false_imp : false → ∃ i : PosFin n, f.assignments[i.1]'(by rw [f_readyForRupAdd.2.1]; exact i.2.2) = both := by
-    intro h
-    simp at h
+    grind
   rcases contradiction_of_insertUnit_fold_success f.assignments f_readyForRupAdd.2.1 f.rupUnits false (negate c) false_imp
     insertUnit_fold_success with ⟨i, hboth⟩
   have i_in_bounds : i.1 < f.assignments.size := by rw [f_readyForRupAdd.2.1]; exact i.2.2
@@ -216,10 +209,7 @@ theorem sat_of_insertRup {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd : Re
       Bool.not_eq_false'] at i_true_in_insertUnit_fold i_false_in_insertUnit_fold
     have c_not_tautology := Clause.not_tautology c (i, true)
     simp only [Clause.toList, (· ⊨ ·)] at c_not_tautology
-    rw [DefaultClause.toList] at c_not_tautology
-    rcases c_not_tautology with i_true_not_in_c | i_false_not_in_c
-    · exact i_true_not_in_c i_false_in_insertUnit_fold
-    · exact i_false_not_in_c i_true_in_insertUnit_fold
+    grind
 
 theorem safe_insert_of_insertRup {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd : ReadyForRupAdd f)
     (c : DefaultClause n) :
@@ -376,24 +366,24 @@ theorem unsat_of_encounteredBoth {n : Nat} (c : DefaultClause n)
     split at h
     · exact ih rfl
     · split at h
-      · split at h <;> simp at h
-      · split at h <;> simp at h
+      · grind
+      · grind
       · next heq =>
         intro p hp
         simp only [(· ⊨ ·), Bool.not_eq_true] at hp
         specialize hp l.1
         simp [heq, has_both] at hp
-      · simp at h
+      · grind
     · split at h
-      · split at h <;> simp at h
-      · split at h <;> simp at h
+      · grind
+      · grind
       · next heq =>
         intro p hp
         simp only [(· ⊨ ·), Bool.not_eq_true] at hp
         specialize hp l.1
         simp [heq, has_both] at hp
-      · simp at h
-    · simp at h
+      · grind
+    · grind
   exact List.foldlRecOn c.clause (reduce_fold_fn assignment) hb hl
 
 def ReducePostconditionInductionMotive (c_arr : Array (Literal (PosFin n)))
@@ -413,11 +403,11 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
   · intro h p
     rw [reduce_fold_fn.eq_def] at h
     split at h
-    · simp at h
+    · grind
     · split at h
       · next heq =>
         split at h
-        · simp at h
+        · grind
         · next c_arr_idx_eq_false =>
           simp only [Bool.not_eq_true] at c_arr_idx_eq_false
           rcases ih.1 rfl p with ih1 | ih1
@@ -453,19 +443,14 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
             · next h =>
               exact Or.inr h
           · exact Or.inr ih1
-      · simp at h
-      · simp at h
-    · next l =>
-      split at h
-      · split at h <;> contradiction
-      · split at h <;> contradiction
-      · simp at h
-      · simp at h
-    · simp at h
+      · grind
+      · grind
+    · grind
+    · grind
   · intro i b h p hp j j_lt_idx_add_one p_entails_c_arr_j
     rw [reduce_fold_fn.eq_def] at h
     split at h
-    · simp at h
+    · grind
     · split at h
       · next heq =>
         split at h
@@ -482,7 +467,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
           · next p_c_arr_idx_eq_false =>
             simp only [h, Bool.not_eq_true] at p_c_arr_idx_eq_false
             simp +decide only [h, p_c_arr_idx_eq_false] at hp
-        · simp at h
+        · grind
       · next heq =>
         split at h
         · next c_arr_idx_eq_true =>
@@ -498,8 +483,8 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
           · next p_c_arr_idx_eq_false =>
             simp only [h] at p_c_arr_idx_eq_false
             simp only [(· ⊨ ·), c_arr_idx_eq_true, p_c_arr_idx_eq_false]
-        · simp at h
-      · simp at h
+        · grind
+      · grind
       · simp only [reducedToUnit.injEq] at h
         rw [← h]
         rcases Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ j_lt_idx_add_one with j_lt_idx | j_eq_idx
@@ -507,13 +492,12 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
           rcases ih.1 rfl p with ih1 | ih1
           · exact ih1 j j_lt_idx p_entails_c_arr_j
           · exact ih1 hp
-        · simp only [j_eq_idx] at p_entails_c_arr_j
-          exact p_entails_c_arr_j
+        · grind
     · next l =>
       split at h
       · next heq =>
         split at h
-        · simp at h
+        · grind
         · next c_arr_idx_eq_false =>
           simp only [Bool.not_eq_true] at c_arr_idx_eq_false
           simp only [reducedToUnit.injEq] at h
@@ -528,7 +512,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
             simp +decide only [p_entails_c_arr_j, decide_true, heq] at hp
       · next heq =>
         split at h
-        · simp at h
+        · grind
         · next c_arr_idx_eq_true =>
           simp only [Bool.not_eq_true', Bool.not_eq_false] at c_arr_idx_eq_true
           simp only [reducedToUnit.injEq] at h
@@ -541,9 +525,9 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
             simp only [(· ⊨ ·), Bool.not_eq_true] at hp
             specialize hp c_arr[idx.1].1
             simp +decide only [p_entails_c_arr_j, decide_true, heq] at hp
-      · simp at h
-      · simp at h
-    · simp at h
+      · grind
+      · grind
+    · grind
 
 theorem reduce_postcondition {n : Nat} (c : DefaultClause n) (assignment : Array Assignment) :
     (reduce c assignment = reducedToEmpty → Incompatible (PosFin n) c assignment) ∧
@@ -553,14 +537,7 @@ theorem reduce_postcondition {n : Nat} (c : DefaultClause n) (assignment : Array
   rw [reduce, c_clause_rw, Array.foldl_toList]
   let motive := ReducePostconditionInductionMotive c_arr assignment
   have h_base : motive 0 reducedToEmpty := by
-    have : ∀ (a : PosFin n) (b : Bool), (reducedToEmpty = reducedToUnit (a, b)) = False := by intros; simp
-    simp only [ReducePostconditionInductionMotive, Fin.getElem_fin, forall_exists_index, and_imp, Prod.forall,
-      forall_const, false_implies, implies_true, and_true, motive, this]
-    intro p
-    apply Or.inl
-    intro i i_lt_zero
-    exfalso
-    exact Nat.not_lt_zero i.1 i_lt_zero
+    grind [ReducePostconditionInductionMotive]
   have h_inductive (idx : Fin c_arr.size) (res : ReduceResult (PosFin n)) (ih : motive idx.1 res) :
     motive (idx.1 + 1) (reduce_fold_fn assignment res c_arr[idx]) := reduce_fold_fn_preserves_induction_motive idx res ih
   rcases Array.foldl_induction motive h_base h_inductive with ⟨h1, h2⟩
@@ -577,6 +554,7 @@ theorem reduce_postcondition {n : Nat} (c : DefaultClause n) (assignment : Array
         have idx_exists : ∃ idx : Fin c_arr.size, c_arr[idx] = (i, false) := by
           rcases List.get_of_mem pc1 with ⟨idx, hidx⟩
           simp only [List.get_eq_getElem] at hidx
+          -- grind -- FIXME: internal grind error
           exact Exists.intro idx hidx
         rcases idx_exists with ⟨idx, hidx⟩
         specialize h1 idx idx.2
@@ -587,6 +565,7 @@ theorem reduce_postcondition {n : Nat} (c : DefaultClause n) (assignment : Array
         have idx_exists : ∃ idx : Fin c_arr.size, c_arr[idx] = (i, true) := by
           rcases List.get_of_mem pc1 with ⟨idx, hidx⟩
           simp only [List.get_eq_getElem] at hidx
+          -- grind -- FIXME: internal grind error
           exact Exists.intro idx hidx
         rcases idx_exists with ⟨idx, hidx⟩
         specialize h1 idx idx.2
@@ -643,15 +622,8 @@ theorem confirmRupHint_preserves_motive {n : Nat} (f : DefaultFormula n) (rupHin
     split
     · next c hc =>
       have c_in_f : c ∈ toList f := by
-        simp only [toList, List.append_assoc, List.mem_append, List.mem_filterMap, id_eq,
-          exists_eq_right, List.mem_map, Prod.exists, Bool.exists_bool]
-        apply Or.inl
-        simp only [getElem?, decidableGetElem?] at hc
-        split at hc
-        · simp only [Option.some.injEq] at hc
-          rw [← hc]
-          apply Array.getElem_mem_toList
-        · simp at hc
+        simp only [toList, List.mem_append, List.mem_filterMap, id_eq, exists_eq_right]
+        grind
       split
       · next heq =>
         simp only [ConfirmRupHintFoldEntailsMotive, h1, imp_self, and_self, hsize,
@@ -660,12 +632,8 @@ theorem confirmRupHint_preserves_motive {n : Nat} (f : DefaultFormula n) (rupHin
         simp only [ConfirmRupHintFoldEntailsMotive, h1, hsize, forall_const, true_and]
         intro p
         rcases incompatible_of_reducedToEmpty c acc.1 heq p with pc | pacc
-        · apply Or.inr
-          intro pf
-          simp only [(· ⊨ ·), List.all_eq_true] at pf
-          specialize pf c c_in_f
-          simp only [(· ⊨ ·)] at pc
-          exact pc <| of_decide_eq_true pf
+        · simp only [(· ⊨ ·)] at pc ⊢
+          grind
         · exact Or.inl pacc
       · next l b heq =>
         simp only [ConfirmRupHintFoldEntailsMotive]
@@ -692,11 +660,7 @@ theorem confirmRupHint_preserves_motive {n : Nat} (f : DefaultFormula n) (rupHin
             · simp only [pi, decide_false]
               simp only [hasAssignment, pi, decide_false, ite_false] at pacc
               by_cases hb : b
-              · simp only [hasAssignment, ↓reduceIte, addAssignment]
-                simp only [hb]
-                simp only [Bool.true_eq_false, decide_false, Bool.false_eq_true, ↓reduceIte,
-                  hasNeg_addPos]
-                exact pacc
+              · grind [hasAssignment, addAssignment, hasNeg_addPos]
               · simp only [Bool.not_eq_true] at hb
                 simp [(· ⊨ ·), hb, Subtype.ext l_eq_i, pi] at plb
             · simp only [Bool.not_eq_true] at pi
@@ -704,15 +668,8 @@ theorem confirmRupHint_preserves_motive {n : Nat} (f : DefaultFormula n) (rupHin
               simp only [pi, decide_true] at pacc
               by_cases hb : b
               · simp [(· ⊨ ·), hb, Subtype.ext l_eq_i, pi] at plb
-              · simp only [Bool.not_eq_true] at hb
-                simp only [hasAssignment, addAssignment, hb, ite_false, ite_true, hasPos_addNeg, reduceCtorEq]
-                simp only [hasAssignment, ite_true] at pacc
-                exact pacc
-          · next l_ne_i =>
-            simp only [getElem!_def, Array.size_modify, i_in_bounds, Array.getElem?_eq_getElem,
-              Array.getElem_modify_of_ne l_ne_i]
-            simp only [getElem!_def, i_in_bounds, Array.getElem?_eq_getElem] at pacc
-            exact pacc
+              · grind [hasAssignment, addAssignment, hasPos_addNeg]
+          · next l_ne_i => grind
       · apply And.intro hsize ∘ And.intro h1
         simp
     · apply And.intro hsize ∘ And.intro h1
@@ -782,9 +739,8 @@ theorem sat_of_confirmRupHint_insertRup_fold {n : Nat} (f : DefaultFormula n)
         simp only [(· ⊨ ·), Bool.not_eq_true] at pv
         simp only [p_unsat_c] at pv
         cases pv
-      · simp [Literal.negate, Bool.not_true] at v'_eq_v
-    · simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq] at pf
-      exact p_unsat_c <| pf unsat_c unsat_c_in_f
+      · grind [Literal.negate]
+    · grind [formulaEntails_def]
 
 theorem safe_insert_of_performRupCheck_insertRup {n : Nat} (f : DefaultFormula n)
     (f_readyForRupAdd : ReadyForRupAdd f) (c : DefaultClause n) (rupHints : Array Nat) :
@@ -799,8 +755,7 @@ theorem safe_insert_of_performRupCheck_insertRup {n : Nat} (f : DefaultFormula n
   rcases c'_in_fc with c'_eq_c | c'_in_f
   · rw [c'_eq_c]
     exact sat_of_confirmRupHint_insertRup_fold f f_readyForRupAdd c rupHints p pf performRupCheck_success
-  · simp only [formulaEntails_def, List.all_eq_true, decide_eq_true_eq] at pf
-    exact pf c' c'_in_f
+  · grind [formulaEntails_def]
 
 theorem rupAdd_sound {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) (rupHints : Array Nat)
     (f' : DefaultFormula n) (f_readyForRupAdd : ReadyForRupAdd f)
@@ -818,9 +773,9 @@ theorem rupAdd_sound {n : Nat} (f : DefaultFormula n) (c : DefaultClause n) (rup
     · exact f_limplies_fc
     · exact limplies_insert f c p
   · split at rupAddSuccess
-    · simp at rupAddSuccess
+    · grind
     · split at rupAddSuccess
-      · simp at rupAddSuccess
+      · grind
       · next performRupCheck_success =>
         rw [Bool.not_eq_false] at performRupCheck_success
         have f_limplies_fc := safe_insert_of_performRupCheck_insertRup f f_readyForRupAdd c rupHints performRupCheck_success

src/Std/Tactic/BVDecide/LRAT/Internal/LRATCheckerSound.lean

@@ -8,6 +8,8 @@ import Std.Tactic.BVDecide.LRAT.Internal.LRATChecker
 import Std.Tactic.BVDecide.LRAT.Internal.CNF
 import Std.Tactic.BVDecide.LRAT.Internal.Actions
 
+set_option grind.warning false
+
 namespace Std.Tactic.BVDecide
 namespace LRAT
 namespace Internal
@@ -18,85 +20,51 @@ theorem addEmptyCaseSound [DecidableEq α] [Clause α β] [Entails α σ] [Formu
     (f_readyForRupAdd : ReadyForRupAdd f) (rupHints : Array Nat)
     (rupAddSuccess : (Formula.performRupAdd f Clause.empty rupHints).snd = true) :
     Unsatisfiable α f := by
-  let f' := (performRupAdd f empty rupHints).1
-  have f'_def := rupAdd_result f empty rupHints f' f_readyForRupAdd
-  rw [← rupAddSuccess] at f'_def
-  specialize f'_def rfl
-  have f_liff_f' := rupAdd_sound f empty rupHints f' f_readyForRupAdd
-  rw [← rupAddSuccess] at f_liff_f'
-  specialize f_liff_f' rfl
-  rw [f'_def] at f_liff_f'
   intro p pf
+  let f' := (performRupAdd f empty rupHints).1
+  have f'_def : f' = Formula.insert f empty := by grind
+  have f_liff_f' : Liff α f (Formula.insert f empty) := by grind
   specialize f_liff_f' p
   rw [f_liff_f', sat_iff_forall] at pf
-  have empty_in_f' : empty ∈ toList (Formula.insert f empty) := by
-    rw [Formula.insert_iff]
-    exact Or.inl rfl
-  specialize pf empty empty_in_f'
-  simp [(· ⊨ ·), Clause.eval, List.any_eq_true, decide_eq_true_eq, Prod.exists, Bool.exists_bool,
-    empty_eq, List.any_nil] at pf
+  have empty_in_f' : empty ∈ toList (Formula.insert f empty) := by grind
+  simp only [(· ⊨ ·)] at pf
+  grind [Clause.eval]
 
 theorem addRupCaseSound [DecidableEq α] [Clause α β] [Entails α σ] [Formula α β σ] (f : σ)
     (f_readyForRupAdd : ReadyForRupAdd f)
     (f_readyForRatAdd : ReadyForRatAdd f) (c : β) (f' : σ) (rupHints : Array Nat)
     (heq : performRupAdd f c rupHints = (f', true))
     (restPrf : List (Action β α)) (restPrfWellFormed : ∀ (a : Action β α), a ∈ restPrf → WellFormedAction a)
-    (ih : ∀ (f : σ),
-      ReadyForRupAdd f → ReadyForRatAdd f → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
-      lratChecker f restPrf = success → Unsatisfiable α f)
+    (ih :
+      ReadyForRupAdd f' → ReadyForRatAdd f' → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
+      lratChecker f' restPrf = success → Unsatisfiable α f')
     (f'_success : lratChecker f' restPrf = success) :
     Unsatisfiable α f := by
-  have f'_def := rupAdd_result f c rupHints f' f_readyForRupAdd heq
-  have f'_readyForRupAdd : ReadyForRupAdd f' := by
-    rw [f'_def]
-    exact readyForRupAdd_insert f c f_readyForRupAdd
-  have f'_readyForRatAdd : ReadyForRatAdd f' := by
-    rw [f'_def]
-    exact readyForRatAdd_insert f c f_readyForRatAdd
-  specialize ih f' f'_readyForRupAdd f'_readyForRatAdd restPrfWellFormed f'_success
-  have f_liff_f' : Liff α f f' := rupAdd_sound f c rupHints f' f_readyForRupAdd heq
-  intro p pf
-  rw [f_liff_f' p] at pf
-  exact ih p pf
+  grind [Unsatisfiable, Liff]
 
 theorem addRatCaseSound [DecidableEq α] [Clause α β] [Entails α σ] [Formula α β σ] (f : σ)
     (f_readyForRupAdd : ReadyForRupAdd f) (f_readyForRatAdd : ReadyForRatAdd f) (c : β)
     (pivot : Literal α) (f' : σ) (rupHints : Array Nat) (ratHints : Array (Nat × Array Nat))
     (pivot_limplies_c : Limplies α pivot c) (heq : performRatAdd f c pivot rupHints ratHints = (f', true))
     (restPrf : List (Action β α)) (restPrfWellFormed : ∀ (a : Action β α), a ∈ restPrf → WellFormedAction a)
-    (ih : ∀ (f : σ),
-      ReadyForRupAdd f → ReadyForRatAdd f → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
-      lratChecker f restPrf = success → Unsatisfiable α f)
+    (ih :
+      ReadyForRupAdd f' → ReadyForRatAdd f' → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
+      lratChecker f' restPrf = success → Unsatisfiable α f')
     (f'_success : lratChecker f' restPrf = success) :
     Unsatisfiable α f := by
-  rw [limplies_iff_mem] at pivot_limplies_c
-  have f'_def := ratAdd_result f c pivot rupHints ratHints f' f_readyForRatAdd pivot_limplies_c heq
-  have f'_readyForRupAdd : ReadyForRupAdd f' := by
-    rw [f'_def]
-    exact readyForRupAdd_insert f c f_readyForRupAdd
-  have f'_readyForRatAdd : ReadyForRatAdd f' := by
-    rw [f'_def]
-    exact readyForRatAdd_insert f c f_readyForRatAdd
-  specialize ih f' f'_readyForRupAdd f'_readyForRatAdd restPrfWellFormed f'_success
-  have f_equisat_f' : Equisat α f f' := ratAdd_sound f c pivot rupHints ratHints f' f_readyForRatAdd pivot_limplies_c heq
-  intro p pf
-  rw [Equisat] at f_equisat_f'
-  rw [← f_equisat_f'] at ih
-  exact ih p pf
+  grind [Equisat, limplies_iff_mem]
 
 theorem delCaseSound [DecidableEq α] [Clause α β] [Entails α σ] [Formula α β σ] (f : σ)
     (f_readyForRupAdd : ReadyForRupAdd f) (f_readyForRatAdd : ReadyForRatAdd f) (ids : Array Nat)
     (restPrf : List (Action β α))
     (restPrfWellFormed : ∀ (a : Action β α), a ∈ restPrf → WellFormedAction a)
-    (ih : ∀ (f : σ),
-      ReadyForRupAdd f → ReadyForRatAdd f → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
-      lratChecker f restPrf = success → Unsatisfiable α f)
+    (ih :
+      ReadyForRupAdd (delete f ids) → ReadyForRatAdd (delete f ids) → (∀ (a : Action β α), a ∈ restPrf → WellFormedAction a) →
+      lratChecker (delete f ids) restPrf = success → Unsatisfiable α (delete f ids))
     (h : lratChecker (Formula.delete f ids) restPrf = success) :
     Unsatisfiable α f := by
   intro p pf
-  have f_del_readyForRupAdd : ReadyForRupAdd (Formula.delete f ids) := readyForRupAdd_delete f ids f_readyForRupAdd
-  have f_del_readyForRatAdd : ReadyForRatAdd (Formula.delete f ids) := readyForRatAdd_delete f ids f_readyForRatAdd
-  exact ih (delete f ids) f_del_readyForRupAdd f_del_readyForRatAdd restPrfWellFormed h p (limplies_delete p pf)
+  exact ih (by grind) (by grind) restPrfWellFormed h p (limplies_delete p pf)
 
 theorem lratCheckerSound [DecidableEq α] [Clause α β] [Entails α σ] [Formula α β σ] (f : σ)
     (f_readyForRupAdd : ReadyForRupAdd f) (f_readyForRatAdd : ReadyForRatAdd f)
@@ -104,48 +72,10 @@ theorem lratCheckerSound [DecidableEq α] [Clause α β] [Entails α σ] [Formul
     lratChecker f prf = success → Unsatisfiable α f := by
   induction prf generalizing f
   · unfold lratChecker
-    simp [false_implies]
-  · next action restPrf ih =>
-    simp only [List.find?, List.mem_cons, forall_eq_or_imp] at prfWellFormed
-    rcases prfWellFormed with ⟨actionWellFormed, restPrfWellFormed⟩
+    grind
+  · simp only [List.mem_cons, forall_eq_or_imp] at prfWellFormed
     unfold lratChecker
-    split
-    · intro h
-      exfalso
-      simp at h
-    · next id rupHints restPrf' _ =>
-      simp [ite_eq_left_iff, Bool.not_eq_true]
-      intro rupAddSuccess
-      exact addEmptyCaseSound f f_readyForRupAdd rupHints rupAddSuccess
-    · next id c rupHints restPrf' hprf =>
-      split
-      next f' checkSuccess heq =>
-      split
-      · next hCheckSuccess =>
-        intro f'_success
-        simp only [List.cons.injEq] at hprf
-        rw [← hprf.2] at f'_success
-        rw [hCheckSuccess] at heq
-        exact addRupCaseSound f f_readyForRupAdd f_readyForRatAdd c f' rupHints heq restPrf restPrfWellFormed ih f'_success
-      · simp [false_implies]
-    · next id c pivot rupHints ratHints restPrf' hprf =>
-      split
-      next f' checkSuccess heq =>
-      split
-      · next hCheckSuccess =>
-        intro f'_success
-        simp only [List.cons.injEq] at hprf
-        rw [← hprf.2] at f'_success
-        rw [hCheckSuccess] at heq
-        simp only [WellFormedAction, hprf.1] at actionWellFormed
-        exact addRatCaseSound f f_readyForRupAdd f_readyForRatAdd c pivot f' rupHints ratHints actionWellFormed heq restPrf
-          restPrfWellFormed ih f'_success
-      · simp [false_implies]
-    · next ids restPrf' hprf =>
-      intro h
-      simp only [List.cons.injEq] at hprf
-      rw [← hprf.2] at h
-      exact delCaseSound f f_readyForRupAdd f_readyForRatAdd ids restPrf restPrfWellFormed ih h
+    grind [addEmptyCaseSound, addRupCaseSound, addRatCaseSound, delCaseSound, WellFormedAction]
 
 end Internal
 end LRAT