test: benchmark from Lean Hackathon

This PR disables the `import all` check across package boundaries. Now
any module can `import all` any other module.

.claude/CLAUDE.md

@@ -45,3 +45,7 @@ feat: add optional binder limit to `mkPatternFromTheorem`
 This PR adds a `num?` parameter to `mkPatternFromTheorem` to control how many
 leading quantifiers are stripped when creating a pattern.
 ```
+
+## CI Log Retrieval
+
+When CI jobs fail, investigate immediately - don't wait for other jobs to complete. Individual job logs are often available even while other jobs are still running. Try `gh run view <run-id> --log` or `gh run view <run-id> --log-failed`, or use `gh run view <run-id> --job=<job-id>` to target the specific failed job. Sleeping is fine when asked to monitor CI and no failures exist yet, but once any job fails, investigate that failure immediately.

.github/workflows/ci.yml

@@ -267,14 +267,17 @@ jobs:
                 "test": true,
                 // turn off custom allocator & symbolic functions to make LSAN do its magic
                 "CMAKE_PRESET": "sanitize",
-                // `StackOverflow*` correctly triggers ubsan.
-                // `reverse-ffi` fails to link in sanitizers.
-                // `interactive` and `async_select_channel` fail nondeterministically, would need to
-                // be investigated..
-                // 9366 is too close to timeout.
-                // `bv_` sometimes times out calling into cadical even though we should be using the
-                // standard compile flags for it.
-                "CTEST_OPTIONS": "-E 'StackOverflow|reverse-ffi|interactive|async_select_channel|9366|run/bv_'"
+                // * `StackOverflow*` correctly triggers ubsan.
+                // * `reverse-ffi` fails to link in sanitizers.
+                // * `interactive` and `async_select_channel` fail nondeterministically, would need
+                //   to be investigated..
+                // * 9366 is too close to timeout.
+                // * `bv_` sometimes times out calling into cadical even though we should be using
+                //   the standard compile flags for it.
+                // * `grind_guide` always times out.
+                // * `pkg/|lake/` tests sometimes time out (likely even hang), related to Lake CI
+                //   failures?
+                "CTEST_OPTIONS": "-E 'StackOverflow|reverse-ffi|interactive|async_select_channel|9366|run/bv_|grind_guide|pkg/|lake/'"
               },
               {
                 "name": "macOS",

script/lakefile.toml

@@ -3,9 +3,3 @@ name = "scripts"
 [[lean_exe]]
 name = "modulize"
 root = "Modulize"
-
-[[lean_exe]]
-name = "shake"
-root = "Shake"
-# needed by `Lake.loadWorkspace`
-supportInterpreter = true

src/CMakeLists.txt

@@ -40,6 +40,10 @@ find_program(LLD_PATH lld)
 if(LLD_PATH)
   string(APPEND LEAN_EXTRA_LINKER_FLAGS_DEFAULT " -fuse-ld=lld")
 endif()
+if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
+  # Create space in install names so they can be patched later in Nix.
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS_DEFAULT " -headerpad_max_install_names")
+endif()
 
 set(LEAN_EXTRA_LINKER_FLAGS ${LEAN_EXTRA_LINKER_FLAGS_DEFAULT} CACHE STRING "Additional flags used by the linker")
 set(LEAN_EXTRA_CXX_FLAGS "" CACHE STRING "Additional flags used by the C++ compiler. Unlike `CMAKE_CXX_FLAGS`, these will not be used to build e.g. cadical.")
@@ -452,11 +456,14 @@ if(LLVM AND ${STAGE} GREATER 0)
     message(VERBOSE "leanshared linker flags: '${LEANSHARED_LINKER_FLAGS}' | lean extra cxx flags '${CMAKE_CXX_FLAGS}'")
 endif()
 
-# get rid of unused parts of C++ stdlib
+# We always strip away unused declarations to reduce binary sizes as the time cost is small and the
+# potential benefit can be huge, especially when stripping `meta import`s.
 if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
-  string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-dead_strip")
+  string(APPEND LEANC_EXTRA_CC_FLAGS " -fdata-sections -ffunction-sections")
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS " -Wl,-dead_strip")
 elseif(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
-  string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,--gc-sections")
+  string(APPEND LEANC_EXTRA_CC_FLAGS " -fdata-sections -ffunction-sections")
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS " -Wl,--gc-sections")
 endif()
 
 if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
@@ -631,6 +638,9 @@ if(${STAGE} GREATER 1)
     COMMAND cmake -E copy_if_different "${PREV_STAGE}/lib/lean/libleanrt.a" "${CMAKE_BINARY_DIR}/lib/lean/libleanrt.a"
     COMMAND cmake -E copy_if_different "${PREV_STAGE}/lib/lean/libleancpp.a" "${CMAKE_BINARY_DIR}/lib/lean/libleancpp.a"
     COMMAND cmake -E copy_if_different "${PREV_STAGE}/lib/temp/libleancpp_1.a" "${CMAKE_BINARY_DIR}/lib/temp/libleancpp_1.a")
+  add_dependencies(leanrt_initial-exec copy-leancpp)
+  add_dependencies(leanrt copy-leancpp)
+  add_dependencies(leancpp_1 copy-leancpp)
   add_dependencies(leancpp copy-leancpp)
   if(LLVM)
       add_custom_target(copy-lean-h-bc

src/Init.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 module
-
 prelude
 public import Init.Prelude
 public import Init.Notation
@@ -38,6 +37,7 @@ public import Init.Omega
 public import Init.MacroTrace
 public import Init.Grind
 public import Init.GrindInstances
+public import Init.Sym
 public import Init.While
 public import Init.Syntax
 public import Init.Internal

src/Init/Core.lean

@@ -13,6 +13,10 @@ public import Init.SizeOf
 public section
 set_option linter.missingDocs true -- keep it documented
 
+-- BEq instance for Option defined here so it's available early in the import chain
+-- (before Init.Grind.Config and Init.MetaTypes which need BEq (Option Nat))
+deriving instance BEq for Option
+
 @[expose] section
 
 universe u v w
@@ -1561,6 +1565,10 @@ instance {p q : Prop} [d : Decidable (p ↔ q)] : Decidable (p = q) :=
   | isTrue h => isTrue (propext h)
   | isFalse h => isFalse fun heq => h (heq ▸ Iff.rfl)
 
+/-- Helper theorem for proving injectivity theorems -/
+theorem Lean.injEq_helper {P Q R : Prop} :
+  (P → Q → R) → (P ∧ Q → R) := by intro h ⟨h₁,h₂⟩; exact h h₁ h₂
+
 gen_injective_theorems% Array
 gen_injective_theorems% BitVec
 gen_injective_theorems% ByteArray

src/Init/Data/BitVec/Bootstrap.lean

@@ -159,4 +159,17 @@ theorem setWidth_neg_of_le {x : BitVec v} (h : w ≤ v) : BitVec.setWidth w (-x)
     omega
   omega
 
+@[induction_eliminator, elab_as_elim]
+theorem cons_induction {motive : (w : Nat) → BitVec w → Prop} (nil : motive 0 .nil)
+    (cons : ∀ {w : Nat} (b : Bool) (bv : BitVec w), motive w bv → motive (w + 1) (.cons b bv)) :
+    ∀ {w : Nat} (x : BitVec w), motive w x := by
+  intros w x
+  induction w
+  case zero =>
+    simp only [BitVec.eq_nil x, nil]
+  case succ wl ih =>
+    rw [← cons_msb_setWidth x]
+    apply cons
+    apply ih
+
 end BitVec

src/Init/Data/BitVec/Lemmas.lean

@@ -3362,6 +3362,26 @@ theorem extractLsb'_concat {x : BitVec (w + 1)} {y : Bool} :
   · simp
   · simp [show i - 1 < t by omega]
 
+theorem concat_extractLsb'_getLsb {x : BitVec (w + 1)} :
+    BitVec.concat (x.extractLsb' 1 w) (x.getLsb 0) = x := by
+  ext i hw
+  by_cases h : i = 0
+  · simp [h]
+  · simp [h, hw, show (1 + (i - 1)) = i by omega, getElem_concat]
+
+@[elab_as_elim]
+theorem concat_induction {motive : (w : Nat) → BitVec w → Prop} (nil : motive 0 .nil)
+    (concat : ∀ {w : Nat} (bv : BitVec w) (b : Bool), motive w bv → motive (w + 1) (bv.concat b)) :
+    ∀ {w : Nat} (x : BitVec w), motive w x := by
+  intros w x
+  induction w
+  case zero =>
+    simp only [BitVec.eq_nil x, nil]
+  case succ wl ih =>
+    rw [← concat_extractLsb'_getLsb (x := x)]
+    apply concat
+    apply ih
+
 /-! ### shiftConcat -/
 
 @[grind =]
@@ -6383,73 +6403,6 @@ theorem cpopNatRec_add {x : BitVec w} {acc n : Nat} :
     x.cpopNatRec n (acc + acc') = x.cpopNatRec n acc + acc' := by
   rw [cpopNatRec_eq (acc := acc + acc'), cpopNatRec_eq (acc := acc), Nat.add_assoc]
 
-theorem cpopNatRec_le {x : BitVec w} (n : Nat) :
-    x.cpopNatRec n acc ≤ acc + n := by
-  induction n generalizing acc
-  · case zero =>
-    simp
-  · case succ n ihn =>
-    have : (x.getLsbD n).toNat ≤ 1 := by cases x.getLsbD n <;> simp
-    specialize ihn (acc := acc + (x.getLsbD n).toNat)
-    simp
-    omega
-
-@[simp]
-theorem cpopNatRec_of_le {x : BitVec w} (k n : Nat) (hn : w ≤ n) :
-    x.cpopNatRec (n + k) acc = x.cpopNatRec n acc := by
-  induction k
-  · case zero =>
-    simp
-  · case succ k ihk =>
-    simp [show n + (k + 1) = (n + k) + 1 by omega, ihk, show w ≤ n + k by omega]
-
-theorem cpopNatRec_zero_le (x : BitVec w) (n : Nat) :
-    x.cpopNatRec n 0 ≤ w := by
-  induction n
-  · case zero =>
-    simp
-  · case succ n ihn =>
-    by_cases hle : n ≤ w
-    · by_cases hx : x.getLsbD n
-      · have := cpopNatRec_le (x := x) (acc := 1) (by omega)
-        have := lt_of_getLsbD hx
-        simp [hx]
-        omega
-      · have := cpopNatRec_le (x := x) (acc := 0) (by omega)
-        simp [hx]
-        omega
-    · simp [show w ≤ n by omega]
-      omega
-
-@[simp]
-theorem cpopNatRec_allOnes (h : n ≤ w) :
-    (allOnes w).cpopNatRec n acc = acc + n := by
-  induction n
-  · case zero =>
-    simp
-  · case succ n ihn =>
-    specialize ihn (by omega)
-    simp [show n < w by omega, ihn,
-      cpopNatRec_add (acc := acc) (acc' := 1)]
-    omega
-
-@[simp]
-theorem cpop_allOnes :
-    (allOnes w).cpop = BitVec.ofNat w w := by
-  simp [cpop, cpopNatRec_allOnes]
-
-@[simp]
-theorem cpop_zero :
-    (0#w).cpop = 0#w := by
-  simp [cpop]
-
-theorem toNat_cpop_le (x : BitVec w) :
-    x.cpop.toNat ≤ w := by
-  have hlt := Nat.lt_two_pow_self (n := w)
-  have hle := cpopNatRec_zero_le (x := x) (n := w)
-  simp only [cpop, toNat_ofNat, ge_iff_le]
-  rw [Nat.mod_eq_of_lt (by omega)]
-  exact hle
 
 @[simp]
 theorem cpopNatRec_cons_of_le {x : BitVec w} {b : Bool} (hn : n ≤ w) :
@@ -6475,6 +6428,68 @@ theorem cpopNatRec_cons_of_lt {x : BitVec w} {b : Bool} (hn : w < n) :
     · simp [show w = n by omega, getElem_cons,
         cpopNatRec_add (acc := acc) (acc' := b.toNat), Nat.add_comm]
 
+theorem cpopNatRec_le {x : BitVec w} (n : Nat) :
+    x.cpopNatRec n acc ≤ acc + n := by
+  induction n generalizing acc
+  · case zero =>
+    simp
+  · case succ n ihn =>
+    have : (x.getLsbD n).toNat ≤ 1 := by cases x.getLsbD n <;> simp
+    specialize ihn (acc := acc + (x.getLsbD n).toNat)
+    simp
+    omega
+
+@[simp]
+theorem cpopNatRec_of_le {x : BitVec w} (k n : Nat) (hn : w ≤ n) :
+    x.cpopNatRec (n + k) acc = x.cpopNatRec n acc := by
+  induction k
+  · case zero =>
+    simp
+  · case succ k ihk =>
+    simp [show n + (k + 1) = (n + k) + 1 by omega, ihk, show w ≤ n + k by omega]
+
+@[simp]
+theorem cpopNatRec_allOnes (h : n ≤ w) :
+    (allOnes w).cpopNatRec n acc = acc + n := by
+  induction n
+  · case zero =>
+    simp
+  · case succ n ihn =>
+    specialize ihn (by omega)
+    simp [show n < w by omega, ihn,
+      cpopNatRec_add (acc := acc) (acc' := 1)]
+    omega
+
+@[simp]
+theorem cpop_allOnes :
+    (allOnes w).cpop = BitVec.ofNat w w := by
+  simp [cpop, cpopNatRec_allOnes]
+
+@[simp]
+theorem cpop_zero :
+    (0#w).cpop = 0#w := by
+  simp [cpop]
+
+theorem cpopNatRec_zero_le (x : BitVec w) (n : Nat) :
+    x.cpopNatRec n 0 ≤ w := by
+  induction x
+  · case nil => simp
+  · case cons w b bv ih =>
+    by_cases hle : n ≤ w
+    · have := cpopNatRec_cons_of_le (b := b) (x := bv) (n := n) (acc := 0) hle
+      omega
+    · rw [cpopNatRec_cons_of_lt (by omega)]
+      have : b.toNat ≤ 1 := by cases b <;> simp
+      omega
+
+theorem toNat_cpop_le (x : BitVec w) :
+    x.cpop.toNat ≤ w := by
+  have hlt := Nat.lt_two_pow_self (n := w)
+  have hle := cpopNatRec_zero_le (x := x) (n := w)
+  simp only [cpop, toNat_ofNat, ge_iff_le]
+  rw [Nat.mod_eq_of_lt (by omega)]
+  exact hle
+
 theorem cpopNatRec_concat_of_lt {x : BitVec w} {b : Bool} (hn : 0 < n) :
     (concat x b).cpopNatRec n acc = b.toNat + x.cpopNatRec (n - 1) acc := by
   induction n generalizing acc
@@ -6572,12 +6587,12 @@ theorem cpop_cast (x : BitVec w) (h : w = v) :
 @[simp]
 theorem toNat_cpop_append {x : BitVec w} {y : BitVec u} :
     (x ++ y).cpop.toNat = x.cpop.toNat + y.cpop.toNat := by
-  induction w generalizing u
-  · case zero =>
-    simp [cpop]
-  · case succ w ihw =>
-    rw [← cons_msb_setWidth x, toNat_cpop_cons, cons_append, cpop_cast, toNat_cast,
-      toNat_cpop_cons, ihw, ← Nat.add_assoc]
+  induction x generalizing y
+  · case nil =>
+    simp
+  · case cons w b bv ih =>
+    simp [cons_append, ih]
+    omega
 
 theorem cpop_append {x : BitVec w} {y : BitVec u} :
     (x ++ y).cpop = x.cpop.setWidth (w + u) + y.cpop.setWidth (w + u) := by
@@ -6588,4 +6603,14 @@ theorem cpop_append {x : BitVec w} {y : BitVec u} :
   simp only [toNat_cpop_append, toNat_add, toNat_setWidth, Nat.add_mod_mod, Nat.mod_add_mod]
   rw [Nat.mod_eq_of_lt (by omega)]
 
+theorem toNat_cpop_not {x : BitVec w} :
+    (~~~x).cpop.toNat = w - x.cpop.toNat := by
+  induction x
+  · case nil =>
+    simp
+  · case cons b x ih =>
+    have := toNat_cpop_le x
+    cases b
+    <;> (simp [ih]; omega)
+
 end BitVec

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

@@ -148,6 +148,7 @@ theorem Subarray.copy_eq_toArray {s : Subarray α} :
     s.copy = s.toArray :=
   (rfl)
 
+@[grind =]
 theorem Subarray.sliceToArray_eq_toArray {s : Subarray α} :
     Slice.toArray s = s.toArray :=
   (rfl)

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

@@ -119,6 +119,13 @@ public theorem forIn_toList {α : Type u} {s : Subarray α}
     ForIn.forIn s.toList init f = ForIn.forIn s init f :=
   Slice.forIn_toList
 
+@[grind =]
+public theorem forIn_eq_forIn_toList {α : Type u} {s : Subarray α}
+    {m : Type v → Type w} [Monad m] [LawfulMonad m] {γ : Type v} {init : γ}
+    {f : α → γ → m (ForInStep γ)} :
+    ForIn.forIn s init f = ForIn.forIn s.toList init f :=
+  forIn_toList.symm
+
 @[simp]
 public theorem forIn_toArray {α : Type u} {s : Subarray α}
     {m : Type v → Type w} [Monad m] [LawfulMonad m] {γ : Type v} {init : γ}
@@ -167,22 +174,22 @@ public theorem Array.toSubarray_eq_min {xs : Array α} {lo hi : Nat} :
   simp only [Array.toSubarray]
   split <;> split <;> simp [Nat.min_eq_right (Nat.le_of_not_ge _), *]
 
-@[simp]
+@[simp, grind =]
 public theorem Array.array_toSubarray {xs : Array α} {lo hi : Nat} :
     (xs.toSubarray lo hi).array = xs := by
   simp [toSubarray_eq_min, Subarray.array]
 
-@[simp]
+@[simp, grind =]
 public theorem Array.start_toSubarray {xs : Array α} {lo hi : Nat} :
     (xs.toSubarray lo hi).start = min lo (min hi xs.size) := by
   simp [toSubarray_eq_min, Subarray.start]
 
-@[simp]
+@[simp, grind =]
 public theorem Array.stop_toSubarray {xs : Array α} {lo hi : Nat} :
     (xs.toSubarray lo hi).stop = min hi xs.size := by
   simp [toSubarray_eq_min, Subarray.stop]
 
-theorem Subarray.toList_eq {xs : Subarray α} :
+public theorem Subarray.toList_eq {xs : Subarray α} :
     xs.toList = (xs.array.extract xs.start xs.stop).toList := by
   let aslice := xs
   obtain ⟨⟨array, start, stop, h₁, h₂⟩⟩ := xs
@@ -199,45 +206,46 @@ theorem Subarray.toList_eq {xs : Subarray α} :
       simp [Subarray.array, Subarray.start, Subarray.stop]
   simp [this, ListSlice.toList_eq, lslice]
 
+@[grind =]
 public theorem Subarray.size_eq {xs : Subarray α} :
     xs.size = xs.stop - xs.start := by
   simp [Subarray.size]
 
-@[simp]
+@[simp, grind =]
 public theorem Subarray.toArray_toList {xs : Subarray α} :
     xs.toList.toArray = xs.toArray := by
   simp [Std.Slice.toList, Subarray.toArray, Std.Slice.toArray]
 
-@[simp]
+@[simp, grind =]
 public theorem Subarray.toList_toArray {xs : Subarray α} :
     xs.toArray.toList = xs.toList := by
   simp [Std.Slice.toList, Subarray.toArray, Std.Slice.toArray]
 
-@[simp]
+@[simp, grind =]
 public theorem Subarray.length_toList {xs : Subarray α} :
     xs.toList.length = xs.size := by
   have : xs.start ≤ xs.stop := xs.internalRepresentation.start_le_stop
   have : xs.stop ≤ xs.array.size := xs.internalRepresentation.stop_le_array_size
   simp [Subarray.toList_eq, Subarray.size]; omega
 
-@[simp]
+@[simp, grind =]
 public theorem Subarray.size_toArray {xs : Subarray α} :
     xs.toArray.size = xs.size := by
   simp [← Subarray.toArray_toList, Subarray.size, Slice.size, SliceSize.size, start, stop]
 
 namespace Array
 
-@[simp]
+@[simp, grind =]
 public theorem array_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].array = xs := by
   simp [Std.Rco.Sliceable.mkSlice, Array.toSubarray, apply_dite, Subarray.array]
 
-@[simp]
+@[simp, grind =]
 public theorem start_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].start = min lo (min hi xs.size) := by
   simp [Std.Rco.Sliceable.mkSlice]
 
-@[simp]
+@[simp, grind =]
 public theorem stop_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].stop = min hi xs.size := by
   simp [Std.Rco.Sliceable.mkSlice]
@@ -246,14 +254,14 @@ public theorem mkSlice_rco_eq_mkSlice_rco_min {xs : Array α} {lo hi : Nat} :
     xs[lo...hi] = xs[(min lo (min hi xs.size))...(min hi xs.size)] := by
   simp [Std.Rco.Sliceable.mkSlice, Array.toSubarray_eq_min]
 
-@[simp]
+@[simp, grind =]
 public theorem toList_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].toList = (xs.toList.take hi).drop lo := by
   rw [List.take_eq_take_min, List.drop_eq_drop_min]
   simp [Std.Rco.Sliceable.mkSlice, Subarray.toList_eq, List.take_drop,
     Nat.add_sub_of_le (Nat.min_le_right _ _)]
 
-@[simp]
+@[simp, grind =]
 public theorem toArray_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].toArray = xs.extract lo hi := by
   simp only [← Subarray.toArray_toList, toList_mkSlice_rco]
@@ -266,12 +274,12 @@ public theorem toArray_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     · simp; omega
     · simp; omega
 
-@[simp]
+@[simp, grind =]
 public theorem size_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...hi].size = min hi xs.size - lo := by
   simp [← Subarray.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rcc_eq_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo...=hi] = xs[lo...(hi + 1)] := by
   simp [Std.Rcc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -280,7 +288,7 @@ public theorem mkSlice_rcc_eq_mkSlice_rco_min {xs : Array α} {lo hi : Nat} :
     xs[lo...=hi] = xs[(min lo (min (hi + 1) xs.size))...(min (hi + 1) xs.size)] := by
   simp [mkSlice_rco_eq_mkSlice_rco_min]
 
-@[simp]
+@[simp, grind =]
 public theorem array_mkSlice_rcc {xs : Array α} {lo hi : Nat} :
     xs[lo...=hi].array = xs := by
   simp [Std.Rcc.Sliceable.mkSlice, Array.toSubarray, apply_dite, Subarray.array]
@@ -325,7 +333,7 @@ public theorem stop_mkSlice_rci {xs : Array α} {lo : Nat} :
     xs[lo...*].stop = xs.size := by
   simp [Std.Rci.Sliceable.mkSlice, Std.Rci.HasRcoIntersection.intersection]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rci_eq_mkSlice_rco {xs : Array α} {lo : Nat} :
     xs[lo...*] = xs[lo...xs.size] := by
   simp [Std.Rci.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice, Std.Rci.HasRcoIntersection.intersection]
@@ -344,7 +352,7 @@ public theorem toArray_mkSlice_rci {xs : Array α} {lo : Nat} :
     xs[lo...*].toArray = xs.extract lo := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem size_mkSlice_rci {xs : Array α} {lo : Nat} :
     xs[lo...*].size = xs.size - lo := by
   simp [← Subarray.length_toList]
@@ -364,7 +372,7 @@ public theorem stop_mkSlice_roo {xs : Array α} {lo hi : Nat} :
     xs[lo<...hi].stop = min hi xs.size := by
   simp [Std.Roo.Sliceable.mkSlice]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roo_eq_mkSlice_rco {xs : Array α} {lo hi : Nat} :
     xs[lo<...hi] = xs[(lo + 1)...hi] := by
   simp [Std.Roo.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -408,6 +416,11 @@ public theorem mkSlice_roc_eq_mkSlice_roo {xs : Array α} {lo hi : Nat} :
     xs[lo<...=hi] = xs[lo<...(hi + 1)] := by
   simp [Std.Roc.Sliceable.mkSlice, Std.Roo.Sliceable.mkSlice]
 
+@[grind =]
+public theorem mkSlice_roc_eq_mkSlice_rco {xs : Array α} {lo hi : Nat} :
+    xs[lo<...=hi] = xs[(lo + 1)...(hi + 1)] := by
+  simp
+
 public theorem mkSlice_roc_eq_mkSlice_roo_min {xs : Array α} {lo hi : Nat} :
     xs[lo<...=hi] = xs[(min (lo + 1) (min (hi + 1) xs.size))...(min (hi + 1) xs.size)] := by
   simp [mkSlice_rco_eq_mkSlice_rco_min]
@@ -452,6 +465,11 @@ public theorem mkSlice_roi_eq_mkSlice_roo {xs : Array α} {lo : Nat} :
     xs[lo<...*] = xs[lo<...xs.size] := by
   simp [mkSlice_rci_eq_mkSlice_rco]
 
+@[grind =]
+public theorem mkSlice_roi_eq_mkSlice_rco {xs : Array α} {lo : Nat} :
+    xs[lo<...*] = xs[(lo + 1)...xs.size] := by
+  simp [mkSlice_rci_eq_mkSlice_rco]
+
 public theorem mkSlice_roi_eq_mkSlice_roo_min {xs : Array α} {lo : Nat} :
     xs[lo<...*] = xs[(min (lo + 1) xs.size)...xs.size] := by
   simp [mkSlice_rco_eq_mkSlice_rco_min]
@@ -476,7 +494,7 @@ public theorem array_mkSlice_rio {xs : Array α} {hi : Nat} :
     xs[*...hi].array = xs := by
   simp [Std.Rio.Sliceable.mkSlice, Array.toSubarray, apply_dite, Subarray.array]
 
-@[simp]
+@[simp, grind =]
 public theorem start_mkSlice_rio {xs : Array α} {hi : Nat} :
     xs[*...hi].start = 0 := by
   simp [Std.Rio.Sliceable.mkSlice]
@@ -486,7 +504,7 @@ public theorem stop_mkSlice_rio {xs : Array α} {hi : Nat} :
     xs[*...hi].stop = min hi xs.size := by
   simp [Std.Rio.Sliceable.mkSlice]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rio_eq_mkSlice_rco {xs : Array α} {hi : Nat} :
     xs[*...hi] = xs[0...hi] := by
   simp [Std.Rio.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -515,7 +533,7 @@ public theorem array_mkSlice_ric {xs : Array α} {hi : Nat} :
     xs[*...=hi].array = xs := by
   simp [Std.Ric.Sliceable.mkSlice, Array.toSubarray, apply_dite, Subarray.array]
 
-@[simp]
+@[simp, grind =]
 public theorem start_mkSlice_ric {xs : Array α} {hi : Nat} :
     xs[*...=hi].start = 0 := by
   simp [Std.Ric.Sliceable.mkSlice]
@@ -530,6 +548,11 @@ public theorem mkSlice_ric_eq_mkSlice_rio {xs : Array α} {hi : Nat} :
     xs[*...=hi] = xs[*...(hi + 1)] := by
   simp [Std.Ric.Sliceable.mkSlice, Std.Rio.Sliceable.mkSlice]
 
+@[grind =]
+public theorem mkSlice_ric_eq_mkSlice_rco {xs : Array α} {hi : Nat} :
+    xs[*...=hi] = xs[0...(hi + 1)] := by
+  simp
+
 public theorem mkSlice_ric_eq_mkSlice_rio_min {xs : Array α} {hi : Nat} :
     xs[*...=hi] = xs[*...(min (hi + 1) xs.size)] := by
   simp [mkSlice_rco_eq_mkSlice_rco_min]
@@ -559,11 +582,16 @@ public theorem mkSlice_rii_eq_mkSlice_rio {xs : Array α} :
     xs[*...*] = xs[*...xs.size] := by
   simp [mkSlice_rci_eq_mkSlice_rco]
 
+@[grind =]
+public theorem mkSlice_rii_eq_mkSlice_rco {xs : Array α} :
+    xs[*...*] = xs[0...xs.size] := by
+  simp
+
 public theorem mkSlice_rii_eq_mkSlice_rio_min {xs : Array α} :
     xs[*...*] = xs[*...xs.size] := by
   simp [mkSlice_rco_eq_mkSlice_rco_min]
 
-@[simp]
+@[simp, grind =]
 public theorem toList_mkSlice_rii {xs : Array α} :
     xs[*...*].toList = xs.toList := by
   rw [mkSlice_rii_eq_mkSlice_rci, toList_mkSlice_rci, List.drop_zero]
@@ -573,7 +601,7 @@ public theorem toArray_mkSlice_rii {xs : Array α} :
     xs[*...*].toArray = xs := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem size_mkSlice_rii {xs : Array α} :
     xs[*...*].size = xs.size := by
   simp [← Subarray.length_toList]
@@ -583,12 +611,12 @@ public theorem array_mkSlice_rii {xs : Array α} :
     xs[*...*].array = xs := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem start_mkSlice_rii {xs : Array α} :
     xs[*...*].start = 0 := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem stop_mkSlice_rii {xs : Array α} :
     xs[*...*].stop = xs.size := by
   simp [Std.Rii.Sliceable.mkSlice]
@@ -599,7 +627,7 @@ section SubarraySlices
 
 namespace Subarray
 
-@[simp]
+@[simp, grind =]
 public theorem toList_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
     xs[lo...hi].toList = (xs.toList.take hi).drop lo := by
   simp only [Std.Rco.Sliceable.mkSlice, Std.Rco.HasRcoIntersection.intersection, toList_eq,
@@ -608,12 +636,12 @@ public theorem toList_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
   rw [Nat.add_sub_cancel' (by omega)]
   simp [Subarray.size, ← Array.length_toList, ← List.take_eq_take_min, Nat.add_comm xs.start]
 
-@[simp]
+@[simp, grind =]
 public theorem toArray_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
     xs[lo...hi].toArray = xs.toArray.extract lo hi := by
   simp [← Subarray.toArray_toList, List.drop_take]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rcc_eq_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
     xs[lo...=hi] = xs[lo...(hi + 1)] := by
   simp [Std.Rcc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice,
@@ -629,7 +657,7 @@ public theorem toArray_mkSlice_rcc {xs : Subarray α} {lo hi : Nat} :
     xs[lo...=hi].toArray = xs.toArray.extract lo (hi + 1) := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rci_eq_mkSlice_rco {xs : Subarray α} {lo : Nat} :
     xs[lo...*] = xs[lo...xs.size] := by
   simp [Std.Rci.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice,
@@ -651,12 +679,17 @@ public theorem mkSlice_roc_eq_mkSlice_roo {xs : Subarray α} {lo hi : Nat} :
   simp [Std.Roc.Sliceable.mkSlice, Std.Roo.Sliceable.mkSlice,
     Std.Roc.HasRcoIntersection.intersection, Std.Roo.HasRcoIntersection.intersection]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roo_eq_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
     xs[lo<...hi] = xs[(lo + 1)...hi] := by
   simp [Std.Roo.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice,
     Std.Roo.HasRcoIntersection.intersection, Std.Rco.HasRcoIntersection.intersection]
 
+@[grind =]
+public theorem mkSlice_roc_eq_mkSlice_rco {xs : Subarray α} {lo hi : Nat} :
+    xs[lo<...=hi] = xs[(lo + 1)...(hi + 1)] := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_roo {xs : Subarray α} {lo hi : Nat} :
     xs[lo<...hi].toList = (xs.toList.take hi).drop (lo + 1) := by
@@ -670,8 +703,7 @@ public theorem toArray_mkSlice_roo {xs : Subarray α} {lo hi : Nat} :
 @[simp]
 public theorem mkSlice_roc_eq_mkSlice_rcc {xs : Subarray α} {lo hi : Nat} :
     xs[lo<...=hi] = xs[(lo + 1)...=hi] := by
-  simp [Std.Roc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice,
-    Std.Roc.HasRcoIntersection.intersection, Std.Rco.HasRcoIntersection.intersection]
+  simp
 
 @[simp]
 public theorem toList_mkSlice_roc {xs : Subarray α} {lo hi : Nat} :
@@ -689,6 +721,11 @@ public theorem mkSlice_roi_eq_mkSlice_rci {xs : Subarray α} {lo : Nat} :
   simp [Std.Roi.Sliceable.mkSlice, Std.Rci.Sliceable.mkSlice,
     Std.Roi.HasRcoIntersection.intersection, Std.Rci.HasRcoIntersection.intersection]
 
+@[grind =]
+public theorem mkSlice_roi_eq_mkSlice_rco {xs : Subarray α} {lo : Nat} :
+    xs[lo<...*] = xs[(lo + 1)...xs.size] := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_roi {xs : Subarray α} {lo : Nat} :
     xs[lo<...*].toList = xs.toList.drop (lo + 1) := by
@@ -705,12 +742,17 @@ public theorem mkSlice_ric_eq_mkSlice_rio {xs : Subarray α} {hi : Nat} :
   simp [Std.Ric.Sliceable.mkSlice, Std.Rio.Sliceable.mkSlice,
     Std.Ric.HasRcoIntersection.intersection, Std.Rio.HasRcoIntersection.intersection]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rio_eq_mkSlice_rco {xs : Subarray α} {hi : Nat} :
     xs[*...hi] = xs[0...hi] := by
   simp [Std.Rio.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice,
     Std.Rio.HasRcoIntersection.intersection, Std.Rco.HasRcoIntersection.intersection]
 
+@[grind =]
+public theorem mkSlice_ric_eq_mkSlice_rco {xs : Subarray α} {hi : Nat} :
+    xs[*...=hi] = xs[0...(hi + 1)] := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_rio {xs : Subarray α} {hi : Nat} :
     xs[*...hi].toList = xs.toList.take hi := by
@@ -737,7 +779,7 @@ public theorem toArray_mkSlice_ric {xs : Subarray α} {hi : Nat} :
     xs[*...=hi].toArray = xs.toArray.extract 0 (hi + 1) := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rii {xs : Subarray α} :
     xs[*...*] = xs := by
   simp [Std.Rii.Sliceable.mkSlice]

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

@@ -47,21 +47,28 @@ public theorem toList_eq {xs : ListSlice α} :
   simp only [Std.Slice.toList, toList_internalIter]
   rfl
 
+@[simp, grind =]
 public theorem toArray_toList {xs : ListSlice α} :
     xs.toList.toArray = xs.toArray := by
   simp [Std.Slice.toArray, Std.Slice.toList]
 
+@[simp, grind =]
 public theorem toList_toArray {xs : ListSlice α} :
     xs.toArray.toList = xs.toList := by
   simp [Std.Slice.toArray, Std.Slice.toList]
 
-@[simp]
+@[simp, grind =]
 public theorem length_toList {xs : ListSlice α} :
     xs.toList.length = xs.size := by
   simp [ListSlice.toList_eq, Std.Slice.size, Std.Slice.SliceSize.size, ← Iter.length_toList_eq_count,
     toList_internalIter]; rfl
 
-@[simp]
+@[grind =]
+public theorem size_eq_length_toList {xs : ListSlice α} :
+    xs.size = xs.toList.length :=
+  length_toList.symm
+
+@[simp, grind =]
 public theorem size_toArray {xs : ListSlice α} :
     xs.toArray.size = xs.size := by
   simp [← ListSlice.toArray_toList]
@@ -70,7 +77,7 @@ end ListSlice
 
 namespace List
 
-@[simp]
+@[simp, grind =]
 public theorem toList_mkSlice_rco {xs : List α} {lo hi : Nat} :
     xs[lo...hi].toList = (xs.take hi).drop lo := by
   rw [List.take_eq_take_min, List.drop_eq_drop_min]
@@ -81,17 +88,17 @@ public theorem toList_mkSlice_rco {xs : List α} {lo hi : Nat} :
   · have : min hi xs.length ≤ lo := by omega
     simp [h, Nat.min_eq_right this]
 
-@[simp]
+@[simp, grind =]
 public theorem toArray_mkSlice_rco {xs : List α} {lo hi : Nat} :
     xs[lo...hi].toArray = ((xs.take hi).drop lo).toArray := by
   simp [← ListSlice.toArray_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem size_mkSlice_rco {xs : List α} {lo hi : Nat} :
     xs[lo...hi].size = min hi xs.length - lo := by
   simp [← ListSlice.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rcc_eq_mkSlice_rco {xs : List α} {lo hi : Nat} :
     xs[lo...=hi] = xs[lo...(hi + 1)] := by
   simp [Std.Rcc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -122,12 +129,22 @@ public theorem toArray_mkSlice_rci {xs : List α} {lo : Nat} :
     xs[lo...*].toArray = (xs.drop lo).toArray := by
   simp [← ListSlice.toArray_toList]
 
+@[grind =]
+public theorem toList_mkSlice_rci_eq_toList_mkSlice_rco {xs : List α} {lo : Nat} :
+    xs[lo...*].toList = xs[lo...xs.length].toList := by
+  simp
+
+@[grind =]
+public theorem toArray_mkSlice_rci_eq_toArray_mkSlice_rco {xs : List α} {lo : Nat} :
+    xs[lo...*].toArray = xs[lo...xs.length].toArray := by
+  simp
+
 @[simp]
 public theorem size_mkSlice_rci {xs : List α} {lo : Nat} :
     xs[lo...*].size = xs.length - lo := by
   simp [← ListSlice.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roo_eq_mkSlice_rco {xs : List α} {lo hi : Nat} :
     xs[lo<...hi] = xs[(lo + 1)...hi] := by
   simp [Std.Roo.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -152,6 +169,11 @@ public theorem mkSlice_roc_eq_mkSlice_roo {xs : List α} {lo hi : Nat} :
     xs[lo<...=hi] = xs[lo<...(hi + 1)] := by
   simp [Std.Roc.Sliceable.mkSlice, Std.Roo.Sliceable.mkSlice]
 
+@[simp, grind =]
+public theorem mkSlice_roc_eq_mkSlice_rco {xs : List α} {lo hi : Nat} :
+    xs[lo<...=hi] = xs[(lo + 1)...(hi + 1)] := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_roc {xs : List α} {lo hi : Nat} :
     xs[lo<...=hi].toList = (xs.take (hi + 1)).drop (lo + 1) := by
@@ -167,11 +189,27 @@ public theorem size_mkSlice_roc {xs : List α} {lo hi : Nat} :
     xs[lo<...=hi].size = min (hi + 1) xs.length - (lo + 1) := by
   simp [← ListSlice.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roi_eq_mkSlice_rci {xs : List α} {lo : Nat} :
     xs[lo<...*] = xs[(lo + 1)...*] := by
   simp [Std.Roi.Sliceable.mkSlice, Std.Rci.Sliceable.mkSlice]
 
+public theorem toList_mkSlice_roi_eq_toList_mkSlice_roo {xs : List α} {lo : Nat} :
+    xs[lo<...*].toList = xs[lo<...xs.length].toList := by
+  simp
+
+public theorem toArray_mkSlice_roi_eq_toArray_mkSlice_roo {xs : List α} {lo : Nat} :
+    xs[lo<...*].toArray = xs[lo<...xs.length].toArray := by
+  simp
+
+public theorem toList_mkSlice_roi_eq_toList_mkSlice_rco {xs : List α} {lo : Nat} :
+    xs[lo<...*].toList = xs[(lo + 1)...xs.length].toList := by
+  simp
+
+public theorem toArray_mkSlice_roi_eq_toArray_mkSlice_rco {xs : List α} {lo : Nat} :
+    xs[lo<...*].toArray = xs[(lo + 1)...xs.length].toArray := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_roi {xs : List α} {lo : Nat} :
     xs[lo<...*].toList = xs.drop (lo + 1) := by
@@ -187,7 +225,7 @@ public theorem size_mkSlice_roi {xs : List α} {lo : Nat} :
     xs[lo<...*].size = xs.length - (lo + 1) := by
   simp [← ListSlice.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rio_eq_mkSlice_rco {xs : List α} {hi : Nat} :
     xs[*...hi] = xs[0...hi] := by
   simp [Std.Rio.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -212,6 +250,11 @@ public theorem mkSlice_ric_eq_mkSlice_rio {xs : List α} {hi : Nat} :
     xs[*...=hi] = xs[*...(hi + 1)] := by
   simp [Std.Ric.Sliceable.mkSlice, Std.Rio.Sliceable.mkSlice]
 
+@[grind =]
+public theorem mkSlice_ric_eq_mkSlice_rco {xs : List α} {hi : Nat} :
+    xs[*...=hi] = xs[0...(hi + 1)] := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_ric {xs : List α} {hi : Nat} :
     xs[*...=hi].toList = xs.take (hi + 1) := by
@@ -227,11 +270,19 @@ public theorem size_mkSlice_ric {xs : List α} {hi : Nat} :
     xs[*...=hi].size = min (hi + 1) xs.length := by
   simp [← ListSlice.length_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rii_eq_mkSlice_rci {xs : List α} :
     xs[*...*] = xs[0...*] := by
   simp [Std.Rii.Sliceable.mkSlice, Std.Rci.Sliceable.mkSlice]
 
+public theorem toList_mkSlice_rii_eq_toList_mkSlice_rco {xs : List α} :
+    xs[*...*].toList = xs[0...xs.length].toList := by
+  simp
+
+public theorem toArray_mkSlice_rii_eq_toArray_mkSlice_rco {xs : List α} :
+    xs[*...*].toArray = xs[0...xs.length].toArray := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_rii {xs : List α} :
     xs[*...*].toList = xs := by
@@ -253,7 +304,7 @@ section ListSubslices
 
 namespace ListSlice
 
-@[simp]
+@[simp, grind =]
 public theorem toList_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
     xs[lo...hi].toList = (xs.toList.take hi).drop lo := by
   simp only [instSliceableListSliceNat_1, List.toList_mkSlice_rco, ListSlice.toList_eq (xs := xs)]
@@ -262,12 +313,12 @@ public theorem toList_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
   · simp
   · simp [List.take_take, Nat.min_comm]
 
-@[simp]
+@[simp, grind =]
 public theorem toArray_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
     xs[lo...hi].toArray = xs.toArray.extract lo hi := by
   simp [← toArray_toList, List.drop_take]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rcc_eq_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
     xs[lo...=hi] = xs[lo...(hi + 1)] := by
   simp [Std.Rcc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -295,9 +346,19 @@ public theorem toArray_mkSlice_rci {xs : ListSlice α} {lo : Nat} :
     xs[lo...*].toArray = xs.toArray.extract lo := by
   simp only [← toArray_toList, toList_mkSlice_rci]
   rw (occs := [1]) [← List.take_length (l := List.drop lo xs.toList)]
+  simp [- toArray_toList]
+
+@[grind =]
+public theorem toList_mkSlice_rci_eq_toList_mkSlice_rco {xs : ListSlice α} {lo : Nat} :
+    xs[lo...*].toList = xs[lo...xs.size].toList := by
+  simp [← length_toList, - Slice.length_toList_eq_size]
+
+@[grind =]
+public theorem toArray_mkSlice_rci_eq_toArray_mkSlice_rco {xs : ListSlice α} {lo : Nat} :
+    xs[lo...*].toArray = xs[lo...xs.size].toArray := by
   simp
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roo_eq_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
     xs[lo<...hi] = xs[(lo + 1)...hi] := by
   simp [Std.Roo.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -322,6 +383,11 @@ public theorem mkSlice_roc_eq_mkSlice_rcc {xs : ListSlice α} {lo hi : Nat} :
     xs[lo<...=hi] = xs[(lo + 1)...=hi] := by
   simp [Std.Roc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
 
+@[simp, grind =]
+public theorem mkSlice_roc_eq_mkSlice_rco {xs : ListSlice α} {lo hi : Nat} :
+    xs[lo<...=hi] = xs[(lo + 1)...(hi + 1)] := by
+  simp [Std.Roc.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
+
 @[simp]
 public theorem toList_mkSlice_roc {xs : ListSlice α} {lo hi : Nat} :
     xs[lo<...=hi].toList = (xs.toList.take (hi + 1)).drop (lo + 1) := by
@@ -332,11 +398,28 @@ public theorem toArray_mkSlice_roc {xs : ListSlice α} {lo hi : Nat} :
     xs[lo<...=hi].toArray = xs.toArray.extract (lo + 1) (hi + 1) := by
   simp [← toArray_toList, List.drop_take]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_roi_eq_mkSlice_rci {xs : ListSlice α} {lo : Nat} :
     xs[lo<...*] = xs[(lo + 1)...*] := by
   simp [Std.Roi.Sliceable.mkSlice, Std.Rci.Sliceable.mkSlice]
 
+public theorem toList_mkSlice_roi_eq_toList_mkSlice_roo {xs : ListSlice α} {lo : Nat} :
+    xs[lo<...*].toList = xs[lo<...xs.size].toList := by
+  simp [← length_toList, - Slice.length_toList_eq_size]
+
+public theorem toArray_mkSlice_roi_eq_toArray_mkSlice_roo {xs : ListSlice α} {lo : Nat} :
+    xs[lo<...*].toArray = xs[lo<...xs.size].toArray := by
+  simp only [mkSlice_roi_eq_mkSlice_rci, toArray_mkSlice_rci, size_toArray_eq_size,
+    mkSlice_roo_eq_mkSlice_rco, toArray_mkSlice_rco]
+
+public theorem toList_mkSlice_roi_eq_toList_mkSlice_rco {xs : ListSlice α} {lo : Nat} :
+    xs[lo<...*].toList = xs[(lo + 1)...xs.size].toList := by
+  simp [← length_toList, - Slice.length_toList_eq_size]
+
+public theorem toArray_mkSlice_roi_eq_toArray_mkSlice_rco {xs : ListSlice α} {lo : Nat} :
+    xs[lo<...*].toArray = xs[(lo + 1)...xs.size].toArray := by
+  simp
+
 @[simp]
 public theorem toList_mkSlice_roi {xs : ListSlice α} {lo : Nat} :
     xs[lo<...*].toList = xs.toList.drop (lo + 1) := by
@@ -347,9 +430,9 @@ public theorem toArray_mkSlice_roi {xs : ListSlice α} {lo : Nat} :
     xs[lo<...*].toArray = xs.toArray.extract (lo + 1) := by
   simp only [← toArray_toList, toList_mkSlice_roi]
   rw (occs := [1]) [← List.take_length (l := List.drop (lo + 1) xs.toList)]
-  simp
+  simp [- toArray_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rio_eq_mkSlice_rco {xs : ListSlice α} {hi : Nat} :
     xs[*...hi] = xs[0...hi] := by
   simp [Std.Rio.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
@@ -374,6 +457,11 @@ public theorem mkSlice_ric_eq_mkSlice_rcc {xs : ListSlice α} {hi : Nat} :
     xs[*...=hi] = xs[0...=hi] := by
   simp [Std.Ric.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
 
+@[grind =]
+public theorem mkSlice_ric_eq_mkSlice_rco {xs : ListSlice α} {hi : Nat} :
+    xs[*...=hi] = xs[0...(hi + 1)] := by
+  simp [Std.Ric.Sliceable.mkSlice, Std.Rco.Sliceable.mkSlice]
+
 @[simp]
 public theorem toList_mkSlice_ric {xs : ListSlice α} {hi : Nat} :
     xs[*...=hi].toList = xs.toList.take (hi + 1) := by
@@ -384,7 +472,7 @@ public theorem toArray_mkSlice_ric {xs : ListSlice α} {hi : Nat} :
     xs[*...=hi].toArray = xs.toArray.extract 0 (hi + 1) := by
   simp [← toArray_toList]
 
-@[simp]
+@[simp, grind =]
 public theorem mkSlice_rii {xs : ListSlice α} :
     xs[*...*] = xs := by
   simp [Std.Rii.Sliceable.mkSlice]

src/Init/Data/String/Bootstrap.lean

@@ -123,18 +123,6 @@ opaque getUTF8Byte (s : @& String) (n : Nat) (h : n < s.utf8ByteSize) : UInt8
 
 end String.Internal
 
-/--
-Creates a string that contains the characters in a list, in order.
-
-Examples:
- * `['L', '∃', '∀', 'N'].asString = "L∃∀N"`
- * `[].asString = ""`
- * `['a', 'a', 'a'].asString = "aaa"`
--/
-@[extern "lean_string_mk", expose]
-def String.ofList (data : List Char) : String :=
-  ⟨List.utf8Encode data,.intro data rfl⟩
-
 @[extern "lean_string_mk", expose, deprecated String.ofList (since := "2025-10-30")]
 def String.mk (data : List Char) : String :=
   ⟨List.utf8Encode data,.intro data rfl⟩

src/Init/MetaTypes.lean

@@ -143,6 +143,7 @@ end DSimp
 
 namespace Simp
 
+@[inline]
 def defaultMaxSteps := 100000
 
 /--

src/Init/Prelude.lean

@@ -3192,7 +3192,7 @@ Constructs a new empty array with initial capacity `0`.
 
 Use `Array.emptyWithCapacity` to create an array with a greater initial capacity.
 -/
-@[expose]
+@[expose, inline]
 def Array.empty {α : Type u} : Array α := emptyWithCapacity 0
 
 /--
@@ -3481,6 +3481,18 @@ structure String where ofByteArray ::
 attribute [extern "lean_string_to_utf8"] String.toByteArray
 attribute [extern "lean_string_from_utf8_unchecked"] String.ofByteArray
 
+/--
+Creates a string that contains the characters in a list, in order.
+
+Examples:
+ * `String.ofList ['L', '∃', '∀', 'N'] = "L∃∀N"`
+ * `String.ofList [] = ""`
+ * `String.ofList ['a', 'a', 'a'] = "aaa"`
+-/
+@[extern "lean_string_mk"]
+def String.ofList (data : List Char) : String :=
+  ⟨List.utf8Encode data, .intro data rfl⟩
+
 /--
 Decides whether two strings are equal. Normally used via the `DecidableEq String` instance and the
 `=` operator.

src/Init/Sym.lean

@@ -0,0 +1,8 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Init.Sym.Lemmas

src/Init/Sym/Lemmas.lean

@@ -0,0 +1,210 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Init.Data.Nat.Basic
+public import Init.Data.Rat.Basic
+public import Init.Data.Int.Basic
+public import Init.Data.UInt.Basic
+public import Init.Data.SInt.Basic
+public section
+namespace Lean.Sym
+
+theorem ne_self (a : α) : (a ≠ a) = False := by simp
+
+theorem ite_cond_congr {α : Sort u} (c : Prop) {inst : Decidable c} (a b : α)
+    (c' : Prop) {inst' : Decidable c'} (h : c = c') : @ite α c inst a b = @ite α c' inst' a b := by
+  simp [*]
+
+theorem dite_cond_congr {α : Sort u} (c : Prop) {inst : Decidable c} (a : c → α) (b : ¬ c → α)
+    (c' : Prop) {inst' : Decidable c'} (h : c = c')
+    : @dite α c inst a b = @dite α c' inst' (fun h' => a (h.mpr_prop h')) (fun h' => b (h.mpr_not h')) := by
+  simp [*]
+
+theorem cond_cond_eq_true {α : Sort u} (c : Bool) (a b : α) (h : c = true) : cond c a b = a := by
+  simp [*]
+
+theorem cond_cond_eq_false {α : Sort u} (c : Bool) (a b : α) (h : c = false) : cond c a b = b := by
+  simp [*]
+
+theorem cond_cond_congr {α : Sort u} (c : Bool) (a b : α) (c' : Bool) (h : c = c') : cond c a b = cond c' a b := by
+  simp [*]
+
+theorem Nat.lt_eq_true (a b : Nat) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Int.lt_eq_true (a b : Int) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Rat.lt_eq_true (a b : Rat) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Int8.lt_eq_true (a b : Int8) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Int16.lt_eq_true (a b : Int16) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Int32.lt_eq_true (a b : Int32) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Int64.lt_eq_true (a b : Int64) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem UInt8.lt_eq_true (a b : UInt8) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem UInt16.lt_eq_true (a b : UInt16) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem UInt32.lt_eq_true (a b : UInt32) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem UInt64.lt_eq_true (a b : UInt64) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem Fin.lt_eq_true (a b : Fin n) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+theorem BitVec.lt_eq_true (a b : BitVec n) (h : decide (a < b) = true) : (a < b) = True := by simp_all
+
+theorem Nat.lt_eq_false (a b : Nat) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Int.lt_eq_false (a b : Int) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Rat.lt_eq_false (a b : Rat) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Int8.lt_eq_false (a b : Int8) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Int16.lt_eq_false (a b : Int16) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Int32.lt_eq_false (a b : Int32) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Int64.lt_eq_false (a b : Int64) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem UInt8.lt_eq_false (a b : UInt8) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem UInt16.lt_eq_false (a b : UInt16) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem UInt32.lt_eq_false (a b : UInt32) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem UInt64.lt_eq_false (a b : UInt64) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem Fin.lt_eq_false (a b : Fin n) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+theorem BitVec.lt_eq_false (a b : BitVec n) (h : decide (a < b) = false) : (a < b) = False := by simp_all
+
+theorem Nat.le_eq_true (a b : Nat) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Int.le_eq_true (a b : Int) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Rat.le_eq_true (a b : Rat) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Int8.le_eq_true (a b : Int8) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Int16.le_eq_true (a b : Int16) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Int32.le_eq_true (a b : Int32) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Int64.le_eq_true (a b : Int64) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem UInt8.le_eq_true (a b : UInt8) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem UInt16.le_eq_true (a b : UInt16) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem UInt32.le_eq_true (a b : UInt32) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem UInt64.le_eq_true (a b : UInt64) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem Fin.le_eq_true (a b : Fin n) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+theorem BitVec.le_eq_true (a b : BitVec n) (h : decide (a ≤ b) = true) : (a ≤ b) = True := by simp_all
+
+theorem Nat.le_eq_false (a b : Nat) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Int.le_eq_false (a b : Int) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Rat.le_eq_false (a b : Rat) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Int8.le_eq_false (a b : Int8) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Int16.le_eq_false (a b : Int16) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Int32.le_eq_false (a b : Int32) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Int64.le_eq_false (a b : Int64) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem UInt8.le_eq_false (a b : UInt8) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem UInt16.le_eq_false (a b : UInt16) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem UInt32.le_eq_false (a b : UInt32) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem UInt64.le_eq_false (a b : UInt64) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem Fin.le_eq_false (a b : Fin n) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+theorem BitVec.le_eq_false (a b : BitVec n) (h : decide (a ≤ b) = false) : (a ≤ b) = False := by simp_all
+
+theorem Nat.gt_eq_true (a b : Nat) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Int.gt_eq_true (a b : Int) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Rat.gt_eq_true (a b : Rat) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Int8.gt_eq_true (a b : Int8) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Int16.gt_eq_true (a b : Int16) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Int32.gt_eq_true (a b : Int32) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Int64.gt_eq_true (a b : Int64) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem UInt8.gt_eq_true (a b : UInt8) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem UInt16.gt_eq_true (a b : UInt16) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem UInt32.gt_eq_true (a b : UInt32) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem UInt64.gt_eq_true (a b : UInt64) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem Fin.gt_eq_true (a b : Fin n) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+theorem BitVec.gt_eq_true (a b : BitVec n) (h : decide (a > b) = true) : (a > b) = True := by simp_all
+
+theorem Nat.gt_eq_false (a b : Nat) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Int.gt_eq_false (a b : Int) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Rat.gt_eq_false (a b : Rat) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Int8.gt_eq_false (a b : Int8) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Int16.gt_eq_false (a b : Int16) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Int32.gt_eq_false (a b : Int32) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Int64.gt_eq_false (a b : Int64) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem UInt8.gt_eq_false (a b : UInt8) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem UInt16.gt_eq_false (a b : UInt16) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem UInt32.gt_eq_false (a b : UInt32) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem UInt64.gt_eq_false (a b : UInt64) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem Fin.gt_eq_false (a b : Fin n) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+theorem BitVec.gt_eq_false (a b : BitVec n) (h : decide (a > b) = false) : (a > b) = False := by simp_all
+
+theorem Nat.ge_eq_true (a b : Nat) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Int.ge_eq_true (a b : Int) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Rat.ge_eq_true (a b : Rat) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Int8.ge_eq_true (a b : Int8) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Int16.ge_eq_true (a b : Int16) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Int32.ge_eq_true (a b : Int32) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Int64.ge_eq_true (a b : Int64) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem UInt8.ge_eq_true (a b : UInt8) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem UInt16.ge_eq_true (a b : UInt16) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem UInt32.ge_eq_true (a b : UInt32) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem UInt64.ge_eq_true (a b : UInt64) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem Fin.ge_eq_true (a b : Fin n) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+theorem BitVec.ge_eq_true (a b : BitVec n) (h : decide (a ≥ b) = true) : (a ≥ b) = True := by simp_all
+
+theorem Nat.ge_eq_false (a b : Nat) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Int.ge_eq_false (a b : Int) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Rat.ge_eq_false (a b : Rat) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Int8.ge_eq_false (a b : Int8) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Int16.ge_eq_false (a b : Int16) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Int32.ge_eq_false (a b : Int32) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Int64.ge_eq_false (a b : Int64) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem UInt8.ge_eq_false (a b : UInt8) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem UInt16.ge_eq_false (a b : UInt16) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem UInt32.ge_eq_false (a b : UInt32) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem UInt64.ge_eq_false (a b : UInt64) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem Fin.ge_eq_false (a b : Fin n) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+theorem BitVec.ge_eq_false (a b : BitVec n) (h : decide (a ≥ b) = false) : (a ≥ b) = False := by simp_all
+
+theorem Nat.eq_eq_true (a b : Nat) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Int.eq_eq_true (a b : Int) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Rat.eq_eq_true (a b : Rat) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Int8.eq_eq_true (a b : Int8) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Int16.eq_eq_true (a b : Int16) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Int32.eq_eq_true (a b : Int32) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Int64.eq_eq_true (a b : Int64) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem UInt8.eq_eq_true (a b : UInt8) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem UInt16.eq_eq_true (a b : UInt16) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem UInt32.eq_eq_true (a b : UInt32) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem UInt64.eq_eq_true (a b : UInt64) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem Fin.eq_eq_true (a b : Fin n) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+theorem BitVec.eq_eq_true (a b : BitVec n) (h : decide (a = b) = true) : (a = b) = True := by simp_all
+
+theorem Nat.eq_eq_false (a b : Nat) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Int.eq_eq_false (a b : Int) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Rat.eq_eq_false (a b : Rat) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Int8.eq_eq_false (a b : Int8) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Int16.eq_eq_false (a b : Int16) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Int32.eq_eq_false (a b : Int32) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Int64.eq_eq_false (a b : Int64) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem UInt8.eq_eq_false (a b : UInt8) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem UInt16.eq_eq_false (a b : UInt16) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem UInt32.eq_eq_false (a b : UInt32) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem UInt64.eq_eq_false (a b : UInt64) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem Fin.eq_eq_false (a b : Fin n) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+theorem BitVec.eq_eq_false (a b : BitVec n) (h : decide (a = b) = false) : (a = b) = False := by simp_all
+
+theorem Nat.ne_eq_true (a b : Nat) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Int.ne_eq_true (a b : Int) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Rat.ne_eq_true (a b : Rat) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Int8.ne_eq_true (a b : Int8) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Int16.ne_eq_true (a b : Int16) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Int32.ne_eq_true (a b : Int32) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Int64.ne_eq_true (a b : Int64) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem UInt8.ne_eq_true (a b : UInt8) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem UInt16.ne_eq_true (a b : UInt16) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem UInt32.ne_eq_true (a b : UInt32) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem UInt64.ne_eq_true (a b : UInt64) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem Fin.ne_eq_true (a b : Fin n) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+theorem BitVec.ne_eq_true (a b : BitVec n) (h : decide (a ≠ b) = true) : (a ≠ b) = True := by simp_all
+
+theorem Nat.ne_eq_false (a b : Nat) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Int.ne_eq_false (a b : Int) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Rat.ne_eq_false (a b : Rat) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Int8.ne_eq_false (a b : Int8) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Int16.ne_eq_false (a b : Int16) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Int32.ne_eq_false (a b : Int32) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Int64.ne_eq_false (a b : Int64) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem UInt8.ne_eq_false (a b : UInt8) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem UInt16.ne_eq_false (a b : UInt16) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem UInt32.ne_eq_false (a b : UInt32) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem UInt64.ne_eq_false (a b : UInt64) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem Fin.ne_eq_false (a b : Fin n) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+theorem BitVec.ne_eq_false (a b : BitVec n) (h : decide (a ≠ b) = false) : (a ≠ b) = False := by simp_all
+
+theorem Nat.dvd_eq_true (a b : Nat) (h : decide (a ∣ b) = true) : (a ∣ b) = True := by simp_all
+theorem Int.dvd_eq_true (a b : Int) (h : decide (a ∣ b) = true) : (a ∣ b) = True := by simp_all
+
+theorem Nat.dvd_eq_false (a b : Nat) (h : decide (a ∣ b) = false) : (a ∣ b) = False := by simp_all
+theorem Int.dvd_eq_false (a b : Int) (h : decide (a ∣ b) = false) : (a ∣ b) = False := by simp_all
+
+end Lean.Sym

src/Init/Tactics.lean

@@ -546,7 +546,7 @@ introducing new local definitions.
 For example, given a local hypotheses if the form `h : let x := v; b x`, then `extract_lets z at h`
 introduces a new local definition `z := v` and changes `h` to be `h : b z`.
 -/
-syntax (name := extractLets) "extract_lets " optConfig (ppSpace colGt (ident <|> hole))* (location)? : tactic
+syntax (name := extractLets) "extract_lets" ppSpace optConfig (ppSpace colGt (ident <|> hole))* (location)? : tactic
 
 /--
 Lifts `let` and `have` expressions within a term as far out as possible.

src/Lean/Compiler/ClosedTermCache.lean

@@ -28,7 +28,8 @@ builtin_initialize closedTermCacheExt : EnvExtension ClosedTermCache ←
         { s with map := s.map.insert e c, constNames := s.constNames.insert c, revExprs := e :: s.revExprs })
 
 def cacheClosedTermName (env : Environment) (e : Expr) (n : Name) : Environment :=
-  closedTermCacheExt.modifyState env fun s => { s with map := s.map.insert e n, constNames := s.constNames.insert n }
+  closedTermCacheExt.modifyState env fun s =>
+    { s with map := s.map.insert e n, constNames := s.constNames.insert n, revExprs := e :: s.revExprs }
 
 def getClosedTermName? (env : Environment) (e : Expr) : Option Name :=
   (closedTermCacheExt.getState env).map.find? e

src/Lean/Compiler/IR/CompilerM.lean

@@ -44,7 +44,7 @@ def log (entry : LogEntry) : CompilerM Unit :=
 def tracePrefixOptionName := `trace.compiler.ir
 
 private def isLogEnabledFor (opts : Options) (optName : Name) : Bool :=
