feat: Diagnostics command for FFI users
This commit is contained in:
parent
69ec70ffbe
commit
66a5dfcf3c
|
@ -212,4 +212,8 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean
|
||||||
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
|
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
|
||||||
runTermElabM <| state.tryNoConfuse goalId eq
|
runTermElabM <| state.tryNoConfuse goalId eq
|
||||||
|
|
||||||
|
@[export pantograph_goal_diag]
|
||||||
|
def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
|
||||||
|
runMetaM $ state.diag diagOptions
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
|
|
@ -270,51 +270,56 @@ protected def GoalState.serializeGoals
|
||||||
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
|
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
|
||||||
|
|
||||||
/-- Print the metavariables in a readable format -/
|
/-- Print the metavariables in a readable format -/
|
||||||
protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
|
protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM String := do
|
||||||
goalState.restoreMetaM
|
goalState.restoreMetaM
|
||||||
let savedState := goalState.savedState
|
let savedState := goalState.savedState
|
||||||
let goals := savedState.tactic.goals
|
let goals := savedState.tactic.goals
|
||||||
let mctx ← getMCtx
|
let mctx ← getMCtx
|
||||||
let root := goalState.root
|
let root := goalState.root
|
||||||
-- Print the root
|
-- Print the root
|
||||||
match mctx.decls.find? root with
|
let result: String ← match mctx.decls.find? root with
|
||||||
| .some decl => printMVar ">" root decl
|
| .some decl => printMVar ">" root decl
|
||||||
| .none => IO.println s!">{root.name}: ??"
|
| .none => pure s!">{root.name}: ??"
|
||||||
goals.forM (fun mvarId => do
|
let resultGoals ← goals.filter (· != root) |>.mapM (fun mvarId =>
|
||||||
if mvarId != root then
|
match mctx.decls.find? mvarId with
|
||||||
match mctx.decls.find? mvarId with
|
| .some decl => printMVar "⊢" mvarId decl
|
||||||
| .some decl => printMVar "⊢" mvarId decl
|
| .none => pure s!"⊢{mvarId.name}: ??"
|
||||||
| .none => IO.println s!"⊢{mvarId.name}: ??"
|
|
||||||
)
|
)
|
||||||
let goals := goals.toSSet
|
let goals := goals.toSSet
|
||||||
mctx.decls.forM (fun mvarId decl => do
|
let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
|
||||||
if goals.contains mvarId || mvarId == root then
|
!(goals.contains mvarId || mvarId == root) && options.printAll)
|
||||||
pure ()
|
|>.mapM (fun (mvarId, decl) => do
|
||||||
-- Print the remainig ones that users don't see in Lean
|
|
||||||
else if options.printAll then
|
|
||||||
let pref := if goalState.newMVars.contains mvarId then "~" else " "
|
let pref := if goalState.newMVars.contains mvarId then "~" else " "
|
||||||
printMVar pref mvarId decl
|
printMVar pref mvarId decl
|
||||||
else
|
|
||||||
pure ()
|
|
||||||
--IO.println s!" {mvarId.name}{userNameToString decl.userName}"
|
|
||||||
)
|
)
|
||||||
|
pure $ result ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
|
||||||
where
|
where
|
||||||
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
|
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := do
|
||||||
if options.printContext then
|
let resultFVars: List String ←
|
||||||
decl.lctx.fvarIdToDecl.forM printFVar
|
if options.printContext then
|
||||||
|
decl.lctx.fvarIdToDecl.toList.mapM (λ (fvarId, decl) =>
|
||||||
|
do pure $ (← printFVar fvarId decl) ++ "\n")
|
||||||
|
else
|
||||||
|
pure []
|
||||||
let type ← if options.instantiate
|
let type ← if options.instantiate
|
||||||
then instantiateMVars decl.type
|
then instantiateMVars decl.type
|
||||||
else pure $ decl.type
|
else pure $ decl.type
|
||||||
let type_sexp ← serializeExpressionSexp type (sanitize := false)
|
let type_sexp ← serializeExpressionSexp type (sanitize := false)
|
||||||
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
|
let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
|
||||||
if options.printValue then
|
let resultValue: String ←
|
||||||
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
|
if options.printValue then
|
||||||
let value ← if options.instantiate
|
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
|
||||||
then instantiateMVars value
|
let value ← if options.instantiate
|
||||||
else pure $ value
|
then instantiateMVars value
|
||||||
IO.println s!" := {← Meta.ppExpr value}"
|
else pure $ value
|
||||||
printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM Unit := do
|
pure s!"\n := {← Meta.ppExpr value}"
|
||||||
IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
|
else
|
||||||
|
pure ""
|
||||||
|
else
|
||||||
|
pure ""
|
||||||
|
pure $ (String.join resultFVars) ++ resultMain ++ resultValue
|
||||||
|
printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM String := do
|
||||||
|
pure s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
|
||||||
userNameToString : Name → String
|
userNameToString : Name → String
|
||||||
| .anonymous => ""
|
| .anonymous => ""
|
||||||
| other => s!"[{other}]"
|
| other => s!"[{other}]"
|
||||||
|
|
Loading…
Reference in New Issue