diff --git a/src/Init/Conv.lean b/src/Init/Conv.lean index c9dbfcaf13..42de4c38b7 100644 --- a/src/Init/Conv.lean +++ b/src/Init/Conv.lean @@ -30,6 +30,8 @@ syntax (name := pattern) "pattern " term : conv syntax (name := rewrite) "rewrite " rwRuleSeq : conv syntax (name := erewrite) "erewrite " rwRuleSeq : conv syntax (name := simp) "simp " ("(" &"config" " := " term ")")? (&"only ")? ("[" (simpStar <|> simpErase <|> simpLemma),* "]")? : conv +syntax (name := simpMatch) "simpMatch " : conv + /-- Execute the given tactic block without converting `conv` goal into a regular goal -/ syntax (name := nestedTacticCore) "tactic'" " => " tacticSeq : conv /-- Focus, convert the `conv` goal `⊢ lhs` into a regular goal `⊢ lhs = rhs`, and then execute the given tactic block. -/ diff --git a/src/Lean/Elab/Tactic/Conv/Simp.lean b/src/Lean/Elab/Tactic/Conv/Simp.lean index 2c8267c569..5797efd983 100644 --- a/src/Lean/Elab/Tactic/Conv/Simp.lean +++ b/src/Lean/Elab/Tactic/Conv/Simp.lean @@ -4,18 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Lean.Elab.Tactic.Simp +import Lean.Elab.Tactic.Split import Lean.Elab.Tactic.Conv.Basic namespace Lean.Elab.Tactic.Conv open Meta -@[builtinTactic Lean.Parser.Tactic.Conv.simp] def evalSimp : Tactic := fun stx => withMainContext do - let { ctx, .. } ← mkSimpContext stx (eraseLocal := false) - let lhs ← getLhs - let result ← simp lhs ctx +def applySimpResult (result : Simp.Result) : TacticM Unit := do if result.proof?.isNone then changeLhs result.expr else updateLhs result.expr (← result.getProof) +@[builtinTactic Lean.Parser.Tactic.Conv.simp] def evalSimp : Tactic := fun stx => withMainContext do + let { ctx, .. } ← mkSimpContext stx (eraseLocal := false) + applySimpResult (← simp (← getLhs) ctx) + +@[builtinTactic Lean.Parser.Tactic.Conv.simpMatch] def evalSimpMatch : Tactic := fun stx => withMainContext do + applySimpResult (← Split.simpMatch (← getLhs)) + end Lean.Elab.Tactic.Conv diff --git a/src/Lean/Meta/Tactic/Split.lean b/src/Lean/Meta/Tactic/Split.lean index a5e74fb56d..7e4b2efa67 100644 --- a/src/Lean/Meta/Tactic/Split.lean +++ b/src/Lean/Meta/Tactic/Split.lean @@ -21,26 +21,42 @@ private def getSimpMatchContext : MetaM Simp.Context := config.decide := false } -private def simpMatchPre (matchDeclName : Name) (matchEqDeclName : Name) (e : Expr) : SimpM Simp.Step := do - if e.isAppOf matchDeclName then +def simpMatch (e : Expr) : MetaM Simp.Result := do + Simp.main e (← getSimpMatchContext) (methods := { pre }) +where + pre (e : Expr) : SimpM Simp.Step := do + let some app ← matchMatcherApp? e | return Simp.Step.visit { expr := e } -- First try to reduce matcher match (← reduceRecMatcher? e) with | some e' => return Simp.Step.done { expr := e' } | none => - -- Try lemma - match (← Simp.tryLemma? e { proof := mkConst matchEqDeclName, name? := matchEqDeclName } SplitIf.discharge?) with - | none => return Simp.Step.visit { expr := e } - | some r => return Simp.Step.done r - else - return Simp.Step.visit { expr := e } + for matchEq in (← Match.getEquationsFor app.matcherName).eqnNames do + -- Try lemma + match (← Simp.tryLemma? e { proof := mkConst matchEq, name? := some matchEq } SplitIf.discharge?) with + | none => pure () + | some r => return Simp.Step.done r + return Simp.Step.visit { expr := e } -private def simpMatch (matchDeclName : Name) (matchEqDeclName : Name) (e : Expr) : MetaM Simp.Result := do - Simp.main e (← getSimpMatchContext) (methods := { pre := simpMatchPre matchDeclName matchEqDeclName }) +private def simpMatchCore (matchDeclName : Name) (matchEqDeclName : Name) (e : Expr) : MetaM Simp.Result := do + Simp.main e (← getSimpMatchContext) (methods := { pre }) +where + pre (e : Expr) : SimpM Simp.Step := do + if e.isAppOf matchDeclName then + -- First try to reduce matcher + match (← reduceRecMatcher? e) with + | some e' => return Simp.Step.done { expr := e' } + | none => + -- Try lemma + match (← Simp.tryLemma? e { proof := mkConst matchEqDeclName, name? := matchEqDeclName } SplitIf.discharge?) with + | none => return Simp.Step.visit { expr := e } + | some r => return Simp.Step.done r + else + return Simp.Step.visit { expr := e } -private def simpMatchTarget (mvarId : MVarId) (matchDeclName : Name) (matchEqDeclName : Name) : MetaM MVarId := do +private def simpMatchTargetCore (mvarId : MVarId) (matchDeclName : Name) (matchEqDeclName : Name) : MetaM MVarId := do withMVarContext mvarId do let target ← instantiateMVars (← getMVarType mvarId) - let r ← simpMatch matchDeclName matchEqDeclName target + let r ← simpMatchCore matchDeclName matchEqDeclName target match r.proof? with | some proof => replaceTargetEq mvarId r.expr proof | none => replaceTargetDefEq mvarId r.expr @@ -78,7 +94,7 @@ def splitMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := do let (_, mvarId) ← introN mvarId numParams let (_, mvarId) ← introNP mvarId numExtra trace[Meta.debug] "before simpMatch:\n{MessageData.ofGoal mvarId}" - let mvarId ← simpMatchTarget mvarId app.matcherName matchEqns.eqnNames[i] + let mvarId ← simpMatchTargetCore mvarId app.matcherName matchEqns.eqnNames[i] return (i+1, mvarId::mvarIds) return mvarIds.reverse