123 also have "\<dots> = ?RHS" using `z\<sharp>y` `z\<sharp>L` by simp |
125 also have "\<dots> = ?RHS" using `z\<sharp>y` `z\<sharp>L` by simp |
124 finally show "?LHS = ?RHS" . |
126 finally show "?LHS = ?RHS" . |
125 qed |
127 qed |
126 next |
128 next |
127 case (App M1 M2) (* case 3: applications *) |
129 case (App M1 M2) (* case 3: applications *) |
128 thus ?case by simp |
130 thus "(App M1 M2)[x::=N][y::=L] = (App M1 M2)[y::=L][x::=N[y::=L]]" by simp |
129 qed |
131 qed |
130 |
132 |
131 lemma substitution_lemma_automatic: |
133 lemma substitution_lemma_automatic: |
132 assumes asm: "x\<noteq>y" "x\<sharp>L" |
134 assumes asm: "x\<noteq>y" "x\<sharp>L" |
133 shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" |
135 shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" |
134 using asm by (nominal_induct M avoiding: x y N L rule: lam.induct) |
136 using asm |
135 (auto simp add: fresh_fact forget) |
137 by (nominal_induct M avoiding: x y N L rule: lam.induct) |
|
138 (auto simp add: fresh_fact forget) |
136 |
139 |
137 lemma subst_rename: |
140 lemma subst_rename: |
138 assumes a: "c\<sharp>t1" |
141 assumes a: "y\<sharp>N" |
139 shows "t1[a::=t2] = ([(c,a)]\<bullet>t1)[c::=t2]" |
142 shows "N[x::=L] = ([(y,x)]\<bullet>N)[y::=L]" |
140 using a |
143 using a |
141 proof (nominal_induct t1 avoiding: a c t2 rule: lam.induct) |
144 proof (nominal_induct N avoiding: x y L rule: lam.induct) |
142 case (Var b) |
145 case (Var b) |
143 thus "(Var b)[a::=t2] = ([(c,a)]\<bullet>(Var b))[c::=t2]" by (simp add: calc_atm fresh_atm) |
146 thus "(Var b)[x::=L] = ([(y,x)]\<bullet>(Var b))[y::=L]" by (simp add: calc_atm fresh_atm) |
144 next |
147 next |
145 case App thus ?case by force |
148 case App thus ?case by force |
146 next |
149 next |
147 case (Lam b s) |
150 case (Lam b N1) |
148 have i: "\<And>a c t2. c\<sharp>s \<Longrightarrow> (s[a::=t2] = ([(c,a)]\<bullet>s)[c::=t2])" by fact |
151 have ih: "y\<sharp>N1 \<Longrightarrow> (N1[x::=L] = ([(y,x)]\<bullet>N1)[y::=L])" by fact |
149 have f: "b\<sharp>a" "b\<sharp>c" "b\<sharp>t2" by fact |
152 have f: "b\<sharp>y" "b\<sharp>x" "b\<sharp>L" by fact |
150 from f have a:"b\<noteq>c" and b: "b\<noteq>a" and c: "b\<sharp>t2" by (simp add: fresh_atm)+ |
153 from f have a:"b\<noteq>y" and b: "b\<noteq>x" and c: "b\<sharp>L" by (simp add: fresh_atm)+ |
151 have "c\<sharp>Lam [b].s" by fact |
154 have "y\<sharp>Lam [b].N1" by fact |
152 hence "c\<sharp>s" using a by (simp add: abs_fresh) |
155 hence "y\<sharp>N1" using a by (simp add: abs_fresh) |
153 hence d: "s[a::=t2] = ([(c,a)]\<bullet>s)[c::=t2]" using i by simp |
156 hence d: "N1[x::=L] = ([(y,x)]\<bullet>N1)[y::=L]" using ih by simp |
154 show "(Lam [b].s)[a::=t2] = ([(c,a)]\<bullet>(Lam [b].s))[c::=t2]" (is "?LHS = ?RHS") |
157 show "(Lam [b].N1)[x::=L] = ([(y,x)]\<bullet>(Lam [b].N1))[y::=L]" (is "?LHS = ?RHS") |
155 proof - |
158 proof - |
156 have "?LHS = Lam [b].(s[a::=t2])" using b c by simp |
159 have "?LHS = Lam [b].(N1[x::=L])" using b c by simp |
157 also have "\<dots> = Lam [b].(([(c,a)]\<bullet>s)[c::=t2])" using d by simp |
160 also have "\<dots> = Lam [b].(([(y,x)]\<bullet>N1)[y::=L])" using d by simp |
158 also have "\<dots> = (Lam [b].([(c,a)]\<bullet>s))[c::=t2]" using a c by simp |
161 also have "\<dots> = (Lam [b].([(y,x)]\<bullet>N1))[y::=L]" using a c by simp |
159 also have "\<dots> = ?RHS" using a b by (simp add: calc_atm) |
162 also have "\<dots> = ?RHS" using a b by (simp add: calc_atm) |
160 finally show "?LHS = ?RHS" by simp |
163 finally show "?LHS = ?RHS" by simp |
161 qed |
164 qed |
162 qed |
165 qed |
163 |
166 |
164 lemma subst_rename_automatic: |
167 lemma subst_rename_automatic: |
165 assumes a: "c\<sharp>t1" |
168 assumes a: "y\<sharp>N" |
166 shows "t1[a::=t2] = ([(c,a)]\<bullet>t1)[c::=t2]" |
169 shows "N[x::=L] = ([(y,x)]\<bullet>N)[y::=L]" |
167 using a |
170 using a |
168 apply(nominal_induct t1 avoiding: a c t2 rule: lam.induct) |
171 by (nominal_induct N avoiding: y x L rule: lam.induct) |
169 apply(auto simp add: calc_atm fresh_atm abs_fresh) |
172 (auto simp add: calc_atm fresh_atm abs_fresh) |
170 done |
|
171 |
173 |
172 section {* Beta Reduction *} |
174 section {* Beta Reduction *} |
173 |
175 |
174 consts |
176 inductive2 |
175 Beta :: "(lam\<times>lam) set" |
177 "Beta" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>\<beta> _" [80,80] 80) |
176 syntax |
178 intros |
177 "_Beta" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>\<beta> _" [80,80] 80) |
179 b1[intro]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (App s1 t)\<longrightarrow>\<^isub>\<beta>(App s2 t)" |
178 "_Beta_star" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>\<beta>\<^sup>* _" [80,80] 80) |
180 b2[intro]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (App t s1)\<longrightarrow>\<^isub>\<beta>(App t s2)" |
179 translations |
181 b3[intro]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (Lam [a].s1)\<longrightarrow>\<^isub>\<beta> (Lam [a].s2)" |
180 "t1 \<longrightarrow>\<^isub>\<beta> t2" \<rightleftharpoons> "(t1,t2) \<in> Beta" |
182 b4[intro]: "(App (Lam [a].s1) s2)\<longrightarrow>\<^isub>\<beta>(s1[a::=s2])" |
181 "t1 \<longrightarrow>\<^isub>\<beta>\<^sup>* t2" \<rightleftharpoons> "(t1,t2) \<in> Beta\<^sup>*" |
183 |
182 inductive Beta |
184 inductive2 |
183 intros |
185 "Beta_star" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>\<beta>\<^sup>* _" [80,80] 80) |
184 b1[intro!]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (App s1 t)\<longrightarrow>\<^isub>\<beta>(App s2 t)" |
186 intros |
185 b2[intro!]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (App t s1)\<longrightarrow>\<^isub>\<beta>(App t s2)" |
187 bs1[intro, simp]: "M \<longrightarrow>\<^isub>\<beta>\<^sup>* M" |
186 b3[intro!]: "s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (Lam [a].s1)\<longrightarrow>\<^isub>\<beta> (Lam [a].s2)" |
188 bs2[intro]: "\<lbrakk>M1\<longrightarrow>\<^isub>\<beta>\<^sup>* M2; M2 \<longrightarrow>\<^isub>\<beta> M3\<rbrakk> \<Longrightarrow> M1 \<longrightarrow>\<^isub>\<beta>\<^sup>* M3" |
187 b4[intro!]: "(App (Lam [a].s1) s2)\<longrightarrow>\<^isub>\<beta>(s1[a::=s2])" |
189 |
188 |
190 lemma beta_star_trans: |
189 lemma eqvt_beta: |
191 assumes a1: "M1\<longrightarrow>\<^isub>\<beta>\<^sup>* M2" |
|
192 and a2: "M2\<longrightarrow>\<^isub>\<beta>\<^sup>* M3" |
|
193 shows "M1 \<longrightarrow>\<^isub>\<beta>\<^sup>* M3" |
|
194 using a2 a1 |
|
195 by (induct) (auto) |
|
196 |
|
197 lemma eqvt_beta: |
190 fixes pi :: "name prm" |
198 fixes pi :: "name prm" |
191 and t :: "lam" |
|
192 and s :: "lam" |
|
193 assumes a: "t\<longrightarrow>\<^isub>\<beta>s" |
199 assumes a: "t\<longrightarrow>\<^isub>\<beta>s" |
194 shows "(pi\<bullet>t)\<longrightarrow>\<^isub>\<beta>(pi\<bullet>s)" |
200 shows "(pi\<bullet>t)\<longrightarrow>\<^isub>\<beta>(pi\<bullet>s)" |
195 using a by (induct, auto) |
201 using a |
|
202 by (induct) (auto) |
196 |
203 |
197 lemma beta_induct[consumes 1, case_names b1 b2 b3 b4]: |
204 lemma beta_induct[consumes 1, case_names b1 b2 b3 b4]: |
198 fixes P :: "'a::fs_name\<Rightarrow>lam \<Rightarrow> lam \<Rightarrow>bool" |
205 fixes P :: "'a::fs_name\<Rightarrow>lam \<Rightarrow> lam \<Rightarrow>bool" |
199 and t :: "lam" |
206 and t :: "lam" |
200 and s :: "lam" |
207 and s :: "lam" |
201 and x :: "'a::fs_name" |
208 and x :: "'a::fs_name" |
202 assumes a: "t\<longrightarrow>\<^isub>\<beta>s" |
209 assumes a: "t\<longrightarrow>\<^isub>\<beta>s" |
203 and a1: "\<And>t s1 s2 x. s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (\<And>z. P z s1 s2) \<Longrightarrow> P x (App s1 t) (App s2 t)" |
210 and a1: "\<And>t s1 s2 x. \<lbrakk>s1\<longrightarrow>\<^isub>\<beta>s2; (\<And>z. P z s1 s2)\<rbrakk> \<Longrightarrow> P x (App s1 t) (App s2 t)" |
204 and a2: "\<And>t s1 s2 x. s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (\<And>z. P z s1 s2) \<Longrightarrow> P x (App t s1) (App t s2)" |
211 and a2: "\<And>t s1 s2 x. \<lbrakk>s1\<longrightarrow>\<^isub>\<beta>s2; (\<And>z. P z s1 s2)\<rbrakk> \<Longrightarrow> P x (App t s1) (App t s2)" |
205 and a3: "\<And>a s1 s2 x. a\<sharp>x \<Longrightarrow> s1\<longrightarrow>\<^isub>\<beta>s2 \<Longrightarrow> (\<And>z. P z s1 s2) \<Longrightarrow> P x (Lam [a].s1) (Lam [a].s2)" |
212 and a3: "\<And>a s1 s2 x. \<lbrakk>a\<sharp>x; s1\<longrightarrow>\<^isub>\<beta>s2; (\<And>z. P z s1 s2)\<rbrakk> \<Longrightarrow> P x (Lam [a].s1) (Lam [a].s2)" |
206 and a4: "\<And>a t1 s1 x. a\<sharp>x \<Longrightarrow> P x (App (Lam [a].t1) s1) (t1[a::=s1])" |
213 and a4: "\<And>a t1 s1 x. a\<sharp>x \<Longrightarrow> P x (App (Lam [a].t1) s1) (t1[a::=s1])" |
207 shows "P x t s" |
214 shows "P x t s" |
208 proof - |
215 proof - |
209 from a have "\<And>(pi::name prm) x. P x (pi\<bullet>t) (pi\<bullet>s)" |
216 from a have "\<And>(pi::name prm) x. P x (pi\<bullet>t) (pi\<bullet>s)" |
210 proof (induct) |
217 proof (induct) |
211 case b1 thus ?case using a1 by (simp, blast intro: eqvt_beta) |
218 case b1 thus ?case using a1 by (simp, blast intro: eqvt_beta) |
212 next |
219 next |
213 case b2 thus ?case using a2 by (simp, blast intro: eqvt_beta) |
220 case b2 thus ?case using a2 by (simp, blast intro: eqvt_beta) |
214 next |
221 next |
215 case (b3 a s1 s2) |
222 case (b3 s1 s2 a) |
216 have j1: "s1 \<longrightarrow>\<^isub>\<beta> s2" by fact |
223 have j1: "s1 \<longrightarrow>\<^isub>\<beta> s2" by fact |
217 have j2: "\<And>x (pi::name prm). P x (pi\<bullet>s1) (pi\<bullet>s2)" by fact |
224 have j2: "\<And>x (pi::name prm). P x (pi\<bullet>s1) (pi\<bullet>s2)" by fact |
218 show ?case |
225 show ?case |
219 proof (simp) |
226 proof (simp) |
220 have f: "\<exists>c::name. c\<sharp>(pi\<bullet>a,pi\<bullet>s1,pi\<bullet>s2,x)" |
227 have f: "\<exists>c::name. c\<sharp>(pi\<bullet>a,pi\<bullet>s1,pi\<bullet>s2,x)" |
254 thus ?thesis by simp |
261 thus ?thesis by simp |
255 qed |
262 qed |
256 |
263 |
257 section {* One-Reduction *} |
264 section {* One-Reduction *} |
258 |
265 |
259 consts |
266 inductive2 |
260 One :: "(lam\<times>lam) set" |
267 One :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>1 _" [80,80] 80) |
261 syntax |
|
262 "_One" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>1 _" [80,80] 80) |
|
263 "_One_star" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>1\<^sup>* _" [80,80] 80) |
|
264 translations |
|
265 "t1 \<longrightarrow>\<^isub>1 t2" \<rightleftharpoons> "(t1,t2) \<in> One" |
|
266 "t1 \<longrightarrow>\<^isub>1\<^sup>* t2" \<rightleftharpoons> "(t1,t2) \<in> One\<^sup>*" |
|
267 inductive One |
|
268 intros |
268 intros |
269 o1[intro!]: "M\<longrightarrow>\<^isub>1M" |
269 o1[intro!]: "M\<longrightarrow>\<^isub>1M" |
270 o2[simp,intro!]: "\<lbrakk>t1\<longrightarrow>\<^isub>1t2;s1\<longrightarrow>\<^isub>1s2\<rbrakk> \<Longrightarrow> (App t1 s1)\<longrightarrow>\<^isub>1(App t2 s2)" |
270 o2[simp,intro!]: "\<lbrakk>t1\<longrightarrow>\<^isub>1t2;s1\<longrightarrow>\<^isub>1s2\<rbrakk> \<Longrightarrow> (App t1 s1)\<longrightarrow>\<^isub>1(App t2 s2)" |
271 o3[simp,intro!]: "s1\<longrightarrow>\<^isub>1s2 \<Longrightarrow> (Lam [a].s1)\<longrightarrow>\<^isub>1(Lam [a].s2)" |
271 o3[simp,intro!]: "s1\<longrightarrow>\<^isub>1s2 \<Longrightarrow> (Lam [a].s1)\<longrightarrow>\<^isub>1(Lam [a].s2)" |
272 o4[simp,intro!]: "\<lbrakk>s1\<longrightarrow>\<^isub>1s2;t1\<longrightarrow>\<^isub>1t2\<rbrakk> \<Longrightarrow> (App (Lam [a].t1) s1)\<longrightarrow>\<^isub>1(t2[a::=s2])" |
272 o4[simp,intro!]: "\<lbrakk>s1\<longrightarrow>\<^isub>1s2;t1\<longrightarrow>\<^isub>1t2\<rbrakk> \<Longrightarrow> (App (Lam [a].t1) s1)\<longrightarrow>\<^isub>1(t2[a::=s2])" |
|
273 |
|
274 inductive2 |
|
275 "One_star" :: "lam\<Rightarrow>lam\<Rightarrow>bool" (" _ \<longrightarrow>\<^isub>1\<^sup>* _" [80,80] 80) |
|
276 intros |
|
277 os1[intro, simp]: "M \<longrightarrow>\<^isub>1\<^sup>* M" |
|
278 os2[intro]: "\<lbrakk>M1\<longrightarrow>\<^isub>1\<^sup>* M2; M2 \<longrightarrow>\<^isub>1 M3\<rbrakk> \<Longrightarrow> M1 \<longrightarrow>\<^isub>1\<^sup>* M3" |
273 |
279 |
274 lemma eqvt_one: |
280 lemma eqvt_one: |
275 fixes pi :: "name prm" |
281 fixes pi :: "name prm" |
276 and t :: "lam" |
282 and t :: "lam" |
277 and s :: "lam" |
283 and s :: "lam" |
278 assumes a: "t\<longrightarrow>\<^isub>1s" |
284 assumes a: "t\<longrightarrow>\<^isub>1s" |
279 shows "(pi\<bullet>t)\<longrightarrow>\<^isub>1(pi\<bullet>s)" |
285 shows "(pi\<bullet>t)\<longrightarrow>\<^isub>1(pi\<bullet>s)" |
280 using a by (induct, auto) |
286 using a by (induct, auto) |
281 |
287 |
|
288 lemma one_star_trans: |
|
289 assumes a1: "M1\<longrightarrow>\<^isub>1\<^sup>* M2" |
|
290 and a2: "M2\<longrightarrow>\<^isub>1\<^sup>* M3" |
|
291 shows "M1\<longrightarrow>\<^isub>1\<^sup>* M3" |
|
292 using a2 a1 |
|
293 by (induct) (auto) |
|
294 |
282 lemma one_induct[consumes 1, case_names o1 o2 o3 o4]: |
295 lemma one_induct[consumes 1, case_names o1 o2 o3 o4]: |
283 fixes P :: "'a::fs_name\<Rightarrow>lam \<Rightarrow> lam \<Rightarrow>bool" |
296 fixes P :: "'a::fs_name\<Rightarrow>lam \<Rightarrow> lam \<Rightarrow>bool" |
284 and t :: "lam" |
297 and t :: "lam" |
285 and s :: "lam" |
298 and s :: "lam" |
286 and x :: "'a::fs_name" |
299 and x :: "'a::fs_name" |
287 assumes a: "t\<longrightarrow>\<^isub>1s" |
300 assumes a: "t\<longrightarrow>\<^isub>1s" |
288 and a1: "\<And>t x. P x t t" |
301 and a1: "\<And>t x. P x t t" |
289 and a2: "\<And>t1 t2 s1 s2 x. t1\<longrightarrow>\<^isub>1t2 \<Longrightarrow> (\<And>z. P z t1 t2) \<Longrightarrow> s1\<longrightarrow>\<^isub>1s2 \<Longrightarrow> (\<And>z. P z s1 s2) \<Longrightarrow> |
302 and a2: "\<And>t1 t2 s1 s2 x. \<lbrakk>t1\<longrightarrow>\<^isub>1t2; (\<And>z. P z t1 t2); s1\<longrightarrow>\<^isub>1s2; (\<And>z. P z s1 s2)\<rbrakk> \<Longrightarrow> |
290 P x (App t1 s1) (App t2 s2)" |
303 P x (App t1 s1) (App t2 s2)" |
291 and a3: "\<And>a s1 s2 x. a\<sharp>x \<Longrightarrow> s1\<longrightarrow>\<^isub>1s2 \<Longrightarrow> (\<And>z. P z s1 s2) \<Longrightarrow> P x (Lam [a].s1) (Lam [a].s2)" |
304 and a3: "\<And>a s1 s2 x. \<lbrakk>a\<sharp>x; s1\<longrightarrow>\<^isub>1s2; (\<And>z. P z s1 s2)\<rbrakk> \<Longrightarrow> P x (Lam [a].s1) (Lam [a].s2)" |
292 and a4: "\<And>a t1 t2 s1 s2 x. |
305 and a4: "\<And>a t1 t2 s1 s2 x. |
293 a\<sharp>x \<Longrightarrow> t1\<longrightarrow>\<^isub>1t2 \<Longrightarrow> (\<And>z. P z t1 t2) \<Longrightarrow> s1\<longrightarrow>\<^isub>1s2 \<Longrightarrow> (\<And>z. P z s1 s2) |
306 \<lbrakk>a\<sharp>x; t1\<longrightarrow>\<^isub>1t2; (\<And>z. P z t1 t2); s1\<longrightarrow>\<^isub>1s2; (\<And>z. P z s1 s2)\<rbrakk> |
294 \<Longrightarrow> P x (App (Lam [a].t1) s1) (t2[a::=s2])" |
307 \<Longrightarrow> P x (App (Lam [a].t1) s1) (t2[a::=s2])" |
295 shows "P x t s" |
308 shows "P x t s" |
296 proof - |
309 proof - |
297 from a have "\<And>(pi::name prm) x. P x (pi\<bullet>t) (pi\<bullet>s)" |
310 from a have "\<And>(pi::name prm) x. P x (pi\<bullet>t) (pi\<bullet>s)" |
298 proof (induct) |
311 proof (induct) |
299 case o1 show ?case using a1 by force |
312 case o1 show ?case using a1 by force |
300 next |
313 next |
301 case (o2 s1 s2 t1 t2) |
314 case (o2 s1 s2 t1 t2) |
302 thus ?case using a2 by (simp, blast intro: eqvt_one) |
315 thus ?case using a2 by (simp, blast intro: eqvt_one) |
303 next |
316 next |
304 case (o3 a t1 t2) |
317 case (o3 t1 t2 a) |
305 have j1: "t1 \<longrightarrow>\<^isub>1 t2" by fact |
318 have j1: "t1 \<longrightarrow>\<^isub>1 t2" by fact |
306 have j2: "\<And>(pi::name prm) x. P x (pi\<bullet>t1) (pi\<bullet>t2)" by fact |
319 have j2: "\<And>(pi::name prm) x. P x (pi\<bullet>t1) (pi\<bullet>t2)" by fact |
307 show ?case |
320 show ?case |
308 proof (simp) |
321 proof (simp) |
309 have f: "\<exists>c::name. c\<sharp>(pi\<bullet>a,pi\<bullet>t1,pi\<bullet>t2,x)" |
322 have f: "\<exists>c::name. c\<sharp>(pi\<bullet>a,pi\<bullet>t1,pi\<bullet>t2,x)" |
644 lemma one_lam_cong: |
664 lemma one_lam_cong: |
645 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
665 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
646 shows "(Lam [a].t1)\<longrightarrow>\<^isub>\<beta>\<^sup>*(Lam [a].t2)" |
666 shows "(Lam [a].t1)\<longrightarrow>\<^isub>\<beta>\<^sup>*(Lam [a].t2)" |
647 using a |
667 using a |
648 proof induct |
668 proof induct |
649 case 1 thus ?case by simp |
669 case bs1 thus ?case by simp |
650 next |
670 next |
651 case (2 y z) |
671 case (bs2 y z) |
652 thus ?case by (blast dest: b3 intro: rtrancl_trans) |
672 thus ?case by (blast dest: b3) |
653 qed |
673 qed |
654 |
674 |
655 lemma one_app_congL: |
675 lemma one_app_congL: |
656 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
676 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
657 shows "App t1 s\<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s" |
677 shows "App t1 s\<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s" |
658 using a |
678 using a |
659 proof induct |
679 proof induct |
660 case 1 thus ?case by simp |
680 case bs1 thus ?case by simp |
661 next |
681 next |
662 case 2 thus ?case by (blast dest: b1 intro: rtrancl_trans) |
682 case bs2 thus ?case by (blast dest: b1) |
663 qed |
683 qed |
664 |
684 |
665 lemma one_app_congR: |
685 lemma one_app_congR: |
666 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
686 assumes a: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
667 shows "App s t1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App s t2" |
687 shows "App s t1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App s t2" |
668 using a |
688 using a |
669 proof induct |
689 proof induct |
670 case 1 thus ?case by simp |
690 case bs1 thus ?case by simp |
671 next |
691 next |
672 case 2 thus ?case by (blast dest: b2 intro: rtrancl_trans) |
692 case bs2 thus ?case by (blast dest: b2) |
673 qed |
693 qed |
674 |
694 |
675 lemma one_app_cong: |
695 lemma one_app_cong: |
676 assumes a1: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
696 assumes a1: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
677 and a2: "s1\<longrightarrow>\<^isub>\<beta>\<^sup>*s2" |
697 and a2: "s1\<longrightarrow>\<^isub>\<beta>\<^sup>*s2" |
678 shows "App t1 s1\<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s2" |
698 shows "App t1 s1\<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s2" |
679 proof - |
699 proof - |
680 have "App t1 s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s1" using a1 by (rule one_app_congL) |
700 have "App t1 s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s1" using a1 by (rule one_app_congL) |
681 moreover |
701 moreover |
682 have "App t2 s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s2" using a2 by (rule one_app_congR) |
702 have "App t2 s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App t2 s2" using a2 by (rule one_app_congR) |
683 ultimately show ?thesis by (blast intro: rtrancl_trans) |
703 ultimately show ?thesis by (rule beta_star_trans) |
684 qed |
704 qed |
685 |
705 |
686 lemma one_beta_star: |
706 lemma one_beta_star: |
687 assumes a: "(t1\<longrightarrow>\<^isub>1t2)" |
707 assumes a: "(t1\<longrightarrow>\<^isub>1t2)" |
688 shows "(t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2)" |
708 shows "(t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2)" |
692 next |
712 next |
693 case o2 thus ?case by (blast intro!: one_app_cong) |
713 case o2 thus ?case by (blast intro!: one_app_cong) |
694 next |
714 next |
695 case o3 thus ?case by (blast intro!: one_lam_cong) |
715 case o3 thus ?case by (blast intro!: one_lam_cong) |
696 next |
716 next |
697 case (o4 a s1 s2 t1 t2) |
717 case (o4 s1 s2 t1 t2 a) |
698 have a1: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" and a2: "s1\<longrightarrow>\<^isub>\<beta>\<^sup>*s2" by fact |
718 have a1: "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" and a2: "s1\<longrightarrow>\<^isub>\<beta>\<^sup>*s2" by fact |
699 have c1: "(App (Lam [a].t2) s2) \<longrightarrow>\<^isub>\<beta> (t2 [a::= s2])" by (rule b4) |
719 have c1: "(App (Lam [a].t2) s2) \<longrightarrow>\<^isub>\<beta> (t2 [a::= s2])" by (rule b4) |
700 from a1 a2 have c2: "App (Lam [a].t1 ) s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App (Lam [a].t2 ) s2" |
720 from a1 a2 have c2: "App (Lam [a].t1 ) s1 \<longrightarrow>\<^isub>\<beta>\<^sup>* App (Lam [a].t2 ) s2" |
701 by (blast intro!: one_app_cong one_lam_cong) |
721 by (blast intro!: one_app_cong one_lam_cong) |
702 show ?case using c1 c2 by (blast intro: rtrancl_trans) |
722 show ?case using c2 c1 by (blast intro: beta_star_trans) |
703 qed |
723 qed |
704 |
724 |
705 lemma one_star_lam_cong: |
725 lemma one_star_lam_cong: |
706 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
726 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
707 shows "(Lam [a].t1)\<longrightarrow>\<^isub>1\<^sup>* (Lam [a].t2)" |
727 shows "(Lam [a].t1)\<longrightarrow>\<^isub>1\<^sup>* (Lam [a].t2)" |
708 using a |
728 using a |
709 proof induct |
729 proof induct |
710 case 1 thus ?case by simp |
730 case os1 thus ?case by simp |
711 next |
731 next |
712 case 2 thus ?case by (blast intro: rtrancl_trans) |
732 case os2 thus ?case by (blast intro: one_star_trans) |
713 qed |
733 qed |
714 |
734 |
715 lemma one_star_app_congL: |
735 lemma one_star_app_congL: |
716 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
736 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
717 shows "App t1 s\<longrightarrow>\<^isub>1\<^sup>* App t2 s" |
737 shows "App t1 s\<longrightarrow>\<^isub>1\<^sup>* App t2 s" |
718 using a |
738 using a |
719 proof induct |
739 proof induct |
720 case 1 thus ?case by simp |
740 case os1 thus ?case by simp |
721 next |
741 next |
722 case 2 thus ?case by (blast intro: rtrancl_trans) |
742 case os2 thus ?case by (blast intro: one_star_trans) |
723 qed |
743 qed |
724 |
744 |
725 lemma one_star_app_congR: |
745 lemma one_star_app_congR: |
726 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
746 assumes a: "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
727 shows "App s t1 \<longrightarrow>\<^isub>1\<^sup>* App s t2" |
747 shows "App s t1 \<longrightarrow>\<^isub>1\<^sup>* App s t2" |
728 using a |
748 using a |
729 proof induct |
749 proof induct |
730 case 1 thus ?case by simp |
750 case os1 thus ?case by simp |
731 next |
751 next |
732 case 2 thus ?case by (blast intro: rtrancl_trans) |
752 case os2 thus ?case by (blast intro: one_star_trans) |
733 qed |
753 qed |
734 |
754 |
735 lemma beta_one_star: |
755 lemma beta_one_star: |
736 assumes a: "t1\<longrightarrow>\<^isub>\<beta>t2" |
756 assumes a: "t1\<longrightarrow>\<^isub>\<beta>t2" |
737 shows "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
757 shows "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
745 next |
765 next |
746 case b4 thus ?case by blast |
766 case b4 thus ?case by blast |
747 qed |
767 qed |
748 |
768 |
749 lemma trans_closure: |
769 lemma trans_closure: |
750 shows "(t1\<longrightarrow>\<^isub>1\<^sup>*t2) = (t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2)" |
770 shows "(M1\<longrightarrow>\<^isub>1\<^sup>*M2) = (M1\<longrightarrow>\<^isub>\<beta>\<^sup>*M2)" |
751 proof |
771 proof |
752 assume "t1 \<longrightarrow>\<^isub>1\<^sup>* t2" |
772 assume "M1 \<longrightarrow>\<^isub>1\<^sup>* M2" |
753 then show "t1\<longrightarrow>\<^isub>\<beta>\<^sup>*t2" |
773 then show "M1\<longrightarrow>\<^isub>\<beta>\<^sup>*M2" |
754 proof induct |
774 proof induct |
755 case 1 thus ?case by simp |
775 case (os1 M1) thus "M1\<longrightarrow>\<^isub>\<beta>\<^sup>*M1" by simp |
756 next |
776 next |
757 case 2 thus ?case by (force intro: rtrancl_trans simp add: one_beta_star) |
777 case (os2 M1 M2 M3) |
758 qed |
778 have "M2\<longrightarrow>\<^isub>1M3" by fact |
759 next |
779 then have "M2\<longrightarrow>\<^isub>\<beta>\<^sup>*M3" by (rule one_beta_star) |
760 assume "t1 \<longrightarrow>\<^isub>\<beta>\<^sup>* t2" |
780 moreover have "M1\<longrightarrow>\<^isub>\<beta>\<^sup>*M2" by fact |
761 then show "t1\<longrightarrow>\<^isub>1\<^sup>*t2" |
781 ultimately show "M1\<longrightarrow>\<^isub>\<beta>\<^sup>*M3" by (auto intro: beta_star_trans) |
|
782 qed |
|
783 next |
|
784 assume "M1 \<longrightarrow>\<^isub>\<beta>\<^sup>* M2" |
|
785 then show "M1\<longrightarrow>\<^isub>1\<^sup>*M2" |
762 proof induct |
786 proof induct |
763 case 1 thus ?case by simp |
787 case (bs1 M1) thus "M1\<longrightarrow>\<^isub>1\<^sup>*M1" by simp |
764 next |
788 next |
765 case 2 thus ?case by (force intro: rtrancl_trans simp add: beta_one_star) |
789 case (bs2 M1 M2 M3) |
|
790 have "M2\<longrightarrow>\<^isub>\<beta>M3" by fact |
|
791 then have "M2\<longrightarrow>\<^isub>1\<^sup>*M3" by (rule beta_one_star) |
|
792 moreover have "M1\<longrightarrow>\<^isub>1\<^sup>*M2" by fact |
|
793 ultimately show "M1\<longrightarrow>\<^isub>1\<^sup>*M3" by (auto intro: one_star_trans) |
766 qed |
794 qed |
767 qed |
795 qed |
768 |
796 |
769 lemma cr_one: |
797 lemma cr_one: |
770 assumes a: "t\<longrightarrow>\<^isub>1\<^sup>*t1" |
798 assumes a: "t\<longrightarrow>\<^isub>1\<^sup>*t1" |
771 and b: "t\<longrightarrow>\<^isub>1t2" |
799 and b: "t\<longrightarrow>\<^isub>1t2" |
772 shows "\<exists>t3. t1\<longrightarrow>\<^isub>1t3 \<and> t2\<longrightarrow>\<^isub>1\<^sup>*t3" |
800 shows "\<exists>t3. t1\<longrightarrow>\<^isub>1t3 \<and> t2\<longrightarrow>\<^isub>1\<^sup>*t3" |
773 using a b |
801 using a b |
774 proof (induct arbitrary: t2) |
802 proof (induct arbitrary: t2) |
775 case 1 thus ?case by force |
803 case os1 thus ?case by force |
776 next |
804 next |
777 case (2 s1 s2) |
805 case (os2 t s1 s2 t2) |
778 have b: "s1 \<longrightarrow>\<^isub>1 s2" by fact |
806 have b: "s1 \<longrightarrow>\<^isub>1 s2" by fact |
779 have h: "\<And>t2. t \<longrightarrow>\<^isub>1 t2 \<Longrightarrow> (\<exists>t3. s1 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3)" by fact |
807 have h: "\<And>t2. t \<longrightarrow>\<^isub>1 t2 \<Longrightarrow> (\<exists>t3. s1 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3)" by fact |
780 have c: "t \<longrightarrow>\<^isub>1 t2" by fact |
808 have c: "t \<longrightarrow>\<^isub>1 t2" by fact |
781 show "\<exists>t3. s2 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3" |
809 show "\<exists>t3. s2 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3" |
782 proof - |
810 proof - |
783 from c h have "\<exists>t3. s1 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3" by blast |
811 from c h have "\<exists>t3. s1 \<longrightarrow>\<^isub>1 t3 \<and> t2 \<longrightarrow>\<^isub>1\<^sup>* t3" by blast |
784 then obtain t3 where c1: "s1 \<longrightarrow>\<^isub>1 t3" and c2: "t2 \<longrightarrow>\<^isub>1\<^sup>* t3" by blast |
812 then obtain t3 where c1: "s1 \<longrightarrow>\<^isub>1 t3" and c2: "t2 \<longrightarrow>\<^isub>1\<^sup>* t3" by blast |
785 have "\<exists>t4. s2 \<longrightarrow>\<^isub>1 t4 \<and> t3 \<longrightarrow>\<^isub>1 t4" using b c1 by (blast intro: diamond) |
813 have "\<exists>t4. s2 \<longrightarrow>\<^isub>1 t4 \<and> t3 \<longrightarrow>\<^isub>1 t4" using b c1 by (blast intro: diamond) |
786 thus ?thesis using c2 by (blast intro: rtrancl_trans) |
814 thus ?thesis using c2 by (blast intro: one_star_trans) |
787 qed |
815 qed |
788 qed |
816 qed |
789 |
817 |
790 lemma cr_one_star: |
818 lemma cr_one_star: |
791 assumes a: "t\<longrightarrow>\<^isub>1\<^sup>*t2" |
819 assumes a: "t\<longrightarrow>\<^isub>1\<^sup>*t2" |
792 and b: "t\<longrightarrow>\<^isub>1\<^sup>*t1" |
820 and b: "t\<longrightarrow>\<^isub>1\<^sup>*t1" |
793 shows "\<exists>t3. t1\<longrightarrow>\<^isub>1\<^sup>*t3\<and>t2\<longrightarrow>\<^isub>1\<^sup>*t3" |
821 shows "\<exists>t3. t1\<longrightarrow>\<^isub>1\<^sup>*t3\<and>t2\<longrightarrow>\<^isub>1\<^sup>*t3" |
794 using a |
822 using a b |
795 proof induct |
823 proof (induct arbitrary: t1) |
796 case 1 |
824 case (os1 t) then show ?case by force |
797 show ?case using b by force |
|
798 next |
825 next |
799 case (2 s1 s2) |
826 case (os2 t s1 s2 t1) |
|
827 have c: "t \<longrightarrow>\<^isub>1\<^sup>* s1" by fact |
|
828 have c': "t \<longrightarrow>\<^isub>1\<^sup>* t1" by fact |
800 have d: "s1 \<longrightarrow>\<^isub>1 s2" by fact |
829 have d: "s1 \<longrightarrow>\<^isub>1 s2" by fact |
801 have "\<exists>t3. t1 \<longrightarrow>\<^isub>1\<^sup>* t3 \<and> s1 \<longrightarrow>\<^isub>1\<^sup>* t3" by fact |
830 have "t \<longrightarrow>\<^isub>1\<^sup>* t1 \<Longrightarrow> (\<exists>t3. t1 \<longrightarrow>\<^isub>1\<^sup>* t3 \<and> s1 \<longrightarrow>\<^isub>1\<^sup>* t3)" by fact |
802 then obtain t3 where f1: "t1 \<longrightarrow>\<^isub>1\<^sup>* t3" |
831 then obtain t3 where f1: "t1 \<longrightarrow>\<^isub>1\<^sup>* t3" |
803 and f2: "s1 \<longrightarrow>\<^isub>1\<^sup>* t3" by blast |
832 and f2: "s1 \<longrightarrow>\<^isub>1\<^sup>* t3" using c' by blast |
804 from cr_one d f2 have "\<exists>t4. t3\<longrightarrow>\<^isub>1t4 \<and> s2\<longrightarrow>\<^isub>1\<^sup>*t4" by blast |
833 from cr_one d f2 have "\<exists>t4. t3\<longrightarrow>\<^isub>1t4 \<and> s2\<longrightarrow>\<^isub>1\<^sup>*t4" by blast |
805 then obtain t4 where g1: "t3\<longrightarrow>\<^isub>1t4" |
834 then obtain t4 where g1: "t3\<longrightarrow>\<^isub>1t4" |
806 and g2: "s2\<longrightarrow>\<^isub>1\<^sup>*t4" by blast |
835 and g2: "s2\<longrightarrow>\<^isub>1\<^sup>*t4" by blast |
807 have "t1\<longrightarrow>\<^isub>1\<^sup>*t4" using f1 g1 by (blast intro: rtrancl_trans) |
836 have "t1\<longrightarrow>\<^isub>1\<^sup>*t4" using f1 g1 by (blast intro: one_star_trans) |
808 thus ?case using g2 by blast |
837 thus ?case using g2 by blast |
809 qed |
838 qed |
810 |
839 |
811 lemma cr_beta_star: |
840 lemma cr_beta_star: |
812 assumes a1: "t\<longrightarrow>\<^isub>\<beta>\<^sup>*t1" |
841 assumes a1: "t\<longrightarrow>\<^isub>\<beta>\<^sup>*t1" |