feat: use explicit allowlist instead of transparency bump in whnfMatcher

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

@@ -311,7 +311,7 @@ theorem drop_length_cons {l : List α} (h : l ≠ []) (a : α) :
   | nil =>
     cases h rfl
   | cons y l ih =>
-    simp only [drop]
+    simp only [length, drop_succ_cons]
     by_cases h₁ : l = []
     · simp [h₁]
     rw [getLast_cons h₁]

src/Init/Data/Range/Polymorphic/IntLemmas.lean

@@ -16,6 +16,9 @@ import Init.Data.Option.Lemmas
 import Init.Data.Range.Polymorphic.Lemmas
 import Init.Omega
 
+-- TODO: remove after stage0 update
+set_option linter.unusedSimpArgs false
+
 public section
 
 set_option doc.verso true
@@ -72,7 +75,7 @@ theorem size_toArray_rco {a b : Int} :
 @[simp]
 theorem size_roc {a b : Int} :
     (a<...=b).size = (b - a).toNat := by
-  simp only [Roc.size, Rxc.HasSize.size]
+  simp only [Roc.size, Rxc.HasSize.size, UpwardEnumerable.succ?]
   omega
 
 @[simp]
@@ -88,7 +91,7 @@ theorem size_toArray_roc {a b : Int} :
 @[simp]
 theorem size_roo {a b : Int} :
     (a<...b).size = (b - a - 1).toNat := by
-  simp only [Roo.size, Rxo.HasSize.size, Rxc.HasSize.size, Int.pred_toNat]
+  simp only [Roo.size, Rxo.HasSize.size, Rxc.HasSize.size, UpwardEnumerable.succ?, Int.pred_toNat]
   omega
 
 @[simp]

src/Init/Data/Range/Polymorphic/NatLemmas.lean

@@ -18,6 +18,9 @@ import Init.Data.Option.Lemmas
 import Init.Data.Range.Polymorphic.Lemmas
 import Init.Omega
 
+-- TODO: remove after stage0 update
+set_option linter.unusedSimpArgs false
+
 set_option doc.verso true
 
 public section
@@ -133,7 +136,7 @@ theorem size_toArray_roo {a b : Nat} :
 @[simp]
 theorem size_ric {b : Nat} :
     (*...=b).size = b + 1 := by
-  simp [Ric.size, Rxc.HasSize.size]
+  simp [Ric.size, Rxc.HasSize.size, Least?.least?]
 
 @[deprecated size_ric (since := "2025-10-30")]
 def _root_.Std.PRange.Nat.size_Ric := @_root_.Nat.size_ric
@@ -154,7 +157,7 @@ theorem size_toArray_ric {b : Nat} :
 @[simp]
 theorem size_rio {b : Nat} :
     (*...b).size = b := by
-  simp [Rio.size, Rxo.HasSize.size, Rxc.HasSize.size]
+  simp [Rio.size, Rxo.HasSize.size, Rxc.HasSize.size, Least?.least?]
 
 @[deprecated size_rio (since := "2025-10-30")]
 def _root_.Std.PRange.Nat.size_Rio := @_root_.Nat.size_rio
@@ -1852,7 +1855,7 @@ theorem induct_roc_right (motive : Nat → Nat → Prop)
 
 theorem toList_rio_eq_toList_rco {n : Nat} :
     (*...n).toList = (0...n).toList := by
-  simp [Rio.toList_eq_match_rco]
+  simp [Rio.toList_eq_match_rco, Least?.least?]
 
 @[simp]
 theorem toList_toArray_rio {n : Nat} :
@@ -2014,7 +2017,7 @@ theorem getD_toList_rio_eq_fallback {n i fallback : Nat} (h : n ≤ i) :
 
 theorem toArray_rio_eq_toArray_rco {n : Nat} :
     (*...n).toArray = (0...n).toArray := by
