feat: Diagnostics command for FFI users

This commit is contained in:
Leni Aniva 2024-05-08 12:41:21 -07:00
parent 69ec70ffbe
commit 66a5dfcf3c
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
2 changed files with 38 additions and 29 deletions

View File

@ -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

View File

@ -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}]"