eq_thm (from drule.ML);
authorwenzelm
Fri, 24 Oct 1997 17:15:59 +0200
changeset 3994 0343230ec85c
parent 3993 f88e0f0e2666
child 3995 88fc1015d241
eq_thm (from drule.ML);
src/Pure/thm.ML
--- a/src/Pure/thm.ML	Fri Oct 24 17:14:41 1997 +0200
+++ b/src/Pure/thm.ML	Fri Oct 24 17:15:59 1997 +0200
@@ -86,6 +86,7 @@
   val crep_thm          : thm -> {sign: Sign.sg, der: deriv, maxidx: int,
                                   shyps: sort list, hyps: cterm list, 
                                   prop: cterm}
+  val eq_thm		: thm * thm -> bool
   val sign_of_thm       : thm -> Sign.sg
   val transfer		: theory -> thm -> thm
   val tpairs_of         : thm -> (term * term) list
@@ -108,7 +109,6 @@
   val implies_elim      : thm -> thm -> thm
   val forall_intr       : cterm -> thm -> thm
   val forall_elim       : cterm -> thm -> thm
-  val flexpair_def      : thm
   val reflexive         : cterm -> thm
   val symmetric         : thm -> thm
   val transitive        : thm -> thm -> thm
@@ -408,6 +408,18 @@
 (*errors involving theorems*)
 exception THM of string * int * thm list;
 
+(*equality of theorems uses equality of signatures and the
+  a-convertible test for terms*)
+fun eq_thm (th1, th2) =
+  let
+    val {sign = sg1, shyps = shyps1, hyps = hyps1, prop = prop1, ...} = rep_thm th1;
+    val {sign = sg2, shyps = shyps2, hyps = hyps2, prop = prop2, ...} = rep_thm th2;
+  in
+    Sign.eq_sg (sg1, sg2) andalso
+    eq_set_sort (shyps1, shyps2) andalso
+    aconvs (hyps1, hyps2) andalso
+    prop1 aconv prop2
+  end;
 
 fun sign_of_thm (Thm {sign_ref, ...}) = Sign.deref sign_ref;
 
@@ -565,11 +577,11 @@
 (*look up the named axiom in the theory*)
 fun get_axiom theory raw_name =
   let
-    val name = Sign.intern (sign_of theory) Theory.thmK raw_name;
+    val name = Sign.intern (sign_of theory) Theory.axiomK raw_name;
     fun get_ax [] = raise Match
       | get_ax (thy :: thys) =
-          let val {sign, new_axioms, parents, ...} = rep_theory thy
-          in case Symtab.lookup (new_axioms, name) of
+          let val {sign, axioms, parents, ...} = rep_theory thy
+          in case Symtab.lookup (axioms, name) of
                 Some t => fix_shyps [] []
                            (Thm {sign_ref = Sign.self_ref sign,
                                  der = infer_derivs (Axiom(theory,name), []),
@@ -581,14 +593,14 @@
           end;
   in
     get_ax [theory] handle Match
-      => raise THEORY ("get_axiom: no axiom " ^ quote name, [theory])
+      => raise THEORY ("No axiom " ^ quote name, [theory])
   end;
 
 
 (*return additional axioms of this theory node*)
 fun axioms_of thy =
   map (fn (s, _) => (s, get_axiom thy s))
-    (Symtab.dest (#new_axioms (rep_theory thy)));
+    (Symtab.dest (#axioms (rep_theory thy)));
 
 (*Attach a label to a theorem to make proof objects more readable*)
 fun name_thm (name, th as Thm {sign_ref, der, maxidx, shyps, hyps, prop}) = 
@@ -747,16 +759,6 @@
 
 (* Equality *)
 
-(* Definition of the relation =?= *)
-val flexpair_def = fix_shyps [] []
-  (Thm{sign_ref= Sign.self_ref Sign.proto_pure, 
-       der = Join(Axiom(Theory.proto_pure, "flexpair_def"), []),
-       shyps = [], 
-       hyps = [], 
-       maxidx = 0,
-       prop = term_of (read_cterm Sign.proto_pure
-                       ("(?t =?= ?u) == (?t == ?u::?'a::{})", propT))});
-
 (*The reflexivity rule: maps  t   to the theorem   t==t   *)
 fun reflexive ct =
   let val Cterm {sign_ref, t, T, maxidx} = ct