|
|
@ -6,7 +6,6 @@ All the functions starting with `try` resume their inner monadic state.
|
|
|
|
import Pantograph.Tactic
|
|
|
|
import Pantograph.Tactic
|
|
|
|
import Lean
|
|
|
|
import Lean
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
namespace Pantograph
|
|
|
|
namespace Pantograph
|
|
|
|
open Lean
|
|
|
|
open Lean
|
|
|
|
|
|
|
|
|
|
|
@ -141,8 +140,7 @@ protected def GoalState.withRootContext { n } [MonadControlT MetaM n] [Monad n]
|
|
|
|
|
|
|
|
|
|
|
|
private def restoreCoreMExtra (state : Core.SavedState) : CoreM Unit :=
|
|
|
|
private def restoreCoreMExtra (state : Core.SavedState) : CoreM Unit :=
|
|
|
|
let { nextMacroScope, ngen, .. } := state
|
|
|
|
let { nextMacroScope, ngen, .. } := state
|
|
|
|
modifyGetThe Core.State (fun st => ((),
|
|
|
|
modifyThe Core.State ({ · with nextMacroScope, ngen })
|
|
|
|
{ st with nextMacroScope, ngen }))
|
|
|
|
|
|
|
|
-- Restore the name generator and macro scopes of the core state
|
|
|
|
-- Restore the name generator and macro scopes of the core state
|
|
|
|
protected def GoalState.restoreCoreMExtra (state: GoalState): CoreM Unit :=
|
|
|
|
protected def GoalState.restoreCoreMExtra (state: GoalState): CoreM Unit :=
|
|
|
|
restoreCoreMExtra state.coreState
|
|
|
|
restoreCoreMExtra state.coreState
|
|
|
@ -152,9 +150,6 @@ protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit := do
|
|
|
|
protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit := do
|
|
|
|
protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit := do
|
|
|
|
state.restoreCoreMExtra
|
|
|
|
state.restoreCoreMExtra
|
|
|
|
state.savedState.term.restore
|
|
|
|
state.savedState.term.restore
|
|
|
|
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
|
|
|
|
|
|
|
|
state.restoreElabM
|
|
|
|
|
|
|
|
Elab.Tactic.setGoals [goal]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/--
|
|
|
|
/--
|
|
|
|
Brings into scope a list of goals. User must ensure `goals` are distinct.
|
|
|
|
Brings into scope a list of goals. User must ensure `goals` are distinct.
|
|
|
@ -469,7 +464,7 @@ protected def GoalState.step (state : GoalState) (site : Site) (tacticM : Elab.T
|
|
|
|
: Elab.TermElabM GoalState :=
|
|
|
|
: Elab.TermElabM GoalState :=
|
|
|
|
Prod.snd <$> GoalState.step' state site tacticM guardMVarErrors
|
|
|
|
Prod.snd <$> GoalState.step' state site tacticM guardMVarErrors
|
|
|
|
|
|
|
|
|
|
|
|
/-- Response for executing a tactic -/
|
|
|
|
/-- Result for executing a tactic, capturing errors in the process -/
|
|
|
|
inductive TacticResult where
|
|
|
|
inductive TacticResult where
|
|
|
|
-- Goes to next state
|
|
|
|
-- Goes to next state
|
|
|
|
| success (state : GoalState) (messages : Array Message)
|
|
|
|
| success (state : GoalState) (messages : Array Message)
|
|
|
@ -480,34 +475,29 @@ inductive TacticResult where
|
|
|
|
-- The given action cannot be executed in the state
|
|
|
|
-- The given action cannot be executed in the state
|
|
|
|
| invalidAction (message : String)
|
|
|
|
| invalidAction (message : String)
|
|
|
|
|
|
|
|
|
|
|
|
private def dumpMessageLog (prevMessageLength : Nat := 0) : CoreM (Bool × List Message) := do
|
|
|
|
private def dumpMessageLog (prevMessageLength : Nat := 0) : CoreM (List Message) := do
|
|
|
|
let newMessages := (← Core.getMessageLog).toList.drop prevMessageLength
|
|
|
|
let newMessages := (← Core.getMessageLog).toList.drop prevMessageLength
|
|
|
|
let hasErrors := newMessages.any (·.severity == .error)
|
|
|
|
|
|
|
|
Core.resetMessageLog
|
|
|
|
Core.resetMessageLog
|
|
|
|
return (hasErrors, newMessages)
|
|
|
|
return newMessages
|
|
|
|
|
|
|
|
|
|
|
|
/-- Execute a `TermElabM` producing a goal state, capturing the error and turn it into a `TacticResult` -/
|
|
|
|
/-- Execute a `TermElabM` producing a goal state, capturing the error and turn it into a `TacticResult` -/
|
|
|
|
def withCapturingError (elabM : Elab.Term.TermElabM GoalState) : Elab.TermElabM TacticResult := do
|
|
|
|
def withCapturingError (elabM : Elab.Term.TermElabM GoalState) : Elab.TermElabM TacticResult := do
|
|
|
|
let messageLog ← Core.getMessageLog
|
|
|
|
let messageLog ← Core.getMessageLog
|
|
|
|
unless messageLog.toList.isEmpty do
|
|
|
|
unless messageLog.toList.isEmpty do
|
|
|
|
IO.eprintln s!"{← messageLog.toList.mapM (·.toString)}"
|
|
|
|
IO.eprintln s!"{← messageLog.toList.mapM (·.toString)}"
|
|
|
|
assert! messageLog.toList.isEmpty
|
|
|
|
throwError "Message log must be empty at the beginning."
|
|
|
|
try
|
|
|
|
try
|
|
|
|
let state ← elabM
|
|
|
|
let state ← elabM
|
|
|
|
|
|
|
|
|
|
|
|
-- Check if error messages have been generated in the core.
|
|
|
|
-- Check if error messages have been generated in the core.
|
|
|
|
let (hasError, newMessages) ← dumpMessageLog
|
|
|
|
let newMessages ← dumpMessageLog
|
|
|
|
if hasError then
|
|
|
|
let hasErrors := newMessages.any (·.severity == .error)
|
|
|
|
|
|
|
|
if hasErrors then
|
|
|
|
return .failure newMessages.toArray
|
|
|
|
return .failure newMessages.toArray
|
|
|
|
else
|
|
|
|
else
|
|
|
|
return .success state newMessages.toArray
|
|
|
|
return .success state newMessages.toArray
|
|
|
|
catch exception =>
|
|
|
|
catch exception =>
|
|
|
|
match exception with
|
|
|
|
let messages ← dumpMessageLog
|
|
|
|
| .internal _ =>
|
|
|
|
|
|
|
|
let (_, messages) ← dumpMessageLog
|
|
|
|
|
|
|
|
return .failure messages.toArray
|
|
|
|
|
|
|
|
| _ =>
|
|
|
|
|
|
|
|
let (_, messages) ← dumpMessageLog
|
|
|
|
|
|
|
|
let message := {
|
|
|
|
let message := {
|
|
|
|
fileName := ← getFileName,
|
|
|
|
fileName := ← getFileName,
|
|
|
|
pos := ← getRefPosition,
|
|
|
|
pos := ← getRefPosition,
|
|
|
|