| author | Cezary Kaliszyk <kaliszyk@in.tum.de> | 
| Mon, 22 Nov 2010 16:16:25 +0900 | |
| changeset 2575 | b1d38940040a | 
| parent 2573 | 6c131c089ce2 | 
| child 2576 | 67828f23c4e9 | 
| permissions | -rw-r--r-- | 
| 2573 | 1 | theory Foo2 | 
| 2 | imports "../Nominal2" | |
| 3 | begin | |
| 4 | ||
| 5 | (* | |
| 6 | Contrived example that has more than one | |
| 7 | binding clause | |
| 8 | *) | |
| 9 | ||
| 10 | atom_decl name | |
| 11 | ||
| 12 | nominal_datatype foo: trm = | |
| 13 | Var "name" | |
| 14 | | App "trm" "trm" | |
| 15 | | Lam x::"name" t::"trm" bind x in t | |
| 16 | | Let1 a1::"assg" t1::"trm" a2::"assg" t2::"trm" bind "bn a1" in t1, bind "bn a2" in t2 | |
| 17 | | Let2 x::"name" y::"name" t1::"trm" t2::"trm" bind x y in t1, bind y in t2 | |
| 18 | and assg = | |
| 19 | As_Nil | |
| 20 | | As "name" x::"name" t::"trm" "assg" | |
| 21 | binder | |
| 22 | bn::"assg \<Rightarrow> atom list" | |
| 23 | where | |
| 24 | "bn (As x y t a) = [atom x] @ bn a" | |
| 25 | | "bn (As_Nil) = []" | |
| 26 | ||
| 27 | thm foo.perm_bn_simps | |
| 28 | ||
| 29 | ||
| 30 | thm foo.distinct | |
| 31 | thm foo.induct | |
| 32 | thm foo.inducts | |
| 33 | thm foo.exhaust | |
| 34 | thm foo.fv_defs | |
| 35 | thm foo.bn_defs | |
| 36 | thm foo.perm_simps | |
| 2575 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 37 | thm foo.eq_iff(5) | 
| 2573 | 38 | thm foo.fv_bn_eqvt | 
| 39 | thm foo.size_eqvt | |
| 40 | thm foo.supports | |
| 41 | thm foo.fsupp | |
| 42 | thm foo.supp | |
| 43 | thm foo.fresh | |
| 44 | ||
| 45 | lemma uu1: | |
| 46 | shows "alpha_bn as (permute_bn p as)" | |
| 47 | apply(induct as rule: foo.inducts(2)) | |
| 48 | apply(auto)[5] | |
| 49 | apply(simp add: foo.perm_bn_simps) | |
| 50 | apply(simp add: foo.eq_iff) | |
| 51 | apply(simp add: foo.perm_bn_simps) | |
| 52 | apply(simp add: foo.eq_iff) | |
| 53 | done | |
| 54 | ||
| 55 | lemma tt1: | |
| 56 | shows "(p \<bullet> bn as) = bn (permute_bn p as)" | |
| 57 | apply(induct as rule: foo.inducts(2)) | |
| 58 | apply(auto)[5] | |
| 59 | apply(simp add: foo.perm_bn_simps foo.bn_defs) | |
| 60 | apply(simp add: foo.perm_bn_simps foo.bn_defs) | |
| 61 | apply(simp add: atom_eqvt) | |
| 62 | done | |
| 63 | ||
| 64 | ||
| 65 | lemma Let1_rename: | |
| 66 | assumes "supp ([bn assn1]lst. trm1) \<sharp>* p" "supp ([bn assn2]lst. trm2) \<sharp>* p" | |
| 67 | shows "Let1 assn1 trm1 assn2 trm2 = Let1 (permute_bn p assn1) (p \<bullet> trm1) (permute_bn p assn2) (p \<bullet> trm2)" | |
| 68 | using assms | |
| 69 | apply - | |
| 70 | apply(drule supp_perm_eq[symmetric]) | |
| 71 | apply(drule supp_perm_eq[symmetric]) | |
| 72 | apply(simp only: permute_Abs) | |
| 73 | apply(simp only: tt1) | |
| 74 | apply(simp only: foo.eq_iff) | |
| 75 | apply(simp add: uu1) | |
| 76 | done | |
| 77 | ||
| 2575 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 78 | lemma Let2_rename: | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 79 | assumes "(supp ([[atom x, atom y]]lst. t1)) \<sharp>* p" and "(supp ([[atom y]]lst. t2)) \<sharp>* p" | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 80 | shows "Let2 x y t1 t2 = Let2 (p \<bullet> x) (p \<bullet> y) (p \<bullet> t1) (p \<bullet> t2)" | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 81 | using assms | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 82 | apply - | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 83 | apply(drule supp_perm_eq[symmetric]) | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 84 | apply(drule supp_perm_eq[symmetric]) | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 85 | apply(simp only: foo.eq_iff) | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 86 | apply(simp only: eqvts) | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 87 | apply simp | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 88 | done | 
| 
b1d38940040a
single rename in let2
 Cezary Kaliszyk <kaliszyk@in.tum.de> parents: 
