clarified operations, including exceptions;
authorwenzelm
Sun, 09 Jun 2024 20:19:53 +0200
changeset 80309 94f3e6ff4576
parent 80308 9aa11b457c36
child 80310 6d091c0c252e
clarified operations, including exceptions;
src/Pure/Isar/element.ML
src/Pure/more_thm.ML
--- a/src/Pure/Isar/element.ML	Sun Jun 09 20:04:41 2024 +0200
+++ b/src/Pure/Isar/element.ML	Sun Jun 09 20:19:53 2024 +0200
@@ -226,11 +226,12 @@
 
 fun thm_name ctxt kind th prts =
   let val head =
-    if Thm.has_name_hint th then
-      Pretty.block [Pretty.keyword1 kind, Pretty.brk 1,
-        Thy_Header.pretty_name' ctxt (Long_Name.base_name (#1 (Thm.get_name_hint th))),
-        Pretty.str ":"]
-    else Pretty.keyword1 kind
+    (case try Thm.the_name_hint th of
+      SOME (name, _) =>
+        Pretty.block [Pretty.keyword1 kind, Pretty.brk 1,
+          Thy_Header.pretty_name' ctxt (Long_Name.base_name name),
+          Pretty.str ":"]
+    | NONE => Pretty.keyword1 kind)
   in Pretty.block (Pretty.fbreaks (head :: prts)) end;
 
 fun obtain prop ctxt =
--- a/src/Pure/more_thm.ML	Sun Jun 09 20:04:41 2024 +0200
+++ b/src/Pure/more_thm.ML	Sun Jun 09 20:19:53 2024 +0200
@@ -87,6 +87,7 @@
   val def_binding: Binding.binding -> Binding.binding
   val def_binding_optional: Binding.binding -> Binding.binding -> Binding.binding
   val make_def_binding: bool -> Binding.binding -> Binding.binding
+  val the_name_hint: thm -> Thm_Name.T  (*exception THM*)
   val has_name_hint: thm -> bool
   val get_name_hint: thm -> Thm_Name.T
   val put_name_hint: Thm_Name.T -> thm -> thm
@@ -606,9 +607,16 @@
 
 (* unofficial theorem names *)
 
-fun has_name_hint thm = AList.defined (op =) (Thm.get_tags thm) Markup.nameN;
-fun the_name_hint thm = Thm_Name.parse (the (AList.lookup (op =) (Thm.get_tags thm) Markup.nameN));
-fun get_name_hint thm = if has_name_hint thm then the_name_hint thm else ("??.unknown", 0);
+fun the_name_hint thm =
+  let val thm_name = Thm_Name.parse (Properties.get_string (Thm.get_tags thm) Markup.nameN)
+  in
+    if Thm_Name.is_empty thm_name
+    then raise THM ("Thm.the_name_hint: missing name", 0, [thm])
+    else thm_name
+  end;
+
+fun has_name_hint thm = can the_name_hint thm;
+fun get_name_hint thm = try the_name_hint thm |> the_default ("??.unknown", 0);
 
 fun put_name_hint name = untag_rule Markup.nameN #> tag_rule (Markup.nameN, Thm_Name.print name);