-  match opts.find optName with
+  match opts.get? optName with
   | some (DataValue.ofBool v) => v
   | _     => opts.getBool tracePrefixOptionName
 

src/Lean/Compiler/LCNF.lean

@@ -45,3 +45,4 @@ public import Lean.Compiler.LCNF.LambdaLifting
 public import Lean.Compiler.LCNF.ReduceArity
 public import Lean.Compiler.LCNF.Probing
 public import Lean.Compiler.LCNF.Irrelevant
+public import Lean.Compiler.LCNF.SplitSCC

src/Lean/Compiler/LCNF/Check.lean

@@ -258,45 +258,4 @@ end Check
 def Decl.check (decl : Decl) : CompilerM Unit := do
   Check.run do decl.value.forCodeM (Check.checkFunDeclCore decl.name decl.params decl.type)
 
-/--
-Check whether every local declaration in the local context is used in one of given `decls`.
--/
-partial def checkDeadLocalDecls (decls : Array Decl) : CompilerM Unit := do
-  let (_, s) := visitDecls decls |>.run {}
-  let usesFVar (binderName : Name) (fvarId : FVarId) :=
-    unless s.contains fvarId do
-      throwError "LCNF local context contains unused local variable declaration `{binderName}`"
-  let lctx := (← get).lctx
-  lctx.params.forM fun fvarId decl => usesFVar decl.binderName fvarId
-  lctx.letDecls.forM fun fvarId decl => usesFVar decl.binderName fvarId
-  lctx.funDecls.forM fun fvarId decl => usesFVar decl.binderName fvarId
-where
-  visitFVar (fvarId : FVarId) : StateM FVarIdHashSet Unit :=
-    modify (·.insert fvarId)
-
-  visitParam (param : Param) : StateM FVarIdHashSet Unit := do
-    visitFVar param.fvarId
-
-  visitParams (params : Array Param) : StateM FVarIdHashSet Unit := do
-    params.forM visitParam
-
-  visitCode (code : Code) : StateM FVarIdHashSet Unit := do
-    match code with
-    | .jmp .. | .return .. | .unreach .. => return ()
-    | .let decl k => visitFVar decl.fvarId; visitCode k
-    | .fun decl k | .jp decl k =>
-      visitFVar decl.fvarId; visitParams decl.params; visitCode decl.value
-      visitCode k
-    | .cases c => c.alts.forM fun alt => do
-      match alt with
-      | .default k => visitCode k
-      | .alt _ ps k => visitParams ps; visitCode k
-
-  visitDecl (decl : Decl) : StateM FVarIdHashSet Unit := do
-    visitParams decl.params
-    decl.value.forCodeM visitCode
-
-  visitDecls (decls : Array Decl) : StateM FVarIdHashSet Unit :=
-    decls.forM visitDecl
-
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/Closure.lean

@@ -156,7 +156,8 @@ mutual
 
   /-- Collect dependencies of the given expression. -/
   partial def collectType (type : Expr) : ClosureM Unit := do
-    type.forEachWhere Expr.isFVar fun e => collectFVar e.fvarId!
+    if type.hasFVar then
+      type.forEachWhere Expr.isFVar fun e => collectFVar e.fvarId!
 
 end
 

src/Lean/Compiler/LCNF/ExtractClosed.lean

@@ -52,6 +52,10 @@ structure Context where
 
 structure State where
   decls : Array Decl := {}
+  /--
+  Cache for `shouldExtractFVar` in order to avoid superlinear behavior.
+  -/
+  fvarDecisionCache : Std.HashMap FVarId Bool := {}
 
 abbrev M := ReaderT Context $ StateRefT State CompilerM
 
@@ -78,6 +82,10 @@ partial def shouldExtractLetValue (isRoot : Bool) (v : LetValue) : M Bool := do
         | _ => true
         if !shouldExtract then
           return false
+      if let some decl ← LCNF.getMonoDecl? name then
+        -- We don't want to extract constants as root terms
+        if decl.getArity == 0 then
+          return false
     args.allM shouldExtractArg
   | .fvar fnVar args => return (← shouldExtractFVar fnVar) && (← args.allM shouldExtractArg)
   | .proj _ _ baseVar => shouldExtractFVar baseVar
@@ -88,10 +96,18 @@ partial def shouldExtractArg (arg : Arg) : M Bool := do
   | .type _ | .erased => return true
 
 partial def shouldExtractFVar (fvarId : FVarId) : M Bool := do
-  if let some letDecl ← findLetDecl? fvarId then
-    shouldExtractLetValue false letDecl.value
+  if let some result := (← get).fvarDecisionCache[fvarId]? then
+    return result
   else
-    return false
+    let result ← go
+    modify fun s => { s with fvarDecisionCache := s.fvarDecisionCache.insert fvarId result }
+    return result
+where
+  go : M Bool := do
+    if let some letDecl ← findLetDecl? fvarId then
+      shouldExtractLetValue false letDecl.value
+    else
+      return false
 
 end
 

src/Lean/Compiler/LCNF/FloatLetIn.lean

@@ -8,6 +8,7 @@ module
 prelude
 public import Lean.Compiler.LCNF.FVarUtil
 public import Lean.Compiler.LCNF.PassManager
+import Lean.Compiler.IR.CompilerM
 
 public section
 
@@ -19,30 +20,27 @@ namespace FloatLetIn
 The decision of the float mechanism.
 -/
 inductive Decision where
-|
   /--
   Push into the arm with name `name`.
   -/
-  arm (name : Name)
-| /--
+  | arm (name : Name)
+  /--
   Push into the default arm.
   -/
-  default
-|
+  | default
   /--
   Don't move this declaration it is needed where it is right now.
   -/
-  dont
-|
+  | dont
   /--
   No decision has been made yet.
   -/
-  unknown
+  | unknown
 deriving Hashable, BEq, Inhabited, Repr
 
 def Decision.ofAlt : Alt → Decision
-| .alt name _ _ => .arm name
-| .default _ => .default
+  | .alt name _ _ => .arm name
+  | .default _ => .default
 
 /--
 The context for `BaseFloatM`.
@@ -112,6 +110,7 @@ def ignore? (decl : LetDecl) : BaseFloatM Bool :=  do
 Compute the initial decision for all declarations that `BaseFloatM` collected
 up to this point, with respect to `cs`. The initial decisions are:
 - `dont` if the declaration is detected by `ignore?`
+- `dont` if the a variable used by the declaration is later used as a potentially owned parameter
 - `dont` if the declaration is the discriminant of `cs` since we obviously need
   the discriminant to be computed before the match.
 - `dont` if we see the declaration being used in more than one cases arm
@@ -120,20 +119,55 @@ up to this point, with respect to `cs`. The initial decisions are:
 -/
 def initialDecisions (cs : Cases) : BaseFloatM (Std.HashMap FVarId Decision) := do
   let mut map := Std.HashMap.emptyWithCapacity (← read).decls.length
-  map ← (← read).decls.foldrM (init := map) fun val acc => do
+  let owned : Std.HashSet FVarId := ∅
+  (map, _) ← (← read).decls.foldlM (init := (map, owned)) fun (acc, owned) val => do
     if let .let decl := val then
       if (← ignore? decl) then
-        return acc.insert decl.fvarId .dont
-    return acc.insert val.fvarId .unknown
+        return (acc.insert decl.fvarId .dont, owned)
+    let (dont, owned) := (visitDecl (← getEnv) val).run owned
+    if dont then
+      return (acc.insert val.fvarId .dont, owned)
+    else
+      return (acc.insert val.fvarId .unknown, owned)
 
   if map.contains cs.discr then
     map := map.insert cs.discr .dont
   (_, map) ← goCases cs |>.run map
   return map
 where
+  visitDecl (env : Environment) (value : CodeDecl) : StateM (Std.HashSet FVarId) Bool := do
+    match value with
+    | .let decl => visitLetValue env decl.value
+    | _ => return false -- will need to investigate whether that can be a problem
+
+  visitLetValue (env : Environment) (value : LetValue) : StateM (Std.HashSet FVarId) Bool := do
+    match value with
+    | .proj _ _ x => visitArg (.fvar x) true
+    | .const nm _ args =>
+      let decl? := IR.findEnvDecl env nm
+      match decl? with
+      | none => args.foldlM (fun b arg => visitArg arg false <||> pure b) false
+      | some decl =>
+        let mut res := false
+        for h : i in *...args.size do
+          if ← visitArg args[i] (decl.params[i]?.any (·.borrow)) then
+            res := true
+        return res
+    | .fvar x args =>
+      args.foldlM (fun b arg => visitArg arg false <||> pure b)
+        (← visitArg (.fvar x) false)
+    | .erased | .lit _ => return false
+
+  visitArg (var : Arg) (borrowed : Bool) : StateM (Std.HashSet FVarId) Bool := do
+    let .fvar v := var | return false
+    let res := (← get).contains v
+    unless borrowed do
+      modify (·.insert v)
+    return res
+
   goFVar (plannedDecision : Decision) (var : FVarId) : StateRefT (Std.HashMap FVarId Decision) BaseFloatM Unit := do
     if let some decision := (← get)[var]? then
-      if decision == .unknown then
+      if decision matches .unknown then
         modify fun s => s.insert var plannedDecision
       else if decision != plannedDecision then
         modify fun s => s.insert var .dont

src/Lean/Compiler/LCNF/Main.lean

@@ -11,6 +11,7 @@ public import Lean.Compiler.LCNF.Passes
 public import Lean.Compiler.LCNF.ToDecl
 public import Lean.Compiler.LCNF.Check
 import Lean.Meta.Match.MatcherInfo
+import Lean.Compiler.LCNF.SplitSCC
 public section
 namespace Lean.Compiler.LCNF
 /--
@@ -50,14 +51,12 @@ The trace can be viewed with `set_option trace.Compiler.step true`.
 def checkpoint (stepName : Name) (decls : Array Decl) (shouldCheck : Bool) : CompilerM Unit := do
   for decl in decls do
     trace[Compiler.stat] "{decl.name} : {decl.size}"
