diff --git a/Pantograph.lean b/Pantograph.lean index 42d46a7..4272001 100644 --- a/Pantograph.lean +++ b/Pantograph.lean @@ -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) diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean index 7ac4d27..6d3f5d9 100644 --- a/Pantograph/Compile.lean +++ b/Pantograph/Compile.lean @@ -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 diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean index 87c511a..8f4f947 100644 --- a/Pantograph/Protocol.lean +++ b/Pantograph/Protocol.lean @@ -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 α