feat: Collect newly defined constants

This commit is contained in:
Leni Aniva 2024-12-09 19:40:00 -08:00
parent 2d068ecd50
commit 5ef2b5c118
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
2 changed files with 41 additions and 1 deletions

View File

@ -2,6 +2,7 @@
import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
import Lean.DeclarationRange
import Pantograph.Frontend.Basic
import Pantograph.Frontend.MetaTranslate
@ -128,7 +129,7 @@ Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
-/
@[export pantograph_frontend_sorrys_to_goal_state]
@[export pantograph_frontend_sorrys_to_goal_state_m]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty
let goalsM := sorrys.mapM λ i => do
@ -147,5 +148,17 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
GoalState.createFromMVars goals root
@[export pantograph_frontend_collect_new_defined_constants_m]
def collectNewDefinedConstants (step : CompilationStep) : IO (List Name) := do
step.after.constants.map₂.foldlM (λ acc name _ => do
if step.before.contains name then
return acc
let coreM : CoreM Bool := Option.isSome <$> findDeclarationRanges? name
let hasRange ← coreM.run' { fileName := step.fileName, fileMap := step.fileMap } { env := step.after } |>.toBaseIO
match hasRange with
| .ok true => return name :: acc
| .ok false => return acc
| .error e => throw $ IO.userError (← e.toMessageData.toString)
) []
end Pantograph.Frontend

View File

@ -184,6 +184,31 @@ def mystery : Nat := true
let goalStates ← (collectSorrysFromSource input).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
def collectNewConstants (source: String) : MetaM (List (List Name)) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
Frontend.collectNewDefinedConstants step
m.run context |>.run' state
def test_collect_one_constant : TestT MetaM Unit := do
let input := "
def mystery : Nat := 123
"
let names ← collectNewConstants input
checkEq "constants" names [[`mystery]]
def test_collect_one_theorem : TestT MetaM Unit := do
let input := "
theorem mystery [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
match as, i with
| a::as, ⟨0, _⟩ => simp_arith [get]
| a::as, ⟨i+1, h⟩ =>
have ih := sizeOf_get as ⟨i, Nat.le_of_succ_le_succ h⟩
apply Nat.lt_trans ih
simp_arith
"
let names ← collectNewConstants input
checkEq "constants" names [[`mystery]]
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
@ -193,6 +218,8 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
("capture_type_mismatch", test_capture_type_mismatch),
("collect_one_constant", test_collect_one_constant),
("collect_one_theorem", test_collect_one_theorem),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))