-  simp [Rio.toArray_eq_match_rco]
+  simp [Rio.toArray_eq_match_rco, Least?.least?]
 
 theorem toArray_rio_eq_if {n : Nat} :
     (*...n).toArray = if 0 < n then (*...(n - 1)).toArray.push (n - 1) else #[] := by
@@ -2166,7 +2169,8 @@ theorem getD_toArray_rio_eq_fallback {n i fallback : Nat} (h : n ≤ i) :
 
 theorem toList_ric_eq_toList_rio {n : Nat} :
     (*...=n).toList = (*...(n + 1)).toList := by
-  simp [Ric.toList_eq_match_rcc, toList_rio_succ_eq_append, toList_rio_eq_toList_rco]
+  simp [Ric.toList_eq_match_rcc, toList_rio_succ_eq_append, toList_rio_eq_toList_rco,
+    Least?.least?]
 
 theorem toList_ric_eq_toList_rcc {n : Nat} :
     (*...=n).toList = (0...=n).toList := by

src/Init/LawfulBEqTactics.lean

@@ -19,7 +19,7 @@ macro "deriving_ReflEq_tactic" : tactic => `(tactic|(
   intro x
   induction x
   all_goals
-    simp only [ BEq.refl, ↓reduceDIte, Bool.and_true, *, reduceBEq ,reduceCtorIdx]
+    simp only [BEq.refl, ↓reduceDIte, Bool.and_true, *, reduceBEq ,reduceCtorIdx]
 ))
 
 theorem and_true_curry {a b : Bool} {P : Prop}

src/Lean/Meta/GetUnfoldableConst.lean

@@ -13,7 +13,7 @@ namespace Lean.Meta
 Implements the `TransparencyMode` hierarchy for unfolding decisions.
 See `TransparencyMode` and `ReducibilityStatus` for the design rationale.
 -/
-private def canUnfoldDefault (cfg : Config) (info : ConstantInfo) : CoreM Bool := do
+def canUnfoldDefault (cfg : Config) (info : ConstantInfo) : CoreM Bool := do
   match cfg.transparency with
   | .none => return false
   | .all  => return true

src/Lean/Meta/WHNF.lean

@@ -496,47 +496,45 @@ Auxiliary predicate for `whnfMatcher`.
 See comment above.
 -/
 def canUnfoldAtMatcher (cfg : Config) (info : ConstantInfo) : CoreM Bool := do
-  match cfg.transparency with
-  | .all     => return true
-  | .default => return !(← isIrreducible info.name)
-  | _ =>
-    let status ← getReducibilityStatus info.name
-    if status matches .reducible | .implicitReducible then
-      return true
-    else if hasMatchPatternAttribute (← getEnv) info.name then
-      return true
-    else
-      return info.name == ``decEq
-       || info.name == ``Nat.decEq
-       || info.name == ``Char.ofNat   || info.name == ``Char.ofNatAux
-       || info.name == ``String.decEq || info.name == ``List.hasDecEq
-       || info.name == ``Fin.ofNat
-       || info.name == ``Fin.ofNat -- It is used to define `BitVec` literals
-       || info.name == ``UInt8.ofNat  || info.name == ``UInt8.decEq
-       || info.name == ``UInt16.ofNat || info.name == ``UInt16.decEq
-       || info.name == ``UInt32.ofNat || info.name == ``UInt32.decEq
-       || info.name == ``UInt64.ofNat || info.name == ``UInt64.decEq
-       /- Remark: we need to unfold the following two definitions because they are used for `Fin`, and
-          lazy unfolding at `isDefEq` does not unfold projections.  -/
-       || info.name == ``HMod.hMod || info.name == ``Mod.mod
+  if (← canUnfoldDefault cfg info) then
+    return true
+  /- Beyond what the normal transparency allows, we additionally unfold
+     certain definitions to expose constructors in match discriminants. -/
+  if hasMatchPatternAttribute (← getEnv) info.name then
+    return true
+  return info.name == ``OfNat.ofNat -- needed to reduce numeric literals in match discriminants
+   || info.name == ``NatCast.natCast -- needed for `↑m` in match discriminants (pervasive in Int proofs)
+   || info.name == ``Zero.zero || info.name == ``One.one -- needed for `0`/`1` in match discriminants
+   || info.name == ``decEq
+   || info.name == ``Nat.decEq
+   || info.name == ``Char.ofNat   || info.name == ``Char.ofNatAux
+   || info.name == ``String.decEq || info.name == ``List.hasDecEq
+   || info.name == ``Fin.ofNat -- needed for Fin literal reduction in match discriminants
+   || info.name == ``UInt8.ofNat  || info.name == ``UInt8.decEq
+   || info.name == ``UInt16.ofNat || info.name == ``UInt16.decEq
+   || info.name == ``UInt32.ofNat || info.name == ``UInt32.decEq
+   || info.name == ``UInt64.ofNat || info.name == ``UInt64.decEq
+   /- `Fin.ofNat` reduces to `⟨a % n, _⟩`, so we also need to unfold `%` (i.e., `HMod.hMod`
+      and `Mod.mod`) to expose the `Fin.mk` constructor in match discriminants. -/
+   || info.name == ``HMod.hMod || info.name == ``Mod.mod
 
 private def whnfMatcher (e : Expr) : MetaM Expr := do
-  /- When reducing `match` expressions, if the reducibility setting is at `TransparencyMode.reducible`,
-     we increase it to `TransparencyMode.instances`. We use the `TransparencyMode.reducible` in many places (e.g., `simp`),
-     and this setting prevents us from reducing `match` expressions where the discriminants are terms such as `OfNat.ofNat α n inst`.
-     For example, `simp [Int.div]` will not unfold the application `Int.div 2 1` occurring in the target.
-
-     TODO: consider other solutions; investigate whether the solution above produces counterintuitive behavior.  -/
+  /- When reducing `match` expressions at `.reducible` or `.instances` transparency,
+     we use a custom `canUnfoldAtMatcher` predicate that additionally allows unfolding
+     class projections (e.g., `OfNat.ofNat`, `NatCast.natCast`) and a few other specific
+     definitions. This ensures match discriminants like `OfNat.ofNat α n inst` can be
+     reduced to expose constructors, without bumping the overall transparency level.  -/
   if (← getTransparency) matches .instances | .reducible then
     -- Also unfold some default-reducible constants; see `canUnfoldAtMatcher`
-    withTransparency .instances <| withCanUnfoldPred canUnfoldAtMatcher do
+    withCanUnfoldPred canUnfoldAtMatcher do
       whnf e
   else
     -- Do NOT use `canUnfoldAtMatcher` here as it does not affect all/default reducibility and inhibits caching (#2564).
     -- In the future, we want to work on better reduction strategies that do not require caching.
     whnf e
 
 def reduceMatcher? (e : Expr) : MetaM ReduceMatcherResult := do
+  let e := e.consumeMData
   let .const declName declLevels := e.getAppFn
     | return .notMatcher
   let some info ← getMatcherInfo? declName
@@ -984,6 +982,7 @@ partial def whnfCoreUnfoldingAnnotations (e : Expr) : MetaM Expr :=
 
 /-- Try to reduce matcher/recursor/quot applications. We say they are all "morally" recursor applications. -/
 def reduceRecMatcher? (e : Expr) : MetaM (Option Expr) := do
+  let e := e.consumeMData
   if !e.isApp then
     return none
   else match (← reduceMatcher? e) with

src/Std/Data/Internal/List/Associative.lean

@@ -3873,7 +3873,7 @@ theorem getValue_insertList_of_contains_eq_false_left [BEq α] [EquivBEq α] {l
   suffices some (getValue k (insertList l toInsert) contains) = some (getValue k toInsert (contains_of_contains_insertList_of_contains_eq_false_left contains not_contains)) from by
     injection this
   simp only [← getValue?_eq_some_getValue]
-  simp only [ getValue?_eq_getEntry? ]
+  simp only [getValue?_eq_getEntry? ]
   congr 1
   exact getEntry?_insertList_of_contains_left_eq_false distinct_l (DistinctKeys_impl_Pairwise_distinct distinct_toInsert) not_contains
 
@@ -3885,7 +3885,7 @@ theorem getValue_insertList_of_contains_right [BEq α] [EquivBEq α] {l toInsert
   suffices some (getValue k (insertList l toInsert) h) = some (getValue k toInsert contains) from by
     injection this
   simp only [← getValue?_eq_some_getValue]
-  simp only [ getValue?_eq_getEntry? ]
+  simp only [getValue?_eq_getEntry? ]
   congr 1
   apply getEntry?_insertList_of_contains_eq_true
   . exact distinct_l

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

@@ -15,6 +15,9 @@ import Init.Data.Int.OfNat
 import Init.Data.Nat.Linear
 import Init.Data.Nat.Simproc
 
+-- TODO: remove after stage0 update
+set_option linter.unusedSimpArgs false
+
 @[expose] public section
 
 /-!
@@ -477,7 +480,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
     next idx_eq_j =>
       apply Or.inl
       constructor
-      · simp only [clearUnit, idx_eq_j, Array.getInternal_eq_getElem, ih1]
+      · simp only [Fin.getElem_fin, clearUnit, idx_eq_j, Array.getInternal_eq_getElem, ih1]
         rw [Array.getElem_modify_self, ih2, remove_add_cancel]
         exact ih3
       · intro k k_ge_idx_add_one
@@ -511,7 +514,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
         · simp only [Fin.getElem_fin]
           exact ih2
         · constructor
-          · simp only [clearUnit, idx_eq_j1, Array.getInternal_eq_getElem, ih1]
+          · simp only [Fin.getElem_fin, clearUnit, idx_eq_j1, Array.getInternal_eq_getElem, ih1]
             rw [Array.getElem_modify_self, ih3, ih4]
             decide
           · constructor
@@ -543,7 +546,7 @@ theorem clear_insert_inductive_case {n : Nat} (f : DefaultFormula n) (f_assignme
           · simp only [Fin.getElem_fin]
             exact ih1
           · constructor
-            · simp only [clearUnit, idx_eq_j2, Array.getInternal_eq_getElem, ih2]
+            · simp only [Fin.getElem_fin, clearUnit, idx_eq_j2, Array.getInternal_eq_getElem, ih2]
               rw [Array.getElem_modify_self, ih3, ih4]
               decide
             · constructor

tests/elab/mvcgenTutorial.lean

@@ -212,8 +212,8 @@ instance : Monad Result where
 instance : LawfulMonad Result :=
   LawfulMonad.mk' _
     (by dsimp only [Functor.map]; grind)
-    (by dsimp only [bind]; grind)
-    (by dsimp only [bind]; grind)
+    (by dsimp only [bind, pure]; grind)
+    (by dsimp only [bind, pure]; grind)
 
 instance Result.instWP : WP Result (.except Error .pure) where
   wp

tests/elab/unfold1.lean.out.expected

@@ -1,8 +1,17 @@
 case succ
 x : Nat
 ih : isEven (2 * x) = true
-⊢ isOdd (Nat.mul 2 x + 1) = true
+⊢ (match 2 * (x + 1) with
+    | 0 => true
+    | n.succ => isOdd n) =
+    true
 case succ
 x : Nat
 ih : isEven (2 * x) = true
-⊢ isEven (Nat.mul 2 x) = true
+⊢ (match 2 * (x + 1) with
+    | 0 => true
+    | n.succ =>
+      match n with
+      | 0 => false
+      | n.succ => isEven n) =
+    true