feat(goal): Unify fragments in replay

This commit is contained in:
Leni Aniva 2025-06-24 13:51:33 -07:00
parent 9b0d96f422
commit 7837ddff4f
Signed by: aniva
GPG Key ID: D5F96287843E8DFB
2 changed files with 18 additions and 1 deletions

View File

@ -218,6 +218,7 @@ protected def GoalState.replay (dst : GoalState) (src src' : GoalState) : CoreM
| .mvar { name } => .mvar ⟨mapId name⟩ | .mvar { name } => .mvar ⟨mapId name⟩
| l => l | l => l
let mapExpr (e : Expr) : CoreM Expr := Core.transform e λ let mapExpr (e : Expr) : CoreM Expr := Core.transform e λ
| .sort level => pure $ .done $ .sort (mapLevel level)
| .mvar { name } => pure $ .done $ .mvar ⟨mapId name⟩ | .mvar { name } => pure $ .done $ .mvar ⟨mapId name⟩
| _ => pure .continue | _ => pure .continue
let mapDelayedAssignment (d : DelayedMetavarAssignment) : CoreM DelayedMetavarAssignment := do let mapDelayedAssignment (d : DelayedMetavarAssignment) : CoreM DelayedMetavarAssignment := do
@ -335,9 +336,14 @@ protected def GoalState.replay (dst : GoalState) (src src' : GoalState) : CoreM
throwError "Conflicting assignment of expr metavariable (d != d) {mvarId.name}" throwError "Conflicting assignment of expr metavariable (d != d) {mvarId.name}"
Meta.saveState Meta.saveState
-- FIXME: Handle fragments
let goals :=dst.savedState.tactic.goals ++ let goals :=dst.savedState.tactic.goals ++
src'.savedState.tactic.goals.map (⟨mapId ·.name⟩) src'.savedState.tactic.goals.map (⟨mapId ·.name⟩)
let fragments ← src'.fragments.foldM (init := dst.fragments) λ acc mvarId' fragment' => do
let mvarId := ⟨mapId mvarId'.name⟩
let fragment ← fragment'.map mapExpr
if let .some _fragment0 := acc[mvarId]? then
throwError "Conflicting fragments on {mvarId.name}"
return acc.insert mvarId fragment
return { return {
dst with dst with
savedState := { savedState := {
@ -349,6 +355,7 @@ protected def GoalState.replay (dst : GoalState) (src src' : GoalState) : CoreM
meta := ← m.run', meta := ← m.run',
}, },
}, },
fragments,
} }
--- Tactic execution functions --- --- Tactic execution functions ---

View File

@ -19,6 +19,16 @@ inductive Fragment where
abbrev FragmentMap := Std.HashMap MVarId Fragment abbrev FragmentMap := Std.HashMap MVarId Fragment
def FragmentMap.empty : FragmentMap := Std.HashMap.emptyWithCapacity 2 def FragmentMap.empty : FragmentMap := Std.HashMap.emptyWithCapacity 2
protected def Fragment.map (fragment : Fragment) (mapExpr : Expr → CoreM Expr) : CoreM Fragment :=
let mapMVarId (mvarId : MVarId) : CoreM MVarId :=
return (← mapExpr (.mvar mvarId)) |>.mvarId!
match fragment with
| .calc prevRhs? => return .calc (← prevRhs?.mapM mapExpr)
| .conv rhs dormant => do
let rhs' ← mapMVarId rhs
let dormant' ← dormant.mapM mapMVarId
return .conv rhs' dormant'
protected def Fragment.enterCalc : Elab.Tactic.TacticM Fragment := do protected def Fragment.enterCalc : Elab.Tactic.TacticM Fragment := do
return .calc .none return .calc .none
protected def Fragment.enterConv : Elab.Tactic.TacticM Fragment := do protected def Fragment.enterConv : Elab.Tactic.TacticM Fragment := do