-    withOptions (fun opts => opts.setBool `pp.motives.pi false) do
+    withOptions (fun opts => opts.set `pp.motives.pi false) do
       let clsName := `Compiler ++ stepName
       if (← Lean.isTracingEnabledFor clsName) then
         Lean.addTrace clsName m!"size: {decl.size}\n{← ppDecl' decl}"
       if shouldCheck then
         decl.check
-  if shouldCheck then
-    checkDeadLocalDecls decls
 
 def isValidMainType (type : Expr) : Bool :=
   let isValidResultName (name : Name) : Bool :=
@@ -74,7 +73,7 @@ def isValidMainType (type : Expr) : Bool :=
 
 namespace PassManager
 
-def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRecDepth 8192 do
+def run (declNames : Array Name) : CompilerM (Array (Array IR.Decl)) := withAtLeastMaxRecDepth 8192 do
   /-
   Note: we need to increase the recursion depth because we currently do to save phase1
   declarations in .olean files. Then, we have to recursively compile all dependencies,
@@ -100,31 +99,33 @@ def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRe
   let decls := markRecDecls decls
   let manager ← getPassManager
   let isCheckEnabled := compiler.check.get (← getOptions)
-  let decls ← profileitM Exception "compilation (LCNF base)" (← getOptions) do
-    let mut decls := decls
-    for pass in manager.basePasses do
-      decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
-        withPhase pass.phase <| pass.run decls
-      withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
-    return decls
-  let decls ← profileitM Exception "compilation (LCNF mono)" (← getOptions) do
-    let mut decls := decls
-    for pass in manager.monoPasses do
-      decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
-        withPhase pass.phase <| pass.run decls
-      withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
-    return decls
-  if (← Lean.isTracingEnabledFor `Compiler.result) then
-    for decl in decls do
-      let decl ← normalizeFVarIds decl
-      Lean.addTrace `Compiler.result m!"size: {decl.size}\n{← ppDecl' decl}"
-  profileitM Exception "compilation (IR)" (← getOptions) do
-    let irDecls ← IR.toIR decls
-    IR.compile irDecls
+  let decls ← runPassManagerPart "compilation (LCNF base)" manager.basePasses decls isCheckEnabled
+  let decls ← runPassManagerPart "compilation (LCNF mono)" manager.monoPasses decls isCheckEnabled
+  let sccs ← withTraceNode `Compiler.splitSCC (fun _ => return m!"Splitting up SCC") do
+    splitScc decls
+  sccs.mapM fun decls => do
+    let decls ← runPassManagerPart "compilation (LCNF mono)" manager.monoPassesNoLambda decls isCheckEnabled
+    if (← Lean.isTracingEnabledFor `Compiler.result) then
+      for decl in decls do
+        let decl ← normalizeFVarIds decl
+        Lean.addTrace `Compiler.result m!"size: {decl.size}\n{← ppDecl' decl}"
+    profileitM Exception "compilation (IR)" (← getOptions) do
+      let irDecls ← IR.toIR decls
+      IR.compile irDecls
+where
+  runPassManagerPart (profilerName : String) (passes : Array Pass) (decls : Array Decl)
+      (isCheckEnabled : Bool) : CompilerM (Array Decl) := do
+    profileitM Exception profilerName (← getOptions) do
+      let mut decls := decls
+      for pass in passes do
+        decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
+          withPhase pass.phase <| pass.run decls
+        withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
+      return decls
 
 end PassManager
 
-def compile (declNames : Array Name) : CoreM (Array IR.Decl) :=
+def compile (declNames : Array Name) : CoreM (Array (Array IR.Decl)) :=
   CompilerM.run <| PassManager.run declNames
 
 def showDecl (phase : Phase) (declName : Name) : CoreM Format := do

src/Lean/Compiler/LCNF/PassManager.lean

@@ -87,6 +87,7 @@ pipeline.
 structure PassManager where
   basePasses : Array Pass
   monoPasses : Array Pass
+  monoPassesNoLambda : Array Pass
   deriving Inhabited
 
 instance : ToString Phase where
@@ -114,6 +115,7 @@ private def validatePasses (phase : Phase) (passes : Array Pass) : CoreM Unit :=
 def validate (manager : PassManager) : CoreM Unit := do
   validatePasses .base manager.basePasses
   validatePasses .mono manager.monoPasses
+  validatePasses .mono manager.monoPassesNoLambda
 
 def findOccurrenceBounds (targetName : Name) (passes : Array Pass) : CoreM (Nat × Nat) := do
   let mut lowest := none

src/Lean/Compiler/LCNF/Passes.lean

@@ -115,6 +115,8 @@ def builtinPassManager : PassManager := {
     simp (occurrence := 4) (phase := .mono),
     floatLetIn (phase := .mono) (occurrence := 2),
     lambdaLifting,
+  ]
+  monoPassesNoLambda := #[
     extendJoinPointContext (phase := .mono) (occurrence := 1),
     simp (occurrence := 5) (phase := .mono),
     elimDeadBranches,

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

@@ -213,13 +213,17 @@ def Folder.mkBinary [Literal α] [Literal β] [Literal γ] (folder : α → β
   mkLit <| folder arg₁ arg₂
 
 def Folder.mkBinaryDecisionProcedure [Literal α] [Literal β] {r : α → β → Prop} (folder : (a : α) → (b : β) → Decidable (r a b)) : Folder := fun args => do
-  if (← getPhase) < .mono then
-    return none
   let #[.fvar fvarId₁, .fvar fvarId₂] := args | return none
   let some arg₁ ← getLit fvarId₁ | return none
   let some arg₂ ← getLit fvarId₂ | return none
-  let boolLit := folder arg₁ arg₂ |>.decide
-  mkLit boolLit
+  let result := folder arg₁ arg₂ |>.decide
+  if (← getPhase) < .mono then
+    if result then
+      return some <| .const ``Decidable.isTrue [] #[.erased, .erased]
+    else
+      return some <| .const ``Decidable.isFalse [] #[.erased, .erased]
+  else
+    mkLit result
 
 /--
 Provide a folder for an operation with a left neutral element.

src/Lean/Compiler/LCNF/SplitSCC.lean

@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+module
+
+prelude
+public import Lean.Compiler.LCNF.CompilerM
+import Lean.Util.SCC
+
+namespace Lean.Compiler.LCNF
+
+namespace SplitScc
+
+partial def findSccCalls (scc : Std.HashMap Name Decl) (decl : Decl) : BaseIO (Std.HashSet Name) := do
+  match decl.value with
+  | .code code =>
+    let (_, calls) ← goCode code |>.run {}
+    return calls
+  | .extern .. => return {}
+where
+  goCode (c : Code) : StateRefT (Std.HashSet Name) BaseIO Unit := do
+    match c with
+    | .let decl k =>
+      if let .const name .. := decl.value then
+        if scc.contains name then
+          modify fun s => s.insert name
+      goCode k
+    | .fun decl k | .jp decl k =>
+      goCode decl.value
+      goCode k
+    | .cases cases => cases.alts.forM (·.forCodeM goCode)
+    | .jmp .. | .return .. | .unreach .. => return ()
+
+end SplitScc
+
+public def splitScc (scc : Array Decl) : CompilerM (Array (Array Decl)) := do
+  if scc.size == 1 then
+    return #[scc]
+  let declMap := Std.HashMap.ofArray <| scc.map fun decl => (decl.name, decl)
+  let callers := Std.HashMap.ofArray <| ← scc.mapM fun decl => do
+    let calls ← SplitScc.findSccCalls declMap decl
+    return (decl.name, calls.toList)
+  let newSccs := Lean.SCC.scc (scc.toList.map (·.name)) (callers.getD · [])
+  trace[Compiler.splitSCC] m!"Split SCC into {newSccs}"
+  return newSccs.toArray.map (fun scc => scc.toArray.map declMap.get!)
+
+builtin_initialize
+  registerTraceClass `Compiler.splitSCC (inherited := true)
+
+end Lean.Compiler.LCNF

src/Lean/CoreM.lean

@@ -543,10 +543,12 @@ def logSnapshotTask (task : Language.SnapshotTask Language.SnapshotTree) : CoreM
 /-- Wraps the given action for use in `EIO.asTask` etc., discarding its final monadic state. -/
 def wrapAsync {α : Type} (act : α → CoreM β) (cancelTk? : Option IO.CancelToken) :
     CoreM (α → EIO Exception β) := do
-  let (childNGen, parentNGen) := (← getDeclNGen).mkChild
-  setDeclNGen parentNGen
+  let (childNGen, parentNGen) := (← getNGen).mkChild
+  setNGen parentNGen
+  let (childDeclNGen, parentDeclNGen) := (← getDeclNGen).mkChild
+  setDeclNGen parentDeclNGen
   let st ← get
-  let st := { st with auxDeclNGen := childNGen }
+  let st := { st with auxDeclNGen := childDeclNGen, ngen := childNGen }
   let ctx ← read
   let ctx := { ctx with cancelTk? }
   let heartbeats := (← IO.getNumHeartbeats) - ctx.initHeartbeats

src/Lean/Data/Json/FromToJson/Basic.lean

@@ -226,7 +226,13 @@ def opt [ToJson α] (k : String) : Option α → List (String × Json)
   | none   => []
   | some o => [⟨k, toJson o⟩]
 
-/-- Parses a JSON-encoded `structure` or `inductive` constructor. Used mostly by `deriving FromJson`. -/
+/-- Returns the string value or single key name, if any. -/
+def getTag? : Json → Option String
+  | .str tag => some tag
+  | .obj kvs => guard (kvs.size == 1) *> kvs.minKey?
+  | _        => none
+
+-- TODO: delete after rebootstrap
 def parseTagged
     (json : Json)
     (tag : String)
@@ -259,5 +265,28 @@ def parseTagged
           | Except.error err => Except.error err
     | Except.error err => Except.error err
 
+/--
+Parses a JSON-encoded `structure` or `inductive` constructor, assuming the tag has already been
+checked and `nFields` is nonzero. Used mostly by `deriving FromJson`.
+-/
+def parseCtorFields
+    (json : Json)
+    (tag : String)
+    (nFields : Nat)
+    (fieldNames? : Option (Array Name)) : Except String (Array Json) := do
+  let payload  ← getObjVal? json tag
+  match fieldNames? with
+  | some fieldNames =>
+    fieldNames.mapM (getObjVal? payload ·.getString!)
+  | none =>
+    if nFields == 1 then
+      Except.ok #[payload]
+    else
+      let fields ← getArr? payload
+      if fields.size == nFields then
+        Except.ok fields
+      else
+        Except.error s!"incorrect number of fields: {fields.size} ≟ {nFields}"
+
 end Json
 end Lean

src/Lean/Data/Options.lean

@@ -14,14 +14,72 @@ public section
 
 namespace Lean
 
-@[expose] def Options := KVMap
+structure Options where
+  private map : NameMap DataValue
+  /--
+  Whether any option with prefix `trace` is set. This does *not* imply that any of such option is
+  set to `true` but it does capture the most common case that no such option has ever been touched.
+  -/
+  hasTrace : Bool
+
+namespace Options
+
+def empty : Options where
+  map := {}
+  hasTrace := false
+
+@[export lean_options_get_empty]
+private def getEmpty (_ : Unit) : Options := .empty
 
-def Options.empty : Options  := {}
 instance : Inhabited Options where
-  default := {}
-instance : ToString Options := inferInstanceAs (ToString KVMap)
-instance [Monad m] : ForIn m Options (Name × DataValue) := inferInstanceAs (ForIn _ KVMap _)
-instance : BEq Options := inferInstanceAs (BEq KVMap)
+  default := .empty
+instance : ToString Options where
+  toString o := private toString o.map.toList
+instance [Monad m] : ForIn m Options (Name × DataValue) where
+  forIn o init f := private forIn o.map init f
+instance : BEq Options where
+  beq o1 o2 := private o1.map.beq o2.map
+instance : EmptyCollection Options where
+  emptyCollection := .empty
+
+@[inline] def find? (o : Options) (k : Name) : Option DataValue :=
+  o.map.find? k
+
+@[deprecated find? (since := "2026-01-15")]
+def find := find?
+
+@[inline] def get? {α : Type} [KVMap.Value α] (o : Options) (k : Name) : Option α :=
+  o.map.find? k |>.bind KVMap.Value.ofDataValue?
+
+@[inline] def get {α : Type} [KVMap.Value α] (o : Options) (k : Name) (defVal : α) : α :=
+  o.get? k |>.getD defVal
+
+@[inline] def getBool (o : Options) (k : Name) (defVal : Bool := false) : Bool :=
+  o.get k defVal
+
+@[inline] def contains (o : Options) (k : Name) : Bool :=
+  o.map.contains k
+
+@[inline] def insert (o : Options) (k : Name) (v : DataValue) : Options where
+  map := o.map.insert k v
+  hasTrace := o.hasTrace || (`trace).isPrefixOf k
+
+def set {α : Type} [KVMap.Value α] (o : Options) (k : Name) (v : α) : Options :=
+  o.insert k (KVMap.Value.toDataValue v)
+
+@[inline] def setBool (o : Options) (k : Name) (v : Bool) : Options :=
+  o.set k v
+
+def erase (o : Options) (k : Name) : Options where
+  map := o.map.erase k
+  -- `erase` is expected to be used even more rarely than `set` so O(n) is fine
+  hasTrace := o.map.keys.any (`trace).isPrefixOf
+
+def mergeBy (f : Name → DataValue → DataValue → DataValue) (o1 o2 : Options) : Options where
+  map := o1.map.mergeWith f o2.map
+  hasTrace := o1.hasTrace || o2.hasTrace
+
+end Options
 
 structure OptionDecl where
   name     : Name
@@ -90,11 +148,11 @@ variable [Monad m] [MonadOptions m]
 
 def getBoolOption (k : Name) (defValue := false) : m Bool := do
   let opts ← getOptions
-  return opts.getBool k defValue
+  return opts.get k defValue
 
 def getNatOption (k : Name) (defValue := 0) : m Nat := do
   let opts ← getOptions
-  return opts.getNat k defValue
+  return opts.get k defValue
 
 class MonadWithOptions (m : Type → Type) where
   withOptions (f : Options → Options) (x : m α) : m α
@@ -108,10 +166,10 @@ instance [MonadFunctor m n] [MonadWithOptions m] : MonadWithOptions n where
    the term being delaborated should be treated as a pattern. -/
 
 def withInPattern [MonadWithOptions m] (x : m α) : m α :=
-  withOptions (fun o => o.setBool `_inPattern true) x
+  withOptions (fun o => o.set `_inPattern true) x
 
 def Options.getInPattern (o : Options) : Bool :=
-  o.getBool `_inPattern
+  o.get `_inPattern false
 
 /-- A strongly-typed reference to an option. -/
 protected structure Option (α : Type) where
@@ -131,12 +189,20 @@ protected def get? [KVMap.Value α] (opts : Options) (opt : Lean.Option α) : Op
 protected def get [KVMap.Value α] (opts : Options) (opt : Lean.Option α) : α :=
   opts.get opt.name opt.defValue
 
+@[export lean_options_get_bool]
+private def getBool (opts : Options) (name : Name) (defValue : Bool) : Bool :=
+  opts.get name defValue
+
 protected def getM [Monad m] [MonadOptions m] [KVMap.Value α] (opt : Lean.Option α) : m α :=
   return opt.get (← getOptions)
 
 protected def set [KVMap.Value α] (opts : Options) (opt : Lean.Option α) (val : α) : Options :=
   opts.set opt.name val
 
+@[export lean_options_update_bool]
+private def updateBool (opts : Options) (name : Name) (val : Bool) : Options :=
+  opts.set name val
+
 /-- Similar to `set`, but update `opts` only if it doesn't already contains an setting for `opt.name` -/
 protected def setIfNotSet [KVMap.Value α] (opts : Options) (opt : Lean.Option α) (val : α) : Options :=
   if opts.contains opt.name then opts else opt.set opts val

src/Lean/DocString/Parser.lean

@@ -1220,7 +1220,7 @@ Disables the option `doc.verso` while running a parser.
 public def withoutVersoSyntax (p : Parser) : Parser where
   fn :=
     adaptUncacheableContextFn
-      (fun c => { c with options := c.options.setBool `doc.verso false })
+      (fun c => { c with options := c.options.set `doc.verso false })
       p.fn
   info := p.info
 

src/Lean/Elab/BuiltinCommand.lean

@@ -456,7 +456,7 @@ where
       withRef tk <| Meta.check e
       let e ← Term.levelMVarToParam (← instantiateMVars e)
       -- TODO: add options or notation for setting the following parameters
-      withTheReader Core.Context (fun ctx => { ctx with options := ctx.options.setBool `smartUnfolding false }) do
+      withTheReader Core.Context (fun ctx => { ctx with options := ctx.options.set `smartUnfolding false }) do
         let e ← withTransparency (mode := TransparencyMode.all) <| reduce e (skipProofs := skipProofs) (skipTypes := skipTypes)
         logInfoAt tk e
 

src/Lean/Elab/Command.lean

@@ -274,10 +274,12 @@ def wrapAsync {α β : Type} (act : α → CommandElabM β) (cancelTk? : Option
     CommandElabM (α → EIO Exception β) := do
   let ctx ← read
   let ctx := { ctx with cancelTk? }
-  let (childNGen, parentNGen) := (← getDeclNGen).mkChild
-  setDeclNGen parentNGen
+  let (childNGen, parentNGen) := (← get).ngen.mkChild
+  modify fun s => { s with ngen := parentNGen }
+  let (childDeclNGen, parentDeclNGen) := (← getDeclNGen).mkChild
+  setDeclNGen parentDeclNGen
   let st ← get
-  let st := { st with auxDeclNGen := childNGen }
+  let st := { st with auxDeclNGen := childDeclNGen, ngen := childNGen }
   return (act · |>.run ctx |>.run' st)
 
 open Language in

src/Lean/Elab/Deriving/Basic.lean

@@ -232,7 +232,7 @@ def applyDerivingHandlers (className : Name) (typeNames : Array Name) (setExpose
   withScope (fun sc => { sc with
     attrs := if setExpose then Unhygienic.run `(Parser.Term.attrInstance| expose) :: sc.attrs else sc.attrs
     -- Deactivate some linting options that only make writing deriving handlers more painful.
-    opts := sc.opts.setBool `warn.exposeOnPrivate false
+    opts := sc.opts.set `warn.exposeOnPrivate false
     -- When any of the types are private, the deriving handler will need access to the private scope
     -- and should create private instances.
     isPublic := !typeNames.any isPrivateName }) do

src/Lean/Elab/Deriving/FromToJson.lean

@@ -111,14 +111,18 @@ def mkFromJsonBodyForStruct (indName : Name) : TermElabM Term := do
 
 def mkFromJsonBodyForInduct (ctx : Context) (indName : Name) : TermElabM Term := do
   let indVal ← getConstInfoInduct indName
-  let alts ← mkAlts indVal
-  let auxTerm ← alts.foldrM (fun xs x => `(Except.orElseLazy $xs (fun _ => $x))) (← `(Except.error "no inductive constructor matched"))
-  `($auxTerm)
+  let (ctors, alts) := (← mkAlts indVal).unzip
+  `(match Json.getTag? json with
+    | some tag => match tag with
+      $[| $(ctors.map Syntax.mkStrLit) => $(alts)]*
+      | _ => Except.error "no inductive constructor matched"
+    | none => Except.error "no inductive tag found")
 where
-  mkAlts (indVal : InductiveVal) : TermElabM (Array Term) := do
+  mkAlts (indVal : InductiveVal) : TermElabM (Array (String × Term)) := do
   let mut alts := #[]
   for ctorName in indVal.ctors do
     let ctorInfo ← getConstInfoCtor ctorName
+    let ctorStr := ctorName.eraseMacroScopes.getString!
     let alt ← do forallTelescopeReducing ctorInfo.type fun xs _ => do
         let mut binders   := #[]
         let mut userNames := #[]
@@ -142,11 +146,14 @@ where
         else
           ``(none)
         let stx ←
-          `((Json.parseTagged json $(quote ctorName.eraseMacroScopes.getString!) $(quote ctorInfo.numFields) $(quote userNamesOpt)).bind
-            (fun jsons => do
-              $[let $identNames:ident ← $fromJsons:doExpr]*
-              return $(mkIdent ctorName):ident $identNames*))
-        pure (stx, ctorInfo.numFields)
+          if ctorInfo.numFields == 0 then
+            `(return $(mkIdent ctorName):ident $identNames*)
+          else
+            `((Json.parseCtorFields json $(quote ctorStr) $(quote ctorInfo.numFields) $(quote userNamesOpt)).bind
+              (fun jsons => do
+                $[let $identNames:ident ← $fromJsons:doExpr]*
+                return $(mkIdent ctorName):ident $identNames*))
+        pure ((ctorStr, stx), ctorInfo.numFields)
       alts := alts.push alt
   -- the smaller cases, especially the ones without fields are likely faster
   let alts' := alts.qsort (fun (_, x) (_, y) => x < y)

src/Lean/Elab/DocString/Builtin.lean

@@ -1267,7 +1267,7 @@ def «set_option» (option : Ident) (value : DataValue) : DocM (Block ElabInline
   pushInfoLeaf <| .ofOptionInfo { stx := option, optionName, declName := decl.declName }
   validateOptionValue optionName decl value
   let o ← getOptions
-  modify fun s => { s with options := o.insert optionName value }
+  modify fun s => { s with options := o.set optionName value }
   return .empty
 
 /--

src/Lean/Elab/MutualInductive.lean

@@ -1210,8 +1210,8 @@ private def applyComputedFields (indViews : Array InductiveView) : CommandElabM
     computedFields := computedFields.push (declName, computedFieldNames)
   withScope (fun scope => { scope with
       opts := scope.opts
-        |>.setBool `bootstrap.genMatcherCode false
-        |>.setBool `elaboratingComputedFields true}) <|
+        |>.set `bootstrap.genMatcherCode false
+        |>.set `elaboratingComputedFields true}) <|
     elabCommand <| ← `(mutual $computedFieldDefs* end)
 
   liftTermElabM do Term.withDeclName indViews[0]!.declName do

src/Lean/Elab/SetOption.lean

@@ -52,7 +52,7 @@ def elabSetOption (id : Syntax) (val : Syntax) : m Options := do
   pushInfoLeaf <| .ofOptionInfo { stx := id, optionName, declName := decl.declName }
   let rec setOption (val : DataValue) : m Options := do
     validateOptionValue optionName decl val
-    return (← getOptions).insert optionName val
+    return (← getOptions).set optionName val
   match val.isStrLit? with
   | some str => setOption (DataValue.ofString str)
   | none     =>

src/Lean/Elab/Syntax.lean

@@ -290,7 +290,7 @@ private def declareSyntaxCatQuotParser (catName : Name) : CommandElabM Unit := d
     let quotSymbol := "`(" ++ suffix ++ "| "
     let name := catName ++ `quot
     let cmd ← `(
-      @[term_parser] meta def $(mkIdent name) : Lean.ParserDescr :=
+      @[term_parser] public meta def $(mkIdent name) : Lean.ParserDescr :=
         Lean.ParserDescr.node `Lean.Parser.Term.quot $(quote Lean.Parser.maxPrec)
           (Lean.ParserDescr.node $(quote name) $(quote Lean.Parser.maxPrec)
             (Lean.ParserDescr.binary `andthen (Lean.ParserDescr.symbol $(quote quotSymbol))
@@ -312,7 +312,7 @@ private def declareSyntaxCatQuotParser (catName : Name) : CommandElabM Unit := d
   let attrName := catName.appendAfter "_parser"
   let catDeclName := ``Lean.Parser.Category ++ catName
   setEnv (← Parser.registerParserCategory (← getEnv) attrName catName catBehavior catDeclName)
-  let cmd ← `($[$docString?]? meta def $(mkIdentFrom stx[2] (`_root_ ++ catDeclName) (canonical := true)) : Lean.Parser.Category := {})
+  let cmd ← `($[$docString?]? public meta def $(mkIdentFrom stx[2] (`_root_ ++ catDeclName) (canonical := true)) : Lean.Parser.Category := {})
   declareSyntaxCatQuotParser catName
   elabCommand cmd
 

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

@@ -309,7 +309,7 @@ where
   Add an auxiliary declaration. Only used to create constants that appear in our reflection proof.
   -/
   mkAuxDecl (name : Name) (value type : Expr) : CoreM Unit :=
