1 theory Term5 |
|
2 imports "../Nominal2_Atoms" "../Nominal2_Eqvt" "../Nominal2_Supp" "../Abs" "../Perm" "../Fv" "../Rsp" |
|
3 begin |
|
4 |
|
5 atom_decl name |
|
6 |
|
7 datatype rtrm5 = |
|
8 rVr5 "name" |
|
9 | rAp5 "rtrm5" "rtrm5" |
|
10 | rLt5 "rlts" "rtrm5" --"bind (bv5 lts) in (rtrm5)" |
|
11 and rlts = |
|
12 rLnil |
|
13 | rLcons "name" "rtrm5" "rlts" |
|
14 |
|
15 primrec |
|
16 rbv5 |
|
17 where |
|
18 "rbv5 rLnil = {}" |
|
19 | "rbv5 (rLcons n t ltl) = {atom n} \<union> (rbv5 ltl)" |
|
20 |
|
21 |
|
22 setup {* snd o define_raw_perms (Datatype.the_info @{theory} "Term5.rtrm5") 2 *} |
|
23 print_theorems |
|
24 |
|
25 local_setup {* snd o define_fv_alpha (Datatype.the_info @{theory} "Term5.rtrm5") |
|
26 [[[], [], [(SOME (@{term rbv5}, true), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [(0,NONE), (2,SOME @{term rbv5})]])] *} |
|
27 print_theorems |
|
28 |
|
29 notation |
|
30 alpha_rtrm5 ("_ \<approx>5 _" [100, 100] 100) and |
|
31 alpha_rlts ("_ \<approx>l _" [100, 100] 100) |
|
32 thm alpha_rtrm5_alpha_rlts_alpha_rbv5.intros |
|
33 |
|
34 local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_rel_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *} |
|
35 thm alpha5_inj |
|
36 |
|
37 lemma rbv5_eqvt[eqvt]: |
|
38 "pi \<bullet> (rbv5 x) = rbv5 (pi \<bullet> x)" |
|
39 apply (induct x) |
|
40 apply (simp_all add: eqvts atom_eqvt) |
|
41 done |
|
42 |
|
43 lemma fv_rtrm5_rlts_eqvt[eqvt]: |
|
44 "pi \<bullet> (fv_rtrm5 x) = fv_rtrm5 (pi \<bullet> x)" |
|
45 "pi \<bullet> (fv_rlts l) = fv_rlts (pi \<bullet> l)" |
|
46 apply (induct x and l) |
|
47 apply (simp_all add: eqvts atom_eqvt) |
|
48 done |
|
49 |
|
50 (*lemma alpha5_eqvt: |
|
51 "(xa \<approx>5 y \<longrightarrow> (p \<bullet> xa) \<approx>5 (p \<bullet> y)) \<and> |
|
52 (xb \<approx>l ya \<longrightarrow> (p \<bullet> xb) \<approx>l (p \<bullet> ya)) \<and> |
|
53 (alpha_rbv5 b c \<longrightarrow> alpha_rbv5 (p \<bullet> b) (p \<bullet> c))" |
|
54 apply (tactic {* alpha_eqvt_tac @{thm alpha_rtrm5_alpha_rlts_alpha_rbv5.induct} @{thms alpha5_inj permute_rtrm5_permute_rlts.simps} @{context} 1 *}) |
|
55 done*) |
|
56 |
|
57 local_setup {* |
|
58 (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_eqvt}, []), |
|
59 build_alpha_eqvts [@{term alpha_rtrm5}, @{term alpha_rlts}, @{term alpha_rbv5}] (fn _ => alpha_eqvt_tac @{thm alpha_rtrm5_alpha_rlts_alpha_rbv5.induct} @{thms alpha5_inj permute_rtrm5_permute_rlts.simps} ctxt 1) ctxt) ctxt)) *} |
|
60 print_theorems |
|
61 |
|
62 lemma alpha5_reflp: |
|
63 "y \<approx>5 y \<and> (x \<approx>l x \<and> alpha_rbv5 x x)" |
|
64 apply (rule rtrm5_rlts.induct) |
|
65 apply (simp_all add: alpha5_inj) |
|
66 apply (rule_tac x="0::perm" in exI) |
|
67 apply (simp add: eqvts alpha_gen fresh_star_def fresh_zero_perm) |
|
68 done |
|
69 |
|
70 lemma alpha5_symp: |
|
71 "(a \<approx>5 b \<longrightarrow> b \<approx>5 a) \<and> |
|
72 (x \<approx>l y \<longrightarrow> y \<approx>l x) \<and> |
|
73 (alpha_rbv5 x y \<longrightarrow> alpha_rbv5 y x)" |
|
74 apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct) |
|
75 apply (simp_all add: alpha5_inj) |
|
76 apply (erule exE) |
|
77 apply (rule_tac x="-pi" in exI) |
|
78 apply (rule alpha_gen_sym) |
|
79 apply (simp_all add: alphas) |
|
80 apply (case_tac x) |
|
81 apply (case_tac y) |
|
82 apply (simp add: alpha5_eqvt) |
|
83 apply clarify |
|
84 apply simp |
|
85 done |
|
86 |
|
87 lemma alpha5_symp1: |
|
88 "(a \<approx>5 b \<longrightarrow> b \<approx>5 a) \<and> |
|
89 (x \<approx>l y \<longrightarrow> y \<approx>l x) \<and> |
|
90 (alpha_rbv5 x y \<longrightarrow> alpha_rbv5 y x)" |
|
91 apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct) |
|
92 apply (simp_all add: alpha5_inj) |
|
93 apply (erule exE) |
|
94 apply (rule_tac x="- pi" in exI) |
|
95 apply (simp add: alpha_gen) |
|
96 apply(simp add: fresh_star_def fresh_minus_perm) |
|
97 apply clarify |
|
98 apply (rule conjI) |
|
99 apply (rotate_tac 3) |
|
100 apply (frule_tac p="- pi" in alpha5_eqvt(2)) |
|
101 apply simp |
|
102 apply (rule conjI) |
|
103 apply (rotate_tac 5) |
|
104 apply (frule_tac p="- pi" in alpha5_eqvt(1)) |
|
105 apply simp |
|
106 apply (rotate_tac 6) |
|
107 apply simp |
|
108 apply (drule_tac p1="- pi" in permute_eq_iff[symmetric,THEN iffD1]) |
|
109 apply (simp) |
|
110 done |
|
111 |
|
112 thm alpha_gen_sym[no_vars] |
|
113 thm alpha_gen_compose_sym[no_vars] |
|
114 |
|
115 lemma tt: |
|
116 "\<lbrakk>R (- p \<bullet> x) y \<Longrightarrow> R (p \<bullet> y) x; (bs, x) \<approx>gen R f (- p) (cs, y)\<rbrakk> \<Longrightarrow> (cs, y) \<approx>gen R f p (bs, x)" |
|
117 unfolding alphas |
|
118 unfolding fresh_star_def |
|
119 by (auto simp add: fresh_minus_perm) |
|
120 |
|
121 lemma alpha5_symp2: |
|
122 shows "a \<approx>5 b \<Longrightarrow> b \<approx>5 a" |
|
123 and "x \<approx>l y \<Longrightarrow> y \<approx>l x" |
|
124 and "alpha_rbv5 x y \<Longrightarrow> alpha_rbv5 y x" |
|
125 apply(induct rule: alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts) |
|
126 (* non-binding case *) |
|
127 apply(simp add: alpha5_inj) |
|
128 (* non-binding case *) |
|
129 apply(simp add: alpha5_inj) |
|
130 (* binding case *) |
|
131 apply(simp add: alpha5_inj) |
|
132 apply(erule exE) |
|
133 apply(rule_tac x="- pi" in exI) |
|
134 apply(rule tt) |
|
135 apply(simp add: alphas) |
|
136 apply(erule conjE)+ |
|
137 apply(drule_tac p="- pi" in alpha5_eqvt(2)) |
|
138 apply(drule_tac p="- pi" in alpha5_eqvt(2)) |
|
139 apply(drule_tac p="- pi" in alpha5_eqvt(1)) |
|
140 apply(drule_tac p="- pi" in alpha5_eqvt(1)) |
|
141 apply(simp) |
|
142 apply(simp add: alphas) |
|
143 apply(erule conjE)+ |
|
144 apply metis |
|
145 (* non-binding case *) |
|
146 apply(simp add: alpha5_inj) |
|
147 (* non-binding case *) |
|
148 apply(simp add: alpha5_inj) |
|
149 (* non-binding case *) |
|
150 apply(simp add: alpha5_inj) |
|
151 (* non-binding case *) |
|
152 apply(simp add: alpha5_inj) |
|
153 done |
|
154 |
|
155 lemma alpha5_transp: |
|
156 "(a \<approx>5 b \<longrightarrow> (\<forall>c. b \<approx>5 c \<longrightarrow> a \<approx>5 c)) \<and> |
|
157 (x \<approx>l y \<longrightarrow> (\<forall>z. y \<approx>l z \<longrightarrow> x \<approx>l z)) \<and> |
|
158 (alpha_rbv5 k l \<longrightarrow> (\<forall>m. alpha_rbv5 l m \<longrightarrow> alpha_rbv5 k m))" |
|
159 (*apply (tactic {* transp_tac @{context} @{thm alpha_rtrm5_alpha_rlts_alpha_rbv5.induct} @{thms alpha5_inj} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} [] @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{thms alpha5_eqvt} 1 *})*) |
|
160 apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct) |
|
161 apply (rule_tac [!] allI) |
|
162 apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *}) |
|
163 apply (simp_all add: alpha5_inj) |
|
164 apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *}) |
|
165 apply (simp_all add: alpha5_inj) |
|
166 apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *}) |
|
167 apply (simp_all add: alpha5_inj) |
|
168 defer |
|
169 apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *}) |
|
170 apply (simp_all add: alpha5_inj) |
|
171 apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *}) |
|
172 apply (simp_all add: alpha5_inj) |
|
173 apply (tactic {* eetac @{thm exi_sum} @{context} 1 *}) |
|
174 (* HERE *) |
|
175 (* |
|
176 apply(rule alpha_gen_trans) |
|
177 thm alpha_gen_trans |
|
178 defer |
|
179 apply (simp add: alpha_gen) |
|
180 apply clarify |
|
181 apply(simp add: fresh_star_plus) |
|
182 apply (rule conjI) |
|
183 apply (erule_tac x="- pi \<bullet> rltsaa" in allE) |
|
184 apply (rotate_tac 5) |
|
185 apply (drule_tac p="- pi" in alpha5_eqvt(2)) |
|
186 apply simp |
|
187 apply (drule_tac p="pi" in alpha5_eqvt(2)) |
|
188 apply simp |
|
189 apply (erule_tac x="- pi \<bullet> rtrm5aa" in allE) |
|
190 apply (rotate_tac 7) |
|
191 apply (drule_tac p="- pi" in alpha5_eqvt(1)) |
|
192 apply simp |
|
193 apply (rotate_tac 3) |
|
194 apply (drule_tac p="pi" in alpha5_eqvt(1)) |
|
195 apply simp |
|
196 done |
|
197 *) |
|
198 sorry |
|
199 |
|
200 lemma alpha5_equivp: |
|
201 "equivp alpha_rtrm5" |
|
202 "equivp alpha_rlts" |
|
203 unfolding equivp_reflp_symp_transp reflp_def symp_def transp_def |
|
204 apply (simp_all only: alpha5_reflp) |
|
205 apply (meson alpha5_symp alpha5_transp) |
|
206 apply (meson alpha5_symp alpha5_transp) |
|
207 done |
|
208 |
|
209 quotient_type |
|
210 trm5 = rtrm5 / alpha_rtrm5 |
|
211 and |
|
212 lts = rlts / alpha_rlts |
|
213 by (auto intro: alpha5_equivp) |
|
214 |
|
215 local_setup {* |
|
216 (fn ctxt => ctxt |
|
217 |> snd o (Quotient_Def.quotient_lift_const ("Vr5", @{term rVr5})) |
|
218 |> snd o (Quotient_Def.quotient_lift_const ("Ap5", @{term rAp5})) |
|
219 |> snd o (Quotient_Def.quotient_lift_const ("Lt5", @{term rLt5})) |
|
220 |> snd o (Quotient_Def.quotient_lift_const ("Lnil", @{term rLnil})) |
|
221 |> snd o (Quotient_Def.quotient_lift_const ("Lcons", @{term rLcons})) |
|
222 |> snd o (Quotient_Def.quotient_lift_const ("fv_trm5", @{term fv_rtrm5})) |
|
223 |> snd o (Quotient_Def.quotient_lift_const ("fv_lts", @{term fv_rlts})) |
|
224 |> snd o (Quotient_Def.quotient_lift_const ("bv5", @{term rbv5})) |
|
225 |> snd o (Quotient_Def.quotient_lift_const ("alpha_bv5", @{term alpha_rbv5}))) |
|
226 *} |
|
227 print_theorems |
|
228 |
|
229 lemma alpha5_rfv: |
|
230 "(t \<approx>5 s \<Longrightarrow> fv_rtrm5 t = fv_rtrm5 s)" |
|
231 "(l \<approx>l m \<Longrightarrow> fv_rlts l = fv_rlts m)" |
|
232 "(alpha_rbv5 b c \<Longrightarrow> True)" |
|
233 apply(induct rule: alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts) |
|
234 apply(simp_all add: eqvts) |
|
235 apply(simp add: alpha_gen) |
|
236 apply(clarify) |
|
237 apply blast |
|
238 done |
|
239 |
|
240 lemma bv_list_rsp: |
|
241 shows "x \<approx>l y \<Longrightarrow> rbv5 x = rbv5 y" |
|
242 apply(induct rule: alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts(2)) |
|
243 apply(simp_all) |
|
244 apply(clarify) |
|
245 apply simp |
|
246 done |
|
247 |
|
248 local_setup {* snd o Local_Theory.note ((@{binding alpha_dis}, []), (flat (map (distinct_rel @{context} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases}) [(@{thms rtrm5.distinct}, @{term alpha_rtrm5}), (@{thms rlts.distinct}, @{term alpha_rlts}), (@{thms rlts.distinct}, @{term alpha_rbv5})]))) *} |
|
249 print_theorems |
|
250 |
|
251 local_setup {* snd o Local_Theory.note ((@{binding alpha_bn_rsp}, []), prove_alpha_bn_rsp [@{term alpha_rtrm5}, @{term alpha_rlts}] @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.inducts} @{thms rtrm5.exhaust rlts.exhaust} @{thms alpha5_inj alpha_dis} @{thms alpha5_equivp} @{context} (@{term alpha_rbv5}, 1)) *} |
|
252 thm alpha_bn_rsp |
|
253 |
|
254 lemma [quot_respect]: |
|
255 "(alpha_rlts ===> op =) fv_rlts fv_rlts" |
|
256 "(alpha_rtrm5 ===> op =) fv_rtrm5 fv_rtrm5" |
|
257 "(alpha_rlts ===> op =) rbv5 rbv5" |
|
258 "(op = ===> alpha_rtrm5) rVr5 rVr5" |
|
259 "(alpha_rtrm5 ===> alpha_rtrm5 ===> alpha_rtrm5) rAp5 rAp5" |
|
260 "(alpha_rlts ===> alpha_rtrm5 ===> alpha_rtrm5) rLt5 rLt5" |
|
261 "(op = ===> alpha_rtrm5 ===> alpha_rlts ===> alpha_rlts) rLcons rLcons" |
|
262 "(op = ===> alpha_rtrm5 ===> alpha_rtrm5) permute permute" |
|
263 "(op = ===> alpha_rlts ===> alpha_rlts) permute permute" |
|
264 "(alpha_rlts ===> alpha_rlts ===> op =) alpha_rbv5 alpha_rbv5" |
|
265 apply (simp_all add: alpha5_inj alpha5_rfv alpha5_eqvt bv_list_rsp alpha_bn_rsp) |
|
266 apply (clarify) |
|
267 apply (rule_tac x="0" in exI) |
|
268 apply (simp add: fresh_star_def fresh_zero_perm alpha_gen alpha5_rfv) |
|
269 done |
|
270 |
|
271 |
|
272 lemma |
|
273 shows "(alpha_rlts ===> op =) rbv5 rbv5" |
|
274 by (simp add: bv_list_rsp) |
|
275 |
|
276 lemmas trm5_lts_inducts = rtrm5_rlts.inducts[quot_lifted] |
|
277 |
|
278 instantiation trm5 and lts :: pt |
|
279 begin |
|
280 |
|
281 quotient_definition |
|
282 "permute_trm5 :: perm \<Rightarrow> trm5 \<Rightarrow> trm5" |
|
283 is |
|
284 "permute :: perm \<Rightarrow> rtrm5 \<Rightarrow> rtrm5" |
|
285 |
|
286 quotient_definition |
|
287 "permute_lts :: perm \<Rightarrow> lts \<Rightarrow> lts" |
|
288 is |
|
289 "permute :: perm \<Rightarrow> rlts \<Rightarrow> rlts" |
|
290 |
|
291 instance by default |
|
292 (simp_all add: permute_rtrm5_permute_rlts_zero[quot_lifted] permute_rtrm5_permute_rlts_append[quot_lifted]) |
|
293 |
|
294 end |
|
295 |
|
296 lemmas permute_trm5_lts = permute_rtrm5_permute_rlts.simps[quot_lifted] |
|
297 lemmas bv5[simp] = rbv5.simps[quot_lifted] |
|
298 lemmas fv_trm5_lts[simp] = fv_rtrm5_fv_rlts.simps[quot_lifted] |
|
299 lemmas alpha5_INJ = alpha5_inj[unfolded alpha_gen2, unfolded alpha_gen, quot_lifted, folded alpha_gen2, folded alpha_gen] |
|
300 lemmas alpha5_DIS = alpha_dis[quot_lifted] |
|
301 |
|
302 end |
|