src/HOL/Nominal/Examples/CR.thy
changeset 21101 286d68ce3f5b
parent 20955 65a9a30b8ece
child 21138 afdd72fc6c4f
equal deleted inserted replaced
21100:cda93bbf35db 21101:286d68ce3f5b
    25 next
    25 next
    26   case (Lam z M)
    26   case (Lam z M)
    27   have vc: "z\<sharp>x" "z\<sharp>P" by fact
    27   have vc: "z\<sharp>x" "z\<sharp>P" by fact
    28   have ih: "x\<sharp>M \<Longrightarrow>  M[x::=P] = M" by fact
    28   have ih: "x\<sharp>M \<Longrightarrow>  M[x::=P] = M" by fact
    29   have asm: "x\<sharp>Lam [z].M" by fact
    29   have asm: "x\<sharp>Lam [z].M" by fact
    30   with vc have "x\<sharp>M" by (simp add: fresh_atm abs_fresh)
    30   then have "x\<sharp>M" using vc by (simp add: fresh_atm abs_fresh)
    31   hence "M[x::=P] = M" using ih by simp
    31   then have "M[x::=P] = M" using ih by simp
    32   thus "(Lam [z].M)[x::=P] = Lam [z].M" using vc by simp
    32   then show "(Lam [z].M)[x::=P] = Lam [z].M" using vc by simp
    33 qed
    33 qed
    34 
    34 
    35 lemma forget_automatic: 
    35 lemma forget_automatic: 
    36   assumes asm: "x\<sharp>L"
    36   assumes asm: "x\<sharp>L"
    37   shows "L[x::=P] = L"
    37   shows "L[x::=P] = L"
    38   using asm by (nominal_induct L avoiding: x P rule: lam.induct)
    38   using asm 
    39                (auto simp add: abs_fresh fresh_atm)
    39 by (nominal_induct L avoiding: x P rule: lam.induct)
       
    40    (auto simp add: abs_fresh fresh_atm)
    40 
    41 
    41 lemma fresh_fact: 
    42 lemma fresh_fact: 
    42   fixes z::"name"
    43   fixes z::"name"
    43   assumes asms: "z\<sharp>N" "z\<sharp>L"
    44   assumes asms: "z\<sharp>N" "z\<sharp>L"
    44   shows "z\<sharp>(N[y::=L])"
    45   shows "z\<sharp>(N[y::=L])"
    69 
    70 
    70 lemma fresh_fact_automatic: 
    71 lemma fresh_fact_automatic: 
    71   fixes z::"name"
    72   fixes z::"name"
    72   assumes asms: "z\<sharp>N" "z\<sharp>L"
    73   assumes asms: "z\<sharp>N" "z\<sharp>L"
    73   shows "z\<sharp>(N[y::=L])"
    74   shows "z\<sharp>(N[y::=L])"
    74 using asms by (nominal_induct N avoiding: z y L rule: lam.induct)
    75   using asms 
    75               (auto simp add: abs_fresh fresh_atm)
    76 by (nominal_induct N avoiding: z y L rule: lam.induct)
       
    77    (auto simp add: abs_fresh fresh_atm)
    76 
    78 
    77 lemma substitution_lemma:  
    79 lemma substitution_lemma:  
    78   assumes a: "x\<noteq>y"
    80   assumes a: "x\<noteq>y"
    79   and     b: "x\<sharp>L"
    81   and     b: "x\<sharp>L"
    80   shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]"
    82   shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]"
   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)"
   319 	by (simp add: lam.inject alpha)
   332 	by (simp add: lam.inject alpha)
   320       show " P x (Lam [(pi\<bullet>a)].(pi\<bullet>t1)) (Lam [(pi\<bullet>a)].(pi\<bullet>t2))"
   333       show " P x (Lam [(pi\<bullet>a)].(pi\<bullet>t1)) (Lam [(pi\<bullet>a)].(pi\<bullet>t2))"
   321 	using x alpha1 alpha2 by (simp only: pt_name2)
   334 	using x alpha1 alpha2 by (simp only: pt_name2)
   322     qed
   335     qed
   323   next
   336   next
   324     case (o4 a s1 s2 t1 t2)
   337     case (o4 s1 s2 t1 t2 a)
   325     have j0: "t1 \<longrightarrow>\<^isub>1 t2" by fact
   338     have j0: "t1 \<longrightarrow>\<^isub>1 t2" by fact
   326     have j1: "s1 \<longrightarrow>\<^isub>1 s2" by fact
   339     have j1: "s1 \<longrightarrow>\<^isub>1 s2" by fact
   327     have j2: "\<And>(pi::name prm) x. P x (pi\<bullet>t1) (pi\<bullet>t2)" by fact
   340     have j2: "\<And>(pi::name prm) x. P x (pi\<bullet>t1) (pi\<bullet>t2)" by fact
   328     have j3: "\<And>(pi::name prm) x. P x (pi\<bullet>s1) (pi\<bullet>s2)" by fact
   341     have j3: "\<And>(pi::name prm) x. P x (pi\<bullet>s1) (pi\<bullet>s2)" by fact
   329     show ?case
   342     show ?case
   373 proof (induct)
   386 proof (induct)
   374   case o1 thus ?case by simp
   387   case o1 thus ?case by simp
   375 next
   388 next
   376   case o2 thus ?case by simp
   389   case o2 thus ?case by simp
   377 next
   390 next
   378   case (o3 c s1 s2)
   391   case (o3 s1 s2 c)
   379   have ih: "a\<sharp>s1 \<Longrightarrow>  a\<sharp>s2" by fact
   392   have ih: "a\<sharp>s1 \<Longrightarrow>  a\<sharp>s2" by fact
   380   have c: "a\<sharp>Lam [c].s1" by fact
   393   have c: "a\<sharp>Lam [c].s1" by fact
   381   show ?case
   394   show ?case
   382   proof (cases "a=c")
   395   proof (cases "a=c")
   383     assume "a=c" thus "a\<sharp>Lam [c].s2" by (simp add: abs_fresh)
   396     assume "a=c" thus "a\<sharp>Lam [c].s2" by (simp add: abs_fresh)
   386     with c have "a\<sharp>s1" by (simp add: abs_fresh)
   399     with c have "a\<sharp>s1" by (simp add: abs_fresh)
   387     hence "a\<sharp>s2" using ih by simp
   400     hence "a\<sharp>s2" using ih by simp
   388     thus "a\<sharp>Lam [c].s2" using d by (simp add: abs_fresh) 
   401     thus "a\<sharp>Lam [c].s2" using d by (simp add: abs_fresh) 
   389   qed
   402   qed
   390 next 
   403 next 
   391   case (o4 c t1 t2 s1 s2)
   404   case (o4 t1 t2 s1 s2 c)
   392   have i1: "a\<sharp>t1 \<Longrightarrow> a\<sharp>t2" by fact
   405   have i1: "a\<sharp>t1 \<Longrightarrow> a\<sharp>t2" by fact
   393   have i2: "a\<sharp>s1 \<Longrightarrow> a\<sharp>s2" by fact
   406   have i2: "a\<sharp>s1 \<Longrightarrow> a\<sharp>s2" by fact
   394   have as: "a\<sharp>App (Lam [c].s1) t1" by fact
   407   have as: "a\<sharp>App (Lam [c].s1) t1" by fact
   395   hence c1: "a\<sharp>Lam [c].s1" and c2: "a\<sharp>t1" by (simp add: fresh_prod)+
   408   hence c1: "a\<sharp>Lam [c].s1" and c2: "a\<sharp>t1" by (simp add: fresh_prod)+
   396   from c2 i1 have c3: "a\<sharp>t2" by simp
   409   from c2 i1 have c3: "a\<sharp>t2" by simp
   408 
   421 
   409 lemma one_abs: 
   422 lemma one_abs: 
   410   fixes    t :: "lam"
   423   fixes    t :: "lam"
   411   and      t':: "lam"
   424   and      t':: "lam"
   412   and      a :: "name"
   425   and      a :: "name"
   413   shows "(Lam [a].t)\<longrightarrow>\<^isub>1t'\<Longrightarrow>\<exists>t''. t'=Lam [a].t'' \<and> t\<longrightarrow>\<^isub>1t''"
   426   assumes a: "(Lam [a].t)\<longrightarrow>\<^isub>1t'"
   414   apply(ind_cases "(Lam [a].t)\<longrightarrow>\<^isub>1t'")
   427   shows "\<exists>t''. t'=Lam [a].t'' \<and> t\<longrightarrow>\<^isub>1t''"
       
   428   using a
       
   429   apply -
       
   430   apply(ind_cases2 "(Lam [a].t)\<longrightarrow>\<^isub>1t'")
   415   apply(auto simp add: lam.distinct lam.inject alpha)
   431   apply(auto simp add: lam.distinct lam.inject alpha)
   416   apply(rule_tac x="[(a,aa)]\<bullet>s2" in exI)
   432   apply(rule_tac x="[(a,aa)]\<bullet>s2" in exI)
   417   apply(rule conjI)
   433   apply(rule conjI)
   418   apply(rule pt_bij2[OF pt_name_inst, OF at_name_inst, symmetric])
   434   apply(rule pt_bij2[OF pt_name_inst, OF at_name_inst, symmetric])
   419   apply(simp)
   435   apply(simp)
   426   apply(simp add: calc_atm)
   442   apply(simp add: calc_atm)
   427   apply(force intro!: eqvt_one)
   443   apply(force intro!: eqvt_one)
   428   done
   444   done
   429 
   445 
   430 lemma one_app: 
   446 lemma one_app: 
   431   "App t1 t2 \<longrightarrow>\<^isub>1 t' \<Longrightarrow> 
   447   assumes a: "App t1 t2 \<longrightarrow>\<^isub>1 t'"
   432   (\<exists>s1 s2. t' = App s1 s2 \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2) \<or> 
   448   shows "(\<exists>s1 s2. t' = App s1 s2 \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2) \<or> 
   433   (\<exists>a s s1 s2. t1 = Lam [a].s \<and> t' = s1[a::=s2] \<and> s \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2)" 
   449          (\<exists>a s s1 s2. t1 = Lam [a].s \<and> t' = s1[a::=s2] \<and> s \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2)" 
   434   apply(ind_cases "App t1 s1 \<longrightarrow>\<^isub>1 t'")
   450   using a
       
   451   apply -
       
   452   apply(ind_cases2 "App t1 s1 \<longrightarrow>\<^isub>1 t'")
   435   apply(auto simp add: lam.distinct lam.inject)
   453   apply(auto simp add: lam.distinct lam.inject)
   436   done
   454   done
   437 
   455 
   438 lemma one_red: 
   456 lemma one_red: 
   439   "App (Lam [a].t1) t2 \<longrightarrow>\<^isub>1 M \<Longrightarrow>
   457   assumes a: "App (Lam [a].t1) t2 \<longrightarrow>\<^isub>1 M"
   440   (\<exists>s1 s2. M = App (Lam [a].s1) s2 \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2) \<or> 
   458   shows "(\<exists>s1 s2. M = App (Lam [a].s1) s2 \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2) \<or> 
   441   (\<exists>s1 s2. M = s1[a::=s2] \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2)" 
   459          (\<exists>s1 s2. M = s1[a::=s2] \<and> t1 \<longrightarrow>\<^isub>1 s1 \<and> t2 \<longrightarrow>\<^isub>1 s2)" 
   442   apply(ind_cases "App (Lam [a].t1) s1 \<longrightarrow>\<^isub>1 M")
   460   using a
       
   461   apply -
       
   462   apply(ind_cases2 "App (Lam [a].t1) s1 \<longrightarrow>\<^isub>1 M")
   443   apply(simp_all add: lam.inject)
   463   apply(simp_all add: lam.inject)
   444   apply(force)
   464   apply(force)
   445   apply(erule conjE)
   465   apply(erule conjE)
   446   apply(drule sym[of "Lam [a].t1"])
   466   apply(drule sym[of "Lam [a].t1"])
   447   apply(simp)
   467   apply(simp)
   537   using a b
   557   using a b
   538 proof (induct arbitrary: M2)
   558 proof (induct arbitrary: M2)
   539   case (o1 M) (* case 1 --- M1 = M *)
   559   case (o1 M) (* case 1 --- M1 = M *)
   540   thus "\<exists>M3. M\<longrightarrow>\<^isub>1M3 \<and>  M2\<longrightarrow>\<^isub>1M3" by blast
   560   thus "\<exists>M3. M\<longrightarrow>\<^isub>1M3 \<and>  M2\<longrightarrow>\<^isub>1M3" by blast
   541 next
   561 next
   542   case (o4 x Q Q' P P') (* case 2 --- a beta-reduction occurs*)
   562   case (o4 Q Q' P P' x) (* case 2 --- a beta-reduction occurs*)
   543   have i1: "\<And>M2. Q \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   563   have i1: "\<And>M2. Q \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   544   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   564   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   545   have "App (Lam [x].P) Q \<longrightarrow>\<^isub>1 M2" by fact
   565   have "App (Lam [x].P) Q \<longrightarrow>\<^isub>1 M2" by fact
   546   hence "(\<exists>P' Q'. M2 = App (Lam [x].P') Q' \<and> P\<longrightarrow>\<^isub>1P' \<and> Q\<longrightarrow>\<^isub>1Q') \<or> 
   566   hence "(\<exists>P' Q'. M2 = App (Lam [x].P') Q' \<and> P\<longrightarrow>\<^isub>1P' \<and> Q\<longrightarrow>\<^isub>1Q') \<or> 
   547          (\<exists>P' Q'. M2 = P'[x::=Q'] \<and> P\<longrightarrow>\<^isub>1P' \<and> Q\<longrightarrow>\<^isub>1Q')" by (simp add: one_red)
   567          (\<exists>P' Q'. M2 = P'[x::=Q'] \<and> P\<longrightarrow>\<^isub>1P' \<and> Q\<longrightarrow>\<^isub>1Q')" by (simp add: one_red)
   575       by (force simp add: one_subst)
   595       by (force simp add: one_subst)
   576     hence "\<exists>M3. P'[x::=Q']\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" using b1 by blast
   596     hence "\<exists>M3. P'[x::=Q']\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" using b1 by blast
   577   }
   597   }
   578   ultimately show "\<exists>M3. P'[x::=Q']\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" by blast
   598   ultimately show "\<exists>M3. P'[x::=Q']\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" by blast
   579 next
   599 next
   580   case (o2 Q Q' P P') (* case 3 *)
   600   case (o2 P P' Q Q') (* case 3 *)
   581   have i0: "P\<longrightarrow>\<^isub>1P'" by fact
   601   have i0: "P\<longrightarrow>\<^isub>1P'" by fact
   582   have i1: "\<And>M2. Q \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   602   have i1: "\<And>M2. Q \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   583   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   603   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   584   assume "App P Q \<longrightarrow>\<^isub>1 M2"
   604   assume "App P Q \<longrightarrow>\<^isub>1 M2"
   585   hence "(\<exists>P'' Q''. M2 = App P'' Q'' \<and> P\<longrightarrow>\<^isub>1P'' \<and> Q\<longrightarrow>\<^isub>1Q'') \<or> 
   605   hence "(\<exists>P'' Q''. M2 = App P'' Q'' \<and> P\<longrightarrow>\<^isub>1P'' \<and> Q\<longrightarrow>\<^isub>1Q'') \<or> 
   621     have "App P' Q'\<longrightarrow>\<^isub>1R1[x::=Q'''] \<and> P1''[x::=Q'']\<longrightarrow>\<^isub>1R1[x::=Q''']" by (simp add: one_subst)
   641     have "App P' Q'\<longrightarrow>\<^isub>1R1[x::=Q'''] \<and> P1''[x::=Q'']\<longrightarrow>\<^isub>1R1[x::=Q''']" by (simp add: one_subst)
   622     hence "\<exists>M3. App P' Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" using b1 by blast
   642     hence "\<exists>M3. App P' Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" using b1 by blast
   623   }
   643   }
   624   ultimately show "\<exists>M3. App P' Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" by blast
   644   ultimately show "\<exists>M3. App P' Q'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3" by blast
   625 next
   645 next
   626   case (o3 x P P') (* case 4 *)
   646   case (o3 P P' x) (* case 4 *)
   627   have i1: "P\<longrightarrow>\<^isub>1P'" by fact
   647   have i1: "P\<longrightarrow>\<^isub>1P'" by fact
   628   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   648   have i2: "\<And>M2. P \<longrightarrow>\<^isub>1M2 \<Longrightarrow> (\<exists>M3. P'\<longrightarrow>\<^isub>1M3 \<and> M2\<longrightarrow>\<^isub>1M3)" by fact
   629   have "(Lam [x].P)\<longrightarrow>\<^isub>1 M2" by fact
   649   have "(Lam [x].P)\<longrightarrow>\<^isub>1 M2" by fact
   630   hence "\<exists>P''. M2=Lam [x].P'' \<and> P\<longrightarrow>\<^isub>1P''" by (simp add: one_abs)
   650   hence "\<exists>P''. M2=Lam [x].P'' \<and> P\<longrightarrow>\<^isub>1P''" by (simp add: one_abs)
   631   then obtain P'' where b1: "M2=Lam [x].P''" and b2: "P\<longrightarrow>\<^isub>1P''" by blast
   651   then obtain P'' where b1: "M2=Lam [x].P''" and b2: "P\<longrightarrow>\<^isub>1P''" by blast
   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"