-    withOptions (fun opt => opt.setBool `compiler.extract_closed false) do
+    withOptions (fun opt => opt.set `compiler.extract_closed false) do
       addAndCompile <| .defnDecl {
         name := name,
         levelParams := [],

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

@@ -41,8 +41,8 @@ public def findSpec (database : SpecTheorems) (wp : Expr) : MetaM SpecTheorem :=
       -- information why the defeq check failed, so we do it again.
       withOptions (fun o =>
         if o.getBool `trace.Elab.Tactic.Do.spec then
-          o |>.setBool `pp.universes true
-            |>.setBool `trace.Meta.isDefEq true
+          o |>.set `pp.universes true
+            |>.set `trace.Meta.isDefEq true
         else
           o) do
       withTraceNode `Elab.Tactic.Do.spec (fun _ => return m!"Defeq check for {type} failed.") do

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

@@ -47,10 +47,10 @@ partial def genVCs (goal : MVarId) (ctx : Context) (fuel : Fuel) : MetaM Result
   mvar.withContext <| withReducible do
     let (prf, state) ← StateRefT'.run (ReaderT.run (onGoal goal (← mvar.getTag)) ctx) { fuel }
     mvar.assign prf
-    for h : idx in [:state.invariants.size] do
+    for h : idx in *...state.invariants.size do
       let mv := state.invariants[idx]
       mv.setTag (Name.mkSimple ("inv" ++ toString (idx + 1)))
-    for h : idx in [:state.vcs.size] do
+    for h : idx in *...state.vcs.size do
       let mv := state.vcs[idx]
       mv.setTag (Name.mkSimple ("vc" ++ toString (idx + 1)) ++ (← mv.getTag).eraseMacroScopes)
     return { invariants := state.invariants, vcs := state.vcs }

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

@@ -94,14 +94,15 @@ def ifOutOfFuel (x : VCGenM α) (k : VCGenM α) : VCGenM α := do
 def addSubGoalAsVC (goal : MVarId) : VCGenM PUnit := do
   goal.freshenLCtxUserNamesSinceIdx (← read).initialCtxSize
   let ty ← goal.getType
-  if ty.isAppOf ``Std.Do.PostCond || ty.isAppOf ``Std.Do.SPred then
-    -- Here we make `mvar` a synthetic opaque goal upon discharge failure.
-    -- This is the right call for (previously natural) holes such as loop invariants, which
-    -- would otherwise lead to spurious instantiations and unwanted renamings (when leaving the
-    -- scope of a local).
-    -- But it's wrong for, e.g., schematic variables. The latter should never be PostConds,
-    -- Invariants or SPreds, hence the condition.
-    goal.setKind .syntheticOpaque
+  -- Here we make `mvar` a synthetic opaque goal upon discharge failure.
+  -- This is the right call for (previously natural) holes such as loop invariants, which
+  -- would otherwise lead to spurious instantiations and unwanted renamings (when leaving the
+  -- scope of a local).
+  -- We also do this for, e.g. schematic variables. One reason is that at this point, we have
+  -- already tried to assign them by unification. Another reason is that we want to display the
+  -- VC to the user as-is, without abstracting any variables in the local context.
+  -- This only makes sense for synthetic opaque metavariables.
+  goal.setKind .syntheticOpaque
   if ty.isAppOf ``Std.Do.Invariant then
     modify fun s => { s with invariants := s.invariants.push goal }
   else

src/Lean/Expr.lean

@@ -2386,4 +2386,27 @@ def eagerReflBoolTrue : Expr :=
 def eagerReflBoolFalse : Expr :=
   mkApp2 (mkConst ``eagerReduce [0]) (mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) (mkConst ``Bool.false) (mkConst ``Bool.false)) reflBoolFalse
 
+/--
+Replaces the head constant in a function application chain with a different constant.
+
+Given an expression that is either a constant or a function application chain,
+replaces the head constant with `declName` while preserving all arguments and universe levels.
+
+**Examples**:
+- `f.replaceFn g` → `g` (where `f` is a constant)
+- `(f a b c).replaceFn g` → `g a b c`
+- `(@f.{u, v} a b).replaceFn g` → `@g.{u, v} a b`
+
+**Panics**: If the expression is neither a constant nor a function application.
+
+**Use case**: Useful for substituting one function for another while maintaining
+the same application structure, such as replacing a theorem with a related theorem
+that has the same type and universe parameters.
+-/
+def Expr.replaceFn (e : Expr) (declName : Name) : Expr :=
+  match e with
+  | .app f a    => mkApp (f.replaceFn declName) a
+  | .const _ us => mkConst declName us
+  | _ => panic! "function application or constant expected"
+
 end Lean

src/Lean/Language/Lean.lean

@@ -308,8 +308,8 @@ def setOption (opts : Options) (decl : OptionDecl) (name : Name) (val : String)
   match decl.defValue with
   | .ofBool _ =>
     match val with
-    | "true"  => return opts.insert name true
-    | "false" => return opts.insert name false
+    | "true"  => return opts.set name true
+    | "false" => return opts.set name false
     | _ =>
       throw <| .userError s!"invalid -D parameter, invalid configuration option '{val}' value, \
         it must be true/false"
@@ -317,8 +317,8 @@ def setOption (opts : Options) (decl : OptionDecl) (name : Name) (val : String)
     let some val := val.toNat?
       | throw <| .userError s!"invalid -D parameter, invalid configuration option '{val}' value, \
           it must be a natural number"
-    return opts.insert name val
-  | .ofString _ => return opts.insert name val
+    return opts.set name val
+  | .ofString _ => return opts.set name val
   | _ => throw <| .userError s!"invalid -D parameter, configuration option '{name}' \
             cannot be set in the command line, use set_option command"
 
@@ -342,7 +342,7 @@ def reparseOptions (opts : Options) : IO Options := do
 If the option is defined in a library, use '-D{`weak ++ name}' to set it conditionally"
 
     let .ofString val := val
-      | opts' := opts'.insert name val  -- Already parsed
+      | opts' := opts'.set name val  -- Already parsed
 
     opts' ← setOption opts' decl name val
 

src/Lean/LibrarySuggestions/Basic.lean

@@ -316,9 +316,10 @@ builtin_initialize typePrefixDenyListExt : SimplePersistentEnvExtension Name (Li
 def isDeniedModule (env : Environment) (moduleName : Name) : Bool :=
   (moduleDenyListExt.getState env).any fun p => moduleName.anyS (· == p)
 
-def isDeniedPremise (env : Environment) (name : Name) : Bool := Id.run do
+def isDeniedPremise (env : Environment) (name : Name) (allowPrivate : Bool := false) : Bool := Id.run do
   if name == ``sorryAx then return true
-  if name.isInternalDetail then return true
+  -- Allow private names through if allowPrivate is set (e.g., for currentFile selector)
+  if name.isInternalDetail && !(allowPrivate && isPrivateName name) then return true
   if Lean.Meta.isInstanceCore env name then return true
   if Lean.Linter.isDeprecated env name then return true
   if (nameDenyListExt.getState env).any (fun p => name.anyS (· == p)) then return true
@@ -358,14 +359,14 @@ def currentFile : Selector := fun _ cfg => do
   let max := cfg.maxSuggestions
   -- Use map₂ from the staged map, which contains locally defined constants
   let mut suggestions := #[]
-  for (name, ci) in env.constants.map₂.toList do
+  for (name, _) in env.constants.map₂ do
     if suggestions.size >= max then
       break
-    if isDeniedPremise env name then
+    -- Allow private names since they're accessible from the current module
+    if isDeniedPremise env name (allowPrivate := true) then
       continue
-    match ci with
-    | .thmInfo _ => suggestions := suggestions.push { name := name, score := 1.0 }
-    | _ => continue
+    if wasOriginallyTheorem env name then
+      suggestions := suggestions.push { name := name, score := 1.0 }
   return suggestions
 
 builtin_initialize librarySuggestionsExt : SimplePersistentEnvExtension Name (Option Name) ←

src/Lean/LibrarySuggestions/SineQuaNon.lean

@@ -74,7 +74,7 @@ def prepareTriggers (names : Array Name) (maxTolerance : Float := 3.0) : MetaM (
   let mut map := {}
   let env ← getEnv
   let names := names.filter fun n =>
-    !isDeniedPremise env n && Lean.wasOriginallyTheorem env n
+    !isDeniedPremise env n && wasOriginallyTheorem env n
   for name in names do
     let triggers ← triggerSymbols (← getConstInfo name) maxTolerance
     for (trigger, tolerance) in triggers do

src/Lean/LibrarySuggestions/SymbolFrequency.lean

@@ -28,7 +28,7 @@ skipping instance arguments and proofs.
 public def localSymbolFrequencyMap : MetaM (NameMap Nat) := do
   let env := (← getEnv)
   env.constants.map₂.foldlM (init := ∅) (fun acc m ci => do
-    if isDeniedPremise env m || !Lean.wasOriginallyTheorem env m then
+    if isDeniedPremise env m || !wasOriginallyTheorem env m then
       pure acc
     else
       ci.type.foldRelevantConstants (init := acc) fun n' acc => return acc.alter n' fun i? => some (i?.getD 0 + 1))

src/Lean/Message.lean

@@ -247,7 +247,7 @@ def ofConstName (constName : Name) (fullNames : Bool := false) : MessageData :=
       let msg ← ofFormatWithInfos <$> match ctx? with
         | .none => pure (format constName)
         | .some ctx =>
-          let ctx := if fullNames then { ctx with opts := ctx.opts.insert `pp.fullNames fullNames } else ctx
+          let ctx := if fullNames then { ctx with opts := ctx.opts.set `pp.fullNames fullNames } else ctx
           ppConstNameWithInfos ctx constName
       return Dynamic.mk msg)
     (fun _ => false)

src/Lean/Meta/Injective.lean

@@ -124,17 +124,41 @@ def mkInjectiveEqTheoremNameFor (ctorName : Name) : Name :=
 private def mkInjectiveEqTheoremType? (ctorVal : ConstructorVal) : MetaM (Option Expr) :=
   mkInjectiveTheoremTypeCore? ctorVal true
 
+/--
+Collects all components of a nested `And`, as projections.
+(Avoids the binders that `MVarId.casesAnd` would introduce.)
+-/
+private partial def andProjections (e : Expr) : MetaM (Array Expr) := do
+  let rec go (e : Expr) (t : Expr) (acc : Array Expr) : MetaM (Array Expr) := do
+    match_expr t with
+    | And t1 t2 =>
+      let acc ← go (mkProj ``And 0 e) t1 acc
+      let acc ← go (mkProj ``And 0 e) t2 acc
+      return acc
+    | _ =>
+      return acc.push e
+  go e (← inferType e) #[]
+
 private def mkInjectiveEqTheoremValue (ctorName : Name) (targetType : Expr) : MetaM Expr := do
   forallTelescopeReducing targetType fun xs type => do
     let mvar ← mkFreshExprSyntheticOpaqueMVar type
     let [mvarId₁, mvarId₂] ← mvar.mvarId!.apply (mkConst ``Eq.propIntro)
       | throwError "unexpected number of subgoals when proving injective theorem for constructor `{ctorName}`"
     let (h, mvarId₁) ← mvarId₁.intro1
-    let (_, mvarId₂) ← mvarId₂.intro1
     solveEqOfCtorEq ctorName mvarId₁ h
-    let mvarId₂ ← mvarId₂.casesAnd
-    if let some mvarId₂ ← mvarId₂.substEqs then
-      try mvarId₂.refl catch _ => throwError (injTheoremFailureHeader ctorName)
+    let mut mvarId₂ := mvarId₂
+    while true do
+      let t ← mvarId₂.getType
+      let some (conj, body) := t.arrow?  | break
+      match_expr conj with
+      | And lhs rhs =>
+        let [mvarId₂'] ← mvarId₂.applyN (mkApp3 (mkConst `Lean.injEq_helper) lhs rhs body) 1
+            | throwError "unexpected number of goals after applying `Lean.and_imp`"
+        mvarId₂ := mvarId₂'
+      | _ => pure ()
+      let (h, mvarId₂') ← mvarId₂.intro1
+      (_, mvarId₂) ← substEq mvarId₂' h
+    try mvarId₂.refl catch _ => throwError (injTheoremFailureHeader ctorName)
     mkLambdaFVars xs mvar
 
 private def mkInjectiveEqTheorem (ctorVal : ConstructorVal) : MetaM Unit := do

src/Lean/Meta/Sym/AlphaShareBuilder.lean

@@ -177,4 +177,16 @@ def mkHaveS (x : Name) (t : Expr) (v : Expr) (b : Expr) : m Expr := do
   else
     mkLetS n newType newVal newBody nondep
 
+def mkAppS₂ (f a₁ a₂ : Expr) : m Expr := do
+  mkAppS (← mkAppS f a₁) a₂
+
+def mkAppS₃ (f a₁ a₂ a₃ : Expr) : m Expr := do
+  mkAppS (← mkAppS₂ f a₁ a₂) a₃
+
+def mkAppS₄ (f a₁ a₂ a₃ a₄ : Expr) : m Expr := do
+  mkAppS (← mkAppS₃ f a₁ a₂ a₃) a₄
+
+def mkAppS₅ (f a₁ a₂ a₃ a₄ a₅ : Expr) : m Expr := do
+  mkAppS (← mkAppS₄ f a₁ a₂ a₃ a₄) a₅
+
 end Lean.Meta.Sym.Internal

src/Lean/Meta/Sym/Pattern.lean

@@ -42,6 +42,10 @@ framework (`Sym`). The design prioritizes performance by using a two-phase appro
 - `instantiateRevS` ensures maximal sharing of result expressions
 -/
 
+/-- Helper function for checking whether types `α` and `β` are definitionally equal during unification/matching. -/
+def isDefEqTypes (α β : Expr) : MetaM Bool := do
+  withReducible <| isDefEq α β
+
 /--
 Collects `ProofInstInfo` for all function symbols occurring in `pattern`.
 
@@ -56,11 +60,18 @@ def mkProofInstInfoMapFor (pattern : Expr) : MetaM (AssocList Name ProofInstInfo
   return fnInfos
 
 public structure Pattern where
-  levelParams  : List Name
-  varTypes     : Array Expr
-  isInstance   : Array Bool
-  pattern      : Expr
-  fnInfos      : AssocList Name ProofInstInfo
+  levelParams    : List Name
+  varTypes       : Array Expr
+  isInstance     : Array Bool
+  pattern        : Expr
+  fnInfos        : AssocList Name ProofInstInfo
+  /--
+  If `checkTypeMask? = some mask`, then we must check the type of pattern variable `i`
+  if `mask[i]` is true.
+  Moreover `mask.size == varTypes.size`.
+  See `mkCheckTypeMask`
+  -/
+  checkTypeMask? : Option (Array Bool)
   deriving Inhabited
 
 def uvarPrefix : Name := `_uvar
@@ -79,6 +90,65 @@ def preprocessPattern (declName : Name) : MetaM (List Name × Expr) := do
   let type ← preprocessType type
   return (levelParams, type)
 
+/--
+Creates a mask indicating which pattern variables require type checking during matching.
+
+When matching a pattern against a target expression, we must ensure that pattern variable
+assignments are type-correct. However, checking types for every variable is expensive.
+This function identifies which variables actually need type checking.
+
+**Key insight**: A pattern variable appearing as an argument to a function application
+does not need its type checked separately, because the type information is already
+encoded in the application structure, and we assume the input is type correct.
+
+**Variables that need type checking**:
+- Variables in function position: `f x` where `f` is a pattern variable
+- Variables in binder domains or bodies: `∀ x : α, β` or `fun x : α => b`
+- Variables appearing alone (not as part of any application)
+
+**Variables that skip type checking**:
+- Variables appearing only as arguments to applications: in `f x`, the variable `x`
+  does not need checking because the type of `f` constrains the type of `x`
+
+**Examples**:
+- `bv0_eq (x : BitVec 0) : x = 0`: pattern is just `x`, must check type to ensure `BitVec 0`
+- `forall_true : (∀ _ : α, True) = True`: `α` appears in binder domain, must check
+- `Nat.add_zero (x : Nat) : x + 0 = x`: `x` is argument to `HAdd.hAdd`, no check needed
+
+**Note**: This analysis is conservative. It may mark some variables for checking even when
+the type information is redundant (already determined by other constraints). This is
+harmless—just extra work, not incorrect behavior.
+
+Returns an array of booleans parallel to the pattern's `varTypes`, where `true` indicates
+the variable's type must be checked against the matched subterm's type.
+-/
+def mkCheckTypeMask (pattern : Expr) (numPatternVars : Nat) : Array Bool :=
+  let mask := Array.replicate numPatternVars false
+  go pattern 0 false mask
+where
+  go (e : Expr) (offset : Nat) (isArg : Bool) : Array Bool → Array Bool :=
+    match e with
+    | .app f a => go f offset isArg ∘ go a offset true
+    | .letE .. => unreachable! -- We zeta-reduce at `preprocessType`
+    | .const .. | .fvar _ | .sort _ | .mvar _ | .lit _ => id
+    | .mdata _ b => go b offset isArg
+    | .proj .. => id -- Should not occur in patterns
+    | .forallE _ d b _
+    | .lam _ d b _ => go d offset false ∘ go b (offset+1) false
+    | .bvar idx => fun mask =>
+      if idx >= offset && !isArg then
+        let idx := idx - offset
+        mask.set! (mask.size - idx - 1) true
+      else
+        mask
+
+def mkPatternCore (levelParams : List Name) (varTypes : Array Expr) (isInstance : Array Bool)
+    (pattern : Expr) : MetaM Pattern := do
+  let fnInfos ← mkProofInstInfoMapFor pattern
+  let checkTypeMask := mkCheckTypeMask pattern varTypes.size
+  let checkTypeMask? := if checkTypeMask.all (· == false) then none else some checkTypeMask
+  return { levelParams, varTypes, isInstance, pattern, fnInfos, checkTypeMask? }
+
 /--
 Creates a `Pattern` from the type of a theorem.
 
@@ -100,9 +170,7 @@ public def mkPatternFromDecl (declName : Name) (num? : Option Nat := none) : Met
     if i < num then
       if let .forallE _ d b _ := type then
         return (← go (i+1) b (varTypes.push d) (isInstance.push (isClass? (← getEnv) d).isSome))
-    let pattern := type
-    let fnInfos ← mkProofInstInfoMapFor pattern
-    return { levelParams, varTypes, isInstance, pattern, fnInfos }
+    mkPatternCore levelParams varTypes isInstance type
   go 0 type #[] #[]
 
 /--
@@ -123,9 +191,8 @@ public def mkEqPatternFromDecl (declName : Name) : MetaM (Pattern × Expr) := do
       return (← go b (varTypes.push d) (isInstance.push (isClass? (← getEnv) d).isSome))
     else
       let_expr Eq _ lhs rhs := type | throwError "resulting type for `{.ofConstName declName}` is not an equality"
-      let pattern := lhs
-      let fnInfos ← mkProofInstInfoMapFor pattern
-      return ({ levelParams, varTypes, isInstance, pattern, fnInfos }, rhs)
+      let pattern ← mkPatternCore levelParams varTypes isInstance lhs
+      return (pattern, rhs)
   go type #[] #[]
 
 structure UnifyM.Context where
@@ -139,6 +206,11 @@ structure UnifyM.State where
   ePending     : Array (Expr × Expr)   := #[]
   uPending     : Array (Level × Level) := #[]
   iPending     : Array (Expr × Expr)   := #[]
+  /--
+  Contains the index of the pattern variables that we must check whether its type
+  matches the type of the value assigned to it.
+  -/
+  tPending     : Array Nat             := #[]
   us           : List Level            := []
   args         : Array Expr            := #[]
 
@@ -153,6 +225,14 @@ def pushLevelPending (u : Level) (v : Level) : UnifyM Unit :=
 def pushInstPending (p : Expr) (e : Expr) : UnifyM Unit :=
   modify fun s => { s with iPending := s.iPending.push (p, e) }
 
+/--
+Mark pattern variable `i` for type checking. That is, at the end of phase 1
+we must check whether the type of this pattern variable is compatible with the type of
+the value assigned to it.
+-/
+def pushCheckTypePending (i : Nat) : UnifyM Unit :=
+  modify fun s => { s with tPending := s.tPending.push i }
+
 def assignExprIfUnassigned (bidx : Nat) (e : Expr) : UnifyM Unit := do
   let s ← get
   let i := s.eAssignment.size - bidx - 1
@@ -169,6 +249,8 @@ def assignExpr (bidx : Nat) (e : Expr) : UnifyM Bool := do
       return true
   else
     modify fun s => { s with eAssignment := s.eAssignment.set! i (some e) }
+    if (← read).pattern.checkTypeMask?.isSome then
+      pushCheckTypePending i
     return true
 
 def assignLevel (uidx : Nat) (u : Level) : UnifyM Bool := do
@@ -369,6 +451,11 @@ structure DefEqM.Context where
   If `unify` is `false`, it contains which variables can be assigned.
   -/
   mvarsNew : Array MVarId := #[]
+  /--
+  If a metavariable is in this collection, when we perform the assignment `?m := v`,
+  we must check whether their types are compatible.
+  -/
+  mvarsToCheckType : Array MVarId := #[]
 
 abbrev DefEqM := ReaderT DefEqM.Context SymM
 
@@ -481,6 +568,12 @@ def mayAssign (t s : Expr) : SymM Bool := do
   let tMaxFVarDecl ← tMaxFVarId.getDecl
   return tMaxFVarDecl.index ≥ sMaxFVarDecl.index
 
+@[inline] def whenUndefDo (x : DefEqM LBool) (k : DefEqM Bool) : DefEqM Bool := do
+  match (← x) with
+  | .true  => return true
+  | .false => return false
+  | .undef => k
+
 /--
 Attempts to solve a unification constraint `t =?= s` where `t` has the form `?m a₁ ... aₙ`
 and satisfies the Miller pattern condition (all `aᵢ` are distinct, newly-introduced free variables).
@@ -495,17 +588,20 @@ The `tFn` parameter must equal `t.getAppFn` (enforced by the proof argument).
 
 Remark: `t` may be of the form `?m`.
 -/
-def tryAssignMillerPattern (tFn : Expr) (t : Expr) (s : Expr) (_ : tFn = t.getAppFn) : DefEqM Bool := do
-  let .mvar mvarId := tFn | return false
-  if !(← isAssignableMVar mvarId) then return false
-  if !(← isMillerPatternArgs t) then return false
+def tryAssignMillerPattern (tFn : Expr) (t : Expr) (s : Expr) (_ : tFn = t.getAppFn) : DefEqM LBool := do
+  let .mvar mvarId := tFn | return .undef
+  if !(← isAssignableMVar mvarId) then return .undef
+  if !(← isMillerPatternArgs t) then return .undef
   let s ← if t.isApp then
     mkLambdaFVarsS t.getAppArgs s
   else
     pure s
-  if !(← mayAssign tFn s) then return false
+  if !(← mayAssign tFn s) then return .undef
+  if (← read).mvarsToCheckType.contains mvarId then
+    unless (← Sym.isDefEqTypes (← mvarId.getDecl).type (← inferType s)) do
+      return .false
   mvarId.assign s
-  return true
+  return .true
 
 /--
 Structural definitional equality for applications without `ProofInstInfo`.
@@ -531,6 +627,11 @@ where
     if (← mvarId.isAssigned) then return false
     if !(← isAssignableMVar mvarId) then return false
     if !(← mayAssign t s) then return false
+    /-
+    **Note**: we don't need to check the type of `mvarId` here even if the variable is marked for
+    checking. This is the case because `tryAssignUnassigned` is invoked only from a context where `t` and `s` are the arguments
+    of function applications.
+    -/
     mvarId.assign s
     return true
 
@@ -619,11 +720,10 @@ def isDefEqMainImpl (t : Expr) (s : Expr) : DefEqM Bool := do
       isDefEqMain (← instantiateMVarsS t) s
     else if (← isAssignedMVar sFn) then
       isDefEqMain t (← instantiateMVarsS s)
-    else if (← tryAssignMillerPattern tFn t s rfl) then
-      return true
-    else if (← tryAssignMillerPattern sFn s t rfl) then
-      return true
-    else if let .fvar fvarId₁ := t then
+    else
+    whenUndefDo (tryAssignMillerPattern tFn t s rfl) do
+    whenUndefDo (tryAssignMillerPattern sFn s t rfl) do
+    if let .fvar fvarId₁ := t then
       unless (← read).zetaDelta do return false
       let some val₁ ← fvarId₁.getValue? | return false
       isDefEqMain val₁ s
@@ -634,17 +734,19 @@ def isDefEqMainImpl (t : Expr) (s : Expr) : DefEqM Bool := do
     else
       isDefEqApp tFn t s rfl
 
-abbrev DefEqM.run (unify := true) (zetaDelta := true) (mvarsNew : Array MVarId := #[]) (x : DefEqM α) : SymM α := do
+abbrev DefEqM.run (unify := true) (zetaDelta := true) (mvarsNew : Array MVarId := #[])
+    (mvarsToCheckType : Array MVarId := #[]) (x : DefEqM α) : SymM α := do
   let lctx ← getLCtx
   let lctxInitialNextIndex := lctx.decls.size
-  x { zetaDelta, lctxInitialNextIndex, unify, mvarsNew }
+  x { zetaDelta, lctxInitialNextIndex, unify, mvarsNew, mvarsToCheckType }
 
 /--
 A lightweight structural definitional equality for the symbolic simulation framework.
 Unlike the full `isDefEq`, it avoids expensive operations while still supporting Miller pattern unification.
 -/
-public def isDefEqS (t : Expr) (s : Expr) (unify := true) (zetaDelta := true) (mvarsNew : Array MVarId := #[]) : SymM Bool := do
-  DefEqM.run (unify := unify) (zetaDelta := zetaDelta) (mvarsNew := mvarsNew) do
+public def isDefEqS (t : Expr) (s : Expr) (unify := true) (zetaDelta := true)
+    (mvarsNew : Array MVarId := #[]) (mvarsToCheckType : Array MVarId := #[]): SymM Bool := do
+  DefEqM.run (unify := unify) (zetaDelta := zetaDelta) (mvarsNew := mvarsNew) (mvarsToCheckType := mvarsToCheckType) do
     isDefEqMain t s
 
 def noPending : UnifyM Bool := do
@@ -655,7 +757,11 @@ def instantiateLevelParamsS (e : Expr) (paramNames : List Name) (us : List Level
   -- We do not assume `e` is maximally shared
   shareCommon (e.instantiateLevelParams paramNames us)
 
-def mkPreResult : UnifyM Unit := do
+inductive MkPreResultResult where
+  | failed
+  | success (mvarsToCheckType : Array MVarId)
+
+def mkPreResult : UnifyM MkPreResultResult := do
   let us ← (← get).uAssignment.toList.mapM fun
     | some val => pure val
     | none => mkFreshLevelMVar
@@ -663,9 +769,20 @@ def mkPreResult : UnifyM Unit := do
   let varTypes := pattern.varTypes
   let isInstance := pattern.isInstance
   let eAssignment := (← get).eAssignment
+  let tPending := (← get).tPending
   let mut args := #[]
+  let mut mvarsToCheckType := #[]
   for h : i in *...eAssignment.size do
     if let .some val := eAssignment[i] then
+      if tPending.contains i then
+        let type := varTypes[i]!
+        let type ← instantiateLevelParamsS type pattern.levelParams us
+        let type ← instantiateRevBetaS type args
+        let valType ← inferType val
+        -- **Note**: we have to use the default `isDefEq` because the type of `val`
+        -- is not necessarily normalized.
+        unless (← isDefEqTypes type valType) do
+          return .failed
       args := args.push val
     else
       let type := varTypes[i]!
@@ -677,8 +794,12 @@ def mkPreResult : UnifyM Unit := do
           continue
       let mvar ← mkFreshExprMVar type
       let mvar ← shareCommon mvar
+      if let some mask := (← read).pattern.checkTypeMask? then
+        if mask[i]! then
+          mvarsToCheckType := mvarsToCheckType.push mvar.mvarId!
       args := args.push mvar
   modify fun s => { s with args, us }
+  return .success mvarsToCheckType
 
 def processPendingLevel : UnifyM Bool := do
   let uPending := (← get).uPending
@@ -704,7 +825,7 @@ def processPendingInst : UnifyM Bool := do
       return false
   return true
 
-def processPendingExpr : UnifyM Bool := do
+def processPendingExpr (mvarsToCheckType : Array MVarId) : UnifyM Bool := do
   let ePending := (← get).ePending
   if ePending.isEmpty then return true
   let pattern := (← read).pattern
@@ -715,7 +836,7 @@ def processPendingExpr : UnifyM Bool := do
   let mvarsNew := if unify then #[] else args.filterMap fun
     | .mvar mvarId => some mvarId
     | _ => none
-  DefEqM.run unify zetaDelta mvarsNew do
+  DefEqM.run unify zetaDelta mvarsNew mvarsToCheckType do
     for (t, s) in ePending do
       let t ← instantiateLevelParamsS t pattern.levelParams us
       let t ← instantiateRevBetaS t args
@@ -723,11 +844,11 @@ def processPendingExpr : UnifyM Bool := do
         return false
     return true
 
-def processPending : UnifyM Bool := do
+def processPending (mvarsToCheckType : Array MVarId) : UnifyM Bool := do
   if (← noPending) then
     return true
   else
-    processPendingLevel <&&> processPendingInst <&&> processPendingExpr
+    processPendingLevel <&&> processPendingInst <&&> processPendingExpr mvarsToCheckType
 
 abbrev UnifyM.run (pattern : Pattern) (unify : Bool) (zetaDelta : Bool) (k : UnifyM α) : SymM α := do
   let eAssignment := pattern.varTypes.map fun _ => none
@@ -745,9 +866,11 @@ def mkResult : UnifyM MatchUnifyResult := do
 def main (p : Pattern) (e : Expr) (unify : Bool) (zetaDelta : Bool) : SymM (Option (MatchUnifyResult)) :=
   UnifyM.run p unify zetaDelta do
     unless (← process p.pattern e) do return none
-    mkPreResult
-    unless (← processPending) do return none
-    return some (← mkResult)
+    match (← mkPreResult) with
+    | .failed => return none
+    | .success mvarsToCheckType =>
+      unless (← processPending mvarsToCheckType) do return none
+      return some (← mkResult)
 
 /--
 Attempts to match expression `e` against pattern `p` using purely syntactic matching.

src/Lean/Meta/Sym/Simp.lean

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
 -/
 module
 prelude
-public import Lean.Meta.Sym.Simp.Congr
+public import Lean.Meta.Sym.Simp.App
 public import Lean.Meta.Sym.Simp.CongrInfo
 public import Lean.Meta.Sym.Simp.DiscrTree
 public import Lean.Meta.Sym.Simp.Main
@@ -14,3 +14,10 @@ public import Lean.Meta.Sym.Simp.Rewrite
 public import Lean.Meta.Sym.Simp.SimpM
 public import Lean.Meta.Sym.Simp.Simproc
 public import Lean.Meta.Sym.Simp.Theorems
+public import Lean.Meta.Sym.Simp.Have
+public import Lean.Meta.Sym.Simp.Lambda
+public import Lean.Meta.Sym.Simp.Forall
+public import Lean.Meta.Sym.Simp.Debug
+public import Lean.Meta.Sym.Simp.EvalGround
+public import Lean.Meta.Sym.Simp.Discharger
+public import Lean.Meta.Sym.Simp.ControlFlow

src/Lean/Meta/Sym/Simp/App.lean

@@ -0,0 +1,481 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.SynthInstance
+import Lean.Meta.Tactic.Simp.Types
+import Lean.Meta.Sym.AlphaShareBuilder
+import Lean.Meta.Sym.InferType
+import Lean.Meta.Sym.Simp.Result
+import Lean.Meta.Sym.Simp.CongrInfo
+namespace Lean.Meta.Sym.Simp
+open Internal
+
+/-!
+# Simplifying Application Arguments and Congruence Lemma Application
+
+This module provides functions for building congruence proofs during simplification.
+Given a function application `f a₁ ... aₙ` where some arguments are rewritable,
+we recursively simplify those arguments (via `simp`) and construct a proof that the
+original expression equals the simplified one.
+
+The key challenge is efficiency: we want to avoid repeatedly inferring types, or destroying sharing,
+The `CongrInfo` type (see `SymM.lean`) categorizes functions
+by their argument structure, allowing us to choose the most efficient proof strategy:
+
+- `fixedPrefix`: Use simple `congrArg`/`congrFun'`/`congr` for trailing arguments. We exploit
+  the fact that there are no dependent arguments in the suffix and use the cheaper `congrFun'`
+  instead of `congrFun`.
+- `interlaced`: Mix rewritable and fixed arguments. It may have to use `congrFun` for fixed
+  dependent arguments.
+- `congrTheorem`: Apply a pre-generated congruence theorem for dependent arguments
+
+**Design principle**: Never infer the type of proofs. This avoids expensive type
+inference on proof terms, which can be arbitrarily complex, and often destroys sharing.
+-/
+
+/--
+Helper function for constructing a congruence proof using `congrFun'`, `congrArg`, `congr`.
+For the dependent case, use `mkCongrFun`
+-/
+public def mkCongr (e : Expr) (f a : Expr) (fr : Result) (ar : Result) (_ : e = .app f a) : SymM Result := do
+  let mkCongrPrefix (declName : Name) : SymM Expr := do
+    let α ← inferType a
+    let u ← getLevel α
+    let β ← inferType e
+    let v ← getLevel β
+    return mkApp2 (mkConst declName [u, v]) α β
+  match fr, ar with
+  | .rfl _,  .rfl _ => return .rfl
+  | .step f' hf _, .rfl _ =>
+    let e' ← mkAppS f' a
+    let h := mkApp4 (← mkCongrPrefix ``congrFun') f f' hf a
+    return .step e' h
+  | .rfl _, .step a' ha _ =>
+    let e' ← mkAppS f a'
+    let h := mkApp4 (← mkCongrPrefix ``congrArg) a a' f ha
+    return .step e' h
+  | .step f' hf _, .step a' ha _ =>
+    let e' ← mkAppS f' a'
+    let h := mkApp6 (← mkCongrPrefix ``congr) f f' a a' hf ha
+    return .step e' h
+
+/--
+Returns a proof using `congrFun`
+```
+congrFun.{u, v} {α : Sort u} {β : α → Sort v} {f g : (x : α) → β x} (h : f = g) (a : α) : f a = g a
+```
+-/
+def mkCongrFun (e : Expr) (f a : Expr) (f' : Expr) (hf : Expr) (_ : e = .app f a) (done := false) : SymM Result := do
+  let .forallE x _ βx _ ← whnfD (← inferType f)
+    | throwError "failed to build congruence proof, function expected{indentExpr f}"
+  let α ← inferType a
+  let u ← getLevel α
+  let v ← getLevel (← inferType e)
+  let β := Lean.mkLambda x .default α βx
+  let e' ← mkAppS f' a
+  let h := mkApp6 (mkConst ``congrFun [u, v]) α β f f' hf a
+  return .step e' h done
+
+/--
+Handles simplification of over-applied function terms.
+
+When a function has more arguments than expected by its `CongrInfo`, we need to handle
+the "extra" arguments separately. This function peels off `numArgs` trailing applications,
+simplifies the remaining function using `simpFn`, then rebuilds the term by simplifying
+and re-applying the trailing arguments.
+
+**Over-application** occurs when:
+- A function with `fixedPrefix prefixSize suffixSize` is applied to more than `prefixSize + suffixSize` arguments
+- A function with `interlaced` rewritable mask is applied to more than `mask.size` arguments
+- A function with a congruence theorem is applied to more than the theorem expects
+
+**Example**: If `f` has `CongrInfo.fixedPrefix 2 3` (expects 5 arguments) but we see `f a₁ a₂ a₃ a₄ a₅ b₁ b₂`,
+then `numArgs = 2` (the extra arguments) and we:
+1. Recursively simplify `f a₁ a₂ a₃ a₄ a₅` using the fixed prefix strategy (via `simpFn`)
+2. Simplify each extra argument `b₁` and `b₂`
+3. Rebuild the term using either `mkCongr` (for non-dependent arrows) or `mkCongrFun` (for dependent functions)
+
+**Parameters**:
+- `e`: The over-applied expression to simplify
+- `numArgs`: Number of excess arguments to peel off
+- `simpFn`: Strategy for simplifying the function after peeling (e.g., `simpFixedPrefix`, `simpInterlaced`, or `simpUsingCongrThm`)
+
+**Note**: This is a fallback path without specialized optimizations. The common case (correct number of arguments)
+is handled more efficiently by the specific strategies.
+-/
+public def simpOverApplied (e : Expr) (numArgs : Nat) (simpFn : Expr → SimpM Result) : SimpM Result := do
+  let rec visit (e : Expr) (i : Nat) : SimpM Result := do
+    if i == 0 then
+      simpFn e
+    else
+      let i := i - 1
+      match h : e with
+      | .app f a =>
+        let fr ← visit f i
+        let .forallE _ α β _ ← whnfD (← inferType f) | unreachable!
+        if !β.hasLooseBVars then
+          if (← isProp α) then
+            mkCongr e f a fr .rfl h
+          else
+            mkCongr e f a fr (← simp a) h
+        else match fr with
+          | .rfl _ => return .rfl
+          | .step f' hf _ => mkCongrFun e f a f' hf h
+      | _ => unreachable!
+  visit e numArgs
+
+/--
+Handles over-applied function expressions by simplifying only the base function and
+propagating changes through extra arguments WITHOUT simplifying them.
+
+Unlike `simpOverApplied`, this function does not simplify the extra arguments themselves.
+It only uses congruence (`mkCongrFun`) to propagate changes when the base function is simplified.
+
+**Algorithm**:
+1. Peel off `numArgs` extra arguments from `e`
+2. Apply `simpFn` to simplify the base function
+3. If the base changed, propagate the change through each extra argument using `mkCongrFun`
+4. Return `.rfl` if the base function was not simplified
+
+**Parameters**:
+- `e`: The over-applied expression
+- `numArgs`: Number of excess arguments to peel off
+- `simpFn`: Strategy for simplifying the base function after peeling
+
+**Contrast with `simpOverApplied`**:
+- `simpOverApplied`: Fully simplifies both base and extra arguments
+- `propagateOverApplied`: Only simplifies base, appends extra arguments unchanged
+-/
+public def propagateOverApplied (e : Expr) (numArgs : Nat) (simpFn : Expr → SimpM Result) : SimpM Result := do
+  let rec visit (e : Expr) (i : Nat) : SimpM Result := do
+    if i == 0 then
+      simpFn e
+    else
+      let i := i - 1
+      match h : e with
+      | .app f a =>
+        let r ← visit f i
+        match r with
+        | .rfl _ => return r
+        | .step f' hf done => mkCongrFun e f a f' hf h done
+      | _ => unreachable!
+  visit e numArgs
+
+/--
+Reduces `type` to weak head normal form and verifies it is a `forall` expression.
+If `type` is already a `forall`, returns it unchanged (avoiding unnecessary work).
+The result is shared via `share` to maintain maximal sharing invariants.
+-/
+def whnfToForall (type : Expr) : SymM Expr := do
+  if type.isForall then return type
+  let type ← whnfD type
+  unless type.isForall do throwError "function type expected{indentD type}"
+  share type
+
+/--
+Returns the type of an expression `e`. If `n > 0`, then `e` is an application
+with at least `n` arguments. This function assumes the `n` trailing arguments are non-dependent.
+Given `e` of the form `f a₁ a₂ ... aₙ`, the type of `e` is computed by
+inferring the type of `f` and traversing the forall telescope.
+
+We use this function to implement `congrFixedPrefix`. Recall that `inferType` is cached.
+This function tries to maximize the likelihood of a cache hit. For example,
+suppose `e` is `@HAdd.hAdd Nat Nat Nat instAdd 5` and `n = 1`. It is much more likely that
+`@HAdd.hAdd Nat Nat Nat instAdd` is already in the cache than
+`@HAdd.hAdd Nat Nat Nat instAdd 5`.
+-/
+def getFnType (e : Expr) (n : Nat) : SymM Expr := do
+  match n with
+  | 0 => inferType e
+  | n+1 =>
+    let type ← getFnType e.appFn! n
+    let .forallE _ _ β _ ← whnfToForall type | unreachable!
+    return β
+
+/--
+Simplifies arguments of a function application with a fixed prefix structure.
+Recursively simplifies the trailing `suffixSize` arguments, leaving the first
+`prefixSize` arguments unchanged.
+
+For a function with `CongrInfo.fixedPrefix prefixSize suffixSize`, the arguments
+are structured as:
+```
+f a₁ ... aₚ b₁ ... bₛ
+  └───────┘ └───────┘
+   prefix    suffix (rewritable)
+```
+
+The prefix arguments (types, instances) should
+not be rewritten directly. Only the suffix arguments are recursively simplified.
+
+**Performance optimization**: We avoid calling `inferType` on applied expressions
+like `f a₁ ... aₚ b₁` or `f a₁ ... aₚ b₁ ... bₛ`, which would have poor cache hit rates.
+Instead, we infer the type of the function prefix `f a₁ ... aₚ`
+(e.g., `@HAdd.hAdd Nat Nat Nat instAdd`) which is probably shared across many applications,
+then traverse the forall telescope to extract argument and result types as needed.
+
+The helper `go` returns `Result × Expr` where the `Expr` is the function type at that
+position. However, the type is only meaningful (non-`default`) when `Result` is
+`.step`, since we only need types for constructing congruence proofs. This avoids
+unnecessary type inference when no rewriting occurs.
+-/
+def simpFixedPrefix (e : Expr) (prefixSize : Nat) (suffixSize : Nat) : SimpM Result := do
+  let numArgs := e.getAppNumArgs
+  if numArgs ≤ prefixSize then
+    -- Nothing to be done
+    return .rfl
+  else if numArgs > prefixSize + suffixSize then
+    simpOverApplied e (numArgs - prefixSize - suffixSize) (main suffixSize)
+  else
+    main (numArgs - prefixSize) e
+where
+  main (n : Nat) (e : Expr) : SimpM Result := do
+    return (← go n e).1
+
+  go (i : Nat) (e : Expr) : SimpM (Result × Expr) := do
+    if i == 0 then
+      return (.rfl, default)
+    else
+      let .app f a := e | unreachable!
+      let (hf, fType) ← go (i-1) f
+      match hf, (← simp a) with
+      | .rfl _,  .rfl _ => return (.rfl, default)
+      | .step f' hf _, .rfl _ =>
+        let .forallE _ α β _ ← whnfToForall fType | unreachable!
+        let e' ← mkAppS f' a
+        let u ← getLevel α
+        let v ← getLevel β
+        let h := mkApp6 (mkConst ``congrFun' [u, v]) α β f f' hf a
+        return (.step e' h, β)
+      | .rfl _, .step a' ha _ =>
+        let fType ← getFnType f (i-1)
+        let .forallE _ α β _ ← whnfToForall fType | unreachable!
+        let e' ← mkAppS f a'
+        let u ← getLevel α
+        let v ← getLevel β
+        let h := mkApp6 (mkConst ``congrArg [u, v]) α β a a' f ha
+        return (.step e' h, β)
+      | .step f' hf _, .step a' ha _ =>
+        let .forallE _ α β _ ← whnfToForall fType | unreachable!
+        let e' ← mkAppS f' a'
+        let u ← getLevel α
+        let v ← getLevel β
+        let h := mkApp8 (mkConst ``congr [u, v]) α β f f' a a' hf ha
+        return (.step e' h, β)
+
+/--
+Simplifies arguments of a function application with interlaced rewritable/fixed arguments.
+Uses `rewritable[i]` to determine whether argument `i` should be simplified.
+For rewritable arguments, calls `simp` and uses `congrFun'`, `congrArg`, and `congr`; for fixed arguments,
+uses `congrFun` to propagate changes from earlier arguments.
+-/
+def simpInterlaced (e : Expr) (rewritable : Array Bool) : SimpM Result := do
+  let numArgs := e.getAppNumArgs
+  if h : numArgs = 0 then
+    -- Nothing to be done
+    return .rfl
+  else if h : numArgs > rewritable.size then
+    simpOverApplied e (numArgs - rewritable.size) (go rewritable.size · (Nat.le_refl _))
+  else
+    go numArgs e (by omega)
+where
+  go (i : Nat) (e : Expr) (h : i ≤ rewritable.size) : SimpM Result := do
+    if h : i = 0 then
+      return .rfl
+    else
+      match h : e with
+      | .app f a =>
+        let fr ← go (i - 1) f (by omega)
+        if rewritable[i - 1] then
+          mkCongr e f a fr (← simp a) h
+        else match fr with
+          | .rfl _ => return .rfl
+          | .step f' hf _ => mkCongrFun e f a f' hf h
+      | _ => unreachable!
+
+/--
+Helper function used at `congrThm`. The idea is to initialize `argResults` lazily
+when we get the first non-`.rfl` result.
+-/
+def pushResult (argResults : Array Result) (numEqs : Nat) (result : Result) : Array Result :=
+  match result with
+  | .rfl .. => if argResults.size > 0 then argResults.push result else argResults
+  | .step .. =>
+    if argResults.size < numEqs then
+      Array.replicate numEqs .rfl |>.push result
+    else
+      argResults.push result
+
+/--
+Simplifies arguments of a function application using a pre-generated congruence theorem.
+
+This strategy is used for functions that have complex argument dependencies, particularly
+those with proof arguments or `Decidable` instances. Unlike `congrFixedPrefix` and
+`congrInterlaced`, which construct proofs on-the-fly using basic congruence lemmas
+(`congrArg`, `congrFun`, `congrFun'`, `congr`), this function applies a specialized congruence theorem
+that was pre-generated for the specific function being simplified.
+
+See type `CongrArgKind`.
+
+**Algorithm**:
+1. Recursively simplify all `.eq` arguments (via `simpEqArgs`)
+2. If all simplifications return `.rfl`, the overall result is `.rfl`
+3. Otherwise, construct the final proof by:
+   - Starting with the congruence theorem's proof term
+   - Applying original arguments and their simplification results
+   - Re-synthesizing subsingleton instances when their dependencies change
+   - Removing unnecessary casts from the result
+
+**Key examples**:
+
+1. `ite`: Has type `{α : Sort u} → (c : Prop) → [Decidable c] → α → α → α`
+   - Argument kinds: `[.fixed, .eq, .subsingletonInst, .eq, .eq]`
+   - When simplifying `ite (x > 0) a b`, if `x > 0` simplifies to `true`, we must
+     re-synthesize `[Decidable true]` because the original `[Decidable (x > 0)]`
+     instance is no longer type-correct
+
+2. `GetElem.getElem`: Has type
+   ```
+   {coll : Type u} → {idx : Type v} → {elem : Type w} → {valid : coll → idx → Prop} →
+   [GetElem coll idx elem valid] → (xs : coll) → (i : idx) → valid xs i → elem
+   ```
+   - The proof argument `valid xs i` depends on earlier arguments `xs` and `i`
+   - When `xs` or `i` are simplified, the proof is adjusted in the `rhs` of the auto-generated
+     theorem.
+-/
+def simpUsingCongrThm (e : Expr) (thm : CongrTheorem) : SimpM Result := do
+  let argKinds := thm.argKinds
+  /-
+  Constructs the non-`rfl` result. `argResults` contains the result for arguments with kind `.eq`.
+  There is at least one non-`rfl` result in `argResults`.
+  -/
+  let mkNonRflResult (argResults : Array Result) : SimpM Result := do
+    let mut proof := thm.proof
+    let mut type  := thm.type
+    let mut j := 0 -- index at argResults
+    let mut subst := #[]
+    let args := e.getAppArgs
+    for arg in args, kind in argKinds do
+      proof := mkApp proof arg
+      type := type.bindingBody!
+      match kind with
+      | .fixed => subst := subst.push arg
+      | .cast  => subst := subst.push arg
+      | .subsingletonInst =>
+        subst := subst.push arg
+        let clsNew := type.bindingDomain!.instantiateRev subst
+        let instNew ← if (← isDefEqI (← inferType arg) clsNew) then
+          pure arg
+        else
+          let .some val ← trySynthInstance clsNew | return .rfl
+          pure val
+        proof := mkApp proof instNew
+        subst := subst.push instNew
+        type := type.bindingBody!
+      | .eq =>
+        subst := subst.push arg
+        match argResults[j]! with
+        | .rfl _ =>
+          let h ← mkEqRefl arg
+          proof := mkApp2 proof arg h
+          subst := subst.push arg |>.push h
+        | .step arg' h _ =>
+          proof := mkApp2 proof arg' h
+          subst := subst.push arg' |>.push h
+        type := type.bindingBody!.bindingBody!
+        j := j + 1
+      | _ => unreachable!
+    let_expr Eq _ _ rhs := type | unreachable!
+    let rhs := rhs.instantiateRev subst
+    let hasCast := argKinds.any (· matches .cast)
+    let rhs ← if hasCast then Simp.removeUnnecessaryCasts rhs else pure rhs
+    let rhs ← share rhs
+    return .step rhs proof
+  /-
+  Recursively simplifies arguments of kind `.eq`. The array `argResults` is initialized lazily
+  as soon as the simplifier returns a non-`rfl` result for some arguments.
+  `numEqs` is the number of `.eq` arguments found so far.
+  -/
+  let rec simpEqArgs (e : Expr) (i : Nat) (numEqs : Nat) (argResults : Array Result) : SimpM Result := do
+    match e with
+    | .app f a =>
+      match argKinds[i]! with
+      | .subsingletonInst
+      | .fixed => simpEqArgs f (i-1) numEqs argResults
+      | .cast => simpEqArgs f (i-1) numEqs argResults
+      | .eq => simpEqArgs f (i-1) (numEqs+1) (pushResult argResults numEqs (← simp a))
+      | _ => unreachable!
+    | _ =>
+      if argResults.isEmpty then
+        return .rfl
+      else
+        mkNonRflResult argResults.reverse
+  let numArgs := e.getAppNumArgs
+  if numArgs > argKinds.size then
+    simpOverApplied e (numArgs - argKinds.size) (simpEqArgs · (argKinds.size - 1) 0 #[])
+  else if numArgs < argKinds.size then
+    /-
+    **Note**: under-applied case. This can be optimized, but this case is so
+    rare that it is not worth doing it. We just reuse `simpOverApplied`
+    -/
+    simpOverApplied e e.getAppNumArgs (fun _ => return .rfl)
+  else
+    simpEqArgs e (argKinds.size - 1) 0 #[]
+
+/--
+Main entry point for simplifying function application arguments.
+Dispatches to the appropriate strategy based on the function's `CongrInfo`.
+-/
+public def simpAppArgs (e : Expr) : SimpM Result := do
+  let f := e.getAppFn
+  match (← getCongrInfo f) with
+  | .none => return .rfl
+  | .fixedPrefix prefixSize suffixSize => simpFixedPrefix e prefixSize suffixSize
+  | .interlaced rewritable => simpInterlaced e rewritable
+  | .congrTheorem thm => simpUsingCongrThm e thm
+
+/--
+Simplifies arguments in a specified range `[start, stop)` of a function application.
+
+Given an expression `f a₀ a₁ ... aₙ`, this function simplifies only the arguments
+at positions `start ≤ i < stop`, leaving arguments outside this range unchanged.
+Changes are propagated using congruence lemmas.
+
+**Use case**: Useful for control-flow simplification where we want to simplify only
+discriminants of a `match` expression without touching the branches.
+-/
+public def simpAppArgRange (e : Expr) (start stop : Nat) : SimpM Result := do
+  let numArgs := e.getAppNumArgs
+  assert! start < stop
+  if numArgs < start then return .rfl
+  let numArgs := numArgs - start
+  let stop := stop - start
+  let rec visit (e : Expr) (i : Nat) : SimpM Result := do
+    if i == 0 then
+      return .rfl
+    let i := i - 1
+    match h : e with
+    | .app f a =>
+      let fr ← visit f i
+      let skip : SimpM Result := do
+        match fr with
+        | .rfl _ => return .rfl
+        | .step f' hf _ => mkCongrFun e f a f' hf h
+      if i < stop then
+        let .forallE _ α β _ ← whnfD (← inferType f) | unreachable!
+        if !β.hasLooseBVars then
+          if (← isProp α) then
+            mkCongr e f a fr .rfl h
+          else
+            mkCongr e f a fr (← simp a) h
+        else skip
+      else skip
+    | _ => unreachable!
+  visit e numArgs
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Congr.lean

@@ -1,157 +0,0 @@
-/-
-Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
--/
-module
-prelude
-public import Lean.Meta.Sym.Simp.SimpM
-import Lean.Meta.Sym.AlphaShareBuilder
-import Lean.Meta.Sym.InferType
-import Lean.Meta.Sym.Simp.Result
-import Lean.Meta.Sym.Simp.CongrInfo
-namespace Lean.Meta.Sym.Simp
-open Internal
-
-/-!
-# Simplifying Application Arguments and Congruence Lemma Application
-
-This module provides functions for building congruence proofs during simplification.
-Given a function application `f a₁ ... aₙ` where some arguments are rewritable,
-we recursively simplify those arguments (via `simp`) and construct a proof that the
-original expression equals the simplified one.
-
-The key challenge is efficiency: we want to avoid repeatedly inferring types, or destroying sharing,
-The `CongrInfo` type (see `SymM.lean`) categorizes functions
-by their argument structure, allowing us to choose the most efficient proof strategy:
-
-- `fixedPrefix`: Use simple `congrArg`/`congrFun'`/`congr` for trailing arguments. We exploit
-  the fact that there are no dependent arguments in the suffix and use the cheaper `congrFun'`
-  instead of `congrFun`.
-- `interlaced`: Mix rewritable and fixed arguments. It may have to use `congrFun` for fixed
-  dependent arguments.
-- `congrTheorem`: Apply a pre-generated congruence theorem for dependent arguments
-
-**Design principle**: Never infer the type of proofs. This avoids expensive type
-inference on proof terms, which can be arbitrarily complex, and often destroys sharing.
--/
-
-/--
-Helper function for constructing a congruence proof using `congrFun'`, `congrArg`, `congr`.
-For the dependent case, use `mkCongrFun`
--/
-def mkCongr (e : Expr) (f a : Expr) (fr : Result) (ar : Result) (_ : e = .app f a) : SymM Result := do
-  let mkCongrPrefix (declName : Name) : SymM Expr := do
-    let α ← inferType a
-    let u ← getLevel α
-    let β ← inferType e
-    let v ← getLevel β
-    return mkApp2 (mkConst declName [u, v]) α β
-  match fr, ar with
-  | .rfl _,  .rfl _ => return .rfl
-  | .step f' hf _, .rfl _ =>
-    let e' ← mkAppS f' a
-    let h := mkApp4 (← mkCongrPrefix ``congrFun') f f' hf a
-    return .step e' h
-  | .rfl _, .step a' ha _ =>
-    let e' ← mkAppS f a'
-    let h := mkApp4 (← mkCongrPrefix ``congrArg) a a' f ha
-    return .step e' h
-  | .step f' hf _, .step a' ha _ =>
-    let e' ← mkAppS f' a'
-    let h := mkApp6 (← mkCongrPrefix ``congr) f f' a a' hf ha
-    return .step e' h
-
-/--
-Returns a proof using `congrFun`
-```
-congrFun.{u, v} {α : Sort u} {β : α → Sort v} {f g : (x : α) → β x} (h : f = g) (a : α) : f a = g a
-```
--/
-def mkCongrFun (e : Expr) (f a : Expr) (f' : Expr) (hf : Expr) (_ : e = .app f a) : SymM Result := do
-  let .forallE x _ βx _ ← whnfD (← inferType f)
-    | throwError "failed to build congruence proof, function expected{indentExpr f}"
-  let α ← inferType a
-  let u ← getLevel α
-  let v ← getLevel (← inferType e)
-  let β := Lean.mkLambda x .default α βx
-  let e' ← mkAppS f' a
-  let h := mkApp6 (mkConst ``congrFun [u, v]) α β f f' hf a
-  return .step e' h
-
-/--
-Simplify arguments of a function application with a fixed prefix structure.
-Recursively simplifies the trailing `suffixSize` arguments, leaving the first
-`prefixSize` arguments unchanged.
--/
-def congrFixedPrefix (e : Expr) (prefixSize : Nat) (suffixSize : Nat) : SimpM Result := do
-  let numArgs := e.getAppNumArgs
-  if numArgs ≤ prefixSize then
-    -- Nothing to be done
-    return .rfl
-  else if numArgs > prefixSize + suffixSize then
-    -- **TODO**: over-applied case
-    return .rfl
-  else
-    go numArgs e
-where
-  go (i : Nat) (e : Expr) : SimpM Result := do
-    if i == prefixSize then
-      return .rfl
-    else
-      match h : e with
-      | .app f a => mkCongr e f a (← go (i - 1) f) (← simp a) h
-      | _ => unreachable!
-
-/--
-Simplify arguments of a function application with interlaced rewritable/fixed arguments.
-Uses `rewritable[i]` to determine whether argument `i` should be simplified.
-For rewritable arguments, calls `simp` and uses `congrFun'`, `congrArg`, and `congr`; for fixed arguments,
-uses `congrFun` to propagate changes from earlier arguments.
--/
-def congrInterlaced (e : Expr) (rewritable : Array Bool) : SimpM Result := do
-  let numArgs := e.getAppNumArgs
-  if h : numArgs = 0 then
-    -- Nothing to be done
-    return .rfl
-  else if h : numArgs > rewritable.size then
-    -- **TODO**: over-applied case
-    return .rfl
-  else
-    go numArgs e (by omega)
-where
-  go (i : Nat) (e : Expr) (h : i ≤ rewritable.size) : SimpM Result := do
-    if h : i = 0 then
-      return .rfl
-    else
-      match h : e with
-      | .app f a =>
-        let fr ← go (i - 1) f (by omega)
-        if rewritable[i - 1] then
-          mkCongr e f a fr (← simp a) h
-        else match fr with
-          | .rfl _ => return .rfl
-          | .step f' hf _ => mkCongrFun e f a f' hf h
-      | _ => unreachable!
-
-/--
-Simplify arguments using a pre-generated congruence theorem.
-Used for functions with proof or `Decidable` arguments.
--/
-def congrThm (_e : Expr) (_ : CongrTheorem) : SimpM Result := do
-  -- **TODO**
-  return .rfl
-
-/--
-Main entry point for simplifying function application arguments.
-Dispatches to the appropriate strategy based on the function's `CongrInfo`.
--/
-public def congrArgs (e : Expr) : SimpM Result := do
-  let f := e.getAppFn
-  match (← getCongrInfo f) with
-  | .none => return .rfl
-  | .fixedPrefix prefixSize suffixSize => congrFixedPrefix e prefixSize suffixSize
-  | .interlaced rewritable => congrInterlaced e rewritable
-  | .congrTheorem thm => congrThm e thm
-
-end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/ControlFlow.lean

@@ -0,0 +1,146 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.Sym.AlphaShareBuilder
+import Lean.Meta.Sym.InstantiateS
+import Lean.Meta.Sym.InferType
+import Lean.Meta.Sym.Simp.App
+import Lean.Meta.SynthInstance
+import Lean.Meta.WHNF
+import Lean.Meta.AppBuilder
+import Init.Sym.Lemmas
+namespace Lean.Meta.Sym.Simp
+open Internal
+
+/--
+Simplifies a non-dependent `if-then-else` expression.
+-/
+def simpIte : Simproc := fun e => do
+  let numArgs := e.getAppNumArgs
+  if numArgs < 5 then return .rfl (done := true)
+  propagateOverApplied e (numArgs - 5) fun e => do
+    let_expr f@ite α c _ a b := e | return .rfl
+    match (← simp c) with
+    | .rfl _ =>
+      if c.isTrue then
+        return .step a <| mkApp3 (mkConst ``ite_true f.constLevels!) α a b
+      else if c.isFalse then
+        return .step b <| mkApp3 (mkConst ``ite_false f.constLevels!) α a b
+      else
+        return .rfl (done := true)
+    | .step c' h _ =>
+      if c'.isTrue then
+        return .step a <| mkApp (e.replaceFn ``ite_cond_eq_true) h
+      else if c'.isFalse then
+        return .step b <| mkApp (e.replaceFn ``ite_cond_eq_false) h
+      else
+        let .some inst' ← trySynthInstance (mkApp (mkConst ``Decidable) c') | return .rfl
+        let inst' ← shareCommon inst'
+        let e' := e.getBoundedAppFn 4
+        let e' ← mkAppS₄ e' c' inst' a b
+        let h' := mkApp3 (e.replaceFn ``Sym.ite_cond_congr) c' inst' h
+        return .step e' h' (done := true)
+
+/--
+Simplifies a dependent `if-then-else` expression.
+-/
+def simpDIte : Simproc := fun e => do
+  let numArgs := e.getAppNumArgs
+  if numArgs < 5 then return .rfl (done := true)
+  propagateOverApplied e (numArgs - 5) fun e => do
+    let_expr f@dite α c _ a b := e | return .rfl
+    match (← simp c) with
+    | .rfl _ =>
+      if c.isTrue then
+        let a' ← share <| a.betaRev #[mkConst ``True.intro]
+        return .step a' <| mkApp3 (mkConst ``dite_true f.constLevels!) α a b
+      else if c.isFalse then
+        let b' ← share <| b.betaRev #[mkConst ``not_false]
+        return .step b' <| mkApp3 (mkConst ``dite_false f.constLevels!) α a b
+      else
+        return .rfl (done := true)
+    | .step c' h _ =>
+      if c'.isTrue then
+        let h' ← shareCommon <| mkOfEqTrueCore c h
+        let a ← share <| a.betaRev #[h']
+        return .step a <| mkApp (e.replaceFn ``dite_cond_eq_true) h
+      else if c'.isFalse then
+        let h' ← shareCommon <| mkOfEqFalseCore c h
+        let b ← share <| b.betaRev #[h']
+        return .step b <| mkApp (e.replaceFn ``dite_cond_eq_false) h
+      else
+        let .some inst' ← trySynthInstance (mkApp (mkConst ``Decidable) c') | return .rfl
+        let inst' ← shareCommon inst'
+        let e' := e.getBoundedAppFn 4
+        let h ← shareCommon h
+        let a ← share <| mkLambda `h .default c' (a.betaRev #[mkApp4 (mkConst ``Eq.mpr_prop) c c' h (mkBVar 0)])
+        let b ← share <| mkLambda `h .default (mkNot c') (b.betaRev #[mkApp4 (mkConst ``Eq.mpr_not) c c' h (mkBVar 0)])
+        let e' ← mkAppS₄ e' c' inst' a b
+        let h' := mkApp3 (e.replaceFn ``Sym.dite_cond_congr) c' inst' h
+        return .step e' h' (done := true)
+
+/--
+Simplifies a `cond` expression (aka Boolean `if-then-else`).
+-/
+def simpCond : Simproc := fun e => do
+  let numArgs := e.getAppNumArgs
+  if numArgs < 4 then return .rfl (done := true)
+  propagateOverApplied e (numArgs - 4) fun e => do
+    let_expr f@cond α c a b := e | return .rfl
+    match (← simp c) with
+    | .rfl _ =>
+      if c.isConstOf ``true then
+        return .step a <| mkApp3 (mkConst ``cond_true f.constLevels!) α a b
+      else if c.isConstOf ``false then
+        return .step b <| mkApp3 (mkConst ``cond_false f.constLevels!) α a b
+      else
+        return .rfl (done := true)
+    | .step c' h _ =>
+      if c'.isConstOf ``true then
+        return .step a <| mkApp (e.replaceFn ``Sym.cond_cond_eq_true) h
+      else if c'.isConstOf ``false then
+        return .step b <| mkApp (e.replaceFn ``Sym.cond_cond_eq_false) h
+      else
+        let e' := e.getBoundedAppFn 3
+        let e' ← mkAppS₃ e' c' a b
+        let h' := mkApp2 (e.replaceFn ``Sym.cond_cond_congr) c' h
+        return .step e' h' (done := true)
+
+/--
+Simplifies a `match`-expression.
+-/
+def simpMatch (declName : Name) : Simproc := fun e => do
+  if let some e' ← reduceRecMatcher? e then
+    return .step e' (← mkEqRefl e')
+  let some info ← getMatcherInfo? declName
+    | return .rfl
+  -- **Note**: Simplify only the discriminants
+  let start := info.numParams + 1
+  let stop  := start + info.numDiscrs
+  let r ← simpAppArgRange e start stop
+  match r with
+  | .step .. => return r
+  | _ => return .rfl (done := true)
+
+/--
+Simplifies control-flow expressions such as `if-then-else` and `match` expressions.
+It visits only the conditions and discriminants.
+-/
+public def simpControl : Simproc := fun e => do
+  if !e.isApp then return .rfl
+  let .const declName _ := e.getAppFn | return .rfl
+  if declName == ``ite then
+    simpIte e
+  else if declName == ``cond then
+    simpCond e
+  else if declName == ``dite then
+    simpDIte e
+  else
+    simpMatch declName e
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Debug.lean

@@ -0,0 +1,50 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+public import Lean.Meta.Sym.Simp.Discharger
+import Lean.Meta.Sym.Simp.Theorems
+import Lean.Meta.Sym.Simp.Rewrite
+import Lean.Meta.Sym.Util
+import Lean.Meta.Tactic.Util
+import Lean.Meta.AppBuilder
+namespace Lean.Meta.Sym
+open Simp
+/-!
+Helper functions for debugging purposes and creating tests.
+-/
+
+public def mkSimprocFor (declNames : Array Name) (d : Discharger := dischargeNone) : MetaM Simproc := do
+  let mut thms : Theorems := {}
+  for declName in declNames do
+    thms := thms.insert (← mkTheoremFromDecl declName)
+  return thms.rewrite d
+
+public def mkMethods (declNames : Array Name) : MetaM Methods := do
+  return { post := (← mkSimprocFor declNames) }
+
+public def simpWith (k : Expr → SymM Result) (mvarId : MVarId) : MetaM (Option MVarId) := SymM.run do
+  let mvarId ← preprocessMVar mvarId
+  let decl ← mvarId.getDecl
+  let target := decl.type
+  match (← k target) with
+  | .rfl _ => throwError "`Sym.simp` made no progress "
+  | .step target' h _ =>
+    let mvarNew ← mkFreshExprSyntheticOpaqueMVar target' decl.userName
+    let h ← mkAppM ``Eq.mpr #[h, mvarNew]
+    mvarId.assign h
+    if target'.isTrue then
+      mvarNew.mvarId!.assign (mkConst ``True.intro)
+      return none
+    else
+      return some mvarNew.mvarId!
+
+public def simpGoal (declNames : Array Name) (mvarId : MVarId) : MetaM (Option MVarId) := SymM.run do
+  let methods ← mkMethods declNames
+  simpWith (simp · methods) mvarId
+
+end Lean.Meta.Sym

src/Lean/Meta/Sym/Simp/Discharger.lean

@@ -0,0 +1,121 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.AppBuilder
+namespace Lean.Meta.Sym.Simp
+
+/-!
+# Dischargers for Conditional Rewrite Rules
+
+This module provides dischargers for handling conditional rewrite rules in `Sym.simp`.
+A discharger attempts to prove side conditions that arise during rewriting.
+
+## Overview
+
+When applying a conditional rewrite rule `h : P → a = b`, the simplifier must prove
+the precondition `P` before using the rule. A `Discharger` is a function that attempts
+to construct such proofs.
+
+**Example**: Consider the rewrite rule:
+```
+theorem div_self (n : Nat) (h : n ≠ 0) : n / n = 1
+```
+When simplifying `x / x`, the discharger must prove `x ≠ 0` to apply this rule.
+
+## Design
+
+Dischargers work by:
+1. Attempting to simplify the side condition to `True`
+2. If successful, extracting a proof from the simplification result
+3. Returning `none` if the condition cannot be discharged
+
+This integrates naturally with `Simproc`-based simplification.
+
+## Important
+
+When using dischargers that access new local declarations introduced when
+visiting binders, it is the user's responsibility to set `wellBehavedMethods := false`.
+This setting will instruct `simp` to discard the cache after visiting the binder's body.
+-/
+
+/--
+A discharger attempts to prove propositions that arise as side conditions during rewriting.
+
+Given a proposition `e : Prop`, returns:
+- `some proof` if `e` can be proven
+- `none` if `e` cannot be discharged
+
+**Usage**: Dischargers are used by the simplifier when applying conditional rewrite rules.
+-/
+public abbrev Discharger := Expr → SimpM (Option Expr)
+
+def resultToOptionProof (e : Expr) (result : Result) : Option Expr :=
+  match result with
+  | .rfl _ => none
+  | .step e' h _ =>
+    if e'.isTrue then
+      some <| mkOfEqTrueCore e h
+    else
+      none
+
+/--
+Converts a simplification procedure into a discharger.
+
+A `Simproc` can be used as a discharger by simplifying the side condition and
+checking if it reduces to `True`. If so, the equality proof is converted to
+a proof of the original proposition.
+
+**Algorithm**:
+1. Apply the simproc to the side condition `e`
+2. If `e` simplifies to `True` (via proof `h : e = True`), return `ofEqTrue h : e`
+3. Otherwise, return `none` (cannot discharge)
+
+**Parameters**:
+- `p`: A simplification procedure to use for discharging conditions
+
+**Example**: If `p` simplifies `5 < 10` to `True` via proof `h : (5 < 10) = True`,
+then `mkDischargerFromSimproc p` returns `ofEqTrue h : 5 < 10`.
+-/
+public def mkDischargerFromSimproc (p : Simproc) : Discharger := fun e => do
+  return resultToOptionProof e (← p e)
+
+/--
+The default discharger uses the simplifier itself to discharge side conditions.
+
+This creates a natural recursive behavior: when applying conditional rules,
+the simplifier is invoked to prove their preconditions. This is effective because:
+
+1. **Ground terms**: Conditions like `5 ≠ 0` are evaluated by simprocs
+2. **Recursive simplification**: Complex conditions are reduced to simpler ones
+3. **Lemma application**: The simplifier can apply other rewrite rules to conditions
+
+It ensures the cached results are discarded, and increases the discharge depth to avoid
+infinite recursion.
+-/
+public def dischargeSimpSelf : Discharger := fun e => do
+  if (← readThe Context).dischargeDepth > (← getConfig).maxDischargeDepth then
+    return none
+  withoutModifyingCache do
+  withTheReader Context (fun ctx => { ctx with dischargeDepth := ctx.dischargeDepth + 1 }) do
+    return resultToOptionProof e (← simp e)
+
+/--
+A discharger that fails to prove any side condition.
+
+This is used when conditional rewrite rules should not be applied. It immediately
+returns `none` for all propositions, effectively disabling conditional rewriting.
+
+**Use cases**:
+- Testing: Isolating unconditional rewriting behavior
+- Performance: Avoiding expensive discharge attempts when conditions are unlikely to hold
+- Controlled rewriting: Explicitly disabling conditional rules in specific contexts
+-/
+public def dischargeNone : Discharger := fun _ =>
+  return none
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/EvalGround.lean

@@ -0,0 +1,667 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Init.Sym.Lemmas
+import Init.Data.Int.Gcd
+namespace Lean.Meta.Sym.Simp
+
+/-!
+# Ground Term Evaluation for `Sym.simp`
+
+This module provides simplification procedures (`Simproc`) for evaluating ground terms
+of builtin types. It is designed for the `Sym.Simp` simplifier and addresses
+performance issues in the standard `Meta.Simp` simprocs.
+
+## Design Differences from `Meta.Simp` Simprocs
+
+### 1. Pure Value Extraction
+
+The `getValue?` functions are pure (`OptionT Id`) rather than monadic (`MetaM`).
+This is possible because `Sym` assumes terms are in canonical form, no `whnf` or
+reduction is needed to recognize literals.
+
+### 2. Proof by Definitional Equality
+
+All evaluation steps produce `Eq.refl` proofs and. The kernel verifies correctness
+by checking that the input and output are definitionally equal.
+
+### 3. Specialized Lemmas for Predicates
+
+Predicates (`<`, `≤`, `=`, etc.) use specialized lemmas that short-circuit the
+standard `decide` proof chain:
+```
+-- Standard approach (Meta.Simp)
+eq_true (of_decide_eq_true (h : decide (a < b) = true)) : (a < b) = True
+
+-- Specialized lemma (Sym.Simp)
+theorem Int.lt_eq_true (a b : Int) (h : decide (a < b) = true) : (a < b) = True :=
+  eq_true (of_decide_eq_true h)
+```
+
+The simproc applies the lemma directly with `rfl` for `h`:
+```
+Int.lt_eq_true 5 7 rfl : (5 < 7) = True
+```
+
+This avoids reconstructing `Decidable` instances at each call site.
+
+### 4. Maximal Sharing
+
+Results are passed through `share` to maintain the invariant that structurally
+equal subterms have pointer equality. This enables O(1) cache lookup in the
+simplifier.
+
+### 5. Type Dispatch via `match_expr`
+
+Operations dispatch on the type expression directly. It assumes non-standard instances are
+**not** used.
+
+**TODO**: additional bit-vector operations, `Char`, `String` support
+-/
+
+def skipIfUnchanged (e : Expr) (result : Result) : Result :=
+  match result with
+  | .step e' _ _ => if isSameExpr e e' then .rfl else result
+  | _ => result
+
+def getNatValue? (e : Expr) : OptionT Id Nat := do
+  let_expr OfNat.ofNat _ n _ := e | failure
+  let .lit (.natVal n) := n | failure
+  return n
+
+def getIntValue? (e : Expr) : OptionT Id Int := do
+  let_expr Neg.neg _ _ a := e | getNatValue? e
+  let v : Int ← getNatValue? a
+  return -v
+
+def getRatValue? (e : Expr) : OptionT Id Rat := do
+  let_expr HDiv.hDiv _ _ _ _ n d := e | getIntValue? e
+  let n : Rat ← getIntValue? n
+  let d : Rat ← getNatValue? d
+  return n / d
+
+structure BitVecValue where
+  n : Nat
+  val : BitVec n
+
+def getBitVecValue? (e : Expr) : OptionT Id BitVecValue :=
+  match_expr e with
+  | BitVec.ofNat nExpr vExpr => do
+    let n ← getNatValue? nExpr
+    let v ← getNatValue? vExpr
+    return ⟨n, BitVec.ofNat n v⟩
+  | BitVec.ofNatLT nExpr vExpr _ => do
+    let n ← getNatValue? nExpr
+    let v ← getNatValue? vExpr
+    return ⟨n, BitVec.ofNat n v⟩
+  | OfNat.ofNat α v _ => do
+    let_expr BitVec n := α | failure
+    let n ← getNatValue? n
+    let .lit (.natVal v) := v | failure
+    return ⟨n, BitVec.ofNat n v⟩
+  | _ => failure
+
+def getUInt8Value? (e : Expr) : OptionT Id UInt8 := return UInt8.ofNat (← getNatValue? e)
+def getUInt16Value? (e : Expr) : OptionT Id UInt16 := return UInt16.ofNat (← getNatValue? e)
+def getUInt32Value? (e : Expr) : OptionT Id UInt32 := return UInt32.ofNat (← getNatValue? e)
+def getUInt64Value? (e : Expr) : OptionT Id UInt64 := return UInt64.ofNat (← getNatValue? e)
+def getInt8Value? (e : Expr) : OptionT Id Int8 := return Int8.ofInt (← getIntValue? e)
+def getInt16Value? (e : Expr) : OptionT Id Int16 := return Int16.ofInt (← getIntValue? e)
+def getInt32Value? (e : Expr) : OptionT Id Int32 := return Int32.ofInt (← getIntValue? e)
+def getInt64Value? (e : Expr) : OptionT Id Int64 := return Int64.ofInt (← getIntValue? e)
+
+structure FinValue where
+  n : Nat
+  val : Fin n
+
+def getFinValue? (e : Expr) : OptionT Id FinValue := do
+  let_expr OfNat.ofNat α v _ := e | failure
+  let_expr Fin n := α | failure
+  let n ← getNatValue? n
+  let .lit (.natVal v) := v | failure
+  if h : n = 0 then failure else
+  let : NeZero n := ⟨h⟩
+  return { n, val := Fin.ofNat n v }
+
+abbrev evalUnary [ToExpr α] (toValue? : Expr → Option α) (op : α → α) (a : Expr) : SimpM Result := do
+  let some a := toValue? a | return .rfl
+  let e ← share <| toExpr (op a)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) (ToExpr.toTypeExpr (α := α)) e) (done := true)
+
+abbrev evalUnaryNat : (op : Nat → Nat) → (a : Expr) → SimpM Result := evalUnary getNatValue?
+abbrev evalUnaryInt : (op : Int → Int) → (a : Expr) → SimpM Result := evalUnary getIntValue?
+abbrev evalUnaryRat : (op : Rat → Rat) → (a : Expr) → SimpM Result := evalUnary getRatValue?
+abbrev evalUnaryUInt8 : (op : UInt8 → UInt8) → (a : Expr) → SimpM Result := evalUnary getUInt8Value?
+abbrev evalUnaryUInt16 : (op : UInt16 → UInt16) → (a : Expr) → SimpM Result := evalUnary getUInt16Value?
+abbrev evalUnaryUInt32 : (op : UInt32 → UInt32) → (a : Expr) → SimpM Result := evalUnary getUInt32Value?
+abbrev evalUnaryUInt64 : (op : UInt64 → UInt64) → (a : Expr) → SimpM Result := evalUnary getUInt64Value?
+abbrev evalUnaryInt8 : (op : Int8 → Int8) → (a : Expr) → SimpM Result := evalUnary getInt8Value?
+abbrev evalUnaryInt16 : (op : Int16 → Int16) → (a : Expr) → SimpM Result := evalUnary getInt16Value?
+abbrev evalUnaryInt32 : (op : Int32 → Int32) → (a : Expr) → SimpM Result := evalUnary getInt32Value?
+abbrev evalUnaryInt64 : (op : Int64 → Int64) → (a : Expr) → SimpM Result := evalUnary getInt64Value?
+
+abbrev evalUnaryFin' (op : {n : Nat} → Fin n → Fin n) (αExpr : Expr) (a : Expr) : SimpM Result := do
+  let some a := getFinValue? a | return .rfl
+  let e ← share <| toExpr (op a.val)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) αExpr e) (done := true)
+
+abbrev evalUnaryBitVec' (op : {n : Nat} → BitVec n → BitVec n) (αExpr : Expr) (a : Expr) : SimpM Result := do
+  let some a := getBitVecValue? a | return .rfl
+  let e ← share <| toExpr (op a.val)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) αExpr e) (done := true)
+
+abbrev evalBin [ToExpr α] (toValue? : Expr → Option α) (op : α → α → α) (a b : Expr) : SimpM Result := do
+  let some a := toValue? a | return .rfl
+  let some b := toValue? b | return .rfl
+  let e ← share <| toExpr (op a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) (ToExpr.toTypeExpr (α := α)) e) (done := true)
+
+abbrev evalBinNat : (op : Nat → Nat → Nat) → (a b : Expr) → SimpM Result := evalBin getNatValue?
+abbrev evalBinInt : (op : Int → Int → Int) → (a b : Expr) → SimpM Result := evalBin getIntValue?
+abbrev evalBinRat : (op : Rat → Rat → Rat) → (a b : Expr) → SimpM Result := evalBin getRatValue?
+abbrev evalBinUInt8 : (op : UInt8 → UInt8 → UInt8) → (a b : Expr) → SimpM Result := evalBin getUInt8Value?
+abbrev evalBinUInt16 : (op : UInt16 → UInt16 → UInt16) → (a b : Expr) → SimpM Result := evalBin getUInt16Value?
+abbrev evalBinUInt32 : (op : UInt32 → UInt32 → UInt32) → (a b : Expr) → SimpM Result := evalBin getUInt32Value?
+abbrev evalBinUInt64 : (op : UInt64 → UInt64 → UInt64) → (a b : Expr) → SimpM Result := evalBin getUInt64Value?
+abbrev evalBinInt8 : (op : Int8 → Int8 → Int8) → (a b : Expr) → SimpM Result := evalBin getInt8Value?
+abbrev evalBinInt16 : (op : Int16 → Int16 → Int16) → (a b : Expr) → SimpM Result := evalBin getInt16Value?
+abbrev evalBinInt32 : (op : Int32 → Int32 → Int32) → (a b : Expr) → SimpM Result := evalBin getInt32Value?
+abbrev evalBinInt64 : (op : Int64 → Int64 → Int64) → (a b : Expr) → SimpM Result := evalBin getInt64Value?
+
+abbrev evalBinFin' (op : {n : Nat} → Fin n → Fin n → Fin n) (αExpr : Expr) (a b : Expr) : SimpM Result := do
+  let some a := getFinValue? a | return .rfl
+  let some b := getFinValue? b | return .rfl
+  if h : a.n = b.n then
+    let e ← share <| toExpr (op a.val (h ▸ b.val))
+    return .step e (mkApp2 (mkConst ``Eq.refl [1]) αExpr e) (done := true)
+  else
+    return .rfl
+
+abbrev evalBinBitVec' (op : {n : Nat} → BitVec n → BitVec n → BitVec n) (αExpr : Expr) (a b : Expr) : SimpM Result := do
+  let some a := getBitVecValue? a | return .rfl
+  let some b := getBitVecValue? b | return .rfl
+  if h : a.n = b.n then
+    let e ← share <| toExpr (op a.val (h ▸ b.val))
+    return .step e (mkApp2 (mkConst ``Eq.refl [1]) αExpr e) (done := true)
+  else
+    return .rfl
+
+abbrev evalPowNat [ToExpr α] (maxExponent : Nat) (toValue? : Expr → Option α) (op : α → Nat → α) (a b : Expr) : SimpM Result := do
+  let some a := toValue? a | return .rfl
+  let some b := getNatValue? b | return .rfl
+  if b > maxExponent then return .rfl
+  let e ← share <| toExpr (op a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) (ToExpr.toTypeExpr (α := α)) e) (done := true)
+
+abbrev evalPowInt [ToExpr α] (maxExponent : Nat) (toValue? : Expr → Option α) (op : α → Int → α) (a b : Expr) : SimpM Result := do
+  let some a := toValue? a | return .rfl
+  let some b := getIntValue? b | return .rfl
+  if b.natAbs > maxExponent then return .rfl
+  let e ← share <| toExpr (op a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) (ToExpr.toTypeExpr (α := α)) e) (done := true)
+
+macro "declare_eval_bin" id:ident op:term : command =>
+  `(def $id:ident (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinNat $op a b
+  | Int => evalBinInt $op a b
+  | Rat => evalBinRat $op a b
+  | Fin _ => evalBinFin' $op α a b
+  | BitVec _ => evalBinBitVec' $op α a b
+  | UInt8 => evalBinUInt8 $op a b
+  | UInt16 => evalBinUInt16 $op a b
+  | UInt32 => evalBinUInt32 $op a b
+  | UInt64 => evalBinUInt64 $op a b
+  | Int8 => evalBinInt8 $op a b
+  | Int16 => evalBinInt16 $op a b
+  | Int32 => evalBinInt32 $op a b
+  | Int64 => evalBinInt64 $op a b
+  | _ => return .rfl
+  )
+
+declare_eval_bin evalAdd (· + ·)
+declare_eval_bin evalSub (· - ·)
+declare_eval_bin evalMul (· * ·)
+
+def evalDiv (e : Expr) (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinNat (. / .) a b
+  | Int => evalBinInt (. / .) a b
+  | Rat => return skipIfUnchanged e (← evalBinRat (. / .) a b)
+  | Fin _ => evalBinFin' (. / .) α a b
+  | BitVec _ => evalBinBitVec' (. / .) α a b
+  | UInt8 => evalBinUInt8 (. / .) a b
+  | UInt16 => evalBinUInt16 (. / .) a b
+  | UInt32 => evalBinUInt32 (. / .) a b
+  | UInt64 => evalBinUInt64 (. / .) a b
+  | Int8 => evalBinInt8 (. / .) a b
+  | Int16 => evalBinInt16 (. / .) a b
+  | Int32 => evalBinInt32 (. / .) a b
+  | Int64 => evalBinInt64 (. / .) a b
+  | _ => return .rfl
+
+def evalMod (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinNat (· % ·) a b
+  | Int => evalBinInt (· % ·) a b
+  | Fin _ => evalBinFin' (· % ·) α a b
+  | BitVec _ => evalBinBitVec' (· % ·) α a b
+  | UInt8 => evalBinUInt8 (· % ·) a b
+  | UInt16 => evalBinUInt16 (· % ·) a b
+  | UInt32 => evalBinUInt32 (· % ·) a b
+  | UInt64 => evalBinUInt64 (· % ·) a b
+  | Int8 => evalBinInt8 (· % ·) a b
+  | Int16 => evalBinInt16 (· % ·) a b
+  | Int32 => evalBinInt32 (· % ·) a b
+  | Int64 => evalBinInt64 (· % ·) a b
+  | _ => return .rfl
+
+def evalNeg (α : Expr) (a : Expr) : SimpM Result :=
+  match_expr α with
+  | Int => evalUnaryInt (- ·) a
+  | Rat => evalUnaryRat (- ·) a
+  | Fin _ => evalUnaryFin' (- ·) α a
+  | BitVec _ => evalUnaryBitVec' (- ·) α a
+  | UInt8 => evalUnaryUInt8 (- ·) a
+  | UInt16 => evalUnaryUInt16 (- ·) a
+  | UInt32 => evalUnaryUInt32 (- ·) a
+  | UInt64 => evalUnaryUInt64 (- ·) a
+  | Int8 => evalUnaryInt8 (- ·) a
+  | Int16 => evalUnaryInt16 (- ·) a
+  | Int32 => evalUnaryInt32 (- ·) a
+  | Int64 => evalUnaryInt64 (- ·) a
+  | _ => return .rfl
+
+def evalComplement (α : Expr) (a : Expr) : SimpM Result :=
+  match_expr α with
+  | Int => evalUnaryInt (~~~ ·) a
+  | BitVec _ => evalUnaryBitVec' (~~~ ·) α a
+  | UInt8 => evalUnaryUInt8 (~~~ ·) a
+  | UInt16 => evalUnaryUInt16 (~~~ ·) a
+  | UInt32 => evalUnaryUInt32 (~~~ ·) a
+  | UInt64 => evalUnaryUInt64 (~~~ ·) a
+  | Int8 => evalUnaryInt8 (~~~ ·) a
+  | Int16 => evalUnaryInt16 (~~~ ·) a
+  | Int32 => evalUnaryInt32 (~~~ ·) a
+  | Int64 => evalUnaryInt64 (~~~ ·) a
+  | _ => return .rfl
+
+def evalInv (α : Expr) (a : Expr) : SimpM Result :=
+  match_expr α with
+  | Rat => evalUnaryRat (· ⁻¹) a
+  | _ => return .rfl
+
+macro "declare_eval_bin_bitwise" id:ident op:term : command =>
+  `(def $id:ident (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinNat $op a b
+  | Fin _ => evalBinFin' $op α a b
+  | BitVec _ => evalBinBitVec' $op α a b
+  | UInt8 => evalBinUInt8 $op a b
+  | UInt16 => evalBinUInt16 $op a b
+  | UInt32 => evalBinUInt32 $op a b
+  | UInt64 => evalBinUInt64 $op a b
+  | Int8 => evalBinInt8 $op a b
+  | Int16 => evalBinInt16 $op a b
+  | Int32 => evalBinInt32 $op a b
+  | Int64 => evalBinInt64 $op a b
+  | _ => return .rfl
+  )
+
+declare_eval_bin_bitwise evalAnd (· &&& ·)
+declare_eval_bin_bitwise evalOr (· ||| ·)
+declare_eval_bin_bitwise evalXOr (· ^^^ ·)
+
+def evalPow (maxExponent : Nat) (α β : Expr) (a b : Expr) : SimpM Result :=
+  match_expr β with
+  | Nat => match_expr α with
+    | Nat => evalPowNat maxExponent getNatValue? (· ^ ·) a b
+    | Int => evalPowNat maxExponent getIntValue? (· ^ ·) a b
+    | Rat => evalPowNat maxExponent getRatValue? (· ^ ·) a b
+    | UInt8 => evalPowNat maxExponent getUInt8Value? (· ^ ·) a b
+    | UInt16 => evalPowNat maxExponent getUInt16Value? (· ^ ·) a b
+    | UInt32 => evalPowNat maxExponent getUInt32Value? (· ^ ·) a b
+    | UInt64 => evalPowNat maxExponent getUInt64Value? (· ^ ·) a b
+    | Int8 => evalPowNat maxExponent getInt8Value? (· ^ ·) a b
+    | Int16 => evalPowNat maxExponent getInt16Value? (· ^ ·) a b
+    | Int32 => evalPowNat maxExponent getInt32Value? (· ^ ·) a b
+    | Int64 => evalPowNat maxExponent getInt64Value? (· ^ ·) a b
+    | _ => return .rfl
+  | Int => match_expr α with
+    | Rat => evalPowInt maxExponent getRatValue? (· ^ ·) a b
+    | _ => return .rfl
+  | _ => return .rfl
+
+abbrev shift [ShiftLeft α] [ShiftRight α] (left : Bool) (a b : α) : α :=
+  if left then a <<< b else a >>> b
+
+def evalShift (left : Bool) (α β : Expr) (a b : Expr) : SimpM Result :=
+  if isSameExpr α β then
+    match_expr α with
+    | Nat => evalBinNat (shift left) a b
+    | Fin _ => if left then evalBinFin' (· <<< ·) α a b else evalBinFin' (· >>> ·) α a b
+    | BitVec _ => if left then evalBinBitVec' (· <<< ·) α a b else evalBinBitVec' (· >>> ·) α a b
+    | UInt8 => evalBinUInt8 (shift left) a b
+    | UInt16 => evalBinUInt16 (shift left) a b
+    | UInt32 => evalBinUInt32 (shift left) a b
+    | UInt64 => evalBinUInt64 (shift left) a b
+    | Int8 => evalBinInt8 (shift left) a b
+    | Int16 => evalBinInt16 (shift left) a b
+    | Int32 => evalBinInt32 (shift left) a b
+    | Int64 => evalBinInt64 (shift left) a b
+    | _ => return .rfl
+  else
+  match_expr β with
+  | Nat =>
+    match_expr α with
+    | Int => do
+      let some a := getIntValue? a | return .rfl
+      let some b := getNatValue? b | return .rfl
+      let e := if left then a <<< b else a >>> b
+      let e ← share <| toExpr e
+      return .step e (mkApp2 (mkConst ``Eq.refl [1]) α e) (done := true)
+    | BitVec _ => do
+      let some a := getBitVecValue? a | return .rfl
+      let some b := getNatValue? b | return .rfl
+      let e := if left then a.val <<< b else a.val >>> b
+      let e ← share <| toExpr e
+      return .step e (mkApp2 (mkConst ``Eq.refl [1]) α e) (done := true)
+    | _ => return .rfl
+  | BitVec _ => do
+    let_expr BitVec _ := α | return .rfl
+    let some a := getBitVecValue? a | return .rfl
+    let some b := getBitVecValue? b | return .rfl
+    let e := if left then a.val <<< b.val else a.val >>> b.val
+    let e ← share <| toExpr e
+    return .step e (mkApp2 (mkConst ``Eq.refl [1]) α e) (done := true)
+  | _ => return .rfl
+
+def evalIntGcd (a b : Expr) : SimpM Result := do
+  let some a := getIntValue? a | return .rfl
+  let some b := getIntValue? b | return .rfl
+  let e ← share <| toExpr (Int.gcd a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) Nat.mkType e) (done := true)
+
+def evalIntBMod (a b : Expr) : SimpM Result := do
+  let some a := getIntValue? a | return .rfl
+  let some b := getNatValue? b | return .rfl
+  let e ← share <| toExpr (Int.bmod a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) Int.mkType e) (done := true)
+
+def evalIntBDiv (a b : Expr) : SimpM Result := do
+  let some a := getIntValue? a | return .rfl
+  let some b := getNatValue? b | return .rfl
+  let e ← share <| toExpr (Int.bdiv a b)
+  return .step e (mkApp2 (mkConst ``Eq.refl [1]) Int.mkType e) (done := true)
+
+abbrev evalBinPred (toValue? : Expr → Option α) (trueThm falseThm : Expr) (op : α → α → Bool) (a b : Expr) : SimpM Result := do
+  let some va := toValue? a | return .rfl
+  let some vb := toValue? b | return .rfl
+  if op va vb then
+    let e ← share <| mkConst ``True
+    return .step e (mkApp3 trueThm a b eagerReflBoolTrue) (done := true)
+  else
+    let e ← share <| mkConst ``False
+    return .step e (mkApp3 falseThm a b eagerReflBoolFalse) (done := true)
+
+def evalBitVecPred (n : Expr) (trueThm falseThm : Expr) (op : {n : Nat} → BitVec n → BitVec n → Bool) (a b : Expr) : SimpM Result := do
+  let some va := getBitVecValue? a | return .rfl
+  let some vb := getBitVecValue? b | return .rfl
+  if h : va.n = vb.n then
+    if op va.val (h ▸ vb.val) then
+      let e ← share <| mkConst ``True
+      return .step e (mkApp4 trueThm n a b eagerReflBoolTrue) (done := true)
+    else
+      let e ← share <| mkConst ``False
+      return .step e (mkApp4 falseThm n a b eagerReflBoolFalse) (done := true)
+  else
+    return .rfl
+
+def evalFinPred (n : Expr) (trueThm falseThm : Expr) (op : {n : Nat} → Fin n → Fin n → Bool) (a b : Expr) : SimpM Result := do
+  let some va := getFinValue? a | return .rfl
+  let some vb := getFinValue? b | return .rfl
+  if h : va.n = vb.n then
+    if op va.val (h ▸ vb.val) then
+      let e ← share <| mkConst ``True
+      return .step e (mkApp4 trueThm n a b eagerReflBoolTrue) (done := true)
+    else
+      let e ← share <| mkConst ``False
+      return .step e (mkApp4 falseThm n a b eagerReflBoolFalse) (done := true)
+  else
+    return .rfl
+
+open Lean.Sym
+
+def evalLT (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.lt_eq_true) (mkConst ``Nat.lt_eq_false) (. < .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.lt_eq_true) (mkConst ``Int.lt_eq_false) (. < .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.lt_eq_true) (mkConst ``Rat.lt_eq_false) (. < .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.lt_eq_true) (mkConst ``Int8.lt_eq_false) (. < .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.lt_eq_true) (mkConst ``Int16.lt_eq_false) (. < .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.lt_eq_true) (mkConst ``Int32.lt_eq_false) (. < .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.lt_eq_true) (mkConst ``Int64.lt_eq_false) (. < .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.lt_eq_true) (mkConst ``UInt8.lt_eq_false) (. < .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.lt_eq_true) (mkConst ``UInt16.lt_eq_false) (. < .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.lt_eq_true) (mkConst ``UInt32.lt_eq_false) (. < .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.lt_eq_true) (mkConst ``UInt64.lt_eq_false) (. < .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.lt_eq_true) (mkConst ``Fin.lt_eq_false) (. < .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.lt_eq_true) (mkConst ``BitVec.lt_eq_false) (. < .) a b
+  | _ => return .rfl
+
+def evalLE (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.le_eq_true) (mkConst ``Nat.le_eq_false) (. ≤ .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.le_eq_true) (mkConst ``Int.le_eq_false) (. ≤ .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.le_eq_true) (mkConst ``Rat.le_eq_false) (. ≤ .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.le_eq_true) (mkConst ``Int8.le_eq_false) (. ≤ .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.le_eq_true) (mkConst ``Int16.le_eq_false) (. ≤ .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.le_eq_true) (mkConst ``Int32.le_eq_false) (. ≤ .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.le_eq_true) (mkConst ``Int64.le_eq_false) (. ≤ .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.le_eq_true) (mkConst ``UInt8.le_eq_false) (. ≤ .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.le_eq_true) (mkConst ``UInt16.le_eq_false) (. ≤ .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.le_eq_true) (mkConst ``UInt32.le_eq_false) (. ≤ .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.le_eq_true) (mkConst ``UInt64.le_eq_false) (. ≤ .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.le_eq_true) (mkConst ``Fin.le_eq_false) (. ≤ .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.le_eq_true) (mkConst ``BitVec.le_eq_false) (. ≤ .) a b
+  | _ => return .rfl
+
+def evalGT (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.gt_eq_true) (mkConst ``Nat.gt_eq_false) (. > .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.gt_eq_true) (mkConst ``Int.gt_eq_false) (. > .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.gt_eq_true) (mkConst ``Rat.gt_eq_false) (. > .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.gt_eq_true) (mkConst ``Int8.gt_eq_false) (. > .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.gt_eq_true) (mkConst ``Int16.gt_eq_false) (. > .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.gt_eq_true) (mkConst ``Int32.gt_eq_false) (. > .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.gt_eq_true) (mkConst ``Int64.gt_eq_false) (. > .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.gt_eq_true) (mkConst ``UInt8.gt_eq_false) (. > .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.gt_eq_true) (mkConst ``UInt16.gt_eq_false) (. > .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.gt_eq_true) (mkConst ``UInt32.gt_eq_false) (. > .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.gt_eq_true) (mkConst ``UInt64.gt_eq_false) (. > .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.gt_eq_true) (mkConst ``Fin.gt_eq_false) (. > .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.gt_eq_true) (mkConst ``BitVec.gt_eq_false) (. > .) a b
+  | _ => return .rfl
+
+def evalGE (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.ge_eq_true) (mkConst ``Nat.ge_eq_false) (. ≥ .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.ge_eq_true) (mkConst ``Int.ge_eq_false) (. ≥ .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.ge_eq_true) (mkConst ``Rat.ge_eq_false) (. ≥ .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.ge_eq_true) (mkConst ``Int8.ge_eq_false) (. ≥ .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.ge_eq_true) (mkConst ``Int16.ge_eq_false) (. ≥ .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.ge_eq_true) (mkConst ``Int32.ge_eq_false) (. ≥ .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.ge_eq_true) (mkConst ``Int64.ge_eq_false) (. ≥ .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.ge_eq_true) (mkConst ``UInt8.ge_eq_false) (. ≥ .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.ge_eq_true) (mkConst ``UInt16.ge_eq_false) (. ≥ .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.ge_eq_true) (mkConst ``UInt32.ge_eq_false) (. ≥ .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.ge_eq_true) (mkConst ``UInt64.ge_eq_false) (. ≥ .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.ge_eq_true) (mkConst ``Fin.ge_eq_false) (. ≥ .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.ge_eq_true) (mkConst ``BitVec.ge_eq_false) (. ≥ .) a b
+  | _ => return .rfl
+
+def evalEq (α : Expr) (a b : Expr) : SimpM Result :=
+  if isSameExpr a b then do
+    let e ← share <| mkConst ``True
+    let u ← getLevel α
+    return .step e (mkApp2 (mkConst ``eq_self [u]) α a) (done := true)
+  else match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.eq_eq_true) (mkConst ``Nat.eq_eq_false) (. = .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.eq_eq_true) (mkConst ``Int.eq_eq_false) (. = .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.eq_eq_true) (mkConst ``Rat.eq_eq_false) (. = .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.eq_eq_true) (mkConst ``Int8.eq_eq_false) (. = .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.eq_eq_true) (mkConst ``Int16.eq_eq_false) (. = .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.eq_eq_true) (mkConst ``Int32.eq_eq_false) (. = .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.eq_eq_true) (mkConst ``Int64.eq_eq_false) (. = .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.eq_eq_true) (mkConst ``UInt8.eq_eq_false) (. = .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.eq_eq_true) (mkConst ``UInt16.eq_eq_false) (. = .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.eq_eq_true) (mkConst ``UInt32.eq_eq_false) (. = .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.eq_eq_true) (mkConst ``UInt64.eq_eq_false) (. = .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.eq_eq_true) (mkConst ``Fin.eq_eq_false) (. = .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.eq_eq_true) (mkConst ``BitVec.eq_eq_false) (. = .) a b
+  | _ => return .rfl
+
+def evalNe (α : Expr) (a b : Expr) : SimpM Result :=
+  if isSameExpr a b then do
+    let e ← share <| mkConst ``False
+    let u ← getLevel α
+    return .step e (mkApp2 (mkConst ``ne_self [u]) α a) (done := true)
+  else match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.ne_eq_true) (mkConst ``Nat.ne_eq_false) (. ≠ .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.ne_eq_true) (mkConst ``Int.ne_eq_false) (. ≠ .) a b
+  | Rat => evalBinPred getRatValue? (mkConst ``Rat.ne_eq_true) (mkConst ``Rat.ne_eq_false) (. ≠ .) a b
+  | Int8 => evalBinPred getInt8Value? (mkConst ``Int8.ne_eq_true) (mkConst ``Int8.ne_eq_false) (. ≠ .) a b
+  | Int16 => evalBinPred getInt16Value? (mkConst ``Int16.ne_eq_true) (mkConst ``Int16.ne_eq_false) (. ≠ .) a b
+  | Int32 => evalBinPred getInt32Value? (mkConst ``Int32.ne_eq_true) (mkConst ``Int32.ne_eq_false) (. ≠ .) a b
+  | Int64 => evalBinPred getInt64Value? (mkConst ``Int64.ne_eq_true) (mkConst ``Int64.ne_eq_false) (. ≠ .) a b
+  | UInt8 => evalBinPred getUInt8Value? (mkConst ``UInt8.ne_eq_true) (mkConst ``UInt8.ne_eq_false) (. ≠ .) a b
+  | UInt16 => evalBinPred getUInt16Value? (mkConst ``UInt16.ne_eq_true) (mkConst ``UInt16.ne_eq_false) (. ≠ .) a b
+  | UInt32 => evalBinPred getUInt32Value? (mkConst ``UInt32.ne_eq_true) (mkConst ``UInt32.ne_eq_false) (. ≠ .) a b
+  | UInt64 => evalBinPred getUInt64Value? (mkConst ``UInt64.ne_eq_true) (mkConst ``UInt64.ne_eq_false) (. ≠ .) a b
+  | Fin n => evalFinPred n (mkConst ``Fin.ne_eq_true) (mkConst ``Fin.ne_eq_false) (. ≠ .) a b
+  | BitVec n => evalBitVecPred n (mkConst ``BitVec.ne_eq_true) (mkConst ``BitVec.ne_eq_false) (. ≠ .) a b
+  | _ => return .rfl
+
+def evalDvd (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinPred getNatValue? (mkConst ``Nat.dvd_eq_true) (mkConst ``Nat.dvd_eq_false) (. ∣ .) a b
+  | Int => evalBinPred getIntValue? (mkConst ``Int.dvd_eq_true) (mkConst ``Int.dvd_eq_false) (. ∣ .) a b
+  | _ => return .rfl
+
+abbrev evalBinBoolPred (toValue? : Expr → Option α) (op : α → α → Bool) (a b : Expr) : SimpM Result := do
+  let some va := toValue? a | return .rfl
+  let some vb := toValue? b | return .rfl
+  let r := op va vb
+  let e ← share (toExpr r)
+  return .step e (if r then eagerReflBoolTrue else eagerReflBoolFalse) (done := true)
+
+abbrev evalBinBoolPredNat : (op : Nat → Nat → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getNatValue?
+abbrev evalBinBoolPredInt : (op : Int → Int → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getIntValue?
+abbrev evalBinBoolPredRat : (op : Rat → Rat → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getRatValue?
+abbrev evalBinBoolPredUInt8 : (op : UInt8 → UInt8 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getUInt8Value?
+abbrev evalBinBoolPredUInt16 : (op : UInt16 → UInt16 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getUInt16Value?
+abbrev evalBinBoolPredUInt32 : (op : UInt32 → UInt32 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getUInt32Value?
+abbrev evalBinBoolPredUInt64 : (op : UInt64 → UInt64 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getUInt64Value?
+abbrev evalBinBoolPredInt8 : (op : Int8 → Int8 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getInt8Value?
+abbrev evalBinBoolPredInt16 : (op : Int16 → Int16 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getInt16Value?
+abbrev evalBinBoolPredInt32 : (op : Int32 → Int32 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getInt32Value?
+abbrev evalBinBoolPredInt64 : (op : Int64 → Int64 → Bool) → (a b : Expr) → SimpM Result := evalBinBoolPred getInt64Value?
+
+abbrev evalBinBoolPredFin (op : {n : Nat} → Fin n → Fin n → Bool) (a b : Expr) : SimpM Result := do
+  let some a := getFinValue? a | return .rfl
+  let some b := getFinValue? b | return .rfl
+  if h : a.n = b.n then
+    let r := op a.val (h ▸ b.val)
+    let e ← share (toExpr r)
+    return .step e (if r then eagerReflBoolTrue else eagerReflBoolFalse) (done := true)
+  else
+    return .rfl
+
+abbrev evalBinBoolPredBitVec (op : {n : Nat} → BitVec n → BitVec n → Bool) (a b : Expr) : SimpM Result := do
+  let some a := getBitVecValue? a | return .rfl
+  let some b := getBitVecValue? b | return .rfl
+  if h : a.n = b.n then
+    let r := op a.val (h ▸ b.val)
+    let e ← share (toExpr r)
+    return .step e (if r then eagerReflBoolTrue else eagerReflBoolFalse) (done := true)
+  else
+    return .rfl
+
+macro "declare_eval_bin_bool_pred" id:ident op:term : command =>
+  `(def $id:ident (α : Expr) (a b : Expr) : SimpM Result :=
+  match_expr α with
+  | Nat => evalBinBoolPredNat $op a b
+  | Int => evalBinBoolPredInt $op a b
+  | Rat => evalBinBoolPredRat $op a b
+  | Fin _ => evalBinBoolPredFin $op a b
+  | BitVec _ => evalBinBoolPredBitVec $op a b
+  | UInt8 => evalBinBoolPredUInt8 $op a b
+  | UInt16 => evalBinBoolPredUInt16 $op a b
+  | UInt32 => evalBinBoolPredUInt32 $op a b
+  | UInt64 => evalBinBoolPredUInt64 $op a b
+  | Int8 => evalBinBoolPredInt8 $op a b
+  | Int16 => evalBinBoolPredInt16 $op a b
+  | Int32 => evalBinBoolPredInt32 $op a b
+  | Int64 => evalBinBoolPredInt64 $op a b
+  | _ => return .rfl
+  )
+
+declare_eval_bin_bool_pred evalBEq (· == ·)
+declare_eval_bin_bool_pred evalBNe (· != ·)
+
+public structure EvalStepConfig where
+  maxExponent := 255
+
+/--
+Simplification procedure that evaluates ground terms of builtin types.
+
+**Important:** This procedure assumes subterms have already been simplified. It evaluates
+a single operation on literal arguments only. For example:
+- `2 + 3` → evaluates to `5`
+- `2 + (3 * 4)` → returns `.rfl` (the argument `3 * 4` is not a literal)
+
+The simplifier is responsible for term traversal, ensuring subterms are reduced
+before `evalGround` is called on the parent expression.
+-/
+public def evalGround (config : EvalStepConfig := {}) : Simproc := fun e =>
+  match_expr e with
+  | HAdd.hAdd α _ _ _ a b => evalAdd α a b
+  | HSub.hSub α _ _ _ a b => evalSub α a b
+  | HMul.hMul α _ _ _ a b => evalMul α a b
+  | HDiv.hDiv α _ _ _ a b => evalDiv e α a b
+  | HMod.hMod α _ _ _ a b => evalMod α a b
+  | HPow.hPow α β _ _ a b => evalPow config.maxExponent α β a b
+  | HAnd.hAnd α _ _ _ a b => evalAnd α a b
+  | HXor.hXor α _ _ _ a b => evalXOr α a b
+  | HOr.hOr α _ _ _ a b => evalOr α a b
+  | HShiftLeft.hShiftLeft α β _ _ a b => evalShift (left := true) α β a b
+  | HShiftRight.hShiftRight α β _ _ a b => evalShift (left := false) α β a b
+  | Inv.inv α _ a => evalInv α a
+  | Neg.neg α _ a => return skipIfUnchanged e (← evalNeg α a)
+  | Complement.complement α _ a => evalComplement α a
+  | Nat.gcd a b => evalBinNat Nat.gcd a b
+  | Nat.succ a => evalUnaryNat (· + 1) a
+  | Int.gcd a b => evalIntGcd a b
+  | Int.tdiv a b => evalBinInt Int.tdiv a b
+  | Int.fdiv a b => evalBinInt Int.fdiv a b
+  | Int.bdiv a b => evalIntBDiv a b
+  | Int.tmod a b => evalBinInt Int.tmod a b
+  | Int.fmod a b => evalBinInt Int.fmod a b
+  | Int.bmod a b => evalIntBMod a b
+  | LE.le α _ a b => evalLE α a b
+  | GE.ge α _ a b => evalGE α a b
+  | LT.lt α _ a b => evalLT α a b
+  | GT.gt α _ a b => evalGT α a b
+  | Dvd.dvd α _ a b => evalDvd α a b
+  | Eq α a b => evalEq α a b
+  | Ne α a b => evalNe α a b
+  | BEq.beq α _ a b => evalBEq α a b
+  | bne α _ a b => evalBNe α a b
+  | _  => return .rfl
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Forall.lean

@@ -5,49 +5,10 @@ Authors: Leonardo de Moura
 -/
 module
 prelude
-public import Lean.Meta.Basic
-import Lean.Meta.InferType
-import Lean.Meta.Closure
-import Lean.Meta.AppBuilder
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.Sym.AlphaShareBuilder
 namespace Lean.Meta.Sym.Simp
 
-/--
-Given `xs` containing free variables
-`(x₁ : α₁) (x₂ : α₂[x₁]) ... (xₙ : αₙ[x₁, ..., x_{n-1}])`
-and `β` a type of the form `β[x₁, ..., xₙ]`,
-creates the custom function extensionality theorem
-```
-∀ (f g : (x₁ : α₁) → (x₂ : α₂[x₁]) → ... → (xₙ : αₙ[x₁, ..., x_{n-1}]) → β[x₁, ..., xₙ])
-  (h : ∀ x₁ ... xₙ, f x₁ ... xₙ = g x₁ ... xₙ),
-  f = g
-```
-The theorem has three arguments `f`, `g`, and `h`.
-This auxiliary theorem is used by the simplifier when visiting lambda expressions.
--/
-public def mkFunextFor (xs : Array Expr) (β : Expr) : MetaM Expr := do
-  let type ← mkForallFVars xs β
-  let v ← getLevel β
-  let w ← getLevel type
-  withLocalDeclD `f type fun f =>
-  withLocalDeclD `g type fun g => do
-  let eq := mkApp3 (mkConst ``Eq [v]) β (mkAppN f xs) (mkAppN g xs)
-  withLocalDeclD `h (← mkForallFVars xs eq) fun h => do
-  let eqv ← mkLambdaFVars #[f, g] (← mkForallFVars xs eq)
-  let quotEqv := mkApp2 (mkConst ``Quot [w]) type eqv
-  withLocalDeclD `f' quotEqv fun f' => do
-  let lift := mkApp6 (mkConst ``Quot.lift [w, v]) type eqv β
-    (mkLambda `f .default type (mkAppN (.bvar 0) xs))
-    (mkLambda `f .default type (mkLambda `g .default type (mkLambda `h .default (mkApp2 eqv (.bvar 1) (.bvar 0)) (mkAppN (.bvar 0) xs))))
-    f'
-  let extfunAppVal ← mkLambdaFVars (#[f'] ++ xs) lift
-  let extfunApp := extfunAppVal
-  let quotSound := mkApp5 (mkConst ``Quot.sound [w]) type eqv f g h
-  let Quot_mk_f := mkApp3 (mkConst ``Quot.mk [w]) type eqv f
-  let Quot_mk_g := mkApp3 (mkConst ``Quot.mk [w]) type eqv g
-  let result := mkApp6 (mkConst ``congrArg [w, w]) quotEqv type Quot_mk_f Quot_mk_g extfunApp quotSound
-  let result ← mkLambdaFVars #[f, g, h] result
-  return result
-
 /--
 Given `xs` containing free variables
 `(x₁ : α₁) (x₂ : α₂[x₁]) ... (xₙ : αₙ[x₁, ..., x_{n-1}])`,
@@ -61,7 +22,7 @@ The theorem has three arguments `p`, `q`, and `h`.
 This auxiliary theorem is used by the simplifier when visiting forall expressions.
 The proof uses the approach used in `mkFunextFor` followed by an `Eq.ndrec`.
 -/
-public def mkForallCongrFor (xs : Array Expr) : MetaM Expr := do
+def mkForallCongrFor (xs : Array Expr) : MetaM Expr := do
   let prop := mkSort 0
   let type ← mkForallFVars xs prop
   let w ← getLevel type
@@ -90,4 +51,54 @@ public def mkForallCongrFor (xs : Array Expr) : MetaM Expr := do
   let result ← mkLambdaFVars #[p, q, h] result
   return result
 
+open Internal
+
+public def simpArrow (e : Expr) : SimpM Result := do
+  let p := e.bindingDomain!
+  let q := e.bindingBody!
+  match (← simp p), (← simp q) with
+  | .rfl _, .rfl _ =>
+    return .rfl
+  | .step p' h _, .rfl _ =>
+    let u ← getLevel p
+    let v ← getLevel q
+    let e' ← e.updateForallS! p' q
+    return .step e' <| mkApp4 (mkConst ``implies_congr_left [u, v]) p p' q h
+  | .rfl _, .step q' h _ =>
+    let u ← getLevel p
+    let v ← getLevel q
+    let e' ← e.updateForallS! p q'
+    return .step e' <| mkApp4 (mkConst ``implies_congr_right [u, v]) p q q' h
+  | .step p' h₁ _, .step q' h₂ _ =>
+    let u ← getLevel p
+    let v ← getLevel q
+    let e' ← e.updateForallS! p' q'
+    return .step e' <| mkApp6 (mkConst ``implies_congr [u, v]) p p' q q' h₁ h₂
+
+public def simpForall (e : Expr) : SimpM Result := do
+  if e.isArrow then
+    simpArrow e
+  else if (← isProp e) then
+    let n := getForallTelescopeSize e.bindingBody! 1
+    forallBoundedTelescope e n fun xs b => withoutModifyingCacheIfNotWellBehaved do
+      main xs b
+  else
+    return .rfl
+where
+  main (xs : Array Expr) (b : Expr) : SimpM Result := do
+    match (← simp b) with
+    | .rfl _ => return .rfl
+    | .step b' h _ =>
+      let h ← mkLambdaFVars xs h
+      let e' ← shareCommonInc (← mkForallFVars xs b')
+      -- **Note**: consider caching the forall-congr theorems
+      let hcongr ← mkForallCongrFor xs
+      return .step e' (mkApp3 hcongr (← mkLambdaFVars xs b) (← mkLambdaFVars xs b') h)
+
+  -- **Note**: Optimize if this is quadratic in practice
+  getForallTelescopeSize (e : Expr) (n : Nat) : Nat :=
+    match e with
+    | .forallE _ _ b _ => if b.hasLooseBVar 0 then getForallTelescopeSize b (n+1) else n
+    | _ => n
+
 end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Have.lean

@@ -0,0 +1,438 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.Sym.Simp.Lambda
+import Lean.Meta.Sym.AlphaShareBuilder
+import Lean.Meta.Sym.InstantiateS
+import Lean.Meta.Sym.ReplaceS
+import Lean.Meta.Sym.AbstractS
+import Lean.Meta.Sym.InferType
+import Lean.Meta.AppBuilder
+import Lean.Meta.HaveTelescope
+import Lean.Util.CollectFVars
+namespace Lean.Meta.Sym.Simp
+
+/-!
+# Have-Telescope Simplification for Sym.simp
+
+This module implements efficient simplification of `have`-telescopes (sequences of
+non-dependent `let` bindings) in the symbolic simplifier. The key insight is to
+transform telescopes into a "parallel" beta-application form, simplify the arguments
+independently, and then convert back to `have` form.
+
+## The Problem
+
+Consider a `have`-telescope:
+```
+have x₁ := v₁
+have x₂ := v₂[x₁]
+...
+have xₙ := vₙ[x₁, ..., xₙ₋₁]
+b[x₁, ..., xₙ]
+```
+
+Naively generating proofs using `have_congr` leads to **quadratic kernel type-checking time**.
+The issue is that when the kernel type-checks congruence proofs, it creates fresh free
+variables for each binder, destroying sharing and generating O(n²) terms.
+
+## The Solution: Virtual Parallelization
+
+We transform the sequential `have` telescope into a parallel beta-application:
+```
+(fun x₁ x₂' ... xₙ' => b[x₁, x₂' x₁, ..., xₙ' (xₙ₋₁' ...)]) v₁ (fun x₁ => v₂[x₁]) ... (fun ... xₙ₋₁ => vₙ[..., xₙ₋₁])
+```
+
+Each `xᵢ'` is now a function that takes its dependencies as arguments. This form:
+1. Is definitionally equal to the original (so conversion is free)
+2. Enables independent simplification of each argument
+3. Produces proofs that type-check in linear time using the existing efficient simplification procedure for lambdas.
+
+## Algorithm Overview
+
+1. **`toBetaApp`**: Transform `have`-telescope → parallel beta-application
+   - Track dependency graph: which `have` depends on which previous `have`s
+   - Convert each value `vᵢ[x₁, ..., xₖ]` to `(fun y₁ ... yₖ => vᵢ[y₁, ..., yₖ])`
+   - Build the body with appropriate applications
+
+2. **`simpBetaApp`**: Simplify the beta-application using congruence lemmas
+   - Simplify function and each argument independently
+   - Generate proof using `congr`, `congrArg`, `congrFun'`
+   - This procedure is optimized for functions taking **many** arguments.
+
+3. **`toHave`**: Convert simplified beta-application → `have`-telescope
+   - Reconstruct the `have` bindings from the lambda structure
+   - Apply each argument to recover original variable references
+-/
+
+/--
+Result of converting a `have`-telescope to a parallel beta-application.
+
+Given:
+```
+have x₁ := v₁; have x₂ := v₂[x₁]; ...; have xₙ := vₙ[...]; b[x₁, ..., xₙ]
+```
+
+We produce:
+```
+(fun x₁ x₂' ... xₙ' => b'[...]) v₁ (fun deps => v₂[deps]) ... (fun deps => vₙ[deps])
+```
+
+where each `xᵢ'` has type `deps_type → Tᵢ` and `b'` contains applications `xᵢ' (deps)`.
+-/
+structure ToBetaAppResult where
+  /-- Type of the input `have`-expression. -/
+  α : Expr
+  /-- The universe level of `α`. -/
+  u : Level
+  /-- The beta-application form: `(fun x₁ ... xₙ' => b') v₁ ... (fun deps => vₙ)`. -/
+  e : Expr
+  /-- Proof that the original expression equals `e` (by reflexivity + hints, since definitionally equal). -/
+  h : Expr
+  /--
+  Dependency information for each `have`.
+  `varDeps[i]` contains the indices of previous `have`s that `vᵢ` depends on.
+  Used by `toHave` to reconstruct the telescope.
+  -/
+  varDeps : Array (Array Nat)
+  /--
+  The function type: `T₁ → (deps₁ → T₂) → ... → (depsₙ₋₁ → Tₙ) → β`.
+  Used to compute universe levels for congruence lemmas.
+  -/
+  fType : Expr
+  deriving Inhabited
+
+/--
+Collect free variable Ids that appear in `e` and are tracked in `fvarIdToPos`,
+sorted by their position in the telescope.
+-/
+def collectFVarIdsAt (e : Expr) (fvarIdToPos : FVarIdMap Nat) : Array FVarId :=
+  let s := collectFVars {} e
+  let fvarIds := s.fvarIds.filter (fvarIdToPos.contains ·)
+  fvarIds.qsort fun fvarId₁ fvarId₂ =>
+    let pos₁ := fvarIdToPos.get! fvarId₁
+    let pos₂ := fvarIdToPos.get! fvarId₂
+    pos₁ < pos₂
+
+open Internal in
+/--
+Build a chain of arrows `α₁ → α₂ → ... → αₙ → β` using the `mkForallS` wrapper
+(not `.forallE`) to preserve sharing.
+-/
+def mkArrows (αs : Array Expr) (β : Expr) : SymM Expr := do
+  go αs.size β (Nat.le_refl _)
+where
+  go (i : Nat) (β : Expr) (h : i ≤ αs.size) : SymM Expr := do
+    match i with
+    | 0 => return β
+    | i+1 => go i (← mkForallS `a .default αs[i] β) (by omega)
+
+/--
+Transform a `have`-telescope into a parallel beta-application.
+
+**Input**: `have x₁ := v₁; ...; have xₙ := vₙ; b`
+
+**Output**: A `ToBetaAppResult` containing the equivalent beta-application.
+
+## Transformation Details
+
+For each `have xᵢ := vᵢ` where `vᵢ` depends on `xᵢ₁, ..., xᵢₖ` (aka `depsₖ`)
+- The argument becomes `fun depsₖ => vᵢ[depsₖ]`
+- The type becomes `Dᵢ₁ → ... → Dᵢₖ → Tᵢ` where `Dᵢⱼ` is the type of `xᵢⱼ`
+- In the body, `xᵢ` is replaced by `xᵢ' sᵢ₁ ... sᵢₖ` where `sᵢⱼ` is the replacement for `xᵢⱼ`
+
+The proof is `rfl` since the transformation is definitionally equal.
+-/
+def toBetaApp (haveExpr : Expr) : SymM ToBetaAppResult := do
+  go haveExpr #[] #[] #[] #[] #[] #[] {}
+where
+  /--
+  Process the telescope recursively.
+
+  - `e`: Current expression (remaining telescope)
+  - `xs`: Original `have` binders (as fvars)
+  - `xs'`: New binders with function types (as fvars)
+  - `args`: Lambda-wrapped values `(fun deps => vᵢ)`
+  - `subst`: Substitution mapping old vars to applications `xᵢ' sᵢ₁ ... sᵢₖ`
+  - `types`: Types of the new binders
+  - `varDeps`: Dependency positions for each `have`
+  - `fvarIdToPos`: Map from fvar ID to telescope position
+  -/
+  go (e : Expr) (xs xs' args subst types : Array Expr) (varDeps : Array (Array Nat)) (fvarIdToPos : FVarIdMap Nat)
+      : SymM ToBetaAppResult := do
+    if let .letE n t v b (nondep := true) := e then
+      assert! !t.hasLooseBVars
+      withLocalDeclD n t fun x => do
+      let v := v.instantiateRev xs
+      let fvarIds := collectFVarIdsAt v fvarIdToPos
+      let varPos := fvarIds.map (fvarIdToPos.getD · 0)
+      let ys := fvarIds.map mkFVar
+      let arg ← mkLambdaFVars ys v
+      let t' ← share (← mkForallFVars ys t)
+      withLocalDeclD n t' fun x' => do
+      let args' := fvarIds.map fun fvarId =>
+        let pos := fvarIdToPos.get! fvarId
+        subst[pos]!
+      let v' ← share <| mkAppN x' args'
+      let fvarIdToPos := fvarIdToPos.insert x.fvarId! xs.size
+      go b (xs.push x) (xs'.push x') (args.push arg) (subst.push v') (types.push t') (varDeps.push varPos) fvarIdToPos
+    else
+      let e ← instantiateRevS e subst
+      let α ← inferType e
+      let u ← getLevel α
+      let fType ← mkArrows types α
+      let e ← mkLambdaFVarsS xs' e
+      let e ← share <| mkAppN e args
+      let eq := mkApp3 (mkConst ``Eq [u]) α haveExpr e
+      let h := mkApp2 (mkConst ``Eq.refl [u]) α haveExpr
+      let h := mkExpectedPropHint h eq
+      return { α, u, e, h, varDeps, fType }
+
+/--
+Strip `n` leading forall binders from a type.
+Used to extract the actual type from a function type when we know the number of arguments.
+-/
+def consumeForallN (type : Expr) (n : Nat) : Expr :=
+  match n with
+  | 0 => type
+  | n+1 => consumeForallN type.bindingBody! n
+
+open Internal in
+/--
+Eliminate auxiliary applications `xᵢ' sᵢ₁ ... sᵢₖ` in the body when converting back to `have` form.
+
+After simplification, the body contains applications like `xᵢ' deps`. This function
+replaces them with the actual `have` variables `xᵢ`.
+
+**Parameters**:
+- `e`: Expression containing `xᵢ' deps` applications (with loose bvars)
+- `xs`: The actual `have` binders to substitute in
+- `varDeps`: Dependency information for each variable
+
+The function uses `replaceS` to traverse `e`, looking for applications of
+bound variables at the expected positions.
+-/
+def elimAuxApps (e : Expr) (xs : Array Expr) (varDeps : Array (Array Nat)) : SymM Expr := do
+  let n := xs.size
+  replaceS e fun e offset => do
+    if offset >= e.looseBVarRange then
+      return some e
+    match e.getAppFn with
+    | .bvar idx =>
+      if _h : idx >= offset then
+        if _h : idx < offset + n then
+          let i := n - (idx - offset) - 1
+          let expectedNumArgs := varDeps[i]!.size
+          let numArgs := e.getAppNumArgs
+          if numArgs > expectedNumArgs then
+            return none -- Over-applied
+          else
+            assert! numArgs == expectedNumArgs
+            return xs[i]
+        else
+          mkBVarS (idx - n)
+      else
+        return some e
+    | _ => return none
+
+/--
+Convert a simplified beta-application back to `have` form.
+
+**Input**: `(fun x₁ ... xₙ' => b') v₁ ... vₙ` with dependency info
+
+**Output**: `have x₁ := w₁; ...; have xₙ := wₙ; b`
+-/
+def toHave (e : Expr) (varDeps : Array (Array Nat)) : SymM Expr :=
+  e.withApp fun f args => do
+  if _h : args.size ≠ varDeps.size then unreachable! else
+  let rec go (f : Expr) (xs : Array Expr) (i : Nat) : SymM Expr := do
+    if _h : i < args.size then
+      let .lam n t b _ := f | unreachable!
+      let varPos := varDeps[i]
+      let ys := varPos.map fun i => xs[i]!
+      let type := consumeForallN t varPos.size
+      let val ← share <| args[i].betaRev ys
+      withLetDecl (nondep := true) n type val fun x => do
+      go b (xs.push (← share x)) (i+1)
+    else
+      let f ← elimAuxApps f xs varDeps
+      let result ← mkLetFVars (generalizeNondepLet := false) (usedLetOnly := false) xs f
+      share result
+  go f #[] 0
+
+/-- Result of extracting universe levels from a non-dependent function type. -/
+structure GetUnivsResult where
+  /-- Universe level of each argument type. -/
+  argUnivs : Array Level
+  /-- Universe level of each partial application's result type. -/
+  fnUnivs : Array Level
+
+/--
+Extract universe levels from a function type for use in congruence lemmas.
+
+For `α₁ → α₂ → ... → αₙ → β`:
+- `argUnivs[i]` = universe of `αᵢ₊₁`
+- `fnUnivs[i]` = universe of `αᵢ₊₁ → ... → β`
+
+These are needed because `congr`, `congrArg`, and `congrFun'` are universe-polymorphic,
+and we want to avoid a quadratic overhead.
+-/
+def getUnivs (fType : Expr) : SymM GetUnivsResult := do
+  go fType #[]
+where
+  go (type : Expr) (argUnivs : Array Level) : SymM GetUnivsResult := do
+    match type with
+    | .forallE _ d b _ =>
+      go b (argUnivs.push (← getLevel d))
+    | _ =>
+      let mut v ← getLevel type
+      let mut i := argUnivs.size
+      let mut fnUnivs := #[]
+      while i > 0 do
+        i := i - 1
+        let u := argUnivs[i]!
+        v := mkLevelIMax' u v |>.normalize
+        fnUnivs := fnUnivs.push v
+      fnUnivs := fnUnivs.reverse
+      return { argUnivs, fnUnivs }
+
+open Internal in
+/--
+Simplify a beta-application and generate a proof.
+
+This is the core simplification routine. Given `f a₁ ... aₙ`, it:
+1. Simplifies `f` and each `aᵢ` independently
+2. Combines the results using appropriate congruence lemmas
+
+## Congruence Lemma Selection
+
+For each application `f a`:
+- If both changed: use `congr : f = f' → a = a' → f a = f' a'`
+- If only `f` changed: use `congrFun' : f = f' → f a = f' a`
+- If only `a` changed: use `congrArg : a = a' → f a = f a'`
+- If neither changed: return `.rfl`
+-/
+def simpBetaApp (e : Expr) (fType : Expr) (fnUnivs argUnivs : Array Level) : SimpM Result := do
+  return (← go e 0).1
+where
+  go (e : Expr) (i : Nat) : SimpM (Result × Expr) := do
+    match e with
+    | .app f a =>
+      let (rf, fType) ← go f (i+1)
+      let r ← match rf, (← simp a) with
+        | .rfl _, .rfl _ =>
+          pure .rfl
+        | .step f' hf _, .rfl _ =>
+          let e' ← mkAppS f' a
+          let h := mkApp4 (← mkCongrPrefix ``congrFun' fType i) f f' hf a
+          pure <| .step e' h
+        | .rfl _, .step a' ha _ =>
+          let e' ← mkAppS f a'
+          let h := mkApp4 (← mkCongrPrefix ``congrArg fType i) a a' f ha
+          pure <| .step e' h
+        | .step f' hf _, .step a' ha _ =>
+          let e' ← mkAppS f' a'
+          let h := mkApp6 (← mkCongrPrefix ``congr fType i) f f' a a' hf ha
+          pure <| .step e' h
+      return (r, fType.bindingBody!)
+    | .lam .. => return (← simpLambda e, fType)
+    | _ => unreachable!
+
+  mkCongrPrefix (declName : Name) (fType : Expr) (i : Nat) : SymM Expr := do
+    let α := fType.bindingDomain!
+    let β := fType.bindingBody!
+    let u := argUnivs[i]!
+    let v := fnUnivs[i]!
+    return mkApp2 (mkConst declName [u, v]) α β
+
+/-- Intermediate result for `have`-telescope simplification. -/
+structure SimpHaveResult where
+  result : Result
+  α : Expr
+  u : Level
+
+/--
+Core implementation of `have`-telescope simplification.
+
+## Algorithm
+
+1. Convert the `have`-telescope to beta-application form (`toBetaApp`)
+2. Simplify the beta-application (`simpBetaApp`)
+3. If changed, convert back to `have` form (`toHave`)
+4. Chain the proofs using transitivity
+
+## Proof Structure
+
+```
+e₁ = e₂    (by rfl, definitional equality from toBetaApp)
+e₂ = e₃    (from simpBetaApp)
+e₃ = e₄    (by rfl, definitional equality from toHave)
+─────────────────────────────────────────────────────────
+e₁ = e₄    (by transitivity)
+```
+-/
+def simpHaveCore (e : Expr) : SimpM SimpHaveResult := do
+  let e₁ := e
+  let r ← toBetaApp e₁
+  let e₂ := r.e
+  let { fnUnivs, argUnivs } ← getUnivs r.fType
+  match (← simpBetaApp e₂ r.fType fnUnivs argUnivs) with
+  | .rfl _ => return { result := .rfl, α := r.α, u := r.u }
+  | .step e₃ h _ =>
+    let h₁ := mkApp6 (mkConst ``Eq.trans [r.u]) r.α e₁ e₂ e₃ r.h h
+    let e₄ ← toHave e₃ r.varDeps
+    let eq := mkApp3 (mkConst ``Eq [r.u]) r.α e₃ e₄
+    let h₂ := mkApp2 (mkConst ``Eq.refl [r.u]) r.α e₃
+    let h₂ := mkExpectedPropHint h₂ eq
+    let h  := mkApp6 (mkConst ``Eq.trans [r.u]) r.α e₁ e₃ e₄ h₁ h₂
+    return { result := .step e₄ h, α := r.α, u := r.u }
+
+/--
+Simplify a `have`-telescope.
+
+This is the main entry point for `have`-telescope simplification in `Sym.simp`.
+See module documentation for the algorithm overview.
+-/
+public def simpHave (e : Expr) : SimpM Result := do
+  return (← simpHaveCore e).result
+
+/--
+Simplify a `have`-telescope and eliminate unused bindings.
+
+This combines simplification with dead variable elimination in a single pass,
+avoiding quadratic behavior from multiple passes.
+-/
+public def simpHaveAndZetaUnused (e₁ : Expr) : SimpM Result := do
+  let r ← simpHaveCore e₁
+  match r.result with
+  | .rfl _ =>
+    let e₂ ← zetaUnused e₁
+    if isSameExpr e₁ e₂ then
+      return .rfl
+    else
+      let h := mkApp2 (mkConst ``Eq.refl [r.u]) r.α e₂
+      return .step e₂ h
+  | .step e₂ h _ =>
+    let e₃ ← zetaUnused e₂
+    if isSameExpr e₂ e₃ then
+      return r.result
+    else
+      let h := mkApp6 (mkConst ``Eq.trans [r.u]) r.α e₁ e₂ e₃ h
+        (mkApp2 (mkConst ``Eq.refl [r.u]) r.α e₃)
+      return .step e₃ h
+
+public def simpLet (e : Expr) : SimpM Result := do
+  if !e.letNondep! then
+    /-
+    **Note**: We don't do anything if it is a dependent `let`.
+    Users may decide to `zeta`-expand them or apply `letToHave` at `pre`/`post`.
+    -/
+    return .rfl
+  else
+    simpHaveAndZetaUnused e
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Lambda.lean

@@ -0,0 +1,72 @@
+/-
+Copyright (c) 2026 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+prelude
+public import Lean.Meta.Sym.Simp.SimpM
+import Lean.Meta.Closure
+namespace Lean.Meta.Sym.Simp
+
+/--
+Given `xs` containing free variables
+`(x₁ : α₁) (x₂ : α₂[x₁]) ... (xₙ : αₙ[x₁, ..., x_{n-1}])`
+and `β` a type of the form `β[x₁, ..., xₙ]`,
+creates the custom function extensionality theorem
+```
+∀ (f g : (x₁ : α₁) → (x₂ : α₂[x₁]) → ... → (xₙ : αₙ[x₁, ..., x_{n-1}]) → β[x₁, ..., xₙ])
+  (h : ∀ x₁ ... xₙ, f x₁ ... xₙ = g x₁ ... xₙ),
+  f = g
+```
+The theorem has three arguments `f`, `g`, and `h`.
+This auxiliary theorem is used by the simplifier when visiting lambda expressions.
+-/
+def mkFunextFor (xs : Array Expr) (β : Expr) : MetaM Expr := do
+  let type ← mkForallFVars xs β
+  let v ← getLevel β
+  let w ← getLevel type
+  withLocalDeclD `f type fun f =>
+  withLocalDeclD `g type fun g => do
+  let eq := mkApp3 (mkConst ``Eq [v]) β (mkAppN f xs) (mkAppN g xs)
+  withLocalDeclD `h (← mkForallFVars xs eq) fun h => do
+  let eqv ← mkLambdaFVars #[f, g] (← mkForallFVars xs eq)
+  let quotEqv := mkApp2 (mkConst ``Quot [w]) type eqv
+  withLocalDeclD `f' quotEqv fun f' => do
+  let lift := mkApp6 (mkConst ``Quot.lift [w, v]) type eqv β
+    (mkLambda `f .default type (mkAppN (.bvar 0) xs))
+    (mkLambda `f .default type (mkLambda `g .default type (mkLambda `h .default (mkApp2 eqv (.bvar 1) (.bvar 0)) (mkAppN (.bvar 0) xs))))
+    f'
+  let extfunAppVal ← mkLambdaFVars (#[f'] ++ xs) lift
+  let extfunApp := extfunAppVal
+  let quotSound := mkApp5 (mkConst ``Quot.sound [w]) type eqv f g h
+  let Quot_mk_f := mkApp3 (mkConst ``Quot.mk [w]) type eqv f
+  let Quot_mk_g := mkApp3 (mkConst ``Quot.mk [w]) type eqv g
+  let result := mkApp6 (mkConst ``congrArg [w, w]) quotEqv type Quot_mk_f Quot_mk_g extfunApp quotSound
+  let result ← mkLambdaFVars #[f, g, h] result
+  return result
+
+public def simpLambda (e : Expr) : SimpM Result := do
+  lambdaTelescope e fun xs b => withoutModifyingCacheIfNotWellBehaved do
+    main xs b
+where
+  main (xs : Array Expr) (b : Expr) : SimpM Result := do
+    match (← simp b) with
+    | .rfl _ => return .rfl
+    | .step b' h _ =>
+      let h ← mkLambdaFVars xs h
+      let e' ← shareCommonInc (← mkLambdaFVars xs b')
+      let funext ← getFunext xs b
+      return .step e' (mkApp3 funext e e' h)
+
+  getFunext (xs : Array Expr) (b : Expr) : SimpM Expr := do
+    let key ← inferType e
+    if let some h := (← get).funext.find? { expr := key } then
+      return h
+    else
+      let β ← inferType b
+      let h ← mkFunextFor xs β
+      modify fun s => { s with funext := s.funext.insert { expr := key } h }
+      return h
+
+end Lean.Meta.Sym.Simp

src/Lean/Meta/Sym/Simp/Main.lean

@@ -6,103 +6,16 @@ Authors: Leonardo de Moura
 module
 prelude
 public import Lean.Meta.Sym.Simp.SimpM
-import Lean.Meta.MonadSimp
-import Lean.Meta.HaveTelescope
 import Lean.Meta.Sym.AlphaShareBuilder
-import Lean.Meta.Sym.InferType
 import Lean.Meta.Sym.Simp.Result
 import Lean.Meta.Sym.Simp.Simproc
-import Lean.Meta.Sym.Simp.Congr
-import Lean.Meta.Sym.Simp.Funext
+import Lean.Meta.Sym.Simp.App
+import Lean.Meta.Sym.Simp.Have
+import Lean.Meta.Sym.Simp.Lambda
+import Lean.Meta.Sym.Simp.Forall
 namespace Lean.Meta.Sym.Simp
 open Internal
 
-instance : MonadSimp SimpM where
-  dsimp e := return e
-  withNewLemmas _ k := k
-  simp e := do match (← simp (← share e)) with
-    | .rfl _ => return .rfl
-    | .step e' h _ => return .step e' h
-
-def simpLambda (e : Expr) : SimpM Result := do
-  lambdaTelescope e fun xs b => do
-    match (← simp b) with
-    | .rfl _ => return .rfl
-    | .step b' h _ =>
-      let h ← mkLambdaFVars xs h
-      let e' ← shareCommonInc (← mkLambdaFVars xs b')
-      let funext ← getFunext xs b
-      return .step e' (mkApp3 funext e e' h)
-where
-  getFunext (xs : Array Expr) (b : Expr) : SimpM Expr := do
-    let key ← inferType e
-    if let some h := (← get).funext.find? { expr := key } then
-      return h
-    else
-      let β ← inferType b
-      let h ← mkFunextFor xs β
-      modify fun s => { s with funext := s.funext.insert { expr := key } h }
-      return h
-
-def simpArrow (e : Expr) : SimpM Result := do
-  let p := e.bindingDomain!
-  let q := e.bindingBody!
-  match (← simp p), (← simp q) with
-  | .rfl _, .rfl _ =>
-    return .rfl
-  | .step p' h _, .rfl _ =>
-    let u ← getLevel p
-    let v ← getLevel q
-    let e' ← e.updateForallS! p' q
-    return .step e' <| mkApp4 (mkConst ``implies_congr_left [u, v]) p p' q h
-  | .rfl _, .step q' h _ =>
-    let u ← getLevel p
-    let v ← getLevel q
-    let e' ← e.updateForallS! p q'
-    return .step e' <| mkApp4 (mkConst ``implies_congr_right [u, v]) p q q' h
-  | .step p' h₁ _, .step q' h₂ _ =>
-    let u ← getLevel p
-    let v ← getLevel q
-    let e' ← e.updateForallS! p' q'
-    return .step e' <| mkApp6 (mkConst ``implies_congr [u, v]) p p' q q' h₁ h₂
-
-def simpForall (e : Expr) : SimpM Result := do
-  if e.isArrow then
-    simpArrow e
-  else if (← isProp e) then
-    let n := getForallTelescopeSize e.bindingBody! 1
-    forallBoundedTelescope e n fun xs b => do
-    match (← simp b) with
-    | .rfl _ => return .rfl
-    | .step b' h _ =>
-      let h ← mkLambdaFVars xs h
-      let e' ← shareCommonInc (← mkForallFVars xs b')
-      -- **Note**: consider caching the forall-congr theorems
-      let hcongr ← mkForallCongrFor xs
-      return .step e' (mkApp3 hcongr (← mkLambdaFVars xs b) (← mkLambdaFVars xs b') h)
-  else
-    return .rfl
-where
-  -- **Note**: Optimize if this is quadratic in practice
-  getForallTelescopeSize (e : Expr) (n : Nat) : Nat :=
-    match e with
-    | .forallE _ _ b _ => if b.hasLooseBVar 0 then getForallTelescopeSize b (n+1) else n
-    | _ => n
-
-def simpLet (e : Expr) : SimpM Result := do
-  if !e.letNondep! then
-    /-
-    **Note**: We don't do anything if it is a dependent `let`.
-    Users may decide to `zeta`-expand them or apply `letToHave` at `pre`/`post`.
-    -/
-    return .rfl
-  else match (← Meta.simpHaveTelescope e) with
-    | .rfl => return .rfl
-    | .step e' h => return .step (← shareCommon e') h
-
-def simpApp (e : Expr) : SimpM Result := do
-  congrArgs e
-
 def simpStep : Simproc := fun e => do
   match e with
   | .lit _ | .sort _ | .bvar _ | .const .. | .fvar _  | .mvar _ => return .rfl
@@ -116,7 +29,7 @@ def simpStep : Simproc := fun e => do
   | .lam .. => simpLambda e
   | .forallE .. => simpForall e
   | .letE .. => simpLet e
-  | .app .. => simpApp e
+  | .app .. => simpAppArgs e
 
 abbrev cacheResult (e : Expr) (r : Result) : SimpM Result := do
   modify fun s => { s with cache := s.cache.insert { expr := e } r }

src/Lean/Meta/Sym/Simp/Rewrite.lean

@@ -8,6 +8,8 @@ prelude
 public import Lean.Meta.Sym.Simp.SimpM
 public import Lean.Meta.Sym.Simp.Simproc
 public import Lean.Meta.Sym.Simp.Theorems
+public import Lean.Meta.Sym.Simp.App
+public import Lean.Meta.Sym.Simp.Discharger
 import Lean.Meta.Sym.InstantiateS
 import Lean.Meta.Sym.Simp.DiscrTree
 namespace Lean.Meta.Sym.Simp
@@ -27,20 +29,35 @@ def mkValue (expr : Expr) (pattern : Pattern) (result : MatchUnifyResult) : Expr
 /--
 Tries to rewrite `e` using the given theorem.
 -/
-public def Theorem.rewrite (thm : Theorem) (e : Expr) : SimpM Result := do
+public def Theorem.rewrite (thm : Theorem) (e : Expr) (d : Discharger := dischargeNone) : SimpM Result := do
   if let some result ← thm.pattern.match? e then
+    -- **Note**: Potential optimization: check whether pattern covers all variables.
+    for arg in result.args do
+      let .mvar mvarId := arg | pure ()
+      unless (← mvarId.isAssigned) do
+        let decl ← mvarId.getDecl
+        if let some val ← d decl.type then
+          mvarId.assign val
+        else
+          -- **Note**: Failed to discharge hypothesis.
+          return .rfl
     let proof := mkValue thm.expr thm.pattern result
     let rhs   := thm.rhs.instantiateLevelParams thm.pattern.levelParams result.us
     let rhs   ← shareCommonInc rhs
     let expr  ← instantiateRevBetaS rhs result.args
-    return .step expr proof
+    if isSameExpr e expr then
+      return .rfl
+    else
+      return .step expr proof
   else
     return .rfl
 
-public def Theorems.rewrite (thms : Theorems) : Simproc := fun e => do
-  -- **TODO**: over-applied terms
-  for thm in thms.getMatch e do
-    let result ← thm.rewrite e
+public def Theorems.rewrite (thms : Theorems) (d : Discharger := dischargeNone) : Simproc := fun e => do
+  for (thm, numExtra) in thms.getMatchWithExtra e do
+    let result ← if numExtra == 0 then
+      thm.rewrite e d
+    else
+      simpOverApplied e numExtra (thm.rewrite · d)
     if !result.isRfl then
       return result
   return .rfl

src/Lean/Meta/Sym/Simp/SimpM.lean

@@ -101,8 +101,12 @@ invalidating the cache and causing O(2^n) behavior on conditional trees.
 /-- Configuration options for the structural simplifier. -/
 structure Config where
   /-- Maximum number of steps that can be performed by the simplifier. -/
-  maxSteps : Nat := 0
-  -- **TODO**: many are still missing
+  maxSteps : Nat := 1000
+  /--
+  Maximum depth of reentrant simplifier calls through dischargers.
+  Prevents infinite loops when conditional rewrite rules trigger recursive discharge attempts.
+  -/
+  maxDischargeDepth : Nat := 2
 
 /--
 The result of simplifying an expression `e`.
@@ -149,6 +153,7 @@ inductive Result where
   Simplified to `e'` with proof `proof : e = e'`.
   If `done = true`, skip recursive simplification of `e'`. -/
   | step (e' : Expr) (proof : Expr) (done : Bool := false)
+  deriving Inhabited
 
 private opaque MethodsRefPointed : NonemptyType.{0}
 def MethodsRef : Type := MethodsRefPointed.type
@@ -161,6 +166,7 @@ structure Context where
   /-- Size of the local context when simplification started.
   Used to determine which free variables were introduced during simplification. -/
   initialLCtxSize : Nat
+  dischargeDepth  : Nat := 0
 
 /-- Cache mapping expressions (by pointer equality) to their simplified results. -/
 abbrev Cache := PHashMap ExprPtr Result
@@ -191,14 +197,13 @@ abbrev Simproc := Expr → SimpM Result
 structure Methods where
   pre        : Simproc  := fun _ => return .rfl
   post       : Simproc  := fun _ => return .rfl
-  discharge? : Expr → SimpM (Option Expr) := fun _ => return none
   /--
-  `wellBehavedDischarge` must **not** be set to `true` IF `discharge?`
-  access local declarations with index >= `Context.lctxInitIndices` when
-  `contextual := false`.
+  `wellBehavedMethods` must **not** be set to `true` IF their behavior
+  depends on new hypotheses in the local context. For example, for applying
+  conditional rewrite rules.
   Reason: it would prevent us from aggressively caching `simp` results.
   -/
-  wellBehavedDischarge : Bool := true
+  wellBehavedMethods : Bool := true
   deriving Inhabited
 
 unsafe def Methods.toMethodsRefImpl (m : Methods) : MethodsRef :=
@@ -236,6 +241,13 @@ abbrev pre : Simproc := fun e => do
 abbrev post : Simproc := fun e => do
   (← getMethods).post e
 
+abbrev withoutModifyingCache (k : SimpM α) : SimpM α := do
+  let cache ← getCache
+  try k finally modify fun s => { s with cache }
+
+abbrev withoutModifyingCacheIfNotWellBehaved (k : SimpM α) : SimpM α := do
+  if (← getMethods).wellBehavedMethods then k else withoutModifyingCache k
+
 end Simp
 
 abbrev simp (e : Expr) (methods :  Simp.Methods := {}) (config : Simp.Config := {}) : SymM Simp.Result := do

src/Lean/Meta/Sym/Simp/Theorems.lean

@@ -38,6 +38,9 @@ def Theorems.insert (thms : Theorems) (thm : Theorem) : Theorems :=
 def Theorems.getMatch (thms : Theorems) (e : Expr) : Array Theorem :=
   Sym.getMatch thms.thms e
 
+def Theorems.getMatchWithExtra (thms : Theorems) (e : Expr) : Array (Theorem × Nat) :=
+  Sym.getMatchWithExtra thms.thms e
+
 def mkTheoremFromDecl (declName : Name) : MetaM Theorem := do
   let (pattern, rhs) ← mkEqPatternFromDecl declName
   return { expr := mkConst declName, pattern, rhs }

src/Lean/Meta/Tactic/Util.lean

@@ -99,7 +99,8 @@ def _root_.Lean.MVarId.getNondepPropHyps (mvarId : MVarId) : MetaM (Array FVarId
   let removeDeps (e : Expr) (candidates : FVarIdHashSet) : MetaM FVarIdHashSet := do
     let e ← instantiateMVars e
     let visit : StateRefT FVarIdHashSet MetaM FVarIdHashSet := do
-      e.forEachWhere Expr.isFVar fun e => modify fun s => s.erase e.fvarId!
+      if e.hasFVar then
+        e.forEachWhere Expr.isFVar fun e => modify fun s => s.erase e.fvarId!
       get
     visit |>.run' candidates
   mvarId.withContext do

src/Lean/MetavarContext.lean

@@ -786,9 +786,6 @@ def localDeclDependsOnPred [Monad m] [MonadMCtx m] (localDecl : LocalDecl) (pf :
 
 namespace MetavarContext
 
-@[export lean_mk_metavar_ctx]
-def mkMetavarContext : Unit → MetavarContext := fun _ => {}
-
 /-- Low level API for adding/declaring metavariable declarations.
    It is used to implement actions in the monads `MetaM`, `ElabM` and `TacticM`.
    It should not be used directly since the argument `(mvarId : MVarId)` is assumed to be "unique". -/

src/Lean/Parser/Extension.lean

@@ -387,7 +387,7 @@ register_builtin_option internal.parseQuotWithCurrentStage : Bool := {
 def evalInsideQuot (declName : Name) : Parser → Parser := withFn fun f c s =>
   if c.quotDepth > 0 && !c.suppressInsideQuot && internal.parseQuotWithCurrentStage.get c.options && c.env.contains declName then
     adaptUncacheableContextFn (fun ctx =>
-      { ctx with options := ctx.options.setBool `interpreter.prefer_native false })
+      { ctx with options := ctx.options.set `interpreter.prefer_native false })
       (evalParserConst declName) c s
   else
     f c s
@@ -717,7 +717,7 @@ def parserOfStackFn (offset : Nat) : ParserFn := fun ctx s => Id.run do
       adaptUncacheableContextFn (fun ctx =>
         -- static quotations such as `(e) do not use the interpreter unless the above option is set,
         -- so for consistency neither should dynamic quotations using this function
-        { ctx with options := ctx.options.setBool `interpreter.prefer_native (!internal.parseQuotWithCurrentStage.get ctx.options) })
+        { ctx with options := ctx.options.set `interpreter.prefer_native (!internal.parseQuotWithCurrentStage.get ctx.options) })
         (evalParserConst parserName) ctx s
     | [.alias alias] =>
       match alias with

src/Lean/PrettyPrinter/Delaborator/Basic.lean

@@ -165,7 +165,7 @@ def getOptionsAtCurrPos : DelabM Options := do
   let mut opts ← getOptions
   if let some opts' := ctx.optionsPerPos.get? (← getPos) then
     for (k, v) in opts' do
-      opts := opts.insert k v
+      opts := opts.set k v
   return opts
 
 /-- Evaluate option accessor, using subterm-specific options if set. -/
@@ -185,7 +185,7 @@ def withOptionAtCurrPos (k : Name) (v : DataValue) (x : DelabM α) : DelabM α :
   let pos ← getPos
   withReader
     (fun ctx =>
-      let opts' := ctx.optionsPerPos.get? pos |>.getD {} |>.insert k v
+      let opts' := ctx.optionsPerPos.get? pos |>.getD {} |>.set k v
       { ctx with optionsPerPos := ctx.optionsPerPos.insert pos opts' })
     x
 

src/Lean/PrettyPrinter/Delaborator/Builtins.lean

@@ -142,7 +142,7 @@ def withMDataOptions [Inhabited α] (x : DelabM α) : DelabM α := do
     for (k, v) in m do
       if (`pp).isPrefixOf k then
         let opts := posOpts.get? pos |>.getD {}
-        posOpts := posOpts.insert pos (opts.insert k v)
+        posOpts := posOpts.insert pos (opts.set k v)
     withReader ({ · with optionsPerPos := posOpts }) $ withMDataExpr x
   | _ => x
 

src/Lean/PrettyPrinter/Delaborator/SubExpr.lean

@@ -22,11 +22,11 @@ abbrev OptionsPerPos := Std.TreeMap SubExpr.Pos Options
 
 def OptionsPerPos.insertAt (optionsPerPos : OptionsPerPos) (pos : SubExpr.Pos) (name : Name) (value : DataValue) : OptionsPerPos :=
   let opts := optionsPerPos.get? pos |>.getD {}
-  optionsPerPos.insert pos <| opts.insert name value
+  optionsPerPos.insert pos <| opts.set name value
 
 /-- Merges two collections of options, where the second overrides the first. -/
 def OptionsPerPos.merge : OptionsPerPos → OptionsPerPos → OptionsPerPos :=
-  Std.TreeMap.mergeWith (fun _ => KVMap.mergeBy (fun _ _ dv => dv))
+  Std.TreeMap.mergeWith (fun _ => Options.mergeBy (fun _ _ dv => dv))
 
 namespace SubExpr
 

src/Lean/PrettyPrinter/Delaborator/TopDownAnalyze.lean

@@ -317,7 +317,7 @@ def checkKnowsType : AnalyzeM Unit := do
     throw $ Exception.internal analyzeFailureId
 
 def annotateBoolAt (n : Name) (pos : Pos) : AnalyzeM Unit := do
-  let opts := (← get).annotations.getD pos {} |>.setBool n true
+  let opts := (← get).annotations.getD pos {} |>.set n true
   trace[pp.analyze.annotate] "{pos} {n}"
   modify fun s => { s with annotations := s.annotations.insert pos opts }
 

src/Lean/ReducibilityAttrs.lean

@@ -107,6 +107,9 @@ register_builtin_option allowUnsafeReducibility : Bool := {
 
 private def validate (declName : Name) (status : ReducibilityStatus) (attrKind : AttributeKind) : CoreM Unit := do
   let suffix := .note "Use `set_option allowUnsafeReducibility true` to override reducibility status validation"
+  -- Allow global visibility attributes even on non-exported definitions - they may be relevant for
+  -- downstream non-`module`s.
+  withoutExporting do
   unless allowUnsafeReducibility.get (← getOptions) do
     match (← getConstInfo declName) with
     | .defnInfo _ =>

src/Lean/Server/GoTo.lean

@@ -39,15 +39,24 @@ def GoToKind.determineTargetExprs (kind : GoToKind) (ti : TermInfo) : MetaM (Arr
   | _ =>
     return #[← instantiateMVars ti.expr]
 
-def getInstanceProjectionArg? (e : Expr) : MetaM (Option Expr) := do
-  let env ← getEnv
-  let .const n _ := e.getAppFn'
-    | return none
-  let some projInfo := env.getProjectionFnInfo? n
+partial def getInstanceProjectionArg? (e : Expr) : MetaM (Option Expr) := do
+  let some (e, projInfo) ← Meta.withReducible <| reduceToProjection? e
     | return none
   let instIdx := projInfo.numParams
   let appArgs := e.getAppArgs
   return appArgs[instIdx]?
+where
+  reduceToProjection? (e : Expr) : MetaM (Option (Expr × ProjectionFunctionInfo)) := do
+    let env ← getEnv
+    let .const n _ := e.getAppFn'
+      | return none
+    if let some projInfo := env.getProjectionFnInfo? n then
+      return some (e, projInfo)
+    -- Unfold reducible definitions when looking for a projection.
+    -- For example, this ensures that we get `LT.lt` instance projection entries on `GT.gt`.
+    let some e ← Meta.unfoldDefinition? e
+      | return none
+    reduceToProjection? e
 
 def isInstanceProjection (e : Expr) : MetaM Bool := do
   return (← getInstanceProjectionArg? e).isSome

src/Lean/Server/References.lean

@@ -117,8 +117,9 @@ namespace ModuleRefs
 
 /-- Adds `ref` to the `RefInfo` corresponding to `ref.ident` in `self`. See `RefInfo.addRef`. -/
 def addRef (self : ModuleRefs) (ref : Reference) : ModuleRefs :=
-  let refInfo := self.getD ref.ident RefInfo.empty
-  self.insert ref.ident (refInfo.addRef ref)
+  self.alter ref.ident fun
+    | some refInfo => some <| refInfo.addRef ref
+    | none => some <| RefInfo.empty.addRef ref
 
 /-- Converts `refs` to a JSON-serializable `Lsp.ModuleRefs` and collects all decls. -/
 def toLspModuleRefs (refs : ModuleRefs) : BaseIO (Lsp.ModuleRefs × Decls) := StateT.run (s := ∅) do
@@ -374,9 +375,9 @@ def dedupReferences (refs : Array Reference) (allowSimultaneousBinderUse := fals
   for ref in refs do
     let isBinder := if allowSimultaneousBinderUse then some ref.isBinder else none
     let key := (ref.ident, isBinder, ref.range)
-    refsByIdAndRange := match refsByIdAndRange[key]? with
-      | some ref' => refsByIdAndRange.insert key { ref' with aliases := ref'.aliases ++ ref.aliases }
-      | none => refsByIdAndRange.insert key ref
+    refsByIdAndRange := refsByIdAndRange.alter key fun
+      | some ref' => some { ref' with aliases := ref'.aliases ++ ref.aliases }
+      | none => some ref
 
   let dedupedRefs := refsByIdAndRange.fold (init := #[]) fun refs _ ref => refs.push ref
   return dedupedRefs.qsort (·.range < ·.range)

src/Lean/Shell.lean

@@ -284,7 +284,7 @@ def setConfigOption (opts : Options) (arg : String) : IO Options := do
     else
       -- More options may be registered by imports, so we leave validating them to the elaborator.
       -- This (minor) duplication may be resolved later.
-      return opts.insert name val
+      return opts.set name val
 
 /--
 Process a command-line option parsed by the C++ shell.

src/Lean/Util/LeanOptions.lean

@@ -43,6 +43,9 @@ instance : Coe Bool LeanOptionValue where
 instance : Coe Nat LeanOptionValue where
   coe := LeanOptionValue.ofNat
 
+instance {n : Nat} : OfNat LeanOptionValue n where
+  ofNat := .ofNat n
+
 instance : FromJson LeanOptionValue where
   fromJson?
     | (s : String) => Except.ok s
@@ -97,9 +100,9 @@ def LeanOptions.appendArray (self : LeanOptions) (new : Array LeanOption) : Lean
 instance : HAppend LeanOptions (Array LeanOption) LeanOptions := ⟨LeanOptions.appendArray⟩
 
 def LeanOptions.toOptions (leanOptions : LeanOptions) : Options := Id.run do
-  let mut options := KVMap.empty
+  let mut options := Options.empty
   for ⟨name, optionValue⟩ in leanOptions.values do
-    options := options.insert name optionValue.toDataValue
+    options := options.set name optionValue.toDataValue
   return options
 
 def LeanOptions.fromOptions? (options : Options) : Option LeanOptions := do

src/Lean/Util/Trace.lean

@@ -102,8 +102,8 @@ def printTraces : m Unit := do
 def resetTraceState : m Unit :=
   modifyTraceState (fun _ => {})
 
-def checkTraceOption (inherited : Std.HashSet Name) (opts : Options) (cls : Name) : Bool :=
-  !opts.isEmpty && go (`trace ++ cls)
+@[inline] def checkTraceOption (inherited : Std.HashSet Name) (opts : Options) (cls : Name) : Bool :=
+  opts.hasTrace && go (`trace ++ cls)
 where
   go (opt : Name) : Bool :=
     if let some enabled := opts.get? opt then
@@ -117,6 +117,15 @@ where
 def isTracingEnabledFor (cls : Name) : m Bool := do
   return checkTraceOption (← MonadTrace.getInheritedTraceOptions) (← getOptions) cls
 
+@[export lean_is_trace_class_enabled]
+private def isTracingEnabledForExport (opts : Options) (cls : Name) : BaseIO Bool := do
+  -- Replicate `checkTraceOption` fast path to make sure it happens before `IORef.get` (which
+  -- itself is slower than `MonadTrace.getInheritedTraceOptions` but at least that's only on the
+  -- slow path).
+  if !opts.hasTrace then
+    return false
+  return checkTraceOption (← inheritedTraceOptions.get) opts cls
+
 @[inline] def getTraces : m (PersistentArray TraceElem) := do
   let s ← getTraceState
   pure s.traces
@@ -265,6 +274,8 @@ def withTraceNode [always : MonadAlwaysExcept ε m] [MonadLiftT BaseIO m] (cls :
     (msg : Except ε α → m MessageData) (k : m α) (collapsed := true) (tag := "") : m α := do
   let _ := always.except
   let opts ← getOptions
+  if !opts.hasTrace then
+    return (← k)
   let clsEnabled ← isTracingEnabledFor cls
   unless clsEnabled || trace.profiler.get opts do
     return (← k)
@@ -374,6 +385,8 @@ def withTraceNodeBefore [MonadRef m] [AddMessageContext m] [MonadOptions m]
     (msg : Unit → m MessageData) (k : m α) (collapsed := true) (tag := "") : m α := do
   let _ := always.except
   let opts ← getOptions
+  if !opts.hasTrace then
+    return (← k)
   let clsEnabled ← isTracingEnabledFor cls
   unless clsEnabled || trace.profiler.get opts do
     return (← k)
@@ -415,4 +428,7 @@ def addTraceAsMessages [Monad m] [MonadRef m] [MonadLog m] [MonadTrace m] : m Un
     let data := .tagged `trace <| .trace { cls := .anonymous } .nil traceMsg
     logMessage <| Elab.mkMessageCore (← getFileName) (← getFileMap) data .information pos endPos
 
+builtin_initialize
+  registerTraceClass `debug
+
 end Lean

src/Std/Tactic/BVDecide/Bitblast/BVExpr/Circuit/Lemmas/Operations/Clz.lean

@@ -30,9 +30,6 @@ namespace BVExpr
 namespace bitblast
 namespace blastClz
 
-example (x : Nat) (hx : 0 < x) : ∃ y, x = y + 1 := by
-  exact Nat.exists_eq_add_one.mpr hx
-
 theorem go_denote_eq {w : Nat} (aig : AIG α)
     (acc : AIG.RefVec aig w) (xc : AIG.RefVec aig w) (x : BitVec w) (assign : α → Bool)
     (hx : ∀ (idx : Nat) (hidx : idx < w), ⟦aig, xc.get idx hidx, assign⟧ = x.getLsbD idx)

src/kernel/expr_maps.h

@@ -5,22 +5,22 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Author: Leonardo de Moura
 */
 #pragma once
-#include <unordered_map>
 #include <functional>
+#include "util/alloc.h"
 #include "kernel/expr.h"
 
 namespace lean {
 // Maps based on structural equality. That is, two keys are equal iff they are structurally equal
 template<typename T>
-using expr_map = typename std::unordered_map<expr, T, expr_hash, std::equal_to<expr>>;
+using expr_map = typename lean::unordered_map<expr, T, expr_hash, std::equal_to<expr>>;
 // The following map also takes into account binder information
 template<typename T>
-using expr_bi_map = typename std::unordered_map<expr, T, expr_hash, is_bi_equal_proc>;
+using expr_bi_map = typename lean::unordered_map<expr, T, expr_hash, is_bi_equal_proc>;
 
 template<typename T>
-class expr_cond_bi_map : public std::unordered_map<expr, T, expr_hash, is_cond_bi_equal_proc> {
+class expr_cond_bi_map : public lean::unordered_map<expr, T, expr_hash, is_cond_bi_equal_proc> {
 public:
     expr_cond_bi_map(bool use_bi = false):
-        std::unordered_map<expr, T, expr_hash, is_cond_bi_equal_proc>(10, expr_hash(), is_cond_bi_equal_proc(use_bi)) {}
+        lean::unordered_map<expr, T, expr_hash, is_cond_bi_equal_proc>(10, expr_hash(), is_cond_bi_equal_proc(use_bi)) {}
 };
 };

src/kernel/expr_sets.h

@@ -5,12 +5,12 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Author: Leonardo de Moura
 */
 #pragma once
-#include <unordered_set>
 #include <utility>
 #include <functional>
+#include "util/alloc.h"
 #include "runtime/hash.h"
 #include "kernel/expr.h"
 
 namespace lean {
-typedef std::unordered_set<expr, expr_hash, std::equal_to<expr>> expr_set;
+typedef lean::unordered_set<expr, expr_hash, std::equal_to<expr>> expr_set;
 }

src/kernel/for_each_fn.cpp

@@ -19,7 +19,7 @@ If `partial_apps = true`, then given a term `g a b`, we also apply the function
 and not only to `g`, `a`, and `b`.
 */
 template<bool partial_apps> class for_each_fn {
-    std::unordered_set<lean_object *> m_cache;
+    lean::unordered_set<lean_object *> m_cache;
     std::function<bool(expr const &)> m_f; // NOLINT
 
     bool visited(expr const & e) {
@@ -95,7 +95,7 @@ class for_each_offset_fn {
             return hash((size_t)p.first, p.second);
         }
     };
-    std::unordered_set<std::pair<lean_object *, unsigned>, key_hasher> m_cache;
+    lean::unordered_set<std::pair<lean_object *, unsigned>, key_hasher> m_cache;
     std::function<bool(expr const &, unsigned)> m_f; // NOLINT
 
     bool visited(expr const & e, unsigned offset) {

src/kernel/instantiate_mvars.cpp

@@ -33,7 +33,7 @@ option_ref<level> get_lmvar_assignment(metavar_ctx & mctx, name const & mid) {
 
 class instantiate_lmvars_fn {
     metavar_ctx & m_mctx;
-    std::unordered_map<lean_object *, level> m_cache;
+    lean::unordered_map<lean_object *, level> m_cache;
     std::vector<level> m_saved; // Helper vector to prevent values from being garbage collected
 
     inline level cache(level const & l, level r, bool shared) {
@@ -141,7 +141,7 @@ class instantiate_mvars_fn {
     metavar_ctx & m_mctx;
     instantiate_lmvars_fn m_level_fn;
     name_set m_already_normalized; // Store metavariables whose assignment has already been normalized.
-    std::unordered_map<lean_object *, expr> m_cache;
+    lean::unordered_map<lean_object *, expr> m_cache;
     std::vector<expr> m_saved; // Helper vector to prevent values from being garbage collected
 
     level visit_level(level const & l) {

src/kernel/trace.cpp

@@ -13,113 +13,26 @@ Author: Leonardo de Moura
 #include "kernel/trace.h"
 
 namespace lean {
-static name_set *            g_trace_classes = nullptr;
-static name_map<name_set>  * g_trace_aliases = nullptr;
-MK_THREAD_LOCAL_GET_DEF(std::vector<name>, get_enabled_trace_classes);
-MK_THREAD_LOCAL_GET_DEF(std::vector<name>, get_disabled_trace_classes);
-LEAN_THREAD_PTR(elab_environment,      g_env);
-LEAN_THREAD_PTR(options,               g_opts);
+LEAN_THREAD_PTR(const options,               g_opts);
 
 void register_trace_class(name const & n, name const & decl_name) {
     register_option(name("trace") + n, decl_name, data_value_kind::Bool, "false",
                     "(trace) enable/disable tracing for the given module and submodules");
-    g_trace_classes->insert(n);
-}
-
-void register_trace_class_alias(name const & n, name const & alias) {
-    name_set new_s;
-    if (auto s = g_trace_aliases->find(n))
-        new_s = *s;
-    new_s.insert(alias);
-    g_trace_aliases->insert(n, new_s);
-}
-
-bool is_trace_enabled() {
-    return !get_enabled_trace_classes().empty();
-}
-
-static void update_class(std::vector<name> & cs, name const & c) {
-    if (std::find(cs.begin(), cs.end(), c) == cs.end()) {
-        cs.push_back(c);
-    }
-}
-
-static void enable_trace_class(name const & c) {
-    update_class(get_enabled_trace_classes(), c);
-}
-
-static void disable_trace_class(name const & c) {
-    update_class(get_disabled_trace_classes(), c);
-}
-
-static bool is_trace_class_set_core(std::vector<name> const & cs, name const & n) {
-    for (name const & p : cs) {
-        if (is_prefix_of(p, n)) {
-            return true;
-        }
-    }
-    return false;
-}
-
-static bool is_trace_class_set(std::vector<name> const & cs, name const & n) {
-    if (is_trace_class_set_core(cs, n))
-        return true;
-    auto it = n;
-    while (true) {
-        if (auto s = g_trace_aliases->find(it)) {
-            bool found = false;
-            s->for_each([&](name const & alias) {
-                    if (!found && is_trace_class_set_core(cs, alias))
-                        found = true;
-                });
-            if (found)
-                return true;
-        }
-        if (it.is_atomic())
-            return false;
-        it = it.get_prefix();
-    }
 }
 
+extern "C" bool lean_is_trace_class_enabled(obj_arg opts, obj_arg cls);
 bool is_trace_class_enabled(name const & n) {
-    if (!is_trace_enabled())
-        return false;
-    if (is_trace_class_set(get_disabled_trace_classes(), n))
-        return false; // it was explicitly disabled
-    return is_trace_class_set(get_enabled_trace_classes(), n);
+    return lean_is_trace_class_enabled(g_opts->to_obj_arg(), n.to_obj_arg());
 }
 
 
-void scope_trace_env::init(elab_environment * env, options * opts) {
-    m_enable_sz  = get_enabled_trace_classes().size();
-    m_disable_sz = get_disabled_trace_classes().size();
-    m_old_env    = g_env;
-    m_old_opts   = g_opts;
-    g_env        = env;
-    name trace("trace");
-    if (opts && g_opts != opts) {
-        opts->for_each([&](name const & n) {
-                if (is_prefix_of(trace, n)) {
-                    name cls        = n.replace_prefix(trace, name());
-                    if (opts->get_bool(n, false))
-                        enable_trace_class(cls);
-                    else
-                        disable_trace_class(cls);
-                }
-            });
-    }
-    g_opts = opts;
-}
-
 scope_trace_env::scope_trace_env(elab_environment const & env, options const & o) {
-    init(const_cast<elab_environment*>(&env), const_cast<options*>(&o));
+    m_old_opts = g_opts;
+    g_opts = &o;
 }
 
 scope_trace_env::~scope_trace_env() {
-    g_env  = const_cast<elab_environment*>(m_old_env);
     g_opts = const_cast<options*>(m_old_opts);
-    get_enabled_trace_classes().resize(m_enable_sz);
-    get_disabled_trace_classes().resize(m_disable_sz);
 }
 
 extern "C" obj_res lean_io_eprint(obj_arg s);
@@ -140,21 +53,9 @@ std::ostream & operator<<(std::ostream & ios, tclass const & c) {
 }
 
 void initialize_trace() {
-    g_trace_classes = new name_set();
-    g_trace_aliases = new name_map<name_set>();
-
-    register_trace_class(name{"debug"});
 }
 
 void finalize_trace() {
-    delete g_trace_classes;
-    delete g_trace_aliases;
 }
 
-/*
-@[export lean_mk_metavar_ctx]
-def mkMetavarContext : Unit → MetavarContext := fun _ => {}
-*/
-extern "C" lean_object* lean_mk_metavar_ctx(lean_object*);
-
 }

src/kernel/trace.h

@@ -13,16 +13,9 @@ Author: Leonardo de Moura
 
 namespace lean {
 void register_trace_class(name const & n, name const & decl_name = {});
-void register_trace_class_alias(name const & n, name const & alias);
-bool is_trace_enabled();
 bool is_trace_class_enabled(name const & n);
 
-#define lean_is_trace_enabled(CName) (::lean::is_trace_enabled() && ::lean::is_trace_class_enabled(CName))
-
 class scope_trace_env {
-    unsigned                 m_enable_sz;
-    unsigned                 m_disable_sz;
-    elab_environment const * m_old_env;
     options     const *      m_old_opts;
     void init(elab_environment * env, options * opts);
 public:
@@ -47,7 +40,7 @@ tout & operator<<(tout const & out, T const & t) {
 std::ostream & operator<<(std::ostream & ios, tclass const &);
 
 #define lean_trace(CName, CODE) {               \
-if (lean_is_trace_enabled(CName)) {             \
+if (lean::is_trace_class_enabled(CName)) {      \
     tout() << tclass(CName); CODE               \
 }}
 

src/kernel/type_checker.h

@@ -25,7 +25,7 @@ class type_checker {
 public:
     class state {
         typedef expr_map<expr> infer_cache;
-        typedef std::unordered_set<expr_pair, expr_pair_hash, expr_pair_eq> expr_pair_set;
+        typedef lean::unordered_set<expr_pair, expr_pair_hash, expr_pair_eq> expr_pair_set;
         environment               m_env;
         name_generator            m_ngen;
         infer_cache               m_infer_type[2];

src/lake/Lake/Build/Context.lean

@@ -36,10 +36,18 @@ Whether the build should show progress information.
 public def BuildConfig.showProgress (cfg : BuildConfig) : Bool :=
   (cfg.noBuild ∧ cfg.verbosity == .verbose) ∨ cfg.verbosity != .quiet
 
+/-- Mutable reference of registered build jobs. -/
+@[expose] -- for codegen
+public def JobQueue := IO.Ref (Array OpaqueJob)
+
+/-- Returns a new empty job queue. -/
+@[inline] public def mkJobQueue : BaseIO JobQueue :=
+  IO.mkRef #[]
+
 /-- A Lake context with a build configuration and additional build data. -/
 public structure BuildContext extends BuildConfig, Context where
   leanTrace : BuildTrace
-  registeredJobs : IO.Ref (Array OpaqueJob)
+  registeredJobs : JobQueue
 
 /-- A transformer to equip a monad with a `BuildContext`. -/
 public abbrev BuildT := ReaderT BuildContext

src/lake/Lake/Build/Module.lean

@@ -373,10 +373,11 @@ private def fetchImportInfo
       return s
     else if n = 1 then -- common fast path
       let mod := mods[0]
-      if imp.importAll && !mod.allowImportAll && pkgName != mod.pkg.keyName then
-        logError s!"{fileName}: cannot `import all` \
-          the module `{imp.module}` from the package `{mod.pkg.discriminant}`"
-        return .error
+      -- Remark: We've decided to disable this check for now
+      -- if imp.importAll && !mod.allowImportAll && pkgName != mod.pkg.keyName then
+      --   logError s!"{fileName}: cannot `import all` \
+      --     the module `{imp.module}` from the package `{mod.pkg.discriminant}`"
+      --   return .error
       let importJob ← mod.exportInfo.fetch
       return s.zipWith (sync := true) (·.addImport nonModule imp ·) importJob
     else

src/lake/Lake/Build/Run.lean

@@ -22,6 +22,7 @@ open System
 namespace Lake
 
 /-- Create a fresh build context from a workspace and a build configuration. -/
+@[deprecated "Deprecated without replacement." (since := "2025-01-08")]
 public def mkBuildContext (ws : Workspace) (config : BuildConfig) : BaseIO BuildContext := do
   return {
     opaqueWs := ws,
@@ -37,7 +38,7 @@ private def Monitor.spinnerFrames :=
 
 /-- Context of the Lake build monitor. -/
 private structure MonitorContext where
-  jobs : IO.Ref (Array OpaqueJob)
+  jobs : JobQueue
   out : IO.FS.Stream
   outLv : LogLevel
   failLv : LogLevel
@@ -49,6 +50,9 @@ private structure MonitorContext where
   /-- How often to poll jobs (in milliseconds). -/
   updateFrequency : Nat
 
+@[inline] def MonitorContext.logger (ctx : MonitorContext) : MonadLog IO :=
+  .stream ctx.out ctx.outLv ctx.useAnsi
+
 /-- State of the Lake build monitor. -/
 private structure MonitorState where
   jobNo : Nat := 0
@@ -189,12 +193,51 @@ private def main (init : Array OpaqueJob) : MonitorM PUnit := do
 
 end Monitor
 
+/-- **For internal use only.** -/
 public structure MonitorResult where
   didBuild : Bool
   failures : Array String
   numJobs : Nat
 
+@[inline] def MonitorResult.isOk (self : MonitorResult) : Bool :=
+  self.failures.isEmpty
+
+def mkMonitorContext (cfg : BuildConfig) (jobs : JobQueue) : BaseIO MonitorContext := do
+  let out ← cfg.out.get
+  let useAnsi ← cfg.ansiMode.isEnabled out
+  let outLv := cfg.outLv
+  let failLv := cfg.failLv
+  let isVerbose := cfg.verbosity = .verbose
+  let showProgress := cfg.showProgress
+  let minAction := if isVerbose then .unknown else .fetch
+  let showOptional := isVerbose
+  let showTime := isVerbose || !useAnsi
+  let updateFrequency := 100
+  return {
+    jobs, out, failLv, outLv, minAction, showOptional
+    useAnsi, showProgress, showTime, updateFrequency
+  }
+
+def monitorJobs'
+  (ctx : MonitorContext)
+  (initJobs : Array OpaqueJob)
+  (initFailures : Array String := #[])
+  (resetCtrl : String := "")
+: BaseIO MonitorResult := do
+  let s := {
+    resetCtrl
+    lastUpdate := ← IO.monoMsNow
+    failures := initFailures
+  }
+  let (_,s) ← Monitor.main initJobs |>.run ctx s
+  return {
+    failures := s.failures
+    numJobs := s.totalJobs
+    didBuild := s.didBuild
+  }
+
 /-- The job monitor function. An auxiliary definition for `runFetchM`. -/
+@[inline, deprecated "Deprecated without replacement" (since := "2025-01-08")]
 public def monitorJobs
   (initJobs : Array OpaqueJob)
   (jobs : IO.Ref (Array OpaqueJob))
@@ -210,99 +253,148 @@ public def monitorJobs
     jobs, out, failLv, outLv, minAction, showOptional
     useAnsi, showProgress, showTime, updateFrequency
   }
-  let s := {
-    resetCtrl
-    lastUpdate := ← IO.monoMsNow
-    failures := initFailures
-  }
-  let (_,s) ← Monitor.main initJobs |>.run ctx s
-  return {
-    failures := s.failures
-    numJobs := s.totalJobs
-    didBuild := s.didBuild
-  }
+  monitorJobs' ctx initJobs initFailures resetCtrl
 
 /-- Exit code to return if `--no-build` is set and a build is required. -/
 public def noBuildCode : ExitCode := 3
 
+def Workspace.saveOutputs
+  [logger : MonadLog IO] (ws : Workspace)
+  (out : IO.FS.Stream) (outputsFile : FilePath) (isVerbose : Bool)
+: IO Unit := do
+  unless ws.isRootArtifactCacheEnabled do
+    logWarning s!"{ws.root.prettyName}: \
+      the artifact cache is not enabled for this package, so the artifacts described \
+      by the mappings produced by `-o` will not necessarily be available in the cache."
+  if let some ref := ws.root.outputsRef? then
+    match (← (← ref.get).writeFile outputsFile {}) with
+    | .ok _ log =>
+      if !log.isEmpty && isVerbose then
+        print! out "There were issues saving input-to-output mappings from the build:\n"
+        log.replay
+    | .error _ log =>
+      print! out "Failed to save input-to-output mappings from the build.\n"
+      if isVerbose then
+        log.replay
+  else
+    print! out "Workspace missing input-to-output mappings from build. (This is likely a bug in Lake.)\n"
+
+def reportResult (cfg : BuildConfig) (out : IO.FS.Stream) (result : MonitorResult) : BaseIO Unit := do
+  if result.failures.isEmpty then
+    if cfg.showProgress && cfg.showSuccess then
+      let numJobs := result.numJobs
+      let jobs := if numJobs == 1 then "1 job" else s!"{numJobs} jobs"
+      if cfg.noBuild then
+        print! out s!"All targets up-to-date ({jobs}).\n"
+      else
+        print! out s!"Build completed successfully ({jobs}).\n"
+  else
+    print! out "Some required targets logged failures:\n"
+    result.failures.forM (print! out s!"- {·}\n")
+    flush out
+
+structure BuildResult (α : Type u) extends MonitorResult where
+  out : Except String α
+
+instance : CoeOut (BuildResult α) MonitorResult := ⟨BuildResult.toMonitorResult⟩
+
+@[inline] def BuildResult.isOk (self : BuildResult α) : Bool :=
+  self.out.isOk
+
+def monitorJob (ctx : MonitorContext) (job : Job α) : BaseIO (BuildResult α) := do
+  let result ← monitorJobs' ctx #[job]
+  if result.isOk then
+    if let some a ← job.wait? then
+      return {toMonitorResult := result, out := .ok a}
+    else
+      -- Computation job failed but was unreported in the monitor. This should be impossible.
+      return {toMonitorResult := result, out := .error <|
+        "uncaught top-level build failure (this is likely a bug in Lake)"}
+  else
+    return {toMonitorResult := result, out := .error "build failed"}
+
+def monitorFetchM
+  (mctx : MonitorContext) (bctx : BuildContext) (build : FetchM α)
+  (caption := "job computation")
+: BaseIO (BuildResult α) := do
+  let compute := Job.async build (caption := caption)
+  let job ← compute.run.run'.run bctx |>.run nilTrace
+  monitorJob mctx job
+
+def Workspace.finalizeBuild
+  (ws : Workspace) (cfg : BuildConfig) (ctx : MonitorContext) (result : BuildResult α)
+: IO α := do
+  reportResult cfg ctx.out result
+  if let some outputsFile := cfg.outputsFile? then
+    ws.saveOutputs (logger := ctx.logger) ctx.out outputsFile (cfg.verbosity matches .verbose)
+  if cfg.noBuild && result.didBuild then
+    IO.Process.exit noBuildCode.toUInt8
+  else
+    IO.ofExcept result.out
+
+def mkBuildContext' (ws : Workspace) (cfg : BuildConfig) (jobs : JobQueue) : BuildContext where
+  opaqueWs := ws
+  toBuildConfig := cfg
+  registeredJobs := jobs
+  leanTrace := .ofHash (pureHash ws.lakeEnv.leanGithash)
+    s!"Lean {Lean.versionStringCore}, commit {ws.lakeEnv.leanGithash}"
+
 /--
 Run a build function in the Workspace's context using the provided configuration.
 Reports incremental build progress and build logs. In quiet mode, only reports
 failing build jobs (e.g., when using `-q` or non-verbose `--no-build`).
 -/
 public def Workspace.runFetchM
-  (ws : Workspace) (build : FetchM α) (cfg : BuildConfig := {})
+  (ws : Workspace) (build : FetchM α) (cfg : BuildConfig := {}) (caption := "job computation")
 : IO α := do
-  -- Configure
-  let out ← cfg.out.get
-  let useAnsi ← cfg.ansiMode.isEnabled out
-  let outLv := cfg.outLv
-  let failLv := cfg.failLv
-  let isVerbose := cfg.verbosity = .verbose
-  let showProgress := cfg.showProgress
-  let showSuccess := cfg.showSuccess
-  let ctx ← mkBuildContext ws cfg
-  -- Job Computation
-  let caption := "job computation"
-  let compute := Job.async build (caption := caption)
-  let job ← compute.run.run'.run ctx |>.run nilTrace
-  -- Job Monitor
-  let minAction := if isVerbose then .unknown else .fetch
-  let showOptional := isVerbose
-  let showTime := isVerbose || !useAnsi
-  let {failures, numJobs, didBuild} ← monitorJobs #[job] ctx.registeredJobs
-    out failLv outLv minAction showOptional useAnsi showProgress showTime
-  -- Save input-to-output mappings
-  if let some outputsFile := cfg.outputsFile? then
-    let logger := .stream out outLv useAnsi
-    unless ws.isRootArtifactCacheEnabled do
-      logger.logEntry <| .warning s!"{ws.root.prettyName}: \
-        the artifact cache is not enabled for this package, so the artifacts described \
-        by the mappings produced by `-o` will not necessarily be available in the cache."
-    if let some ref := ws.root.outputsRef? then
-      match (← (← ref.get).writeFile outputsFile {}) with
-      | .ok _ log =>
-        if !log.isEmpty && isVerbose then
-          print! out "There were issues saving input-to-output mappings from the build:\n"
-          log.replay (logger := logger)
-      | .error _ log =>
-        print! out "Failed to save input-to-output mappings from the build.\n"
-        if isVerbose then
-          log.replay (logger := logger)
+  let jobs ← mkJobQueue
+  let mctx ← mkMonitorContext cfg jobs
+  let bctx := mkBuildContext' ws cfg jobs
+  let result ← monitorFetchM mctx bctx build caption
+  ws.finalizeBuild cfg mctx result
+
+def monitorBuild
+  (mctx : MonitorContext) (bctx : BuildContext) (build : FetchM (Job α))
+  (caption := "job computation")
+: BaseIO (BuildResult α) := do
+  let result ← monitorFetchM mctx bctx build caption
+   match result.out with
+  | .ok job =>
+    if let some a ← job.wait? then
+      return {result with out := .ok a}
     else
-      print! out "Workspace missing input-to-output mappings from build. (This is likely a bug in Lake.)\n"
-  -- Report
-  let isNoBuild := cfg.noBuild
-  if failures.isEmpty then
-    let some a ← job.wait?
-      | print! out "Uncaught top-level build failure (this is likely a bug in Lake).\n"
-        error "build failed"
-    if showProgress && showSuccess then
-      let jobs := if numJobs == 1 then "1 job" else s!"{numJobs} jobs"
-      if isNoBuild then
-        print! out s!"All targets up-to-date ({jobs}).\n"
-      else
-        print! out s!"Build completed successfully ({jobs}).\n"
-    return a
-  else
-    print! out "Some required targets logged failures:\n"
-    failures.forM (print! out s!"- {·}\n")
-    flush out
-    if isNoBuild && didBuild then
-      IO.Process.exit noBuildCode.toUInt8
-    else
-      error "build failed"
+      -- Job failed but was unreported in the monitor. It was likely not properly registered.
+      return {result with out := .error <|
+        "uncaught top-level build failure (this is likely a bug in the build script)"}
+  | .error e =>
+    return {result with out := .error e}
+
+/--
+Returns whether a build is needed to validate `build`. Does not report on the attempted build.
+
+This is equivalent to checking whether `lake build --no-build` exits with code 0.
+-/
+@[inline] public def Workspace.checkNoBuild
+  (ws : Workspace) (build : FetchM (Job α))
+: BaseIO Bool := do
+  let jobs ← mkJobQueue
+  let cfg := {noBuild := true}
+  let mctx ← mkMonitorContext cfg jobs
+  let bctx := mkBuildContext' ws cfg jobs
+  let result ← monitorBuild mctx bctx build
+  return result.isOk && !result.didBuild
 
 /-- Run a build function in the Workspace's context and await the result. -/
 @[inline] public def Workspace.runBuild
   (ws : Workspace) (build : FetchM (Job α)) (cfg : BuildConfig := {})
 : IO α := do
-  let job ← ws.runFetchM build cfg
-  let some a ← job.wait? | error "build failed"
-  return a
+  let jobs ← mkJobQueue
+  let mctx ← mkMonitorContext cfg jobs
+  let bctx := mkBuildContext' ws cfg jobs
+  let result ← monitorBuild mctx bctx build
+  ws.finalizeBuild cfg mctx result
 
 /-- Produce a build job in the Lake monad's workspace and await the result. -/
 @[inline] public def runBuild
   (build : FetchM (Job α)) (cfg : BuildConfig := {})
-: LakeT IO α := do
-  (← getWorkspace).runBuild build cfg
+: LakeT IO α := do (← getWorkspace).runBuild build cfg

src/lake/Lake/CLI.lean

@@ -13,6 +13,7 @@ public import Lake.CLI.Help
 public import Lake.CLI.Init
 public import Lake.CLI.Main
 public import Lake.CLI.Serve
+public import Lake.CLI.Shake
 public import Lake.CLI.Translate
 public import Lake.CLI.Translate.Lean
 public import Lake.CLI.Translate.Toml

src/lake/Lake/CLI/Help.lean

@@ -30,6 +30,7 @@ COMMANDS:
   lint                  lint the package using the configured lint driver
   check-lint            check if there is a properly configured lint driver
   clean                 remove build outputs
+  shake                 minimize imports in source files
   env <cmd> <args>...   execute a command in Lake's environment
   lean <file>           elaborate a Lean file in Lake's context
   update                update dependencies and save them to the manifest
@@ -310,6 +311,44 @@ USAGE:
 If no package is specified, deletes the build directories of every package in
 the workspace. Otherwise, just deletes those of the specified packages."
 
+def helpShake :=
+"Minimize imports in Lean source files
+
+USAGE:
+  lake shake [OPTIONS] [<MODULE>...]
+
+Checks the current project for unused imports by analyzing generated `.olean`
+files to deduce required imports and ensuring that every import contributes
+some constant or other elaboration dependency.
+
+ARGUMENTS:
+  <MODULE>              A module path like `Mathlib`. All files transitively
+                        reachable from the provided module(s) will be checked.
+                        If not specified, uses the package's default targets.
+
+OPTIONS:
+  --force               Skip the `lake build --no-build` sanity check
+  --keep-implied        Preserve imports implied by other imports
+  --keep-prefix         Prefer parent module imports over specific submodules
+  --keep-public         Preserve all `public` imports for API stability
+  --add-public          Add new imports as `public` if they were in the
+                        original public closure
+  --explain             Show which constants require each import
+  --fix                 Apply suggested fixes directly to source files
+  --gh-style            Output in GitHub problem matcher format
+
+ANNOTATIONS:
+  Source files can contain special comments to control shake behavior:
+
+  * `module -- shake: keep-downstream`
+    Preserves this module in all downstream modules
+
+  * `module -- shake: keep-all`
+    Preserves all existing imports in this module
+
+  * `import X -- shake: keep`
+    Preserves this specific import"
+
 def helpCacheCli :=
 "Manage the Lake cache
 
@@ -557,6 +596,7 @@ public def help : (cmd : String) → String
 | "lint"                => helpLint
 | "check-lint"          => helpCheckLint
 | "clean"               => helpClean
+| "shake"               => helpShake
 | "script"              => helpScriptCli
 | "scripts"             => helpScriptList
 | "run"                 => helpScriptRun

src/lake/Lake/CLI/Main.lean

@@ -10,6 +10,7 @@ public import Init.System.IO
 public import Lake.Util.Exit
 public import Lake.Load.Config
 public import Lake.CLI.Error
+public import Lake.CLI.Shake
 import Lake.Version
 import Lake.Build.Run
 import Lake.Build.Targets
@@ -74,6 +75,7 @@ public structure LakeOptions where
   toolchain? : Option String := none
   rev? : Option String := none
   maxRevs : Nat := 100
+  shake : Shake.Args := {}
 
 def LakeOptions.outLv (opts : LakeOptions) : LogLevel :=
   opts.outLv?.getD opts.verbosity.minLogLv
@@ -299,6 +301,16 @@ def lakeLongOption : (opt : String) → CliM PUnit
 | "--"            => do
   let subArgs ← takeArgs
   modifyThe LakeOptions ({· with subArgs})
+-- Shake options
+| "--keep-implied" => modifyThe LakeOptions ({· with shake.keepImplied := true})
+| "--keep-prefix" => modifyThe LakeOptions ({· with shake.keepPrefix := true})
+| "--keep-public" => modifyThe LakeOptions ({· with shake.keepPublic := true})
+| "--add-public" => modifyThe LakeOptions ({· with shake.addPublic := true})
+| "--force" => modifyThe LakeOptions ({· with shake.force := true})
+| "--gh-style" => modifyThe LakeOptions ({· with shake.githubStyle := true})
+| "--explain" => modifyThe LakeOptions ({· with shake.explain := true})
+| "--trace" => modifyThe LakeOptions ({· with shake.trace := true})
+| "--fix" => modifyThe LakeOptions ({· with shake.fix := true})
 | opt             =>  throw <| CliError.unknownLongOption opt
 
 def lakeOption :=
@@ -358,7 +370,6 @@ def parseTemplateLangSpec (spec : String) : Except CliError (InitTemplate × Con
   | [tmp] => return (← parseTemplateSpec tmp, default)
   | _ => return default
 
-
 /-! ## Commands -/
 
 namespace lake
@@ -756,6 +767,31 @@ protected def clean : CliM PUnit := do
       | some pkg => pure pkg
     pkgs.forM (·.clean)
 
+/-- The `lake shake` command: minimize imports in Lean source files. -/
+protected def shake : CliM PUnit := do
+  processOptions lakeOption
+  let opts ← getThe LakeOptions
+  let config ← mkLoadConfig opts
+  let ws ← loadWorkspace config
+  -- Get remaining arguments as module names
+  let mods := (← takeArgs).toArray.map (·.toName)
+  -- Get default target modules from workspace if no modules specified
+  let mods := if mods.isEmpty then ws.defaultTargetRoots else mods
+  if h : 0 < mods.size then
+    let args := {opts.shake with mods}
+    unless args.force do
+      let specs ← parseTargetSpecs ws []
+      let upToDate ← ws.checkNoBuild (buildSpecs specs)
+      unless upToDate do
+        error "there are out of date oleans; run `lake build` or fetch them from a cache first"
+    -- Run shake with workspace search paths
+    Lean.searchPathRef.set ws.augmentedLeanPath
+    let exitCode ← Shake.run args h ws.augmentedLeanSrcPath
+    if exitCode != 0 then
+      exit exitCode
+  else
+    error "no modules specified and there are no applicable default targets"
+
 protected def script : CliM PUnit := do
   if let some cmd ← takeArg? then
     processLeadingOptions lakeOption -- between `lake script <cmd>` and args
@@ -910,6 +946,7 @@ def lakeCli : (cmd : String) → CliM PUnit
 | "lint"                => lake.lint
 | "check-lint"          => lake.checkLint
 | "clean"               => lake.clean
+| "shake"               => lake.shake
 | "script"              => lake.script
 | "scripts"             => lake.script.list
 | "run"                 => lake.script.run

src/lake/Lake/CLI/Shake.lean

@@ -5,12 +5,13 @@ Authors: Mario Carneiro, Sebastian Ullrich
 -/
 module
 
+prelude
+public import Init.Prelude
+public import Init.System.IO
+public import Lean.Util.Path
 import Lean.Environment
 import Lean.ExtraModUses
-
-import Lake.CLI.Main
 import Lean.Parser.Module
-import Lake.Load.Workspace
 
 /-! # Shake: A Lean import minimizer
 
@@ -20,84 +21,12 @@ ensuring that every import is used to contribute some constant or other elaborat
 recorded by `recordExtraModUse` and friends.
 -/
 
-/-- help string for the command line interface -/
-def help : String := "Lean project tree shaking tool
-Usage: lake exe shake [OPTIONS] <MODULE>..
-
-Arguments:
-  <MODULE>
-    A module path like `Mathlib`. All files transitively reachable from the
-    provided module(s) will be checked.
-
-Options:
-  --force
-    Skips the `lake build --no-build` sanity check
-
-  --keep-implied
-    Preserves existing imports that are implied by other imports and thus not technically needed
-    anymore
-
-  --keep-prefix
-    If an import `X` would be replaced in favor of a more specific import `X.Y...` it implies,
-    preserves the original import instead. More generally, prefers inserting `import X` even if it
-    was not part of the original imports as long as it was in the original transitive import closure
-    of the current module.
-
-  --keep-public
-    Preserves all `public` imports to avoid breaking changes for external downstream modules
-
-  --add-public
-    Adds new imports as `public` if they have been in the original public closure of that module.
-    In other words, public imports will not be removed from a module unless they are unused even
-    in the private scope, and those that are removed will be re-added as `public` in downstream
-    modules even if only needed in the private scope there. Unlike `--keep-public`, this may
-    introduce breaking changes but will still limit the number of inserted imports.
-
-  --explain
-    Gives constants explaining why each module is needed
-
-  --fix
-    Apply the suggested fixes directly. Make sure you have a clean checkout
-    before running this, so you can review the changes.
-
-  --gh-style
-    Outputs messages that can be parsed by `gh-problem-matcher-wrap`
-
-Annotations:
-  The following annotations can be added to Lean files in order to configure the behavior of
-  `shake`. Only the substring `shake: ` directly followed by a directive is checked for, so multiple
-  directives can be mixed in one line such as `-- shake: keep-downstream, shake: keep-all`, and they
-  can be surrounded by arbitrary comments such as `-- shake: keep (metaprogram output dependency)`.
-
-  * `module -- shake: keep-downstream`:
-    Preserves this module in all (current) downstream modules, adding new imports of it if needed.
-
-  * `module -- shake: keep-all`:
-    Preserves all existing imports in this module as is. New imports now needed because of upstream
-    changes may still be added.
-
-  * `import X -- shake: keep`:
-    Preserves this specific import in the current module. The most common use case is to preserve a
-    public import that will be needed in downstream modules to make sense of the output of a
-    metaprogram defined in this module. For example, if a tactic is defined that may synthesize a
-    reference to a theorem when run, there is no way for `shake` to detect this by itself and the
-    module of that theorem should be publicly imported and annotated with `keep` in the tactic's
-    module.
-    ```
-    public import X  -- shake: keep (metaprogram output dependency)
-
-    ...
-
-    elab \"my_tactic\" : tactic => do
-      ... mkConst ``f -- `f`, defined in `X`, may appear in the output of this tactic
-    ```
-"
-
 open Lean
 
-/-- The parsed CLI arguments. See `help` for more information -/
-structure Args where
-  help : Bool := false
+namespace Lake.Shake
+
+/-- The parsed CLI arguments for shake. -/
+public structure Args where
   keepImplied : Bool := false
   keepPrefix : Bool := false
   keepPublic : Bool := false
@@ -640,7 +569,7 @@ def visitModule (pkg : Name) (srcSearchPath : SearchPath)
         if toRemove.any fun imp => imp == decodeImport stx then
           let pos := inputCtx.fileMap.toPosition stx.raw.getPos?.get!
           println! "{path}:{pos.line}:{pos.column+1}: warning: unused import \
-            (use `lake exe shake --fix` to fix this, or `lake exe shake --update` to ignore)"
+            (use `lake shake --fix` to fix this, or `lake shake --update` to ignore)"
       if !toAdd.isEmpty then
         -- we put the insert message on the beginning of the last import line
         let pos := inputCtx.fileMap.toPosition endHeader.offset
@@ -685,76 +614,31 @@ def visitModule (pkg : Name) (srcSearchPath : SearchPath)
         run j
     for i in toAdd do run i
 
-/-- Convert a list of module names to a bitset of module indexes -/
-def toBitset (s : State) (ns : List Name) : Bitset :=
-  ns.foldl (init := ∅) fun c name =>
-    match s.env.getModuleIdxFor? name with
-    | some i => c ∪ {i}
-    | none => c
-
 local instance : Ord Import where
   compare :=
     let _ := @lexOrd
     compareOn fun imp => (!imp.isExported, imp.module.toString)
 
-/-- The main entry point. See `help` for more information on arguments. -/
-public def main (args : List String) : IO UInt32 := do
-  initSearchPath (← findSysroot)
-  -- Parse the arguments
-  let rec parseArgs (args : Args) : List String → Args
-    | [] => args
-    | "--help" :: rest => parseArgs { args with help := true } rest
-    | "--keep-implied" :: rest => parseArgs { args with keepImplied := true } rest
-    | "--keep-prefix" :: rest => parseArgs { args with keepPrefix := true } rest
-    | "--keep-public" :: rest => parseArgs { args with keepPublic := true } rest
-    | "--add-public" :: rest => parseArgs { args with addPublic := true } rest
-    | "--force" :: rest => parseArgs { args with force := true } rest
-    | "--fix" :: rest => parseArgs { args with fix := true } rest
-    | "--explain" :: rest => parseArgs { args with explain := true } rest
-    | "--trace" :: rest => parseArgs { args with trace := true } rest
-    | "--gh-style" :: rest => parseArgs { args with githubStyle := true } rest
-    | "--" :: rest => { args with mods := args.mods ++ rest.map (·.toName) }
-    | other :: rest => parseArgs { args with mods := args.mods.push other.toName } rest
-  let args := parseArgs {} args
+/--
+Run the shake analysis with the given arguments.
 
-  -- Bail if `--help` is passed
-  if args.help then
-    IO.println help
-    IO.Process.exit 0
+Assumes Lean's search path has already been properly configured.
+-/
+public def run (args : Args) (h : 0 < args.mods.size)
+    (srcSearchPath : SearchPath := {}) : IO UInt32 := do
 
-  if !args.force then
-    if (← IO.Process.output { cmd := "lake", args := #["build", "--no-build"] }).exitCode != 0 then
-      IO.println "There are out of date oleans. Run `lake build` or `lake exe cache get` first"
-      IO.Process.exit 1
-
-  -- Determine default module(s) to run shake on
-  let defaultTargetModules : Array Name ← try
-    let (elanInstall?, leanInstall?, lakeInstall?) ← Lake.findInstall?
-    let config ← Lake.MonadError.runEIO <| Lake.mkLoadConfig { elanInstall?, leanInstall?, lakeInstall? }
-    let some workspace ← Lake.loadWorkspace config |>.toBaseIO
-      | throw <| IO.userError "failed to load Lake workspace"
-    let defaultTargetModules := workspace.root.defaultTargets.flatMap fun target =>
-      if let some lib := workspace.root.findLeanLib? target then
-        lib.roots
-      else if let some exe := workspace.root.findLeanExe? target then
-        #[exe.config.root]
-      else
-        #[]
-    pure defaultTargetModules
-  catch _ =>
-    pure #[]
-
-  let srcSearchPath ← getSrcSearchPath
   -- the list of root modules
-  let mods := if args.mods.isEmpty then defaultTargetModules else args.mods
+  let mods := args.mods
   -- Only submodules of `pkg` will be edited or have info reported on them
-  let pkg := mods[0]!.components.head!
+  let pkg := mods[0].getRoot
 
   -- Load all the modules
   let imps := mods.map ({ module := · })
   let (_, s) ← importModulesCore imps (isExported := true) |>.run
   let s := s.markAllExported
   let mut env ← finalizeImport s (isModule := true) imps {} (leakEnv := false) (loadExts := false)
+  if env.header.moduleData.any (!·.isModule) then
+    throw <| .userError "`lake shake` only works with `module`s currently"
   -- the one env ext we want to initialize
   let is := indirectModUseExt.toEnvExtension.getState env
   let newState ← indirectModUseExt.addImportedFn is.importedEntries { env := env, opts := {} }

src/lake/Lake/Config/Env.lean

@@ -40,7 +40,7 @@ public structure Env where
   -/
   noCache : Bool
   /-- Whether the Lake artifact cache should be enabled by default (i.e., `LAKE_ARTIFACT_CACHE`). -/
-  enableArtifactCache : Bool
+  enableArtifactCache? : Option Bool
   /-- Whether the system cache has been disabled (`LAKE_CACHE_DIR` is set but empty). -/
   noSystemCache : Bool := false
   /--
@@ -158,7 +158,7 @@ public def compute
     pkgUrlMap := ← computePkgUrlMap
     reservoirApiUrl := ← getUrlD "RESERVOIR_API_URL" s!"{reservoirBaseUrl}/v1"
     noCache := (noCache <|> (← IO.getEnv "LAKE_NO_CACHE").bind envToBool?).getD false
-    enableArtifactCache := (← IO.getEnv "LAKE_ARTIFACT_CACHE").bind envToBool? |>.getD false
+    enableArtifactCache? := (← IO.getEnv "LAKE_ARTIFACT_CACHE").bind envToBool?
     cacheKey? := (← IO.getEnv "LAKE_CACHE_KEY").map (·.trimAscii.copy)
     cacheArtifactEndpoint? := (← IO.getEnv "LAKE_CACHE_ARTIFACT_ENDPOINT").map normalizeUrl
     cacheRevisionEndpoint? := (← IO.getEnv "LAKE_CACHE_REVISION_ENDPOINT").map normalizeUrl
@@ -269,7 +269,6 @@ public def baseVars (env : Env) : Array (String × Option String)  :=
     ("LAKE_HOME", env.lake.home.toString),
     ("LAKE_PKG_URL_MAP", toJson env.pkgUrlMap |>.compress),
     ("LAKE_NO_CACHE", toString env.noCache),
-    ("LAKE_ARTIFACT_CACHE", toString env.enableArtifactCache),
     ("LAKE_CACHE_KEY", env.cacheKey?),
     ("LAKE_CACHE_ARTIFACT_ENDPOINT", env.cacheArtifactEndpoint?),
     ("LAKE_CACHE_REVISION_ENDPOINT", env.cacheRevisionEndpoint?),
@@ -283,6 +282,7 @@ public def baseVars (env : Env) : Array (String × Option String)  :=
 public def vars (env : Env) : Array (String × Option String)  :=
   let vars := env.baseVars ++ #[
     ("LAKE_CACHE_DIR", if let some cache := env.lakeCache? then cache.dir.toString else ""),
+    ("LAKE_ARTIFACT_CACHE", if let some b := env.enableArtifactCache? then toString b else ""),
     ("LEAN_PATH", some env.leanPath.toString),
     ("LEAN_SRC_PATH", some env.leanSrcPath.toString),
     ("LEAN_GITHASH", env.leanGithash),

src/lake/Lake/Config/PackageConfig.lean

@@ -289,8 +289,10 @@ public configuration PackageConfig (p : Name) (n : Name) extends WorkspaceConfig
   in their usual location within the build directory. Thus, projects with custom build
   scripts that rely on specific location of artifacts may wish to disable this feature.
 
-  If `none` (the default), the cache will be disabled by default unless
-  the `LAKE_ARTIFACT_CACHE` environment variable is set to true.
+  If `none` (the default), this will fallback to (in order):
+  * The `LAKE_ARTIFACT_CACHE` environment variable (if set)
+  * The workspace root's `enableArtifactCache` configuration (if set and this package is a dependency)
+  * Lake's default: `false`
   -/
   enableArtifactCache?, enableArtifactCache : Option Bool := none
 

src/lake/Lake/Config/Workspace.lean

@@ -52,6 +52,16 @@ public instance : Nonempty Workspace :=
 
 public hydrate_opaque_type OpaqueWorkspace Workspace
 
+/-- Returns the names of the root modules of the package's default targets. -/
+public def Package.defaultTargetRoots (self : Package) : Array Lean.Name :=
+  self.defaultTargets.flatMap fun target =>
+    if let some lib := self.findLeanLib? target then
+      lib.roots
+    else if let some exe := self.findLeanExe? target then
+      #[exe.root.name]
+    else
+      #[]
+
 namespace Workspace
 
 /-- **For internal use.** Whether this workspace is Lean itself.  -/
@@ -75,12 +85,12 @@ namespace Workspace
   self.root.lakeDir
 
 /-- Whether the Lake artifact cache should be enabled by default for packages in the workspace. -/
-@[inline] public def enableArtifactCache (ws : Workspace) : Bool :=
-  ws.lakeEnv.enableArtifactCache
+public def enableArtifactCache (ws : Workspace) : Bool :=
+  ws.lakeEnv.enableArtifactCache? <|> ws.root.enableArtifactCache? |>.getD false
 
 /-- Whether the Lake artifact cache should is enabled for workspace's root package. -/
 public def isRootArtifactCacheEnabled (ws : Workspace) : Bool :=
-  ws.root.enableArtifactCache?.getD ws.enableArtifactCache
+  ws.root.enableArtifactCache? <|> ws.lakeEnv.enableArtifactCache? |>.getD false
 
 /-- The path to the workspace's remote packages directory relative to {lean}`dir`. -/
 @[inline] public def relPkgsDir (self : Workspace) : FilePath :=
@@ -102,6 +112,10 @@ public def isRootArtifactCacheEnabled (ws : Workspace) : Bool :=
 @[inline] public def serverOptions (self : Workspace) : LeanOptions :=
   self.root.moreServerOptions
 
+/-- Returns the names of the root modules of the workpace root's default targets. -/
+@[inline] public def defaultTargetRoots (self : Workspace) : Array Lean.Name :=
+  self.root.defaultTargetRoots
+
 /-- The workspace's Lake manifest. -/
 @[inline] public def manifestFile (self : Workspace) : FilePath :=
   self.root.manifestFile
@@ -286,6 +300,7 @@ to run executables.
 public def augmentedEnvVars (self : Workspace) : Array (String × Option String) :=
   let vars := self.lakeEnv.baseVars ++ #[
     ("LAKE_CACHE_DIR", some self.lakeCache.dir.toString),
+    ("LAKE_ARTIFACT_CACHE", toString self.enableArtifactCache),
     ("LEAN_PATH", some self.augmentedLeanPath.toString),
     ("LEAN_SRC_PATH", some self.augmentedLeanSrcPath.toString),
     -- Allow the Lean version to change dynamically within core

src/lake/schemas/lakefile-toml-schema.json

@@ -464,7 +464,7 @@
                 },
                 "enableArtifactCache": {
                     "type": "boolean",
-                    "description": "Whether to enables Lake's local, offline artifact cache for the package.\n\nArtifacts (i.e., build products) of packages will be shared across local copies by storing them in a cache associated with the Lean toolchain.\nThis can significantly reduce initial build times and disk space usage when working with multiple copies of large projects or large dependencies.\n\nAs a caveat, build targets which support the artifact cache will not be stored in their usual location within the build directory. Thus, projects with custom build scripts that rely on specific location of artifacts may wish to disable this feature.\n\nIf not set, the cache will be disabled by default unless the `LAKE_ARTIFACT_CACHE` environment variable is set to true."
+                    "description": "Whether to enables Lake's local, offline artifact cache for the package.\n\nArtifacts (i.e., build products) of packages will be shared across local copies by storing them in a cache associated with the Lean toolchain.\nThis can significantly reduce initial build times and disk space usage when working with multiple copies of large projects or large dependencies.\n\nAs a caveat, build targets which support the artifact cache will not be stored in their usual location within the build directory. Thus, projects with custom build scripts that rely on specific location of artifacts may wish to disable this feature.\n\nIf not set,   If `none` (the default), this will fallback to (in order):\n* The `LAKE_ARTIFACT_CACHE` environment variable (if set)\n* The workspace root's `enableArtifactCache` configuration (if set and this package is a dependency)\n* Lake's default: `false`"
                 },
                 "restoreAllArtifacts": {
                     "type": "boolean",