feat: Add compilation unit boundary command

This commit is contained in:
Leni Aniva 2024-05-31 16:35:46 -07:00
parent b9b16ba0e9
commit 855e771609
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
3 changed files with 28 additions and 13 deletions

View File

@ -45,7 +45,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
| "compile.tactics" => run compile_tactics
| "compile.unit" => run compile_unit
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@ -192,11 +192,19 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => runMetaM <| do
return .ok (← goalPrint goalState state.options)
compile_tactics (args: Protocol.CompileTactics): MainM (CR Protocol.CompileTacticsResult) := do
compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
let module := args.module.toName
try
let result ← Compile.compileAndCollectTacticInvocations module
return .ok result
let steps ← Compile.processSource module
let units? := if args.compilationUnits then
.some $ steps.map λ step => (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
else
.none
let invocations? ← if args.invocations then
pure $ .some (← Compile.collectTacticsFromCompilation steps)
else
pure .none
return .ok { units?, invocations? }
catch e =>
return .error $ errorI "compile" (← e.toMessageData.toString)

View File

@ -8,22 +8,23 @@ open Lean
namespace Pantograph.Compile
def compileAndCollectTacticInvocations (module : Name) : IO Protocol.CompileTacticsResult := do
let steps ← processSource module
--def readCompilationUnits (module : Name) : IO Protocol.CompileUnitsResult := do
-- let steps ← processSource module
-- return { units := steps.map (·.src.toString) }
def collectTacticsFromCompilation (steps : List CompilationStep) : IO (List Protocol.InvokedTactic) := do
let infoTrees := steps.bind (·.trees)
let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal
| _ => false
let tactics := tacticInfoTrees.bind collectTactics
IO.println s!"{steps.length} compilation steps, {infoTrees.length} trees found, {tacticInfoTrees.length} tactic trees, {tactics.length} tactics found"
let invocations : List Protocol.InvokedTactic ← tactics.mapM λ invocation => do
tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
let tactic ← invocation.ctx.runMetaM {} do
let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
return t.pretty
return { goalBefore, goalAfter, tactic }
return { invocations }
end Pantograph.Compile

View File

@ -275,17 +275,23 @@ structure GoalDiag where
printAll: Bool := false
instantiate: Bool := true
structure CompileTactics where
module: String
deriving Lean.FromJson
/-- Executes the Lean compiler on a single file -/
structure CompileUnit where
module: String
-- If set to true, query the string boundaries of compilation units
compilationUnits: Bool := false
-- If set to true, collect tactic invocations
invocations: Bool := false
deriving Lean.FromJson
structure InvokedTactic where
goalBefore: String
goalAfter: String
tactic: String
deriving Lean.ToJson
structure CompileTacticsResult where
invocations: List InvokedTactic
structure CompileUnitResult where
units?: Option $ List (Nat × Nat)
invocations?: Option $ List InvokedTactic
deriving Lean.ToJson
abbrev CR α := Except InteractionError α