more diagnostic operations;
authorwenzelm
Thu, 11 May 2023 12:20:47 +0200
changeset 78032 73c77db63594
parent 78031 a526f69145ec
child 78033 9c18535a9fcd
more diagnostic operations;
src/Pure/Isar/proof_display.ML
src/Pure/PIDE/session.ML
--- a/src/Pure/Isar/proof_display.ML	Thu May 11 10:46:52 2023 +0200
+++ b/src/Pure/Isar/proof_display.ML	Thu May 11 12:20:47 2023 +0200
@@ -28,6 +28,9 @@
     ((string * string) * (string * thm list) list) -> unit
   val print_consts: bool -> Position.T -> Proof.context ->
     (string * typ -> bool) -> (string * typ) list -> unit
+  val markup_extern_label: Position.T -> (Markup.T * xstring) option
+  val print_label: Position.T -> string
+  val print_context_tracing: Context.generic * Position.T -> string
 end
 
 structure Proof_Display: PROOF_DISPLAY =
@@ -390,4 +393,30 @@
 
 end;
 
+
+(* position label *)
+
+val command_prefix = Markup.commandN ^ ".";
+
+fun markup_extern_label pos =
+  Position.label_of pos |> Option.map (fn label =>
+    (case try (unprefix command_prefix) label of
+      SOME cmd => (Markup.keyword1, Long_Name.base_name cmd)
+    | NONE => (Markup.empty, label)));
+
+fun print_label pos =
+  (case markup_extern_label pos of
+    NONE => ""
+  | SOME (m, s) => Markup.markup m s);
+
+
+(* context tracing *)
+
+fun context_type (Context.Theory _) = "theory"
+  | context_type (Context.Proof ctxt) =
+      if can Local_Theory.assert ctxt then "local_theory" else "Proof.context";
+
+fun print_context_tracing (context, pos) =
+  context_type context ^ (case print_label pos of "" => "" | s => " " ^ s) ^ Position.here pos;
+
 end;
--- a/src/Pure/PIDE/session.ML	Thu May 11 10:46:52 2023 +0200
+++ b/src/Pure/PIDE/session.ML	Thu May 11 12:20:47 2023 +0200
@@ -11,6 +11,7 @@
   val welcome: unit -> string
   val shutdown: unit -> unit
   val finish: unit -> unit
+  val print_context_tracing: (Context.generic -> bool) -> unit
 end;
 
 structure Session: SESSION =
@@ -43,4 +44,8 @@
   Context.finish_tracing ();
   shutdown ());
 
+fun print_context_tracing pred =
+  List.app (writeln o Proof_Display.print_context_tracing)
+    (filter (pred o #1) (#contexts (Context.finish_tracing ())));
+
 end;