refactor: MetaM form of define (evaluate)

This commit is contained in:
Leni Aniva 2024-08-15 23:23:17 -07:00
parent 9b0456a5e0
commit 1e7a186bb1
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
3 changed files with 20 additions and 17 deletions

View File

@ -169,14 +169,14 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
runTermElabM do runTermElabM do
state.restoreElabM state.restoreElabM
state.tryTacticM goalId $ Tactic.evalHave binderName.toName type state.tryTacticM goalId $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_evaluate_m] @[export pantograph_goal_try_define_m]
protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do protected def GoalState.tryDefine (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
let expr ← match (← Compile.parseTermM expr) with let expr ← match (← Compile.parseTermM expr) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => return .parseError error | .error error => return .parseError error
runTermElabM do runTermElabM do
state.restoreElabM state.restoreElabM
state.tryTacticM goalId (Tactic.evaluate binderName.toName expr) state.tryTacticM goalId (Tactic.evalDefine binderName.toName expr)
@[export pantograph_goal_let_m] @[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult := def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type runTermElabM <| state.tryLet goalId binderName type

View File

@ -5,19 +5,22 @@ open Lean
namespace Pantograph.Tactic namespace Pantograph.Tactic
def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do /-- Introduces a fvar to the current mvar -/
let goal ← Elab.Tactic.getMainGoal def define (mvarId: MVarId) (binderName: Name) (expr: Expr): MetaM (FVarId × MVarId) := mvarId.withContext do
let nextGoals ← goal.withContext do mvarId.checkNotAssigned `Pantograph.Tactic.define
let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none) let type ← Meta.inferType expr
let type ← Meta.inferType expr
let mvarUpstream ← Meta.withLetDecl binderName type expr λ _ => do Meta.withLetDecl binderName type expr λ fvar => do
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances) let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
(← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous) (← mvarId.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
goal.assign mvarUpstream mvarId.assign mvarUpstream
pure mvarUpstream pure (fvar.fvarId!, mvarUpstream.mvarId!)
pure [mvarUpstream.mvarId!]
Elab.Tactic.setGoals nextGoals def evalDefine (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let expr ← goal.withContext $ Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
let (_, mvarId) ← define goal binderName expr
Elab.Tactic.setGoals [mvarId]
structure BranchResult where structure BranchResult where
fvarId?: Option FVarId := .none fvarId?: Option FVarId := .none

View File

@ -32,7 +32,7 @@ def test_eval : TestT Elab.TermElabM Unit := do
], ],
target, target,
}) })
let tactic := Tactic.evaluate `h2 e let tactic := Tactic.evalDefine `h2 e
let m := .mvar ⟨uniq 13⟩ let m := .mvar ⟨uniq 13⟩
let [newGoal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number" let [newGoal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
addTest $ LSpec.test "goals after" ((← toCondensedGoal newGoal).devolatilize == { addTest $ LSpec.test "goals after" ((← toCondensedGoal newGoal).devolatilize == {
@ -73,7 +73,7 @@ def test_proof_eval : TestT Elab.TermElabM Unit := do
let evalBind := "y" let evalBind := "y"
let evalExpr := "Or.inl h" let evalExpr := "Or.inl h"
let state2 ← match ← state1.tryEvaluate (goalId := 0) (binderName := evalBind) (expr := evalExpr) with let state2 ← match ← state1.tryDefine (goalId := 0) (binderName := evalBind) (expr := evalExpr) with
| .success state => pure state | .success state => pure state
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString