refactor: MetaM form of have and let
This commit is contained in:
parent
7968072097
commit
9b0456a5e0
|
@ -156,7 +156,6 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId)
|
||||||
|
|
||||||
protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
|
protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
|
||||||
: Elab.TermElabM GoalState := do
|
: Elab.TermElabM GoalState := do
|
||||||
state.restoreElabM
|
|
||||||
unless (← getMCtx).decls.contains mvarId do
|
unless (← getMCtx).decls.contains mvarId do
|
||||||
throwError s!"MVarId is not in context: {mvarId.name}"
|
throwError s!"MVarId is not in context: {mvarId.name}"
|
||||||
mvarId.checkNotAssigned `GoalState.step
|
mvarId.checkNotAssigned `GoalState.step
|
||||||
|
@ -197,6 +196,7 @@ protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: El
|
||||||
/-- Execute a string tactic on given state -/
|
/-- Execute a string tactic on given state -/
|
||||||
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
|
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
|
||||||
Elab.TermElabM TacticResult := do
|
Elab.TermElabM TacticResult := do
|
||||||
|
state.restoreElabM
|
||||||
let tactic ← match Parser.runParserCategory
|
let tactic ← match Parser.runParserCategory
|
||||||
(env := ← MonadEnv.getEnv)
|
(env := ← MonadEnv.getEnv)
|
||||||
(catName := if state.isConv then `conv else `tactic)
|
(catName := if state.isConv then `conv else `tactic)
|
||||||
|
@ -223,45 +223,14 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
|
||||||
protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
|
protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
|
||||||
Elab.TermElabM TacticResult := do
|
Elab.TermElabM TacticResult := do
|
||||||
state.restoreElabM
|
state.restoreElabM
|
||||||
let goal ← match state.savedState.tactic.goals.get? goalId with
|
|
||||||
| .some goal => pure goal
|
|
||||||
| .none => return .indexError goalId
|
|
||||||
goal.checkNotAssigned `GoalState.tryLet
|
|
||||||
let type ← match Parser.runParserCategory
|
let type ← match Parser.runParserCategory
|
||||||
(env := state.env)
|
(env := ← MonadEnv.getEnv)
|
||||||
(catName := `term)
|
(catName := `term)
|
||||||
(input := type)
|
(input := type)
|
||||||
(fileName := filename) with
|
(fileName := filename) with
|
||||||
| .ok syn => pure syn
|
| .ok syn => pure syn
|
||||||
| .error error => return .parseError error
|
| .error error => return .parseError error
|
||||||
let binderName := binderName.toName
|
state.tryTacticM goalId $ Tactic.evalLet binderName.toName type
|
||||||
try
|
|
||||||
-- Implemented similarly to the intro tactic
|
|
||||||
let nextGoals: List MVarId ← goal.withContext do
|
|
||||||
let type ← Elab.Term.elabType (stx := type)
|
|
||||||
let lctx ← MonadLCtx.getLCtx
|
|
||||||
|
|
||||||
-- The branch goal inherits the same context, but with a different type
|
|
||||||
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
|
|
||||||
|
|
||||||
let upstreamType := .letE binderName type mvarBranch (← goal.getType) false
|
|
||||||
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
|
|
||||||
upstreamType (kind := MetavarKind.synthetic) (userName := (← goal.getTag))
|
|
||||||
|
|
||||||
goal.assign mvarUpstream
|
|
||||||
|
|
||||||
pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
|
|
||||||
return .success {
|
|
||||||
root := state.root,
|
|
||||||
savedState := {
|
|
||||||
term := ← MonadBacktrack.saveState,
|
|
||||||
tactic := { goals := nextGoals }
|
|
||||||
},
|
|
||||||
parentMVar? := .some goal,
|
|
||||||
calcPrevRhs? := .none
|
|
||||||
}
|
|
||||||
catch exception =>
|
|
||||||
return .failure #[← exception.toMessageData.toString]
|
|
||||||
|
|
||||||
/-- Enter conv tactic mode -/
|
/-- Enter conv tactic mode -/
|
||||||
protected def GoalState.conv (state: GoalState) (goalId: Nat):
|
protected def GoalState.conv (state: GoalState) (goalId: Nat):
|
||||||
|
|
|
@ -168,7 +168,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
|
||||||
| .error error => return .parseError error
|
| .error error => return .parseError error
|
||||||
runTermElabM do
|
runTermElabM do
|
||||||
state.restoreElabM
|
state.restoreElabM
|
||||||
state.tryTacticM goalId (Tactic.«have» binderName.toName type)
|
state.tryTacticM goalId $ Tactic.evalHave binderName.toName type
|
||||||
@[export pantograph_goal_evaluate_m]
|
@[export pantograph_goal_evaluate_m]
|
||||||
protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
|
protected def GoalState.tryEvaluate (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
|
||||||
|
|
|
@ -19,29 +19,65 @@ def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
|
||||||
pure [mvarUpstream.mvarId!]
|
pure [mvarUpstream.mvarId!]
|
||||||
Elab.Tactic.setGoals nextGoals
|
Elab.Tactic.setGoals nextGoals
|
||||||
|
|
||||||
def «have» (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
|
structure BranchResult where
|
||||||
|
fvarId?: Option FVarId := .none
|
||||||
|
main: MVarId
|
||||||
|
branch: MVarId
|
||||||
|
|
||||||
|
def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
|
||||||
|
mvarId.checkNotAssigned `Pantograph.Tactic.have
|
||||||
|
let lctx ← MonadLCtx.getLCtx
|
||||||
|
-- The branch goal inherits the same context, but with a different type
|
||||||
|
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
|
||||||
|
|
||||||
|
-- Create the context for the `upstream` goal
|
||||||
|
let fvarId ← mkFreshFVarId
|
||||||
|
let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
|
||||||
|
let mvarUpstream ←
|
||||||
|
withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
|
||||||
|
Meta.withNewLocalInstances #[.fvar fvarId] 0 do
|
||||||
|
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
|
||||||
|
(← mvarId.getType) (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
|
||||||
|
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
|
||||||
|
mvarId.assign mvarUpstream
|
||||||
|
pure mvarUpstream
|
||||||
|
|
||||||
|
return {
|
||||||
|
fvarId? := .some fvarId,
|
||||||
|
main := mvarUpstream.mvarId!,
|
||||||
|
branch := mvarBranch.mvarId!,
|
||||||
|
}
|
||||||
|
|
||||||
|
def evalHave (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
|
||||||
let goal ← Elab.Tactic.getMainGoal
|
let goal ← Elab.Tactic.getMainGoal
|
||||||
let nextGoals: List MVarId ← goal.withContext do
|
let nextGoals: List MVarId ← goal.withContext do
|
||||||
let type ← Elab.Term.elabType (stx := type)
|
let type ← Elab.Term.elabType (stx := type)
|
||||||
let lctx ← MonadLCtx.getLCtx
|
let result ← «have» goal binderName type
|
||||||
|
pure [result.branch, result.main]
|
||||||
-- The branch goal inherits the same context, but with a different type
|
|
||||||
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
|
|
||||||
|
|
||||||
-- Create the context for the `upstream` goal
|
|
||||||
let fvarId ← mkFreshFVarId
|
|
||||||
let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
|
|
||||||
let fvar := mkFVar fvarId
|
|
||||||
let mvarUpstream ←
|
|
||||||
withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
|
|
||||||
Meta.withNewLocalInstances #[fvar] 0 do
|
|
||||||
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
|
|
||||||
(← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
|
|
||||||
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
|
|
||||||
goal.assign mvarUpstream
|
|
||||||
pure mvarUpstream
|
|
||||||
|
|
||||||
pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
|
|
||||||
Elab.Tactic.setGoals nextGoals
|
Elab.Tactic.setGoals nextGoals
|
||||||
|
|
||||||
|
def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
|
||||||
|
mvarId.checkNotAssigned `Pantograph.Tactic.let
|
||||||
|
let lctx ← MonadLCtx.getLCtx
|
||||||
|
|
||||||
|
-- The branch goal inherits the same context, but with a different type
|
||||||
|
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
|
||||||
|
|
||||||
|
assert! ¬ type.hasLooseBVars
|
||||||
|
let upstreamType := .letE binderName type mvarBranch (← mvarId.getType) false
|
||||||
|
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
|
||||||
|
upstreamType (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
|
||||||
|
mvarId.assign mvarUpstream
|
||||||
|
|
||||||
|
return {
|
||||||
|
main := mvarUpstream.mvarId!,
|
||||||
|
branch := mvarBranch.mvarId!,
|
||||||
|
}
|
||||||
|
|
||||||
|
def evalLet (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
|
||||||
|
let goal ← Elab.Tactic.getMainGoal
|
||||||
|
let type ← goal.withContext $ Elab.Term.elabType (stx := type)
|
||||||
|
let result ← «let» goal binderName type
|
||||||
|
Elab.Tactic.setGoals [result.branch, result.main]
|
||||||
|
|
||||||
end Pantograph.Tactic
|
end Pantograph.Tactic
|
||||||
|
|
Loading…
Reference in New Issue