Compare commits

...

5 Commits

Author SHA1 Message Date
Kim Morrison
36b63ce4ac add tests to ensure still works with -star 2025-12-04 05:32:02 +00:00
Kim Morrison
aec4960ceb remove spurious changes from other branch 2025-12-04 05:32:02 +00:00
Kim Morrison
b89cfdacad restore test 2025-12-04 05:32:02 +00:00
Kim Morrison
54ef2c77d1 refactor: replace fullExt with starLemmasExt and add eliminator support
This PR makes two main improvements to library search:

1. **Replace duplicate tree with array for star-indexed lemmas**
   - Instead of maintaining `fullExt` (a complete duplicate discrimination tree),
     use `starLemmasExt` (a simple array for lemmas with `[*]` or `[Eq,*,*,*]` keys)
   - Star-indexed lemmas are captured during tree initialization via `extractKeys`
   - Two-pass search: first excludes star lemmas, fallback includes them
   - Controlled by `-star`/`+star` flags

2. **Support eliminator-style theorems like `iteInduction`**
   - Add `getFirstArgEntry` to create secondary index entries for fvar-headed theorems
   - For `motive (ite c t e)`, creates entry keyed by `.const ite 4`
   - Modify `getMatchCore` to check first argument's const key for fvar-headed goals
   - This enables finding eliminators even with `-star`

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
2025-12-04 05:32:02 +00:00
Kim Morrison
e787a09d6b feat: exact? uses star-indexed lemmas as fallback
This PR adds support for star-indexed lemmas (like `Empty.elim`, `And.left`, `not_not.mp`)
to `exact?` and `apply?` as a fallback search when no concrete-keyed lemmas are found.

Star-indexed lemmas are those whose discrimination tree keys are `[*]` or patterns like
`[Eq,*,*,*]` - these match too broadly to include in the primary search, but can be
helpful when the goal type is headed by a free variable (e.g., `⊢ h` where `h : P`).

The fallback is only triggered when:
1. No results are found from the primary (concrete-keyed) search
2. The goal type is headed by a free variable
3. The `-star` flag is not set

Use `exact? -star` or `apply? -star` to disable the fallback.

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
2025-12-04 05:32:02 +00:00
7 changed files with 216 additions and 31 deletions

View File

@@ -1700,6 +1700,10 @@ structure LibrarySearchConfig where
/-- If true, use `try?` as a discharger for subgoals that cannot be closed
by `solve_by_elim` alone. -/
try? : Bool := false
/-- If true (the default), star-indexed lemmas (with overly-general discrimination keys
like `[*]`) are searched as a fallback when no concrete-keyed lemmas are found.
Use `-star` to disable this fallback. -/
star : Bool := true
/--
Searches environment for definitions or theorems that can solve the goal using `exact`
@@ -1711,6 +1715,7 @@ ways to resolve the goal, and one wants to guide which lemma is used.
Use `+grind` to enable `grind` as a fallback discharger for subgoals.
Use `+try?` to enable `try?` as a fallback discharger for subgoals.
Use `-star` to disable fallback to star-indexed lemmas (like `Empty.elim`, `And.left`).
-/
syntax (name := exact?) "exact?" optConfig (" using " (colGt ident),+)? : tactic
@@ -1723,6 +1728,7 @@ used when closing the goal.
Use `+grind` to enable `grind` as a fallback discharger for subgoals.
Use `+try?` to enable `try?` as a fallback discharger for subgoals.
Use `-star` to disable fallback to star-indexed lemmas.
-/
syntax (name := apply?) "apply?" optConfig (" using " (colGt term),+)? : tactic

View File

