open typedefs everywhere in the package
authortraytel
Sun, 09 Sep 2012 10:58:11 +0200
changeset 49228 e43910ccee74
parent 49227 2652319c394e
child 49229 d5717b5e2217
open typedefs everywhere in the package
src/HOL/Codatatype/Tools/bnf_comp.ML
src/HOL/Codatatype/Tools/bnf_fp_util.ML
src/HOL/Codatatype/Tools/bnf_gfp.ML
src/HOL/Codatatype/Tools/bnf_lfp.ML
src/HOL/Codatatype/Tools/bnf_tactics.ML
src/HOL/Codatatype/Tools/bnf_util.ML
--- a/src/HOL/Codatatype/Tools/bnf_comp.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_comp.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -658,23 +658,15 @@
     val params = fold Term.add_tfreesT Ds [];
     val deads = map TFree params;
 
-    val ((bdT_name, (bdT_glob_info, bdT_loc_info)), (lthy', lthy)) =
-      lthy
-      |> Typedef.add_typedef true NONE (bdT_bind, params, NoSyn)
-        (HOLogic.mk_UNIV bd_repT) NONE (EVERY' [rtac exI, rtac UNIV_I] 1)
-      ||> `Local_Theory.restore;
-
-    val phi = Proof_Context.export_morphism lthy lthy';
+    val ((bdT_name, (bdT_glob_info, bdT_loc_info)), lthy) =
+      typedef false NONE (bdT_bind, params, NoSyn)
+        (HOLogic.mk_UNIV bd_repT) NONE (EVERY' [rtac exI, rtac UNIV_I] 1) lthy;
 
     val bnf_bd' = mk_dir_image bnf_bd
       (Const (#Abs_name bdT_glob_info, bd_repT --> Type (bdT_name, deads)))
 
-    val set_def = Morphism.thm phi (the (#set_def bdT_loc_info));
-    val Abs_inject = Morphism.thm phi (#Abs_inject bdT_loc_info);
-    val Abs_cases = Morphism.thm phi (#Abs_cases bdT_loc_info);
-
-    val Abs_bdT_inj = mk_Abs_inj_thm set_def Abs_inject;
-    val Abs_bdT_bij = mk_Abs_bij_thm lthy' set_def Abs_inject Abs_cases;
+    val Abs_bdT_inj = mk_Abs_inj_thm (#Abs_inject bdT_loc_info);
+    val Abs_bdT_bij = mk_Abs_bij_thm lthy Abs_bdT_inj (#Abs_cases bdT_loc_info);
 
     val bd_ordIso = @{thm dir_image} OF [Abs_bdT_inj, bd_Card_order_of_bnf bnf];
     val bd_card_order =
--- a/src/HOL/Codatatype/Tools/bnf_fp_util.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_fp_util.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -77,9 +77,6 @@
   val mk_set_minimalN: int -> string
   val mk_set_inductN: int -> string
 
-  val typedef: bool -> binding option -> binding * (string * sort) list * mixfix -> term ->
-    (binding * binding) option -> tactic -> local_theory -> (string * Typedef.info) * local_theory
-
   val split_conj_thm: thm -> thm list
   val split_conj_prems: int -> thm -> thm
 
@@ -126,18 +123,6 @@
   then warning (msg ^ ": " ^ ATP_Util.string_from_time (Timer.checkRealTimer timer))
   else (); Timer.startRealTimer ());
 
-(*TODO: is this really different from Typedef.add_typedef_global?*)
-fun typedef def opt_name typ set opt_morphs tac lthy =
-  let
-    val ((name, info), (lthy, lthy_old)) =
-      lthy
-      |> Typedef.add_typedef def opt_name typ set opt_morphs tac
-      ||> `Local_Theory.restore;
-    val phi = Proof_Context.export_morphism lthy_old lthy;
-  in
-    ((name, Typedef.transform_info phi info), lthy)
-  end;
-
 val preN = "pre_"
 val rawN = "raw_"
 
--- a/src/HOL/Codatatype/Tools/bnf_gfp.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_gfp.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -1028,7 +1028,7 @@
           val sbdT_bind = Binding.suffix_name ("_" ^ sum_bdTN) b;
 
           val ((sbdT_name, (sbdT_glob_info, sbdT_loc_info)), lthy) =
-            typedef true NONE (sbdT_bind, params, NoSyn)
+            typedef false NONE (sbdT_bind, params, NoSyn)
               (HOLogic.mk_UNIV sum_bdT) NONE (EVERY' [rtac exI, rtac UNIV_I] 1) lthy;
 
           val sbdT = Type (sbdT_name, params');
@@ -1052,12 +1052,8 @@
           val sbd_def = Morphism.thm phi sbd_def_free;
           val sbd = Const (fst (Term.dest_Const (Morphism.term phi sbd_free)), mk_relT (`I sbdT));
 
-          val sbdT_set_def = the (#set_def sbdT_loc_info);
-          val sbdT_Abs_inject = #Abs_inject sbdT_loc_info;
-          val sbdT_Abs_cases = #Abs_cases sbdT_loc_info;
-
-          val Abs_sbdT_inj = mk_Abs_inj_thm sbdT_set_def sbdT_Abs_inject;
-          val Abs_sbdT_bij = mk_Abs_bij_thm lthy sbdT_set_def sbdT_Abs_inject sbdT_Abs_cases;
+          val Abs_sbdT_inj = mk_Abs_inj_thm (#Abs_inject sbdT_loc_info);
+          val Abs_sbdT_bij = mk_Abs_bij_thm lthy Abs_sbdT_inj (#Abs_cases sbdT_loc_info);
 
           fun mk_sum_Cinfinite [thm] = thm
             | mk_sum_Cinfinite (thm :: thms) =
--- a/src/HOL/Codatatype/Tools/bnf_lfp.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_lfp.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -774,14 +774,13 @@
     val IIT_bind = Binding.suffix_name ("_" ^ IITN) b;
 
     val ((IIT_name, (IIT_glob_info, IIT_loc_info)), lthy) =
-      typedef true NONE (IIT_bind, params, NoSyn)
+      typedef false NONE (IIT_bind, params, NoSyn)
         (HOLogic.mk_UNIV II_repT) NONE (EVERY' [rtac exI, rtac UNIV_I] 1) lthy;
 
     val IIT = Type (IIT_name, params');
     val Abs_IIT = Const (#Abs_name IIT_glob_info, II_repT --> IIT);
     val Rep_IIT = Const (#Rep_name IIT_glob_info, IIT --> II_repT);
-    val Abs_IIT_inverse_thm =
-      mk_Abs_inverse_thm (the (#set_def IIT_loc_info)) (#Abs_inverse IIT_loc_info);
+    val Abs_IIT_inverse_thm = UNIV_I RS #Abs_inverse IIT_loc_info;
 
     val initT = IIT --> Asuc_bdT;
     val active_initTs = replicate n initT;
--- a/src/HOL/Codatatype/Tools/bnf_tactics.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_tactics.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -20,12 +20,8 @@
   val mk_rotate_eq_tac: (int -> tactic) -> thm -> thm -> thm -> thm -> ''a list -> ''a list ->
     int -> tactic
 
-  val mk_Abs_bij_thm: Proof.context -> thm -> thm -> thm -> thm
-  val mk_Abs_inj_thm: thm -> thm -> thm
-  val mk_Abs_inverse_thm: thm -> thm -> thm
-  val mk_T_I: thm -> thm
-  val mk_T_subset1: thm -> thm
-  val mk_T_subset2: thm -> thm
+  val mk_Abs_bij_thm: Proof.context -> thm -> thm -> thm
+  val mk_Abs_inj_thm: thm -> thm
 
   val mk_Card_order_tac: thm -> tactic
   val mk_collect_set_natural_tac: Proof.context -> thm list -> tactic
@@ -81,17 +77,11 @@
 
 
 
-(* Theorems for typedefs with UNIV as representing set *)
+(* Theorems for open typedefs with UNIV as representing set *)
 
-(*equivalent to UNIV_I for the representing set of the particular type T*)
-fun mk_T_subset1 def = set_mp OF [def RS meta_eq_to_obj_eq RS equalityD2];
-fun mk_T_subset2 def = set_mp OF [def RS meta_eq_to_obj_eq RS equalityD1];
-fun mk_T_I def = UNIV_I RS mk_T_subset1 def;
-
-fun mk_Abs_inverse_thm def inv = mk_T_I def RS inv;
-fun mk_Abs_inj_thm def inj = inj OF (replicate 2 (mk_T_I def));
-fun mk_Abs_bij_thm ctxt def inj surj = rule_by_tactic ctxt ((rtac surj THEN' etac exI) 1)
-  (mk_Abs_inj_thm def inj RS @{thm bijI});
+fun mk_Abs_inj_thm inj = inj OF (replicate 2 UNIV_I);
+fun mk_Abs_bij_thm ctxt Abs_inj_thm surj = rule_by_tactic ctxt ((rtac surj THEN' etac exI) 1)
+  (Abs_inj_thm RS @{thm bijI});
 
 
 
--- a/src/HOL/Codatatype/Tools/bnf_util.ML	Sun Sep 09 10:15:58 2012 +0200
+++ b/src/HOL/Codatatype/Tools/bnf_util.ML	Sun Sep 09 10:58:11 2012 +0200
@@ -124,6 +124,9 @@
   val certifyT: Proof.context -> typ -> ctyp
   val certify: Proof.context -> term -> cterm
 
+  val typedef: bool -> binding option -> binding * (string * sort) list * mixfix -> term ->
+    (binding * binding) option -> tactic -> local_theory -> (string * Typedef.info) * local_theory
+
   val WRAP: ('a -> tactic) -> ('a -> tactic) -> 'a list -> tactic -> tactic
   val WRAP': ('a -> int -> tactic) -> ('a -> int -> tactic) -> 'a list -> (int -> tactic) -> int ->
     tactic
@@ -243,6 +246,18 @@
 fun certify ctxt = Thm.cterm_of (Proof_Context.theory_of ctxt);
 fun certifyT ctxt = Thm.ctyp_of (Proof_Context.theory_of ctxt);
 
+(*TODO: is this really different from Typedef.add_typedef_global?*)
+fun typedef def opt_name typ set opt_morphs tac lthy =
+  let
+    val ((name, info), (lthy, lthy_old)) =
+      lthy
+      |> Typedef.add_typedef def opt_name typ set opt_morphs tac
+      ||> `Local_Theory.restore;
+    val phi = Proof_Context.export_morphism lthy_old lthy;
+  in
+    ((name, Typedef.transform_info phi info), lthy)
+  end;
+
 (*Tactical WRAP surrounds a static given tactic (core) with two deterministic chains of tactics*)
 fun WRAP gen_before gen_after xs core_tac =
   fold_rev (fn x => fn tac => gen_before x THEN tac THEN gen_after x) xs core_tac;