added read_def_cterms, read_cterm (from thm.ML);
authorwenzelm
Sat, 14 Apr 2007 17:36:10 +0200
changeset 22682 92448396c9d9
parent 22681 9d42e5365ad1
child 22683 0e9a65ddfe9d
added read_def_cterms, read_cterm (from thm.ML);
src/Pure/more_thm.ML
--- a/src/Pure/more_thm.ML	Sat Apr 14 17:36:09 2007 +0200
+++ b/src/Pure/more_thm.ML	Sat Apr 14 17:36:10 2007 +0200
@@ -27,14 +27,20 @@
   val proof_attributes: attribute list -> Proof.context * thm -> Proof.context * thm
   val no_attributes: 'a -> 'a * 'b list
   val simple_fact: 'a -> ('a * 'b list) list
+  val read_def_cterms:
+    theory * (indexname -> typ option) * (indexname -> sort option) ->
+    string list -> bool -> (string * typ)list
+    -> cterm list * (indexname * typ)list
+  val read_cterm: theory -> string * typ -> cterm
 end;
 
 structure Thm: THM =
 struct
 
-(* compare theorems *)
+(** compare theorems **)
 
-(*order: ignores theory context!*)
+(* order: ignores theory context! *)
+
 fun thm_ord (th1, th2) =
   let
     val {shyps = shyps1, hyps = hyps1, tpairs = tpairs1, prop = prop1, ...} = Thm.rep_thm th1;
@@ -51,6 +57,9 @@
     | ord => ord)
   end;
 
+
+(* equality *)
+
 fun eq_thm ths =
   Context.joinable (pairself Thm.theory_of_thm ths) andalso
   thm_ord ths = EQUAL;
@@ -60,12 +69,15 @@
 val eq_thm_thy = eq_thy o pairself Thm.theory_of_thm;
 val eq_thm_prop = op aconv o pairself Thm.full_prop_of;
 
-(*pattern equivalence*)
+
+(* pattern equivalence *)
+
 fun equiv_thm ths =
   Pattern.equiv (Theory.merge (pairself Thm.theory_of_thm ths)) (pairself Thm.full_prop_of ths);
 
 
-(* theorem kinds *)
+
+(** theorem kinds **)
 
 val axiomK = "axiom";
 val assumptionK = "assumption";
@@ -76,7 +88,8 @@
 val internalK = "internal";
 
 
-(* attributes *)
+
+(** attributes **)
 
 fun rule_attribute f (x, th) = (x, f x th);
 fun declaration_attribute f (x, th) = (f th x, th);
@@ -94,6 +107,21 @@
 fun simple_fact x = [(x, [])];
 
 
+(** read/certify terms (obsolete) **)    (*exception ERROR*)
+
+fun read_def_cterms (thy, types, sorts) used freeze sTs =
+  let
+    val (ts', tye) = Sign.read_def_terms (thy, types, sorts) used freeze sTs;
+    val cts = map (Thm.cterm_of thy) ts'
+      handle TYPE (msg, _, _) => error msg
+           | TERM (msg, _) => error msg;
+  in (cts, tye) end;
+
+fun read_cterm thy sT =
+  let val ([ct], _) = read_def_cterms (thy, K NONE, K NONE) [] true [sT]
+  in ct end;
+
+
 open Thm;
 
 end;