feat: do not dsimp instances (#12195)

This PR ensures `dsimp` does not "simplify" instances by default. The
old behavior can be retrieved by using
```
set_option backward.dsimp.instances true
```
Applying `dsimp` to instances creates non-standard instances, and this
creates all sorts of problems in Mathlib.
This modification is similar to
```
set_option backward.dsimp.proofs true
```

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
Co-authored-by: Claude <noreply@anthropic.com>

src/Init/Control/Lawful/Instances.lean

@@ -469,13 +469,13 @@ namespace EStateM
 
 instance : LawfulMonad (EStateM ε σ) := .mk'
   (id_map := fun x => funext <| fun s => by
-    dsimp only [EStateM.instMonad, EStateM.map]
+    simp only [Functor.map, EStateM.map]
     match x s with
     | .ok _ _ => rfl
     | .error _ _ => rfl)
   (pure_bind := fun _ _ => by rfl)
   (bind_assoc := fun x _ _ => funext <| fun s => by
-    dsimp only [EStateM.instMonad, EStateM.bind]
+    simp only [bind, EStateM.bind]
     match x s with
     | .ok _ _ => rfl
     | .error _ _ => rfl)

src/Init/Data/List/Lex.lean

@@ -85,7 +85,7 @@ theorem cons_lex_cons_iff : Lex r (a :: l₁) (b :: l₂) ↔ r a b ∨ a = b
 
 theorem cons_lt_cons_iff [LT α] {a b} {l₁ l₂ : List α} :
     (a :: l₁) < (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ < l₂ := by
-  dsimp only [instLT, List.lt]
+  simp only [LT.lt, List.lt]
   simp [cons_lex_cons_iff]
 
 @[simp] theorem cons_lt_cons_self [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] {l₁ l₂ : List α} :
@@ -101,7 +101,7 @@ theorem cons_le_cons_iff [LT α]
     [i₂ : Std.Trichotomous (· < · : α → α → Prop)]
     {a b} {l₁ l₂ : List α} :
     (a :: l₁) ≤ (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ ≤ l₂ := by
-  dsimp only [instLE, instLT, List.le, List.lt]
+  simp only [LE.le, LT.lt, List.le, List.lt]
   open Classical in
   simp only [not_cons_lex_cons_iff, ne_eq]
   constructor

src/Init/MetaTypes.lean

@@ -137,6 +137,11 @@ structure Config where
   For local theorems, use `+suggestions` instead.
   -/
   locals : Bool := false
+  /--
+  If `instances` is `true`, `dsimp` will visit instance arguments.
+  If option `backward.dsimp.instances` is `true`, it overrides this field.
+  -/
+  instances : Bool := false
   deriving Inhabited, BEq
 
 end DSimp
@@ -308,6 +313,11 @@ structure Config where
   For local theorems, use `+suggestions` instead.
   -/
   locals : Bool := false
+  /--
+  If `instances` is `true`, `dsimp` will visit instance arguments.
+  If option `backward.dsimp.instances` is `true`, it overrides this field.
+  -/
+  instances : Bool := false
   deriving Inhabited, BEq
 
 -- Configuration object for `simp_all`

src/Lean/Elab/Tactic/Simp.lean

@@ -87,10 +87,14 @@ private def mkDischargeWrapper (optDischargeSyntax : Syntax) : TacticM Simp.Disc
   `optConfig` is of the form `("(" "config" ":=" term ")")?`
 -/
 def elabSimpConfig (optConfig : Syntax) (kind : SimpKind) : TacticM Meta.Simp.Config := do
-  match kind with
-  | .simp    => elabSimpConfigCore optConfig
-  | .simpAll => return (← elabSimpConfigCtxCore optConfig).toConfig
-  | .dsimp   => return { (← elabDSimpConfigCore optConfig) with }
+  let cfg ← match kind with
+    | .simp    => elabSimpConfigCore optConfig
+    | .simpAll => pure (← elabSimpConfigCtxCore optConfig).toConfig
+    | .dsimp   => pure { (← elabDSimpConfigCore optConfig) with }
+  if Simp.backward.dsimp.instances.get (← getOptions) then
+    return { cfg with instances := true }
+  else
+    return cfg
 
 inductive ResolveSimpIdResult where
   | none

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

@@ -23,6 +23,11 @@ register_builtin_option backward.dsimp.proofs : Bool := {
     descr    := "Let `dsimp` simplify proof terms"
   }
 
+register_builtin_option backward.dsimp.instances : Bool := {
+    defValue := false
+    descr    := "Let `dsimp` simplify instance terms"
+  }
+
 register_builtin_option debug.simp.check.have : Bool := {
     defValue := false
     descr    := "(simp) enable consistency checks for `have` telescope simplification"
@@ -497,7 +502,11 @@ private partial def dsimpImpl (e : Expr) : SimpM Expr := do
   let pre := m.dpre >> doNotVisitOfNat >> doNotVisitOfScientific >> doNotVisitCharLit >> doNotVisitProofs
   let post := m.dpost >> dsimpReduce
   withInDSimpWithCache fun cache => do
-    transformWithCache e cache (usedLetOnly := cfg.zeta || cfg.zetaUnused) (pre := pre) (post := post)
+    transformWithCache e cache
+      (usedLetOnly := cfg.zeta || cfg.zetaUnused)
+      (skipInstances := !cfg.instances)
+      (pre := pre)
+      (post := post)
 
 def visitFn (e : Expr) : SimpM Result := do
   let f := e.getAppFn

src/Lean/Meta/Transform.lean

@@ -4,12 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 module
-
 prelude
 public import Lean.Meta.Basic
-
+public import Lean.Meta.FunInfo
 public section
-
 namespace Lean
 
 inductive TransformStep where
@@ -30,16 +28,18 @@ inductive TransformStep where
 namespace Core
 
 /--
-  Transform the expression `input` using `pre` and `post`.
-  - First `pre` is invoked with the current expression and recursion is continued according to the `TransformStep` result.
-    In all cases, the expression contained in the result, if any, must be definitionally equal to the current expression.
-  - After recursion, if any, `post` is invoked on the resulting expression.
+Recursively transforms `input` using `pre` and `post` callbacks.
 
-  The term `s` in both `pre s` and `post s` may contain loose bound variables. So, this method is not appropriate for
-  if one needs to apply operations (e.g., `whnf`, `inferType`) that do not handle loose bound variables.
-  Consider using `Meta.transform` to avoid loose bound variables.
+For each subexpression:
+1. `pre` is invoked first; recursion continues according to the `TransformStep` result.
+2. After recursion (if any), `post` is invoked on the resulting expression.
 
-  This method is useful for applying transformations such as beta-reduction and delta-reduction.
+The expressions passed to `pre` and `post` may contain loose bound variables.
+Use `Meta.transform` instead if you need operations like `whnf` or `inferType`
+that require expressions without loose bound variables.
+
+Results are cached using pointer equality (`ExprStructEq`), so structurally
+identical subexpressions are transformed only once.
 -/
 partial def transform {m} [Monad m] [MonadLiftT CoreM m] [MonadControlT CoreM m]
     (input : Expr)
@@ -70,6 +70,7 @@ partial def transform {m} [Monad m] [MonadLiftT CoreM m] [MonadControlT CoreM m]
         | _                => visitPost e
   visit input |>.run
 
+/-- Applies beta reduction to all beta-reducible subexpressions in `e`. -/
 def betaReduce (e : Expr) : CoreM Expr :=
   transform e (pre := fun e => return if e.isHeadBetaTarget then .visit e.headBeta else .continue)
 
@@ -78,12 +79,19 @@ end Core
 namespace Meta
 
 /--
-Similar to `Meta.transform`, but allows the use of a pre-existing cache.
+Like `Meta.transform`, but accepts and returns a cache for reuse across multiple calls.
 
-Warnings:
-- For the cache to be valid, it must always use the same `pre` and `post` functions.
-- It is important that there are no other references to `cache` when it is passed to
-  `transformWithCache`, to avoid unnecessary copying of the hash map.
+Parameters:
+- `usedLetOnly`: when true, `mkLambdaFVars`/`mkForallFVars`/`mkLetFVars` only abstract
+  over variables that are actually used in the body.
+- `skipConstInApp`: when true, constant heads in applications are not visited separately.
+- `skipInstances`: when true, instance arguments (determined via `getFunInfo`) are not visited.
+
+The `skipInstances` flag is used by `dsimp` to avoid rewriting instances.
+
+**Warnings:**
+- The cache is only valid when using the same `pre` and `post` functions.
+- Ensure there are no other references to `cache` to avoid unnecessary hash map copying.
 -/
 @[inline]
 partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m]
@@ -93,6 +101,7 @@ partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT
     (post  : Expr → m TransformStep := fun e => return .done e)
     (usedLetOnly := false)
     (skipConstInApp := false)
+    (skipInstances := false)
     : m (Expr × Std.HashMap ExprStructEq Expr) :=
   let _ : STWorld IO.RealWorld m := ⟨⟩
   let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := MetaM) (liftM (m := ST IO.RealWorld) x) }
@@ -123,10 +132,22 @@ partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT
         | e => visitPost (← mkLetFVars (usedLetOnly := usedLetOnly) (generalizeNondepLet := false) fvars (← visit (e.instantiateRev fvars)))
       let visitApp (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
         e.withApp fun f args => do
-          if skipConstInApp && f.isConst then
-            visitPost (mkAppN f (← args.mapM visit))
-          else
-            visitPost (mkAppN (← visit f) (← args.mapM visit))
+        let f ← if skipConstInApp && f.isConst then pure f else visit f
+        if skipInstances then
+          let infos := (← getFunInfoNArgs f args.size).paramInfo
+          let mut args := args.toVector
+          for h : i in *...args.size do
+            let arg := args[i]
+            if h : i < infos.size then
+              let info := infos[i]
+              if skipInstances && info.isInstance then
+                continue
+              args := args.set i (← visit arg)
+            else
+              args := args.set i (← visit arg)
+          visitPost (mkAppN f args.toArray)
+        else
+          visitPost (mkAppN f (← args.mapM visit))
       match (← pre e) with
       | .done e  => pure e
       | .visit e => visit e
@@ -163,6 +184,10 @@ def transform {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m]
   let (e, _) ← transformWithCache input {} pre post usedLetOnly skipConstInApp
   return e
 
+/--
+Replaces all free variables in `e` that have let-values with their values.
+The substitution is applied recursively to the values themselves.
+-/
 -- TODO: add options to distinguish zeta and zetaDelta reduction
 def zetaReduce (e : Expr) : MetaM Expr := do
   let pre (e : Expr) : MetaM TransformStep := do
@@ -173,7 +198,8 @@ def zetaReduce (e : Expr) : MetaM Expr := do
   transform e (pre := pre) (usedLetOnly := true)
 
 /--
-Zeta reduces only the provided fvars, beta reducing the substitutions.
+Zeta-reduces only the specified free variables, applying beta reduction after substitution.
+For example, if `x` has value `fun y => y + 1` and appears as `x 2`, the result is `2 + 1`.
 -/
 def zetaDeltaFVars (e : Expr) (fvars : Array FVarId) : MetaM Expr :=
   let unfold? (fvarId : FVarId) : MetaM (Option Expr) := do
@@ -207,10 +233,10 @@ def unfoldDeclsFrom (biggerEnv : Environment) (e : Expr) : CoreM Expr := do
     Core.transform e (pre := pre)
 
 /--
-Unfolds theorems that are applied to a `f x₁ .. xₙ` where `f` is in the given array, and
-`n ≤ SectionVars`, i.e. an unsaturated application of `f`.
+Unfolds theorems that are applied to `f x₁ .. xₙ` where `f` is in `fnNames` and
+`n ≤ numSectionVars` (i.e., an unsaturated application of `f`).
 
-This is used tounfoldIfArgIsAppOf undo proof abstraction for termination checking, as otherwise the bare
+This is used to undo proof abstraction for termination checking, as otherwise the bare
 occurrence of the recursive function prevents termination checking from succeeding.
 
 Usually, the argument is just `f` (the constant), arising from `mkAuxTheorem` abstracting over the
@@ -249,9 +275,11 @@ def unfoldIfArgIsAppOf (fnNames : Array Name) (numSectionVars : Nat) (e : Expr)
       af.isConst && fnNames.any fun f => af.constName! == f && axs.size ≤ numSectionVars
 
 
+/-- Removes all `inaccessible` annotations from `e`. -/
 def eraseInaccessibleAnnotations (e : Expr) : CoreM Expr :=
   Core.transform e (post := fun e => return .done <| if let some e := inaccessible? e then e else e)
 
+/-- Removes all `patternWithRef` annotations from `e`. -/
 def erasePatternRefAnnotations (e : Expr) : CoreM Expr :=
   Core.transform e (post := fun e => return .done <| if let some (_, e) := patternWithRef? e then e else e)
 

tests/lean/run/doLogicTests.lean

@@ -147,7 +147,7 @@ theorem throwing_loop_spec :
   ⦃post⟨fun _ _ => ⌜False⌝,
         fun e s => ⌜e = 42 ∧ s = 4⌝⟩⦄ := by
   mintro hs
-  dsimp only [throwing_loop, get, getThe, instMonadStateOfOfMonadLift, liftM, monadLift]
+  dsimp +instances only [throwing_loop, get, getThe, instMonadStateOfOfMonadLift, liftM, monadLift]
   mspec
   mspec
   mspec

tests/lean/run/dsimp_instances.lean

@@ -0,0 +1,33 @@
+set_option warn.sorry false
+
+def f [Add α] (a : α) := a + a
+abbrev id' (a : α) := a
+abbrev addNat : Add Nat := ⟨Nat.add⟩
+
+set_option pp.explicit true
+
+/--
+trace: a b : Nat
+⊢ @Eq Nat (@f Nat (@id' (Add Nat) addNat) a) b
+---
+trace: a b : Nat
+⊢ @Eq Nat (@f Nat addNat a) b
+-/
+#guard_msgs in
+example : @f _ (id' addNat) a = id b := by
+  dsimp [id']
+  trace_state -- `id'` was not unfolded because it is part of an instance
+  dsimp +instances [id']
+  trace_state
+  sorry
+
+/--
+trace: a b : Nat
+⊢ @Eq Nat (@f Nat addNat a) b
+-/
+#guard_msgs in
+set_option backward.dsimp.instances true in
+example : @f _ (id' addNat) a = id b := by
+  dsimp [id']
+  trace_state
+  sorry

tests/lean/run/linearCategory_perf_issue.lean

@@ -362,12 +362,10 @@ instance functorCategoryPreadditive : Preadditive (C ⥤ D) where
         apply neg_add_cancel }
   add_comp := by
     intros
-    dsimp only [id_eq]
     ext
     apply add_comp
   comp_add := by
     intros
-    dsimp only [id_eq]
     ext
     apply comp_add