feat: Prograde tactics #83
|
@ -548,6 +548,6 @@ protected def GoalState.tryEval (state: GoalState) (goalId: Nat) (binderName: Na
|
|||
(fileName := filename) with
|
||||
| .ok syn => pure syn
|
||||
| .error error => return .parseError error
|
||||
state.execute goalId (tacticM := Tactic.tacticEval binderName expr)
|
||||
state.execute goalId (tacticM := Tactic.evaluate binderName expr)
|
||||
|
||||
end Pantograph
|
||||
|
|
|
@ -202,7 +202,7 @@ def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.
|
|||
}
|
||||
|
||||
/-- Adapted from ppGoal -/
|
||||
def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
|
||||
def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl := .none)
|
||||
: MetaM Protocol.Goal := do
|
||||
-- Options for printing; See Meta.ppGoal for details
|
||||
let showLetValues := true
|
||||
|
|
|
@ -5,7 +5,7 @@ open Lean
|
|||
|
||||
namespace Pantograph.Tactic
|
||||
|
||||
def tacticEval (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
|
||||
def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
|
||||
let goal ← Elab.Tactic.getMainGoal
|
||||
let nextGoals ← goal.withContext do
|
||||
let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
|
||||
|
|
|
@ -8,6 +8,17 @@ open Lean
|
|||
|
||||
namespace Pantograph
|
||||
|
||||
deriving instance Repr for Expr
|
||||
-- Use strict equality check for expressions
|
||||
--instance : BEq Expr := ⟨Expr.equal⟩
|
||||
instance (priority := 80) (x y : Expr) : LSpec.Testable (x.equal y) :=
|
||||
if h : Expr.equal x y then
|
||||
.isTrue h
|
||||
else
|
||||
.isFalse h $ s!"Expected to be equalaaa: '{x.dbgToString}' and '{y.dbgToString}'"
|
||||
|
||||
def uniq (n: Nat): Name := .num (.str .anonymous "_uniq") n
|
||||
|
||||
-- Auxiliary functions
|
||||
namespace Protocol
|
||||
def Goal.devolatilizeVars (goal: Goal): Goal :=
|
||||
|
|
|
@ -52,6 +52,7 @@ def main (args: List String) := do
|
|||
("Tactic/Congruence", Tactic.Congruence.suite env_default),
|
||||
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
|
||||
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
|
||||
("Tactic/Prograde", Tactic.Prograde.suite env_default),
|
||||
]
|
||||
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
|
||||
LSpec.lspecIO (← runTestGroup name_filter tests)
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
import Test.Tactic.Congruence
|
||||
import Test.Tactic.MotivatedApply
|
||||
import Test.Tactic.NoConfuse
|
||||
import Test.Tactic.Prograde
|
||||
|
|
|
@ -0,0 +1,42 @@
|
|||
import LSpec
|
||||
import Lean
|
||||
import Test.Common
|
||||
|
||||
open Lean
|
||||
open Pantograph
|
||||
|
||||
namespace Pantograph.Test.Tactic.Prograde
|
||||
|
||||
def test_eval (env: Environment): IO LSpec.TestSeq :=
|
||||
let expr := "forall (p q : Prop) (h: p), And (Or p q) (Or p q)"
|
||||
runMetaMSeq env do
|
||||
let expr ← parseSentence expr
|
||||
Meta.forallTelescope expr $ λ _ body => do
|
||||
let e ← match Parser.runParserCategory
|
||||
(env := ← MonadEnv.getEnv)
|
||||
(catName := `term)
|
||||
(input := "Or.inl h")
|
||||
(fileName := filename) with
|
||||
| .ok syn => pure syn
|
||||
| .error error => throwError "Failed to parse: {error}"
|
||||
let mut tests := LSpec.TestSeq.done
|
||||
-- Apply the tactic
|
||||
let goal ← Meta.mkFreshExprSyntheticOpaqueMVar body
|
||||
let target: Expr := mkAnd
|
||||
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
|
||||
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
|
||||
let test := LSpec.test "goals before" ((← goal.mvarId!.getType) == target)
|
||||
tests := tests ++ test
|
||||
let tactic := Tactic.evaluate `h2 e
|
||||
let test ← runTermElabMInMeta do
|
||||
let newGoals ← runTacticOnMVar tactic goal.mvarId!
|
||||
pure $ LSpec.test "goals after" ((← newGoals.head!.getType) == target)
|
||||
tests := tests ++ test
|
||||
return tests
|
||||
|
||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
||||
[
|
||||
("eval", test_eval env),
|
||||
]
|
||||
|
||||
end Pantograph.Test.Tactic.Prograde
|
Loading…
Reference in New Issue