modernized setup;
authorwenzelm
Wed, 29 Oct 2014 15:28:27 +0100
changeset 58824 d480d1d7c544
parent 58823 513268cb2178
child 58825 2065f49da190
modernized setup;
src/HOL/Nat_Transfer.thy
src/HOL/Tools/legacy_transfer.ML
--- a/src/HOL/Nat_Transfer.thy	Wed Oct 29 15:15:17 2014 +0100
+++ b/src/HOL/Nat_Transfer.thy	Wed Oct 29 15:28:27 2014 +0100
@@ -16,7 +16,6 @@
   by (simp add: transfer_morphism_def)
 
 ML_file "Tools/legacy_transfer.ML"
-setup Legacy_Transfer.setup
 
 
 subsection {* Set up transfer from nat to int *}
--- a/src/HOL/Tools/legacy_transfer.ML	Wed Oct 29 15:15:17 2014 +0100
+++ b/src/HOL/Tools/legacy_transfer.ML	Wed Oct 29 15:28:27 2014 +0100
@@ -14,7 +14,6 @@
   val add: thm -> bool -> entry -> Context.generic -> Context.generic
   val del: thm -> entry -> Context.generic -> Context.generic
   val drop: thm -> Context.generic -> Context.generic
-  val setup: theory -> theory
 end;
 
 structure Legacy_Transfer : LEGACY_TRANSFER =
@@ -112,7 +111,7 @@
     val transform = Thm.apply @{cterm "Trueprop"} o Thm.apply D;
     val T = Thm.typ_of (Thm.ctyp_of_term a);
     val (aT, bT) = (Term.range_type T, Term.domain_type T);
-    
+
     (* determine variables to transfer *)
     val ctxt3 = ctxt2
       |> Variable.declare_thm thm
@@ -168,7 +167,7 @@
       cong = union Thm.eq_thm cong1 cong2, hints = union (op =) hints1 hints2 }
   end;
 
-fun diminish_entry 
+fun diminish_entry
     { inj = inj0, embed = embed0, return = return0, cong = cong0, hints = hints0 }
     { inj = inj2, embed = embed2, return = return2, cong = cong2, hints = hints2 } =
   { inj = subtract Thm.eq_thm inj0 inj2, embed = subtract Thm.eq_thm embed0 embed2,
@@ -243,28 +242,23 @@
 
 in
 
-val transfer_attribute = keyword delN >> K (Thm.declaration_attribute drop)
-  || keyword addN |-- Scan.optional mode true -- entry_pair
-    >> (fn (guess, (entry_add, entry_del)) => Thm.declaration_attribute
-      (fn thm => add thm guess entry_add #> del thm entry_del))
-  || keyword_colon keyN |-- Attrib.thm
-    >> (fn key => Thm.declaration_attribute
-      (fn thm => add key false
-        { inj = [], embed = [], return = [thm], cong = [], hints = [] }));
-
-val transferred_attribute = selection -- these (keyword_colon leavingN |-- names)
-  >> (fn (selection, leave) => Thm.rule_attribute (fn context =>
-      Conjunction.intr_balanced o transfer context selection leave));
+val _ =
+  Theory.setup
+   (Attrib.setup @{binding transfer}
+      (keyword delN >> K (Thm.declaration_attribute drop)
+    || keyword addN |-- Scan.optional mode true -- entry_pair
+      >> (fn (guess, (entry_add, entry_del)) =>
+          Thm.declaration_attribute (fn thm => add thm guess entry_add #> del thm entry_del))
+    || keyword_colon keyN |-- Attrib.thm
+      >> (fn key => Thm.declaration_attribute (fn thm =>
+            add key false { inj = [], embed = [], return = [thm], cong = [], hints = [] })))
+    "install transfer data" #>
+    Attrib.setup @{binding transferred}
+      (selection -- these (keyword_colon leavingN |-- names)
+        >> (fn (selection, leave) => Thm.rule_attribute (fn context =>
+              Conjunction.intr_balanced o transfer context selection leave)))
+    "transfer theorems");
 
 end;
 
-
-(* theory setup *)
-
-val setup =
-  Attrib.setup @{binding transfer} transfer_attribute
-    "Installs transfer data" #>
-  Attrib.setup @{binding transferred} transferred_attribute
-    "Transfers theorems";
-
 end;