2573diff
changeset | 89 | |
| 2573 | 90 | lemma strong_exhaust1: | 
| 91 | fixes c::"'a::fs" | |
| 92 | assumes "\<And>name. y = Var name \<Longrightarrow> P" | |
| 93 | and "\<And>trm1 trm2. y = App trm1 trm2 \<Longrightarrow> P" | |
| 94 |   and     "\<And>name trm. \<lbrakk>{atom name} \<sharp>* c; y = Lam name trm\<rbrakk> \<Longrightarrow> P" 
 | |
| 95 | and "\<And>assn1 trm1 assn2 trm2. | |
| 96 | \<lbrakk>((set (bn assn1)) \<union> (set (bn assn2))) \<sharp>* c; y = Let1 assn1 trm1 assn2 trm2\<rbrakk> \<Longrightarrow> P" | |
| 97 |   and     "\<And>x1 x2 trm1 trm2. \<lbrakk>{atom x1, atom x2} \<sharp>* c; y = Let2 x1 x2 trm1 trm2\<rbrakk> \<Longrightarrow> P"
 | |
| 98 | shows "P" | |
| 99 | apply(rule_tac y="y" in foo.exhaust(1)) | |
| 100 | apply(rule assms(1)) | |
| 101 | apply(assumption) | |
| 102 | apply(rule assms(2)) | |
| 103 | apply(assumption) | |
| 104 | apply(subgoal_tac "\<exists>q. (q \<bullet> {atom name}) \<sharp>* c \<and> supp (Lam name trm) \<sharp>* q")
 | |
| 105 | apply(erule exE) | |
| 106 | apply(erule conjE) | |
| 107 | apply(rule assms(3)) | |
| 108 | apply(perm_simp) | |
| 109 | apply(assumption) | |
| 110 | apply(simp) | |
| 111 | apply(drule supp_perm_eq[symmetric]) | |
| 112 | apply(perm_simp) | |
| 113 | apply(simp) | |
| 114 | apply(rule at_set_avoiding2) | |
| 115 | apply(simp add: finite_supp) | |
| 116 | apply(simp add: finite_supp) | |
| 117 | apply(simp add: finite_supp) | |
| 118 | apply(simp add: foo.fresh fresh_star_def) | |
| 119 | apply(subgoal_tac "\<exists>q. (q \<bullet> (set (bn assg1))) \<sharp>* c \<and> supp ([bn assg1]lst. trm1) \<sharp>* q") | |
| 120 | apply(subgoal_tac "\<exists>q. (q \<bullet> (set (bn assg2))) \<sharp>* c \<and> supp ([bn assg2]lst. trm2) \<sharp>* q") | |
| 121 | apply(erule exE)+ | |
| 122 | apply(erule conjE)+ | |
| 123 | apply(rule assms(4)) | |
| 124 | apply(simp add: set_eqvt union_eqvt) | |
| 125 | apply(simp add: tt1) | |
| 126 | apply(simp add: fresh_star_union) | |
| 127 | apply(rule conjI) | |
| 128 | apply(assumption) | |
| 129 | apply(rotate_tac 3) | |
| 130 | apply(assumption) | |
| 131 | apply(simp add: foo.eq_iff) | |
| 132 | apply(drule supp_perm_eq[symmetric])+ | |
| 133 | apply(simp add: tt1 uu1) | |
| 134 | apply(auto)[1] | |
| 135 | apply(rule at_set_avoiding2) | |
| 136 | apply(simp add: finite_supp) | |
| 137 | apply(simp add: finite_supp) | |
| 138 | apply(simp add: finite_supp) | |
| 139 | apply(simp add: Abs_fresh_star) | |
| 140 | apply(rule at_set_avoiding2) | |
| 141 | apply(simp add: finite_supp) | |
| 142 | apply(simp add: finite_supp) | |
| 143 | apply(simp add: finite_supp) | |
| 144 | apply(simp add: Abs_fresh_star) | |
| 145 | thm foo.eq_iff | |
| 146 | apply(subgoal_tac | |
| 147 |   "\<exists>q. (q \<bullet> {atom name1}) \<sharp>* c \<and> supp ([[atom name1]]lst. trm1) \<sharp>* q")
 | |
| 148 | apply(subgoal_tac | |
| 149 |   "\<exists>q. (q \<bullet> {atom name2}) \<sharp>* c \<and> supp ([[atom name2]]lst. trm2) \<sharp>* q")
 | |
| 150 | apply(erule exE)+ | |
| 151 | apply(erule conjE)+ | |
| 152 | apply(rule assms(5)) | |
| 153 | apply(perm_simp) | |
| 154 | apply(simp (no_asm) add: fresh_star_insert) | |
| 155 | apply(rule conjI) | |
| 156 | apply(simp add: fresh_star_def) | |
| 157 | apply(rotate_tac 3) | |
| 158 | apply(simp add: fresh_star_def) | |
| 159 | apply(simp) | |
| 160 | apply(simp add: foo.eq_iff) | |
| 161 | apply(drule supp_perm_eq[symmetric])+ | |
| 162 | apply(simp add: atom_eqvt) | |
| 163 | apply(rule conjI) | |
| 164 | oops | |
| 165 | ||
| 166 | ||
| 167 | end | |
| 168 | ||
| 169 | ||
| 170 |