diff --git a/src/Init/Control/Lawful/Instances.lean b/src/Init/Control/Lawful/Instances.lean index 87afa267f6..10dffbc238 100644 --- a/src/Init/Control/Lawful/Instances.lean +++ b/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) diff --git a/src/Init/Data/List/Lex.lean b/src/Init/Data/List/Lex.lean index 7f573af902..60d4c1beb9 100644 --- a/src/Init/Data/List/Lex.lean +++ b/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 diff --git a/src/Init/MetaTypes.lean b/src/Init/MetaTypes.lean index fcbf622800..ae918af19e 100644 --- a/src/Init/MetaTypes.lean +++ b/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` diff --git a/src/Lean/Elab/Tactic/Simp.lean b/src/Lean/Elab/Tactic/Simp.lean index 1fce8aa67f..d07c490fd5 100644 --- a/src/Lean/Elab/Tactic/Simp.lean +++ b/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 diff --git a/src/Lean/Meta/Tactic/Simp/Main.lean b/src/Lean/Meta/Tactic/Simp/Main.lean index ea93f831b6..b6fb9d045d 100644 --- a/src/Lean/Meta/Tactic/Simp/Main.lean +++ b/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 diff --git a/src/Lean/Meta/Transform.lean b/src/Lean/Meta/Transform.lean index 34488a57b3..13cb5d33a9 100644 --- a/src/Lean/Meta/Transform.lean +++ b/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) diff --git a/tests/lean/run/doLogicTests.lean b/tests/lean/run/doLogicTests.lean index cee467b741..28151fd023 100644 --- a/tests/lean/run/doLogicTests.lean +++ b/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 diff --git a/tests/lean/run/dsimp_instances.lean b/tests/lean/run/dsimp_instances.lean new file mode 100644 index 0000000000..22f8e712db --- /dev/null +++ b/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 diff --git a/tests/lean/run/linearCategory_perf_issue.lean b/tests/lean/run/linearCategory_perf_issue.lean index 94ac28b175..da52a67009 100644 --- a/tests/lean/run/linearCategory_perf_issue.lean +++ b/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