@@ -42,7 +42,7 @@ def exact? (ref : Syntax) (config : Parser.Tactic.LibrarySearchConfig)
let allowFailure := fun g => do
let g g.withContext (instantiateMVars (.mvar g))
return required.all fun e => e.occurs g
match ( librarySearch goal tactic allowFailure) with
match ( librarySearch goal tactic allowFailure (includeStar := config.star)) with
-- Found goal that closed problem
| none =>
addExactSuggestion ref ( instantiateMVars (mkMVar mvar)).headBeta (checkState? := initialState)

View File

@@ -928,6 +928,57 @@ def createLocalPreDiscrTree
def dropKeys (t : LazyDiscrTree α) (keys : List (List LazyDiscrTree.Key)) : MetaM (LazyDiscrTree α) := do
keys.foldlM (init := t) (·.dropKey ·)
/-- Collect all values from a subtree recursively and clear them. -/
partial def collectSubtreeAux (next : TrieIndex) : MatchM α (Array α) :=
if next = 0 then
pure #[]
else do
let (values, star, children) evalNode next
-- Collect from star subtrie
let starVals collectSubtreeAux star
-- Collect from all children
let mut childVals : Array α := #[]
for (_, childIdx) in children do
childVals := childVals ++ ( collectSubtreeAux childIdx)
-- Clear this node (keep structure but remove values)
modify (·.set! next {values := #[], star, children})
return values ++ starVals ++ childVals
/-- Navigate to a key path and return all values in that subtree, then drop them. -/
def extractKeyAux (next : TrieIndex) (rest : List Key) :
MatchM α (Array α) :=
if next = 0 then
pure #[]
else do
let (_, star, children) evalNode next
match rest with
| [] =>
-- At the target node: collect ALL values from entire subtree
collectSubtreeAux next
| k :: r => do
let next := if k == .star then star else children.getD k 0
extractKeyAux next r
/-- Extract and drop entries at a specific key, returning the dropped entries. -/
def extractKey (t : LazyDiscrTree α) (path : List LazyDiscrTree.Key) :
MetaM (Array α × LazyDiscrTree α) :=
match path with
| [] => pure (#[], t)
| rootKey :: rest => do
let idx := t.roots.getD rootKey 0
runMatch t (extractKeyAux idx rest)
/-- Extract entries at the given keys and also drop them from the tree. -/
def extractKeys (t : LazyDiscrTree α) (keys : List (List LazyDiscrTree.Key)) :
MetaM (Array α × LazyDiscrTree α) := do
let mut allExtracted : Array α := #[]
let mut tree := t
for path in keys do
let (extracted, newTree) extractKey tree path
allExtracted := allExtracted ++ extracted
tree := newTree
return (allExtracted, tree)
def logImportFailure [Monad m] [MonadLog m] [AddMessageContext m] [MonadOptions m] (f : ImportFailure) : m Unit :=
logError m!"Processing failure with {f.const} in {f.module}:\n {f.exception.toMessageData}"
@@ -979,6 +1030,7 @@ def findImportMatches
(addEntry : Name ConstantInfo MetaM (Array (InitEntry α)))
(droppedKeys : List (List LazyDiscrTree.Key) := [])
(constantsPerTask : Nat := 1000)
(droppedEntriesRef : Option (IO.Ref (Option (Array α))) := none)
(ty : Expr) : MetaM (MatchResult α) := do
let cctx (read : CoreM Core.Context)
let ngen getNGen
@@ -990,7 +1042,13 @@ def findImportMatches
profileitM Exception "lazy discriminator import initialization" (getOptions) $ do
let t createImportedDiscrTree (createTreeCtx cctx) cNGen (getEnv) addEntry
(constantsPerTask := constantsPerTask)
dropKeys t droppedKeys
-- If a reference is provided, extract and store dropped entries
if let some droppedRef := droppedEntriesRef then
let (extracted, t) extractKeys t droppedKeys
droppedRef.set (some extracted)
pure t
else
dropKeys t droppedKeys
let (importCandidates, importTree) importTree.getMatch ty
ref.set (some importTree)
pure importCandidates
@@ -1064,10 +1122,11 @@ def findMatchesExt
(addEntry : Name ConstantInfo MetaM (Array (InitEntry α)))
(droppedKeys : List (List LazyDiscrTree.Key) := [])
(constantsPerTask : Nat := 1000)
(droppedEntriesRef : Option (IO.Ref (Option (Array α))) := none)
(adjustResult : Nat α β)
(ty : Expr) : MetaM (Array β) := do
let moduleMatches findModuleMatches moduleTreeRef ty
let importMatches findImportMatches ext addEntry droppedKeys constantsPerTask ty
let importMatches findImportMatches ext addEntry droppedKeys constantsPerTask droppedEntriesRef ty
return Array.mkEmpty (moduleMatches.size + importMatches.size)
|> moduleMatches.appendResultsAux (f := adjustResult)
|> importMatches.appendResultsAux (f := adjustResult)
@@ -1080,13 +1139,15 @@ def findMatchesExt
* `addEntry` is the function for creating discriminator tree entries from constants.
* `droppedKeys` contains keys we do not want to consider when searching for matches.
It is used for dropping very general keys.
* `droppedEntriesRef` optionally stores entries dropped from the tree for later use.
-/
def findMatches (ext : EnvExtension (IO.Ref (Option (LazyDiscrTree α))))
(addEntry : Name ConstantInfo MetaM (Array (InitEntry α)))
(droppedKeys : List (List LazyDiscrTree.Key) := [])
(constantsPerTask : Nat := 1000)
(droppedEntriesRef : Option (IO.Ref (Option (Array α))) := none)
(ty : Expr) : MetaM (Array α) := do
let moduleTreeRef createModuleTreeRef addEntry droppedKeys
let incPrio _ v := v
findMatchesExt moduleTreeRef ext addEntry droppedKeys constantsPerTask incPrio ty
findMatchesExt moduleTreeRef ext addEntry droppedKeys constantsPerTask droppedEntriesRef incPrio ty

View File

@@ -179,11 +179,33 @@ initialization performance.
-/
private def constantsPerImportTask : Nat := 6500
/-- Create function for finding relevant declarations. -/
def libSearchFindDecls : Expr MetaM (Array (Name × DeclMod)) :=
/-- Environment extension for caching star-indexed lemmas.
Used for fallback when primary search finds nothing for fvar-headed goals. -/
private builtin_initialize starLemmasExt : EnvExtension (IO.Ref (Option (Array (Name × DeclMod))))
registerEnvExtension (IO.mkRef .none)
/-- Create function for finding relevant declarations.
Also captures dropped entries in starLemmasExt for fallback search. -/
def libSearchFindDecls (ty : Expr) : MetaM (Array (Name × DeclMod)) := do
let _ : Inhabited (IO.Ref (Option (Array (Name × DeclMod)))) := IO.mkRef none
let droppedRef := starLemmasExt.getState (getEnv)
findMatches ext addImport
(droppedKeys := droppedKeys)
(constantsPerTask := constantsPerImportTask)
(droppedEntriesRef := some droppedRef)
ty
/-- Get star-indexed lemmas (lazily computed during tree initialization). -/
def getStarLemmas : MetaM (Array (Name × DeclMod)) := do
let _ : Inhabited (IO.Ref (Option (Array (Name × DeclMod)))) := IO.mkRef none
let ref := starLemmasExt.getState (getEnv)
match ref.get with
| some lemmas => return lemmas
| none =>
-- If star lemmas aren't cached yet, trigger tree initialization by searching for a dummy type
-- This will populate starLemmasExt as a side effect
let _ libSearchFindDecls (mkConst ``True)
pure ((ref.get).getD #[])
/--
Return an action that returns true when the remaining heartbeats is less
@@ -341,19 +363,34 @@ def tryOnEach
private def librarySearch' (goal : MVarId)
(tactic : List MVarId MetaM (List MVarId))
(allowFailure : MVarId MetaM Bool)
(leavePercentHeartbeats : Nat) :
(leavePercentHeartbeats : Nat)
(includeStar : Bool := true) :
MetaM (Option (Array (List MVarId × MetavarContext))) := do
withTraceNode `Tactic.librarySearch (return m!"{librarySearchEmoji ·} {← goal.getType}") do
profileitM Exception "librarySearch" ( getOptions) do
-- Create predicate that returns true when running low on heartbeats.
let candidates librarySearchSymm libSearchFindDecls goal
let cfg : ApplyConfig := { allowSynthFailures := true }
let shouldAbort mkHeartbeatCheck leavePercentHeartbeats
let act := fun cand => do
if shouldAbort then
abortSpeculation
librarySearchLemma cfg tactic allowFailure cand
tryOnEach act candidates
-- First pass: search with droppedKeys (excludes star-indexed lemmas)
let candidates librarySearchSymm libSearchFindDecls goal
match tryOnEach act candidates with
| none => return none -- Found a complete solution
| some results =>
-- Only do star fallback if:
-- 1. No results from primary search
-- 2. includeStar is true
if !results.isEmpty || !includeStar then
return some results
-- Second pass: try star-indexed lemmas (those with [*] or [Eq,*,*,*] keys)
-- No need for librarySearchSymm since getStarLemmas ignores the goal type
let starLemmas getStarLemmas
if starLemmas.isEmpty then return some results
let mctx getMCtx
let starCandidates := starLemmas.map ((goal, mctx), ·)
tryOnEach act starCandidates
/--
Tries to solve the goal by applying a library lemma
@@ -376,9 +413,10 @@ def librarySearch (goal : MVarId)
(tactic : List MVarId MetaM (List MVarId) :=
fun g => solveByElim [] (maxDepth := 6) (exfalso := false) g)
(allowFailure : MVarId MetaM Bool := fun _ => pure true)
(leavePercentHeartbeats : Nat := 10) :
(leavePercentHeartbeats : Nat := 10)
(includeStar : Bool := true) :
MetaM (Option (Array (List MVarId × MetavarContext))) := do
librarySearch' goal tactic allowFailure leavePercentHeartbeats
librarySearch' goal tactic allowFailure leavePercentHeartbeats includeStar
end LibrarySearch

View File

@@ -63,7 +63,7 @@ info: Try this:
#guard_msgs in
example : x < x + 1 := exact?%
/-- error: `exact?%` didn't find any relevant lemmas -/
/-- error: `exact?%` could not close the goal. Try `by apply?` to see partial suggestions. -/
#guard_msgs in
example {α : Sort u} (x y : α) : Eq x y := exact?%
@@ -94,10 +94,13 @@ example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by sho
#guard_msgs (drop info) in
example (α : Prop) : α α := by show_term solve_by_elim
-- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`.
-- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp`
-- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left`
-- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr`
-- These examples work via star-indexed fallback.
#guard_msgs (drop info) in
example (p : Prop) : (¬¬p) p := by apply?
#guard_msgs (drop info) in
example (a b : Prop) (h : a b) : a := by apply?
#guard_msgs (drop info) in
example (P Q : Prop) : (¬ Q ¬ P) (P Q) := by apply?
/--
info: Try this:
@@ -260,10 +263,11 @@ info: Try this:
#guard_msgs in
example {a b c : Nat} (h₁ : a c) (h₂ : a b + c) : a b := by apply?
-- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`.
-- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h`
-- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g`
-- example (n : Nat) (r : ) : := by apply? using n, r -- exact nsmulRec n r
-- These examples work via star-indexed fallback.
#guard_msgs (drop info) in
example {α : Sort u} (h : Empty) : α := by apply?
#guard_msgs (drop info) in
example (f : A C) (g : B C) : (A B) C := by apply?
opaque f : Nat Nat
axiom F (a b : Nat) : f a f b a b
@@ -366,10 +370,8 @@ info: Try this:
example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by
with_reducible exact?
/--
error: apply? didn't find any relevant lemmas
-/
#guard_msgs in
-- Now finds star-indexed lemmas (e.g., noConfusion) as partial proofs
#guard_msgs (drop info) in
example {α : Sort u} (x y : α) : Eq x y := by apply?
-- If this lemma is added later to the library, please update this `#guard_msgs`.
@@ -381,3 +383,81 @@ example (p q : Prop) : (¬ p = q) = (p = ¬ q) := by exact?
-- Verify that there is a `sorry` warning when `apply?` closes the goal.
#guard_msgs (drop info) in
example : False := by apply?
-- Test the `-star` and `+star` flags for controlling star-indexed lemma fallback.
-- `Empty.elim` is a star-indexed lemma (polymorphic result type), so `-star` prevents finding it.
/-- error: apply? didn't find any relevant lemmas -/
#guard_msgs in
example {α : Sort u} (h : Empty) : α := by apply? -star
-- With `+star`, we find `Empty.elim` via star-indexed lemma fallback.
#guard_msgs (drop info) in
example {α : Sort u} (h : Empty) : α := by apply? +star
-- Verify that `-star` doesn't break normal (non-star-indexed) lemma search.
section MinusStar
/--
info: Try this:
[apply] exact Nat.add_comm x y
-/
#guard_msgs in
example (x y : Nat) : x + y = y + x := by apply? -star
/--
info: Try this:
[apply] exact fun a => Nat.add_le_add_right a k
-/
#guard_msgs in
example (n m k : Nat) : n m n + k m + k := by apply? -star
/--
info: Try this:
[apply] exact Nat.mul_dvd_mul_left a w
-/
#guard_msgs in
example (_ha : a > 0) (w : b c) : a * b a * c := by apply? -star
/--
info: Try this:
[apply] exact Nat.lt_add_one x
-/
#guard_msgs in
example : x < x + 1 := by exact? -star
/--
info: Try this:
[apply] exact eq_comm
-/
#guard_msgs in
example {α : Type} (x y : α) : x = y y = x := by apply? -star
/--
info: Try this:
[apply] exact (p_iff_q a).mp h
-/
#guard_msgs in
example {a : Nat} (h : P a) : Q a := by apply? -star
/--
info: Try this:
[apply] exact (Nat.dvd_add_iff_left h₁).mpr h₂
-/
#guard_msgs in
example {a b c : Nat} (h₁ : a c) (h₂ : a b + c) : a b := by apply? -star
/--
info: Try this:
[apply] exact L.flatten
-/
#guard_msgs in
example (L : List (List Nat)) : List Nat := by apply? -star using L
/--
info: Try this:
[apply] exact Bool_eq_iff
-/
#guard_msgs in
example {A B : Bool} : (A = B) = (A B) := by apply? -star
end MinusStar

View File

@@ -1 +1,3 @@
librarySearch.lean:383:0-383:7: warning: declaration uses 'sorry'
librarySearch.lean:270:0-270:7: warning: declaration uses 'sorry'
librarySearch.lean:375:0-375:7: warning: declaration uses 'sorry'
librarySearch.lean:385:0-385:7: warning: declaration uses 'sorry'

View File

@@ -63,11 +63,9 @@ example : EqExplicit (fun (f : α → β) => (fun g x => g x) f) id := by
exact?
/-! `exact?` no longer uses `solve_by_elim` first, so it can't find local hypotheses -/
/--
error: `exact?` could not close the goal.
-/
#guard_msgs in
/-! `exact?` no longer uses `solve_by_elim` first, so it can't find local hypotheses.
However, star-indexed lemmas (like `Function.comp`) may find a proof via fallback. -/
#guard_msgs (drop info) in
example {P : Prop} : P P := by
intro
exact?