feat: Congruence tactic FFI interface and tests
This commit is contained in:
parent
75df7268c5
commit
bbc00cbbb8
|
@ -76,7 +76,7 @@ private def GoalState.mvars (state: GoalState): SSet MVarId :=
|
||||||
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
|
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
|
||||||
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
|
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
|
||||||
state.savedState.term.meta.restore
|
state.savedState.term.meta.restore
|
||||||
private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
|
protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
|
||||||
state.savedState.term.restore
|
state.savedState.term.restore
|
||||||
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
|
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
|
||||||
state.savedState.restore
|
state.savedState.restore
|
||||||
|
@ -518,11 +518,6 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
|
||||||
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
|
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: 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.tryMotivatedApply
|
|
||||||
|
|
||||||
let recursor ← match Parser.runParserCategory
|
let recursor ← match Parser.runParserCategory
|
||||||
(env := state.env)
|
(env := state.env)
|
||||||
(catName := `term)
|
(catName := `term)
|
||||||
|
@ -534,11 +529,6 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
|
||||||
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
|
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: 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.tryMotivatedApply
|
|
||||||
|
|
||||||
let recursor ← match Parser.runParserCategory
|
let recursor ← match Parser.runParserCategory
|
||||||
(env := state.env)
|
(env := state.env)
|
||||||
(catName := `term)
|
(catName := `term)
|
||||||
|
|
|
@ -204,4 +204,20 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean
|
||||||
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
|
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
|
||||||
runTermElabM <| state.tryNoConfuse goalId eq
|
runTermElabM <| state.tryNoConfuse goalId eq
|
||||||
|
|
||||||
|
inductive TacticExecute where
|
||||||
|
| congruenceArg
|
||||||
|
| congruenceFun
|
||||||
|
| congruence
|
||||||
|
@[export pantograph_goal_tactic_execute_m]
|
||||||
|
def goalTacticExecute (state: GoalState) (goalId: Nat) (tacticExecute: TacticExecute): Lean.CoreM TacticResult :=
|
||||||
|
runTermElabM do
|
||||||
|
state.restoreElabM
|
||||||
|
let tactic := match tacticExecute with
|
||||||
|
| .congruenceArg => Tactic.congruenceArg
|
||||||
|
| .congruenceFun => Tactic.congruenceFun
|
||||||
|
| .congruence => Tactic.congruence
|
||||||
|
state.execute goalId tactic
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
|
|
@ -27,10 +27,54 @@ def test_congr_arg (env: Environment): IO LSpec.TestSeq :=
|
||||||
])
|
])
|
||||||
tests := tests ++ test
|
tests := tests ++ test
|
||||||
return tests
|
return tests
|
||||||
|
def test_congr_fun (env: Environment): IO LSpec.TestSeq :=
|
||||||
|
let expr := "λ (n m: Nat) => (n + m) + (n + m) = (n + m) * 2"
|
||||||
|
runMetaMSeq env do
|
||||||
|
let expr ← parseSentence expr
|
||||||
|
Meta.lambdaTelescope expr $ λ _ body => do
|
||||||
|
let mut tests := LSpec.TestSeq.done
|
||||||
|
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
|
||||||
|
let test ← runTermElabMInMeta do
|
||||||
|
let newGoals ← runTacticOnMVar Tactic.congruenceFun target.mvarId!
|
||||||
|
pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
|
||||||
|
[
|
||||||
|
(`α, "Sort ?u.159"),
|
||||||
|
(`f₁, "?α → Nat"),
|
||||||
|
(`f₂, "?α → Nat"),
|
||||||
|
(`h, "?f₁ = ?f₂"),
|
||||||
|
(`a, "?α"),
|
||||||
|
(`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
|
||||||
|
])
|
||||||
|
tests := tests ++ test
|
||||||
|
return tests
|
||||||
|
def test_congr (env: Environment): IO LSpec.TestSeq :=
|
||||||
|
let expr := "λ (a b: Nat) => a = b"
|
||||||
|
runMetaMSeq env do
|
||||||
|
let expr ← parseSentence expr
|
||||||
|
Meta.lambdaTelescope expr $ λ _ body => do
|
||||||
|
let mut tests := LSpec.TestSeq.done
|
||||||
|
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
|
||||||
|
let test ← runTermElabMInMeta do
|
||||||
|
let newGoals ← runTacticOnMVar Tactic.congruence target.mvarId!
|
||||||
|
pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
|
||||||
|
[
|
||||||
|
(`α, "Sort ?u.10"),
|
||||||
|
(`f₁, "?α → Nat"),
|
||||||
|
(`f₂, "?α → Nat"),
|
||||||
|
(`a₁, "?α"),
|
||||||
|
(`a₂, "?α"),
|
||||||
|
(`h₁, "?f₁ = ?f₂"),
|
||||||
|
(`h₂, "?a₁ = ?a₂"),
|
||||||
|
(`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
|
||||||
|
])
|
||||||
|
tests := tests ++ test
|
||||||
|
return tests
|
||||||
|
|
||||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
||||||
[
|
[
|
||||||
("congrArg", test_congr_arg env),
|
("congrArg", test_congr_arg env),
|
||||||
|
("congrFun", test_congr_fun env),
|
||||||
|
("congr", test_congr env),
|
||||||
]
|
]
|
||||||
|
|
||||||
end Pantograph.Test.Tactic.Congruence
|
end Pantograph.Test.Tactic.Congruence
|
||||||
|
|
Loading…
Reference in New Issue