Nominal/Nominal2.thy
changeset 2561 7926f1cb45eb
parent 2560 82e37a4595c7
child 2562 e8ec504dddf2
--- a/Nominal/Nominal2.thy	Fri Nov 12 01:20:53 2010 +0000
+++ b/Nominal/Nominal2.thy	Sat Nov 13 10:25:03 2010 +0000
@@ -315,7 +315,7 @@
     else raise TEST lthy3
 
   (* defining the permute_bn functions *)
-  val (_, _, lthy3b) = 
+  val (raw_perm_bns, raw_perm_bn_simps, lthy3b) = 
     if get_STEPS lthy3a > 2
     then define_raw_bn_perms raw_tys raw_bn_info raw_cns_info 
       (raw_inject_thms @ raw_distinct_thms) raw_size_thms lthy3a
@@ -447,11 +447,18 @@
     then raw_alpha_bn_rsp alpha_bn_trms alpha_bn_equivp_thms alpha_bn_imp_thms
     else raise TEST lthy6 
 
+  val raw_perm_bn_rsp =
+    if get_STEPS lthy > 21
+    then raw_perm_bn_rsp (alpha_trms @ alpha_bn_trms) raw_perm_bns alpha_induct 
+      alpha_intros raw_perm_bn_simps lthy6
+    else raise TEST lthy6
+
   (* noting the quot_respects lemmas *)
   val (_, lthy6a) = 
-    if get_STEPS lthy > 21
+    if get_STEPS lthy > 22
     then Local_Theory.note ((Binding.empty, [rsp_attr]),
-      raw_constrs_rsp @ raw_funs_rsp @ raw_size_rsp @ alpha_permute_rsp @ alpha_bn_rsp) lthy6
+      raw_constrs_rsp @ raw_funs_rsp @ raw_size_rsp @ alpha_permute_rsp @ 
+      alpha_bn_rsp @ raw_perm_bn_rsp) lthy6
     else raise TEST lthy6
 
   (* defining the quotient type *)
@@ -459,7 +466,7 @@
   val qty_descr = map (fn (vs, bind, mx, _) => (vs, bind, mx)) dts
      
   val (qty_infos, lthy7) = 
-    if get_STEPS lthy > 22
+    if get_STEPS lthy > 23
     then define_qtypes qty_descr alpha_tys alpha_trms alpha_equivp_thms lthy6a
     else raise TEST lthy6a
 
@@ -492,7 +499,7 @@
     map2 (fn n => fn t => ("size_" ^ n, t, NoSyn)) qty_names raw_size_trms
 
   val (((((qconstrs_info, qbns_info), qfvs_info), qfv_bns_info), qalpha_bns_info), lthy8) = 
-    if get_STEPS lthy > 23
+    if get_STEPS lthy > 24
     then 
       lthy7
       |> define_qconsts qtys qconstrs_descr 
@@ -504,12 +511,12 @@
 
   (* definition of the quotient permfunctions and pt-class *)
   val lthy9 = 
-    if get_STEPS lthy > 24
+    if get_STEPS lthy > 25
     then define_qperms qtys qty_full_names tvs qperm_descr raw_perm_laws lthy8 
     else raise TEST lthy8
   
   val lthy9a = 
-    if get_STEPS lthy > 25
+    if get_STEPS lthy > 26
     then define_qsizes qtys qty_full_names tvs qsize_descr lthy9
     else raise TEST lthy9
 
@@ -526,7 +533,7 @@
     prod.cases} 
 
   val ((((((qdistincts, qeq_iffs), qfv_defs), qbn_defs), qperm_simps), qfv_qbn_eqvts), lthyA) = 
-    if get_STEPS lthy > 26
+    if get_STEPS lthy > 27
     then 
       lthy9a    
       |> lift_thms qtys [] alpha_distincts  
@@ -538,7 +545,7 @@
     else raise TEST lthy9a
 
   val ((((qsize_eqvt, [qinduct]), qexhausts), qsize_simps), lthyB) = 
-    if get_STEPS lthy > 27
+    if get_STEPS lthy > 28
     then
       lthyA 
       |> lift_thms qtys [] raw_size_eqvt
@@ -552,26 +559,26 @@
   (* supports lemmas *) 
   val _ = warning "Proving Supports Lemmas and fs-Instances"
   val qsupports_thms =
-    if get_STEPS lthy > 28
+    if get_STEPS lthy > 29
     then prove_supports lthyB qperm_simps qtrms
     else raise TEST lthyB
 
   (* finite supp lemmas *)
   val qfsupp_thms =
-    if get_STEPS lthy > 29
+    if get_STEPS lthy > 30
     then prove_fsupp lthyB qtys qinduct qsupports_thms
     else raise TEST lthyB
 
   (* fs instances *)
   val lthyC =
-    if get_STEPS lthy > 30
+    if get_STEPS lthy > 31
     then fs_instance qtys qty_full_names tvs qfsupp_thms lthyB
     else raise TEST lthyB
 
   (* fv - supp equality *)
   val _ = warning "Proving Equality between fv and supp"
   val qfv_supp_thms = 
-    if get_STEPS lthy > 31
+    if get_STEPS lthy > 32
     then prove_fv_supp qtys qtrms qfvs qfv_bns qalpha_bns qfv_defs qeq_iffs 
       qperm_simps qfv_qbn_eqvts qinduct (flat raw_bclauses) lthyC
     else []