Compare commits

...

5 Commits

Author SHA1 Message Date
Leonardo de Moura
19f9b6e7f3 test: try? exact 2025-02-07 14:12:34 -08:00
Leonardo de Moura
1abd89d625 chore: fix test 2025-02-07 14:12:34 -08:00
Leonardo de Moura
faa543abe9 feat: improve try? tactic generation 2025-02-07 14:12:34 -08:00
Leonardo de Moura
0f39462801 feat: exact? in try? 2025-02-07 14:12:34 -08:00
Leonardo de Moura
f0bd90cc4d fix: empty first at evalAndSuggest 2025-02-07 14:12:34 -08:00
3 changed files with 125 additions and 25 deletions

View File

@@ -11,6 +11,7 @@ import Lean.Meta.Tactic.Try
import Lean.Meta.Tactic.TryThis
import Lean.Elab.Tactic.Config
import Lean.Elab.Tactic.SimpTrace
import Lean.Elab.Tactic.LibrarySearch
import Lean.Elab.Tactic.Grind
namespace Lean.Elab.Tactic
@@ -28,6 +29,59 @@ namespace Try
combinatiors such as `first`, `attempt_all`, `<;>`, `;`, and `try`.
-/
/-- Returns `true` if `fvarId` has an accessible name. -/
private def isAccessible (fvarId : FVarId) : MetaM Bool := do
let localDecl fvarId.getDecl
if localDecl.userName.hasMacroScopes then
return false
else
-- Check whether variable has been shadowed
let some localDecl' := ( getLCtx).findFromUserName? localDecl.userName
| return false
return localDecl'.fvarId == localDecl.fvarId
/-- Returns `true` if all free variables occurring in `e` are accessible. -/
private def isExprAccessible (e : Expr) : MetaM Bool := do
let (_, s) e.collectFVars |>.run {}
s.fvarIds.allM isAccessible
/-- Creates a temporary local context where all names are exposed, and executes `k`-/
private def withExposedNames (k : MetaM α) : MetaM α := do
withNewMCtxDepth do
-- Create a helper goal to apply
let mvarId := ( mkFreshExprMVar (mkConst ``True)).mvarId!
let mvarId mvarId.exposeNames
mvarId.withContext do k
/-- Executes `tac` in the saved state. This function is used to validate a tactic before suggesting it. -/
def checkTactic (savedState : SavedState) (tac : TSyntax `tactic) : TacticM Unit := do
let currState saveState
savedState.restore
try
evalTactic tac
finally
currState.restore
def evalSuggestExact : TacticM (TSyntax `tactic) := do
let savedState saveState
let mvarId :: mvarIds getGoals
| throwError "no goals"
mvarId.withContext do
let tactic := fun exfalso => LibrarySearch.solveByElim [] (exfalso := exfalso) (maxDepth := 6)
let allowFailure := fun _ => return false
let .none LibrarySearch.librarySearch mvarId tactic allowFailure
| throwError "`exact?` failed"
let proof := ( instantiateMVars (mkMVar mvarId)).headBeta
let tac if ( isExprAccessible proof) then
let stx PrettyPrinter.delab proof
`(tactic| exact $stx)
else withExposedNames do
let stx PrettyPrinter.delab proof
`(tactic| (expose_names; exact $stx))
checkTactic savedState tac
setGoals mvarIds
return tac
/-- Returns the suggestions represented by `tac`. -/
private def getSuggestionOfTactic (tac : TSyntax `tactic) : Array (TSyntax `tactic) :=
match tac with
@@ -53,6 +107,29 @@ private def filterSkipDone (tacs : Array (TSyntax `tactic)) : Array (TSyntax `ta
| `(tactic| done) | `(tactic| skip) => false
| _ => true
private def getTacSeqElems? (tseq : TSyntax ``Parser.Tactic.tacticSeq) : Option (Array (TSyntax `tactic)) :=
match tseq with
| `(tacticSeq| { $t;* }) => some t.getElems
| `(tacticSeq| $t;*) => some t.getElems
| _ => none
private def isCDotTac (tac : TSyntax `tactic) : Bool :=
match tac with
| `(tactic| · $_:tacticSeq) => true
| _ => false
private def appendSeq (tacs : Array (TSyntax `tactic)) (tac : TSyntax `tactic) : Array (TSyntax `tactic) := Id.run do
match tac with
| `(tactic| ($tseq:tacticSeq)) =>
if let some tacs' := getTacSeqElems? tseq then
return tacs ++ tacs'
| `(tactic| · $tseq:tacticSeq) =>
if let some tacs' := getTacSeqElems? tseq then
if !tacs'.any isCDotTac then
return tacs ++ tacs'
| _ => pure ()
return tacs.push tac
private def mkSeq (tacs : Array (TSyntax `tactic)) (terminal : Bool) : CoreM (TSyntax `tactic) := do
let tacs := filterSkipDone tacs
if tacs.size = 0 then
@@ -354,9 +431,9 @@ private def evalSuggestSeq (tacs : Array (TSyntax `tactic)) : M (TSyntax `tactic
if ( read).terminal then
let mut result := #[]
for i in [:tacs.size - 1] do
result := result.push ( withNonTerminal <| evalSuggest tacs[i]!)
result := appendSeq result ( withNonTerminal <| evalSuggest tacs[i]!)
let suggestions getSuggestionOfTactic ( evalSuggest tacs.back!) |>.mapM fun tac =>
mkSeq (result.push tac) (terminal := true)
mkSeq (appendSeq result tac) (terminal := true)
mkTrySuggestions suggestions
else
mkSeq ( tacs.mapM evalSuggest) (terminal := false)
@@ -373,6 +450,8 @@ private def evalSuggestTacticSeq (s : TSyntax ``Parser.Tactic.tacticSeq) : M (TS
/-- `evalSuggest` for `first` tactic. -/
private partial def evalSuggestFirst (tacs : Array (TSyntax ``Parser.Tactic.tacticSeq)) : M (TSyntax `tactic) := do
if tacs.size == 0 then
throwError "`first` expects at least one argument"
go 0
where
go (i : Nat) : M (TSyntax `tactic) := do
@@ -414,6 +493,7 @@ where
-- `evalSuggest` implementation
@[export lean_eval_suggest_tactic]
private partial def evalSuggestImpl (tac : TSyntax `tactic) : M (TSyntax `tactic) := do
trace[try.debug] "{tac}"
match tac with
| `(tactic| $tac1 <;> $tac2) => evalSuggestChain tac1 tac2
| `(tactic| first $[| $tacs]*) => evalSuggestFirst tacs
@@ -429,6 +509,8 @@ private partial def evalSuggestImpl (tac : TSyntax `tactic) : M (TSyntax `tactic
evalSuggestGrindTrace tac
else if k == ``Parser.Tactic.simpTrace then
evalSuggestSimpTrace tac
else if k == ``Parser.Tactic.exact? then
evalSuggestExact
else
evalSuggestAtomic tac
if ( read).terminal then
@@ -515,27 +597,12 @@ private def mkSimpleTacStx : CoreM (TSyntax `tactic) :=
/-! Function induction generators -/
private def allAccessible (majors : Array FVarId) : MetaM Bool :=
majors.allM fun major => do
let localDecl major.getDecl
if localDecl.userName.hasMacroScopes then
return false
else
-- Check whether variable has been shadowed
let some localDecl' := ( getLCtx).findFromUserName? localDecl.userName
| return false
return localDecl'.fvarId == localDecl.fvarId
open Try.Collector in
private def mkFunIndStx (c : FunIndCandidate) (cont : TSyntax `tactic) : MetaM (TSyntax `tactic) := do
if ( allAccessible c.majors) then
if ( c.majors.allM isAccessible) then
go
else withNewMCtxDepth do
-- Create a helper goal to apply
let mvarId := ( mkFreshExprMVar (mkConst ``True)).mvarId!
let mvarId mvarId.exposeNames
mvarId.withContext do
`(tactic| (expose_names; $( go):tactic))
else withExposedNames do
`(tactic| (expose_names; $( go):tactic))
where
go : MetaM (TSyntax `tactic) := do
let mut terms := #[]
@@ -558,11 +625,11 @@ private def mkTryEvalSuggestStx (info : Try.Info) : MetaM (TSyntax `tactic) := d
let grind mkGrindStx info
let atomic `(tactic| attempt_all | $simple:tactic | $simp:tactic | $grind:tactic | simp_all)
let funInds mkAllFunIndStx info atomic
`(tactic| first | $atomic:tactic | $funInds:tactic)
let extra `(tactic| (intros; first | $simple:tactic | $simp:tactic | exact?))
`(tactic| first | $atomic:tactic | $funInds:tactic | $extra:tactic)
-- TODO: vanilla `induction`.
-- TODO: make it extensible.
-- TODO: librarySearch integration.
-- TODO: premise selection.
@[builtin_tactic Lean.Parser.Tactic.tryTrace] def evalTryTrace : Tactic := fun stx => do

View File

@@ -83,9 +83,7 @@ example : False := by
set_option hygiene false in
macro "simple_tac2" : tactic => `(tactic| eval_suggest (intros; (simp only [Nat.zero_add]; simp only [Nat.one_mul]); simp [*]))
/--
info: Try this: · intros; (simp only [Nat.zero_add]; simp only [Nat.one_mul]); simp [*]
-/
/-- info: Try this: · intros; simp only [Nat.zero_add]; simp only [Nat.one_mul]; simp [*] -/
#guard_msgs (info) in
example : x = 0 0 + 1*x = 0 := by
simple_tac2

View File

@@ -0,0 +1,35 @@
opaque P : Nat Prop
opaque Q : Nat Prop
theorem Pall : Q x P x := sorry
/-- info: Try this: exact Pall h -/
#guard_msgs (info) in
example (h : Q x) (_ : x > 0) : P x := by
try?
/-- info: Try this: · intros; expose_names; exact Pall h -/
#guard_msgs (info) in
example: Q x True P x := by
try?
/-- info: Try this: · intros; expose_names; exact Pall h_1 -/
#guard_msgs (info) in
example: True Q x True P x := by
try?
theorem Qall {x y : Nat} : Q x := sorry
/--
error: tactic 'try?' failed, consider using `grind` manually, or `try? +missing` for partial proofs containing `sorry`
x : Nat
⊢ Q x
-/
#guard_msgs (error) in
example : Q x := by
try? -- should fail, we cannot elaborate `exact Qall`
/-- info: Try this: · expose_names; exact Pall h -/
#guard_msgs (info) in
example (_ : Q x) (_ : x > 0) : P x := by
try?