Enable handling of m-Coupled goals #20

Merged
aniva merged 11 commits from goal/dependency into dev 2023-10-27 19:30:21 -07:00
2 changed files with 69 additions and 24 deletions
Showing only changes of commit 4ffd226cac - Show all commits

View File

@ -38,9 +38,13 @@ protected def GoalState.create (expr: Expr): M GoalState := do
root, root,
newMVars := SSet.insert .empty root, newMVars := SSet.insert .empty root,
} }
protected def GoalState.goals (goalState: GoalState): List MVarId := goalState.savedState.tactic.goals protected def GoalState.goals (state: GoalState): List MVarId := state.savedState.tactic.goals
private def GoalState.mctx (state: GoalState): MetavarContext := protected def GoalState.runM {α: Type} (state: GoalState) (m: Elab.TermElabM α) : M α := do
state.savedState.term.restore
m
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx state.savedState.term.meta.meta.mctx
private def GoalState.mvars (state: GoalState): SSet MVarId := 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

View File

@ -141,6 +141,37 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
return () return ()
example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
def proof_arith: TestM Unit := do
let state? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let (state1, goal) ← match ← state0.execute (goalId := 0) (tactic := "intros") with
| .success state #[goal] => pure (state, goal)
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "1 root" state1.rootExpr.isNone
let (state2, goal) ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state #[goal] => pure (state, goal)
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "2 root" state2.rootExpr.isNone
let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
| .success state #[] => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "3 root" state3.rootExpr.isSome
return ()
-- Two ways to write the same theorem -- Two ways to write the same theorem
example: ∀ (p q: Prop), p q → q p := by example: ∀ (p q: Prop), p q → q p := by
@ -218,7 +249,6 @@ def proof_or_comm: TestM Unit := do
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
state4_1.print
addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome
return () return ()
@ -234,25 +264,35 @@ def proof_or_comm: TestM Unit := do
] ]
} }
--example (w x y z : Nat) (p : Nat → Prop) /-- M-coupled goals -/
-- (h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by def proof_m_couple: TestM Unit := do
-- simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at * let state? ← startProof (.expr "(2: Nat) ≤ 5")
-- assumption let state0 ← match state? with
--def proof_arith_1: TestM Unit := do | .some state => pure state
-- let goal? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)") | .none => do
-- addTest $ LSpec.check "Start goal" goal?.isSome addTest $ assertUnreachable "Goal could not parse"
-- if let .some goal := goal? then return ()
-- if let .success #[(goal, _)] ← goal.execute "intros" then
-- if let .success #[(goal, _)] ← goal.execute "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *" then let (state1, goalL, goalR, goalM) ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
-- if let .success #[] ← goal.execute "assumption" then | .success state #[goalL, goalR, goalM] => pure (state, goalL, goalR, goalM)
-- return () | other => do
-- else addTest $ assertUnreachable $ other.toString
-- addTest $ assertUnreachable "assumption" return ()
-- else addTest $ LSpec.test "2 ≤ ?m" (goalL.target.pp? = .some "2 ≤ ?m")
-- addTest $ assertUnreachable "simp ..." addTest $ LSpec.test "?m ≤ 5" (goalR.target.pp? = .some "?m ≤ 5")
-- else addTest $ LSpec.test "Nat" (goalM.target.pp? = .some "Nat")
-- addTest $ assertUnreachable "intros" -- Set m to 3
-- let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
| .success state #[] => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let state1b ← match state1.continue state2 with
| .ok state => pure state
| .error error => do
addTest $ assertUnreachable $ error
return ()
state1b.print
--def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do --def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
-- let goal? ← startProof (.expr "∀ (a b: Nat), a + b = b + a") -- let goal? ← startProof (.expr "∀ (a b: Nat), a + b = b + a")
-- addTest $ LSpec.check "Start goal" goal?.isSome -- addTest $ LSpec.check "Start goal" goal?.isSome
@ -278,8 +318,9 @@ def suite: IO LSpec.TestSeq := do
let tests := [ let tests := [
("Nat.add_comm", proof_nat_add_comm false), ("Nat.add_comm", proof_nat_add_comm false),
("Nat.add_comm manual", proof_nat_add_comm true), ("Nat.add_comm manual", proof_nat_add_comm true),
("Or.comm", proof_or_comm) ("arithmetic", proof_arith),
--("arithmetic 1", proof_arith_1), ("Or.comm", proof_or_comm),
("2 < 5", proof_m_couple)
--("delta variable", proof_delta_variable) --("delta variable", proof_delta_variable)
] ]
let tests ← tests.foldlM (fun acc tests => do let tests ← tests.foldlM (fun acc tests => do