feat: Expose `GoalState` functions
This commit is contained in:
parent
9c40a83956
commit
02556f3c79
|
@ -164,7 +164,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
|
|||
| .some branchId, .none => do
|
||||
match state.goalStates.find? branchId with
|
||||
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
|
||||
| .some branch => pure $ goalContinue target branch
|
||||
| .some branch => pure $ target.continue branch
|
||||
| .none, .some goals =>
|
||||
pure $ goalResume target goals
|
||||
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
|
||||
|
|
|
@ -39,15 +39,15 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
|
|||
|
||||
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
|
||||
--let expr ← instantiateMVars expr
|
||||
let goal ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
|
||||
let root ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
|
||||
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
|
||||
let root := goal.mvarId!
|
||||
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
|
||||
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root.mvarId!]}
|
||||
return {
|
||||
root,
|
||||
root := root.mvarId!,
|
||||
savedState,
|
||||
parentMVar? := .none,
|
||||
}
|
||||
@[export pantograph_goal_state_is_conv]
|
||||
protected def GoalState.isConv (state: GoalState): Bool :=
|
||||
state.convMVar?.isSome
|
||||
protected def GoalState.goals (state: GoalState): List MVarId :=
|
||||
|
@ -56,6 +56,7 @@ protected def GoalState.goals (state: GoalState): List MVarId :=
|
|||
protected def GoalState.goalsArray (state: GoalState): Array MVarId := state.goals.toArray
|
||||
protected def GoalState.mctx (state: GoalState): MetavarContext :=
|
||||
state.savedState.term.meta.meta.mctx
|
||||
@[export pantograph_goal_state_env]
|
||||
protected def GoalState.env (state: GoalState): Environment :=
|
||||
state.savedState.term.meta.core.env
|
||||
|
||||
|
@ -85,7 +86,7 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
|
|||
state.savedState.restore
|
||||
Elab.Tactic.setGoals [goal]
|
||||
|
||||
|
||||
@[export pantograph_goal_state_focus]
|
||||
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
|
||||
let goal ← state.savedState.tactic.goals.get? goalId
|
||||
return {
|
||||
|
@ -121,6 +122,7 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
|
|||
/--
|
||||
Brings into scope all goals from `branch`
|
||||
-/
|
||||
@[export pantograph_goal_state_continue]
|
||||
protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
|
||||
if !target.goals.isEmpty then
|
||||
.error s!"Target state has unresolved goals"
|
||||
|
|
|
@ -134,10 +134,6 @@ def goalStartExpr (expr: String) (levels: Array String): CoreM (Protocol.CR Goal
|
|||
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
|
||||
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
|
||||
|
||||
@[export pantograph_goal_continue]
|
||||
def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
|
||||
target.continue branch
|
||||
|
||||
@[export pantograph_goal_serialize_m]
|
||||
def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array Protocol.Goal) :=
|
||||
runMetaM <| state.serializeGoals (parent := .none) options
|
||||
|
@ -189,8 +185,5 @@ def goalConvExit (state: GoalState): CoreM TacticResult :=
|
|||
@[export pantograph_goal_calc_m]
|
||||
def goalCalc (state: GoalState) (goalId: Nat) (pred: String): CoreM TacticResult :=
|
||||
runTermElabM <| state.tryCalc goalId pred
|
||||
@[export pantograph_goal_focus]
|
||||
def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
|
||||
state.focus goalId
|
||||
|
||||
end Pantograph
|
||||
|
|
Loading…
Reference in New Issue