feat: Prograde tactics #83
|
@ -22,8 +22,6 @@ structure GoalState where
|
||||||
|
|
||||||
-- The root hole which is the search target
|
-- The root hole which is the search target
|
||||||
root: MVarId
|
root: MVarId
|
||||||
-- New metavariables acquired in this state
|
|
||||||
newMVars: SSet MVarId
|
|
||||||
|
|
||||||
-- Parent state metavariable source
|
-- Parent state metavariable source
|
||||||
parentMVar?: Option MVarId
|
parentMVar?: Option MVarId
|
||||||
|
@ -48,7 +46,6 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
|
||||||
return {
|
return {
|
||||||
root,
|
root,
|
||||||
savedState,
|
savedState,
|
||||||
newMVars := SSet.insert .empty root,
|
|
||||||
parentMVar? := .none,
|
parentMVar? := .none,
|
||||||
}
|
}
|
||||||
protected def GoalState.isConv (state: GoalState): Bool :=
|
protected def GoalState.isConv (state: GoalState): Bool :=
|
||||||
|
@ -89,15 +86,6 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
|
||||||
Elab.Tactic.setGoals [goal]
|
Elab.Tactic.setGoals [goal]
|
||||||
|
|
||||||
|
|
||||||
private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
|
|
||||||
mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
|
|
||||||
if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
|
|
||||||
assert! prevMVarDecl.type == mvarDecl.type
|
|
||||||
acc
|
|
||||||
else
|
|
||||||
acc.insert mvarId
|
|
||||||
) SSet.empty
|
|
||||||
|
|
||||||
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
|
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
|
||||||
let goal ← state.savedState.tactic.goals.get? goalId
|
let goal ← state.savedState.tactic.goals.get? goalId
|
||||||
return {
|
return {
|
||||||
|
@ -166,6 +154,21 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId)
|
||||||
|
|
||||||
--- Tactic execution functions ---
|
--- Tactic execution functions ---
|
||||||
|
|
||||||
|
protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
|
||||||
|
: Elab.TermElabM GoalState := do
|
||||||
|
state.restoreElabM
|
||||||
|
unless (← getMCtx).decls.contains mvarId do
|
||||||
|
throwError s!"MVarId is not in context: {mvarId.name}"
|
||||||
|
mvarId.checkNotAssigned `GoalState.step
|
||||||
|
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [mvarId] }
|
||||||
|
let nextElabState ← MonadBacktrack.saveState
|
||||||
|
return {
|
||||||
|
state with
|
||||||
|
savedState := { term := nextElabState, tactic := newGoals },
|
||||||
|
parentMVar? := .some mvarId,
|
||||||
|
calcPrevRhs? := .none,
|
||||||
|
}
|
||||||
|
|
||||||
/-- Response for executing a tactic -/
|
/-- Response for executing a tactic -/
|
||||||
inductive TacticResult where
|
inductive TacticResult where
|
||||||
-- Goes to next state
|
-- Goes to next state
|
||||||
|
@ -182,27 +185,12 @@ inductive TacticResult where
|
||||||
/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
|
/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
|
||||||
protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
|
protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
|
||||||
Elab.TermElabM TacticResult := do
|
Elab.TermElabM TacticResult := do
|
||||||
state.restoreElabM
|
let mvarId ← match state.savedState.tactic.goals.get? goalId with
|
||||||
let goal ← match state.savedState.tactic.goals.get? goalId with
|
|
||||||
| .some goal => pure $ goal
|
| .some goal => pure $ goal
|
||||||
| .none => return .indexError goalId
|
| .none => return .indexError goalId
|
||||||
goal.checkNotAssigned `GoalState.tryTacticM
|
|
||||||
try
|
try
|
||||||
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
|
let nextState ← state.step mvarId tacticM
|
||||||
if (← getThe Core.State).messages.hasErrors then
|
return .success nextState
|
||||||
let messages := (← getThe Core.State).messages.toArray
|
|
||||||
let errors ← (messages.map (·.data)).mapM fun md => md.toString
|
|
||||||
return .failure errors
|
|
||||||
let nextElabState ← MonadBacktrack.saveState
|
|
||||||
let nextMCtx := nextElabState.meta.meta.mctx
|
|
||||||
let prevMCtx := state.mctx
|
|
||||||
return .success {
|
|
||||||
state with
|
|
||||||
savedState := { term := nextElabState, tactic := newGoals },
|
|
||||||
newMVars := newMVarSet prevMCtx nextMCtx,
|
|
||||||
parentMVar? := .some goal,
|
|
||||||
calcPrevRhs? := .none,
|
|
||||||
}
|
|
||||||
catch exception =>
|
catch exception =>
|
||||||
return .failure #[← exception.toMessageData.toString]
|
return .failure #[← exception.toMessageData.toString]
|
||||||
|
|
||||||
|
@ -269,7 +257,6 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str
|
||||||
term := ← MonadBacktrack.saveState,
|
term := ← MonadBacktrack.saveState,
|
||||||
tactic := { goals := nextGoals }
|
tactic := { goals := nextGoals }
|
||||||
},
|
},
|
||||||
newMVars := nextGoals.toSSet,
|
|
||||||
parentMVar? := .some goal,
|
parentMVar? := .some goal,
|
||||||
calcPrevRhs? := .none
|
calcPrevRhs? := .none
|
||||||
}
|
}
|
||||||
|
@ -296,12 +283,9 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
|
||||||
return (← MonadBacktrack.saveState, convMVar)
|
return (← MonadBacktrack.saveState, convMVar)
|
||||||
try
|
try
|
||||||
let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
|
let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
|
||||||
let prevMCtx := state.mctx
|
|
||||||
let nextMCtx := nextSavedState.term.meta.meta.mctx
|
|
||||||
return .success {
|
return .success {
|
||||||
root := state.root,
|
root := state.root,
|
||||||
savedState := nextSavedState
|
savedState := nextSavedState
|
||||||
newMVars := newMVarSet prevMCtx nextMCtx,
|
|
||||||
parentMVar? := .some goal,
|
parentMVar? := .some goal,
|
||||||
convMVar? := .some (convRhs, goal),
|
convMVar? := .some (convRhs, goal),
|
||||||
calcPrevRhs? := .none
|
calcPrevRhs? := .none
|
||||||
|
@ -335,12 +319,9 @@ protected def GoalState.convExit (state: GoalState):
|
||||||
MonadBacktrack.saveState
|
MonadBacktrack.saveState
|
||||||
try
|
try
|
||||||
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
|
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
|
||||||
let nextMCtx := nextSavedState.term.meta.meta.mctx
|
|
||||||
let prevMCtx := state.savedState.term.meta.meta.mctx
|
|
||||||
return .success {
|
return .success {
|
||||||
root := state.root,
|
root := state.root,
|
||||||
savedState := nextSavedState
|
savedState := nextSavedState
|
||||||
newMVars := newMVarSet prevMCtx nextMCtx,
|
|
||||||
parentMVar? := .some convGoal,
|
parentMVar? := .some convGoal,
|
||||||
convMVar? := .none
|
convMVar? := .none
|
||||||
calcPrevRhs? := .none
|
calcPrevRhs? := .none
|
||||||
|
@ -420,7 +401,6 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
|
||||||
term := ← MonadBacktrack.saveState,
|
term := ← MonadBacktrack.saveState,
|
||||||
tactic := { goals },
|
tactic := { goals },
|
||||||
},
|
},
|
||||||
newMVars := goals.toSSet,
|
|
||||||
parentMVar? := .some goal,
|
parentMVar? := .some goal,
|
||||||
calcPrevRhs?
|
calcPrevRhs?
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue