--- a/src/Pure/drule.ML Sat Oct 13 20:31:34 2001 +0200
+++ b/src/Pure/drule.ML Sat Oct 13 20:32:07 2001 +0200
@@ -89,8 +89,13 @@
val untag_rule : string -> thm -> thm
val tag : tag -> 'a attribute
val untag : string -> 'a attribute
- val tag_lemma : 'a attribute
- val tag_internal : 'a attribute
+ val get_kind : thm -> string
+ val kind : string -> 'a attribute
+ val theoremK : string
+ val lemmaK : string
+ val corollaryK : string
+ val internalK : string
+ val kind_internal : 'a attribute
val has_internal : tag list -> bool
val close_derivation : thm -> thm
val compose_single : thm * int * thm -> thm
@@ -249,11 +254,23 @@
fun simple_tag name x = tag (name, []) x;
-fun tag_lemma x = simple_tag "lemma" x;
+
+(* theorem kinds *)
+
+val theoremK = "theorem";
+val lemmaK = "lemma";
+val corollaryK = "corollary";
+val internalK = "internal";
-val internal_tag = ("internal", []);
-fun tag_internal x = tag internal_tag x;
-fun has_internal tags = exists (equal internal_tag) tags;
+fun get_kind thm =
+ (case Library.assoc (#2 (Thm.get_name_tags thm), "kind") of
+ Some (k :: _) => k
+ | _ => "unknown");
+
+fun kind_rule k = tag_rule ("kind", [k]) o untag_rule "kind";
+fun kind k x = rule_attribute (K (kind_rule k)) x;
+fun kind_internal x = kind internalK x;
+fun has_internal tags = exists (equal internalK o fst) tags;
@@ -726,9 +743,9 @@
val G = Logic.mk_goal A;
val (G_def, _) = freeze_thaw ProtoPure.Goal_def;
in
- val triv_goal = store_thm "triv_goal" (tag_rule internal_tag (standard
+ val triv_goal = store_thm "triv_goal" (kind_rule internalK (standard
(Thm.equal_elim (Thm.symmetric G_def) (Thm.assume (cert A)))));
- val rev_triv_goal = store_thm "rev_triv_goal" (tag_rule internal_tag (standard
+ val rev_triv_goal = store_thm "rev_triv_goal" (kind_rule internalK (standard
(Thm.equal_elim G_def (Thm.assume (cert G)))));
end;