clarified output;
authorwenzelm
Mon, 14 Jul 2025 11:18:10 +0200
changeset 82864 2703f19d323e
parent 82863 af6f55b15749
child 82865 639ceaf8eb0d
clarified output;
src/Provers/classical.ML
src/Pure/Isar/context_rules.ML
src/Pure/bires.ML
--- a/src/Provers/classical.ML	Mon Jul 14 10:57:46 2025 +0200
+++ b/src/Provers/classical.ML	Mon Jul 14 11:18:10 2025 +0200
@@ -867,13 +867,10 @@
 fun print_claset ctxt =
   let
     val {decls, swrappers, uwrappers, ...} = rep_claset_of ctxt;
-    val prt_rules =
-      Bires.pretty_decls ctxt
-        [Bires.intro_bang_kind, Bires.intro_kind, Bires.elim_bang_kind, Bires.elim_kind] decls;
     val prt_wrappers =
      [Pretty.strs ("safe wrappers:" :: map #1 swrappers),
       Pretty.strs ("unsafe wrappers:" :: map #1 uwrappers)];
-  in Pretty.writeln (Pretty.chunks (prt_rules @ prt_wrappers)) end;
+  in Pretty.writeln (Pretty.chunks (Bires.pretty_decls ctxt decls @ prt_wrappers)) end;
 
 val _ =
   Outer_Syntax.command \<^command_keyword>\<open>print_claset\<close> "print context of Classical Reasoner"
--- a/src/Pure/Isar/context_rules.ML	Mon Jul 14 10:57:46 2025 +0200
+++ b/src/Pure/Isar/context_rules.ML	Mon Jul 14 11:18:10 2025 +0200
@@ -113,7 +113,7 @@
 
 fun print_rules ctxt =
   let val Rules {decls, ...} = Data.get (Context.Proof ctxt)
-  in Pretty.writeln (Pretty.chunks (Bires.pretty_decls ctxt Bires.kind_domain decls)) end;
+  in Pretty.writeln (Pretty.chunks (Bires.pretty_decls ctxt decls)) end;
 
 
 (* access data *)
--- a/src/Pure/bires.ML	Mon Jul 14 10:57:46 2025 +0200
+++ b/src/Pure/bires.ML	Mon Jul 14 11:18:10 2025 +0200
@@ -47,7 +47,7 @@
   val has_decls: 'a decls -> thm -> bool
   val get_decls: 'a decls -> thm -> 'a decl list
   val dest_decls: 'a decls -> (thm * 'a decl -> bool) -> (thm * 'a decl) list
-  val pretty_decls: Proof.context -> kind list -> 'a decls -> Pretty.T list
+  val pretty_decls: Proof.context -> 'a decls -> Pretty.T list
   val merge_decls: 'a decls * 'a decls -> 'a decl list * 'a decls
   val extend_decls: thm * 'a decl -> 'a decls -> 'a decl option * 'a decls
   val remove_decls: thm -> 'a decls -> 'a decl list * 'a decls
@@ -120,8 +120,8 @@
 val kind_infos =
  [(intro_bang_kind, ("safe introduction", "(intro!)")),
   (elim_bang_kind, ("safe elimination", "(elim!)")),
-  (intro_kind, ("introduction", "(intro)")),
-  (elim_kind, ("elimination", "(elim)")),
+  (intro_kind, ("unsafe introduction", "(intro)")),
+  (elim_kind, ("unsafe elimination", "(elim)")),
   (intro_query_kind, ("extra introduction", "(intro?)")),
   (elim_query_kind, ("extra elimination", "(elim?)"))];
 
@@ -189,11 +189,13 @@
   build (rules |> Proptab.fold (fn (th, ds) => ds |> fold (fn d => pred (th, d) ? cons (th, d))))
   |> sort (decl_ord o apply2 #2);
 
-fun pretty_decls ctxt kinds decls =
-  kinds |> map (fn kind =>
-    Pretty.big_list (kind_title kind ^ ":")
-      (dest_decls decls (fn (_, {kind = kind', ...}) => kind = kind')
-        |> map (fn (th, _) => Thm.pretty_thm_item ctxt th)));
+fun pretty_decls ctxt decls =
+  kind_domain |> map_filter (fn kind =>
+    (case dest_decls decls (fn (_, {kind = kind', ...}) => kind = kind') of
+      [] => NONE
+    | ds =>
+        SOME (Pretty.big_list (kind_title kind ^ ":")
+          (map (Thm.pretty_thm_item ctxt o #1) ds))));
 
 fun merge_decls (decls1, decls2) =
   decls1 |> fold_map add_decls (rev (dest_decls decls2 (not o dup_decls decls1)));