e01cbf2b8f
This PR adds a `result? : Option TraceResult` field to `TraceData` and populates it in `withTraceNode` and `withTraceNodeBefore`, so that metaprograms walking trace trees can determine success/failure structurally instead of string-matching on emoji. `TraceResult` has three cases: `.success` (checkEmoji), `.failure` (crossEmoji), and `.error` (bombEmoji, exception thrown). An `ExceptToTraceResult` typeclass converts `Except` results to `TraceResult` directly, with instances for `Bool` and `Option`. `TraceResult.toEmoji` converts back to emoji for display. This replaces the previous `ExceptToEmoji` typeclass — `TraceResult` is now the primary representation rather than being derived from emoji strings. `withTraceNodeBefore` (used by `isDefEq`) uses `ExceptToTraceResult.toTraceResult` directly, correctly handling `Bool` (`.ok false` = failure) and `Option` (`.ok none` = failure), with `Except.error` mapping to `.error`. For `withTraceNode`, `result?` defaults to `none`. Callers can pass `mkResult?` to provide structured results; when set, the corresponding emoji is auto-prepended to the message. Motivated by mathlib's `#defeq_abuse` diagnostic tactic (https://github.com/leanprover-community/mathlib4/pull/35750) which currently string-matches on emoji to determine trace node outcomes. See https://leanprover.zulipchat.com/#narrow/channel/113488-general/topic/backward.2EisDefEq.2ErespectTransparency 🤖 Prepared with Claude Code --------- Co-authored-by: Claude Opus 4.6 <noreply@anthropic.com>
80 lines
3.9 KiB
Text
80 lines
3.9 KiB
Text
/-
|
|
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Authors: Joachim Breitner
|
|
-/
|
|
|
|
module
|
|
prelude
|
|
public import Lean.Meta.Basic
|
|
import Lean.Meta.Tactic.Rewrite
|
|
import Lean.Meta.Constructions.SparseCasesOn
|
|
import Lean.Meta.Constructions.SparseCasesOnEq
|
|
import Lean.Meta.HasNotBit
|
|
import Lean.Meta.Tactic.Cases
|
|
import Lean.Meta.Tactic.Replace
|
|
|
|
namespace Lean.Meta
|
|
|
|
private def rewriteGoalUsingEq (goal : MVarId) (eq : Expr) (symm : Bool := false) : MetaM MVarId := do
|
|
let rewriteResult ← goal.rewrite (←goal.getType) eq symm
|
|
goal.replaceTargetEq rewriteResult.eNew rewriteResult.eqProof
|
|
|
|
/--
|
|
Reduces a sparse casesOn applied to a concrete constructor.
|
|
-/
|
|
public def reduceSparseCasesOn (mvarId : MVarId) : MetaM (Array MVarId) := do
|
|
let some (_, lhs) ← matchEqHEqLHS? (← mvarId.getType) | throwError "Target not an equality"
|
|
lhs.withApp fun f xs => do
|
|
let .const matchDeclName _ := f | throwError "Not a const application"
|
|
let some sparseCasesOnInfo ← getSparseCasesOnInfo matchDeclName | throwError "Not a sparse casesOn application"
|
|
withTraceNode `Meta.Match.matchEqs (msg := (fun _ => return m!"splitSparseCasesOn")) do
|
|
if xs.size < sparseCasesOnInfo.arity then
|
|
throwError "Not enough arguments for sparse casesOn application"
|
|
let majorIdx := sparseCasesOnInfo.majorPos
|
|
let major := xs[majorIdx]!
|
|
let some ctorInfo ← isConstructorApp'? major
|
|
| throwError "Major premise is not a constructor application:{indentExpr major}"
|
|
if sparseCasesOnInfo.insterestingCtors.contains ctorInfo.name then
|
|
let mvarId' ← mvarId.modifyTargetEqLHS fun lhs =>
|
|
unfoldDefinition lhs
|
|
return #[mvarId']
|
|
else
|
|
let sparseCasesOnEqName ← getSparseCasesOnEq matchDeclName
|
|
let eqProof := mkConst sparseCasesOnEqName lhs.getAppFn.constLevels!
|
|
let eqProof := mkAppN eqProof lhs.getAppArgs[:sparseCasesOnInfo.arity]
|
|
let eqProof := mkApp eqProof (← mkHasNotBitProof (mkRawNatLit ctorInfo.cidx) (← sparseCasesOnInfo.insterestingCtors.mapM (fun n => return (← getConstInfoCtor n).cidx)))
|
|
let mvarId' ← rewriteGoalUsingEq mvarId eqProof
|
|
return #[mvarId']
|
|
|
|
public def splitSparseCasesOn (mvarId : MVarId) : MetaM (Array MVarId) := do
|
|
let some (_, lhs) ← matchEqHEqLHS? (← mvarId.getType) | throwError "Target not an equality"
|
|
lhs.withApp fun f xs => do
|
|
let .const matchDeclName _ := f | throwError "Not a const application"
|
|
let some sparseCasesOnInfo ← getSparseCasesOnInfo matchDeclName | throwError "Not a sparse casesOn application"
|
|
withTraceNode `Meta.Match.matchEqs (msg := (fun _ => return m!"splitSparseCasesOn")) do
|
|
try
|
|
trace[Meta.Match.matchEqs] "splitSparseCasesOn running on\n{mvarId}"
|
|
if xs.size < sparseCasesOnInfo.arity then
|
|
throwError "Not enough arguments for sparse casesOn application"
|
|
let majorIdx := sparseCasesOnInfo.majorPos
|
|
unless xs[majorIdx]!.isFVar do
|
|
throwError "Major premise is not a free variable:{indentExpr xs[majorIdx]!}"
|
|
let fvarId := xs[majorIdx]!.fvarId!
|
|
let subgoals ← mvarId.cases fvarId (interestingCtors? := sparseCasesOnInfo.insterestingCtors)
|
|
subgoals.mapM fun s => s.mvarId.withContext do
|
|
if s.ctorName.isNone then
|
|
unless s.fields.size = 1 do
|
|
throwError "Unexpected number of fields for catch-all branch: {s.fields}"
|
|
let sparseCasesOnEqName ← getSparseCasesOnEq matchDeclName
|
|
let some (_, lhs) ← matchEqHEqLHS? (← s.mvarId.getType) | throwError "Target not an equality"
|
|
let eqProof := mkConst sparseCasesOnEqName lhs.getAppFn.constLevels!
|
|
let eqProof := mkAppN eqProof lhs.getAppArgs[:sparseCasesOnInfo.arity]
|
|
let eqProof := mkApp eqProof s.fields[0]!
|
|
rewriteGoalUsingEq s.mvarId eqProof
|
|
else
|
|
s.mvarId.modifyTargetEqLHS fun lhs =>
|
|
unfoldDefinition lhs
|
|
catch e =>
|
|
trace[Meta.Match.matchEqs] "splitSparseCasesOn failed{indentD e.toMessageData}"
|
|
throw e
|