Unification/PreEqu.thy
changeset 107 5c816239deaa
equal deleted inserted replaced
106:ed54ec416bb3 107:5c816239deaa
       
     1 
       
     2 
       
     3 theory PreEqu = Main + Swap + Terms + Disagreement + Fresh:
       
     4 
       
     5 consts 
       
     6   equ :: "(fresh_envs \<times> trm \<times> trm) set"
       
     7 
       
     8 syntax 
       
     9   "_equ_judge"   :: "fresh_envs \<Rightarrow> trm \<Rightarrow> trm \<Rightarrow> bool" (" _ \<turnstile> _ \<approx> _" [80,80,80] 80)
       
    10 translations 
       
    11   "nabla \<turnstile> t1 \<approx> t2" \<rightleftharpoons> "(nabla,t1,t2) \<in> equ"
       
    12 
       
    13 inductive equ 
       
    14 intros
       
    15 equ_abst_ab[intro!]: "\<lbrakk>a\<noteq>b;(nabla \<turnstile> a \<sharp> t2);(nabla \<turnstile> t1 \<approx> (swap [(a,b)] t2))\<rbrakk> 
       
    16                       \<Longrightarrow> (nabla \<turnstile> Abst a t1 \<approx> Abst b t2)"
       
    17 equ_abst_aa[intro!]: "(nabla \<turnstile> t1 \<approx> t2) \<Longrightarrow> (nabla \<turnstile> Abst a t1 \<approx> Abst a t2)" 
       
    18 equ_unit[intro!]:    "(nabla \<turnstile> Unit \<approx> Unit)"
       
    19 equ_atom[intro!]:    "a=b\<Longrightarrow>nabla \<turnstile> Atom a \<approx> Atom b"
       
    20 equ_susp[intro!]:    "(\<forall> c \<in> ds pi1 pi2. (c,X) \<in> nabla) \<Longrightarrow> (nabla \<turnstile> Susp pi1 X \<approx> Susp pi2 X)"
       
    21 equ_paar[intro!]:    "\<lbrakk>(nabla \<turnstile> t1\<approx>t2);(nabla \<turnstile> s1\<approx>s2)\<rbrakk> \<Longrightarrow> (nabla \<turnstile> Paar t1 s1 \<approx> Paar t2 s2)"
       
    22 equ_func[intro!]:    "(nabla \<turnstile> t1 \<approx> t2) \<Longrightarrow> (nabla \<turnstile> Func F t1 \<approx> Func F t2)" 
       
    23 
       
    24 lemma equ_atom_elim[elim!]: "nabla\<turnstile>Atom a \<approx> Atom b \<Longrightarrow> a=b"
       
    25 apply(ind_cases "nabla \<turnstile> Atom a \<approx> Atom b", auto)
       
    26 done
       
    27 
       
    28 lemma equ_susp_elim[elim!]: "(nabla \<turnstile> Susp pi1 X \<approx> Susp pi2 X) 
       
    29                              \<Longrightarrow> (\<forall> c \<in> ds pi1 pi2. (c,X)\<in> nabla)"
       
    30 apply(ind_cases "nabla \<turnstile> Susp pi1 X \<approx> Susp pi2 X", auto)
       
    31 done
       
    32 lemma equ_paar_elim[elim!]: "(nabla \<turnstile> Paar s1 t1 \<approx> Paar s2 t2) \<Longrightarrow> 
       
    33                              (nabla \<turnstile> s1 \<approx> s2)\<and>(nabla \<turnstile> t1 \<approx> t2)"
       
    34 apply(ind_cases "nabla \<turnstile> Paar s1 t1 \<approx> Paar s2 t2", auto)
       
    35 done
       
    36 lemma equ_func_elim[elim!]: "(nabla \<turnstile> Func F t1 \<approx> Func F t2) \<Longrightarrow> (nabla \<turnstile> t1 \<approx> t2)"
       
    37 apply(ind_cases "nabla \<turnstile> Func F t1 \<approx> Func F t2", auto)
       
    38 done
       
    39 lemma equ_abst_aa_elim[elim!]: "(nabla \<turnstile> Abst a t1 \<approx> Abst a t2) \<Longrightarrow> (nabla \<turnstile> t1 \<approx> t2)"
       
    40 apply(ind_cases "nabla \<turnstile> Abst a t1 \<approx> Abst a t2", auto)
       
    41 done
       
    42 lemma equ_abst_ab_elim[elim!]: "\<lbrakk>(nabla \<turnstile> Abst a t1 \<approx> Abst b t2);a\<noteq>b\<rbrakk> \<Longrightarrow> 
       
    43                                 (nabla \<turnstile> t1 \<approx> (swap [(a,b)] t2))\<and>(nabla\<turnstile>a\<sharp>t2)"
       
    44 apply(ind_cases "(nabla \<turnstile> Abst a t1 \<approx> Abst b t2)", auto)
       
    45 done
       
    46 
       
    47 lemma equ_depth: "nabla \<turnstile> t1 \<approx> t2 \<Longrightarrow> depth t1 = depth t2"
       
    48 apply(erule equ.induct)
       
    49 apply(simp_all)
       
    50 done
       
    51 
       
    52 lemma rev_pi_pi_equ: "(nabla\<turnstile>swap (rev pi) (swap pi t)\<approx>t)"
       
    53 apply(induct_tac t)
       
    54 apply(auto)
       
    55 -- Susp
       
    56 apply(drule_tac ds_cancel_pi_left[of _ "rev pi @ pi" _ "[]", THEN mp, simplified])
       
    57 apply(simp only: ds_rev_pi_pi)
       
    58 apply(simp only: ds_def)
       
    59 apply(force)
       
    60 done
       
    61 
       
    62 lemma equ_pi_right: "\<forall>pi. (\<forall>a\<in>ds [] pi. nabla\<turnstile>a\<sharp>t) \<longrightarrow> (nabla\<turnstile>t\<approx>swap pi t)"
       
    63 apply(induct_tac t)
       
    64 apply(simp_all)
       
    65 -- Abst
       
    66 apply(rule allI)
       
    67 apply(case_tac "(swapas pi list)=list") 
       
    68 apply(simp)
       
    69 apply(rule impI)
       
    70 apply(rule equ_abst_aa)
       
    71 apply(drule_tac x="pi" in spec)
       
    72 apply(subgoal_tac "(\<forall>a\<in>ds [] pi.  nabla \<turnstile> a \<sharp> trm)")--A
       
    73 apply(force)
       
    74 --A
       
    75 apply(rule ballI)
       
    76 apply(drule_tac x=a in bspec)
       
    77 apply(assumption)
       
    78 apply(case_tac "list\<noteq>a")
       
    79 apply(force dest!: fresh_abst_ab_elim)
       
    80 apply(simp add: ds_def)
       
    81 apply(rule impI)
       
    82 apply(rule equ_abst_ab)
       
    83 apply(force)
       
    84 apply(drule_tac x="swapas (rev pi) list" in bspec)
       
    85 apply(simp add: ds_def)
       
    86 apply(rule conjI)
       
    87 apply(subgoal_tac "swapas (rev pi) list \<in> atms (rev pi)") --B
       
    88 apply(simp)
       
    89 --B
       
    90 apply(drule swapas_pi_ineq_a[THEN mp])
       
    91 apply(rule swapas_pi_in_atms)
       
    92 apply(simp)
       
    93 apply(clarify)
       
    94 apply(drule swapas_rev_pi_b)
       
    95 apply(simp)
       
    96 apply(force dest!: fresh_abst_ab_elim  swapas_rev_pi_b intro!: fresh_swap_right[THEN mp])
       
    97 apply(drule_tac x="(list, swapas pi list)#pi" in spec)
       
    98 apply(subgoal_tac "(\<forall>a\<in>ds [] ((list, swapas pi list) # pi).  nabla \<turnstile> a \<sharp> trm)")--C
       
    99 apply(force simp add: swap_append[THEN sym])
       
   100 --C
       
   101 apply(rule ballI)
       
   102 apply(drule_tac x="a" in bspec)
       
   103 apply(rule_tac b="list" in ds_7)
       
   104 apply(force)
       
   105 apply(assumption)
       
   106 apply(case_tac "list=a")
       
   107 apply(simp)
       
   108 apply(simp only: ds_def mem_Collect_eq)
       
   109 apply(erule conjE)
       
   110 apply(subgoal_tac "a\<noteq>swapas pi a")
       
   111 apply(simp)
       
   112 apply(force)
       
   113 apply(force dest!: fresh_abst_ab_elim)
       
   114 -- Susp
       
   115 apply(rule allI)
       
   116 apply(rule impI)
       
   117 apply(rule equ_susp)
       
   118 apply(rule ballI)
       
   119 apply(subgoal_tac "swapas list1 c\<in>ds [] pi")--A
       
   120 apply(force dest!: fresh_susp_elim)
       
   121 --A
       
   122 apply(rule ds_cancel_pi_left[THEN mp])
       
   123 apply(simp)
       
   124 -- Unit
       
   125 apply(force)
       
   126 -- Atom
       
   127 apply(rule allI)
       
   128 apply(rule impI)
       
   129 apply(case_tac "(swapas pi list) = list")
       
   130 apply(force)
       
   131 apply(drule ds_elem)
       
   132 apply(force dest!: fresh_atom_elim)
       
   133 -- Paar
       
   134 apply(force dest!: fresh_paar_elim)
       
   135 -- Func
       
   136 apply(force)
       
   137 done
       
   138 
       
   139 lemma pi_comm: "nabla\<turnstile>(swap (pi@[(a,b)]) t)\<approx>(swap ([(swapas pi a, swapas pi b)]@pi) t)"
       
   140 apply(induct_tac t)
       
   141 apply(simp_all)
       
   142 -- Abst
       
   143 apply(force simp add: swapas_comm)
       
   144 -- Susp
       
   145 apply(rule equ_susp)
       
   146 apply(rule ballI)
       
   147 apply(simp only: ds_def)
       
   148 apply(simp only: mem_Collect_eq)
       
   149 apply(erule conjE)
       
   150 apply(subgoal_tac "swapas (pi@[(a,b)]) (swapas list1 c) =
       
   151                    swapas ([(swapas pi a,swapas pi b)]@pi) (swapas list1 c)")--A
       
   152 apply(simp add: swapas_append[THEN sym])
       
   153 --A
       
   154 apply(simp only: swapas_comm)
       
   155 -- Units
       
   156 apply(rule equ_unit)
       
   157 -- Atom
       
   158 apply(force dest!: swapas_rev_pi_b swapas_rev_pi_a simp add: swapas_append)
       
   159 --Paar
       
   160 apply(force)
       
   161 --Func
       
   162 apply(force)
       
   163 done
       
   164 
       
   165 
       
   166 lemma l3_jud: "(nabla \<turnstile> t1\<approx>t2) \<Longrightarrow> (nabla \<turnstile> a\<sharp>t1) \<longrightarrow> (nabla \<turnstile> a\<sharp>t2)"
       
   167 apply(erule equ.induct)
       
   168 apply(simp_all)
       
   169 --Abst.ab
       
   170 apply(rule impI)
       
   171 apply(case_tac "aa=a")
       
   172 apply(force)
       
   173 apply(case_tac "b=a")
       
   174 apply(force)
       
   175 apply(force dest!: fresh_abst_ab_elim fresh_swap_left[THEN mp])
       
   176 -- Abst.aa
       
   177 apply(case_tac "a=aa")
       
   178 apply(force)
       
   179 apply(force dest!: fresh_abst_ab_elim)
       
   180 -- Susp
       
   181 apply(rule impI)
       
   182 apply(drule fresh_susp_elim, rule fresh_susp)
       
   183 apply(case_tac "swapas (rev pi1) a = swapas (rev pi2) a") 
       
   184 apply(simp)
       
   185 apply(drule_tac x="swapas (rev pi2) a" in bspec)
       
   186 apply(rule ds_cancel_pi_left[THEN mp])
       
   187 apply(subgoal_tac "swapas (pi1@(rev pi2)) a \<noteq> a")--A
       
   188 apply(drule ds_elem)
       
   189 apply(force simp add: ds_def swapas_append)
       
   190 --A
       
   191 apply(clarify)
       
   192 apply(simp only: swapas_append)
       
   193 apply(drule swapas_rev_pi_a)
       
   194 apply(force)
       
   195 apply(assumption)
       
   196 -- Paar
       
   197 apply(force dest!: fresh_paar_elim)
       
   198 -- Func
       
   199 apply(force dest!: fresh_func_elim)
       
   200 done
       
   201 
       
   202 lemma big: "\<forall>t1 t2 t3. (n=depth t1) \<longrightarrow>
       
   203              (((nabla\<turnstile>t1\<approx>t2)\<longrightarrow>(nabla\<turnstile>t2\<approx>t1))\<and>  
       
   204               (\<forall>pi. (nabla\<turnstile>t1\<approx>t2)\<longrightarrow>(nabla\<turnstile>swap pi t1\<approx>swap pi t2))\<and> 
       
   205               ((nabla\<turnstile>t1\<approx>t2)\<and>(nabla\<turnstile>t2\<approx>t3)\<longrightarrow>(nabla\<turnstile>t1\<approx>t3)))" 
       
   206 apply(induct_tac n rule: nat_less_induct)
       
   207 apply(rule allI)+apply(rule impI)
       
   208 apply(rule conjI)
       
   209 -- SYMMETRY
       
   210 apply(rule impI)
       
   211 apply(ind_cases "nabla \<turnstile> t1 \<approx> t2")
       
   212 apply(simp_all)
       
   213 -- Abst.ab
       
   214 apply(rule equ_abst_ab)
       
   215 apply(force) --abst.ab.first.premise
       
   216 apply(rule_tac "t1.1"="swap [(a,b)] t2a" in l3_jud[THEN mp])
       
   217 apply(drule_tac x="depth t1a" in spec)
       
   218 apply(simp)
       
   219 apply(rule fresh_swap_right[THEN mp])
       
   220 apply(simp) --abst.ab.second.premise
       
   221 apply(subgoal_tac "nabla \<turnstile> swap [(b, a)] t1a \<approx> t2a")
       
   222 apply(drule_tac x="depth t1a" in spec)
       
   223 apply(simp)
       
   224 apply(subgoal_tac "nabla \<turnstile> swap [(b,a)] t1a \<approx> swap ([(b,a)]@[(a,b)]) t2a") --A
       
   225 apply(subgoal_tac "nabla \<turnstile> swap ([(b,a)]@[(a,b)]) t2a \<approx> t2a") --B
       
   226 apply(drule_tac x="depth t1a" in spec)
       
   227 apply(simp (no_asm_use))
       
   228 apply(drule_tac x="swap [(b,a)] t1a" in spec)
       
   229 apply(simp (no_asm_use))
       
   230 apply(drule_tac x="swap [(b,a),(a,b)] t2a" in spec)
       
   231 apply(force)
       
   232 --B
       
   233 apply(subgoal_tac "nabla\<turnstile>t2a \<approx> swap ([(b, a)] @ [(a, b)]) t2a")--C
       
   234 apply(drule_tac x="depth t1a" in spec)
       
   235 apply(simp)
       
   236 apply(drule_tac x="t2a" in spec)
       
   237 apply(drule mp)
       
   238 apply(drule equ_depth)
       
   239 apply(force)
       
   240 apply(best)
       
   241 --C
       
   242 apply(rule equ_pi_right[THEN spec,THEN mp])
       
   243 apply(subgoal_tac "ds [] ([(b, a)] @ [(a, b)])={}")
       
   244 apply(simp)
       
   245 apply(simp add: ds_baab)
       
   246 --A
       
   247 apply(force simp only: swap_append)
       
   248 -- Abst.aa
       
   249 apply(force)
       
   250 -- Unit
       
   251 apply(rule equ_unit)
       
   252 -- Atom
       
   253 apply(force)
       
   254 -- Susp
       
   255 apply(force simp only: ds_sym)
       
   256 -- Paar
       
   257 apply(rule equ_paar)
       
   258 apply(drule_tac x="depth t1a" in spec)
       
   259 apply(simp add: Suc_max_left)
       
   260 apply(drule_tac x="depth s1" in spec)
       
   261 apply(simp add: Suc_max_right)
       
   262 -- Func
       
   263 apply(best)
       
   264 -- ADD.PI
       
   265 apply(rule conjI)
       
   266 apply(rule impI)
       
   267 apply(ind_cases "nabla \<turnstile> t1 \<approx> t2")
       
   268 apply(simp_all)
       
   269 -- Abst.ab
       
   270 apply(rule allI)
       
   271 apply(rule equ_abst_ab)
       
   272 -- abst.ab.first.premise
       
   273 apply(clarify)
       
   274 apply(drule swapas_rev_pi_a)
       
   275 apply(simp)
       
   276 -- abst.ab.second.premise
       
   277 apply(rule fresh_swap_right[THEN mp])
       
   278 apply(simp)
       
   279 -- abst.ab.third.premise
       
   280 apply(subgoal_tac "nabla \<turnstile> swap pi t1a \<approx> swap (pi@[(a,b)]) t2a") --A
       
   281 apply(subgoal_tac "nabla \<turnstile> swap (pi@[(a,b)]) t2a \<approx> swap ([(swapas pi a,swapas pi b)]@pi) t2a") --B
       
   282 apply(drule_tac x="depth t1a" in spec)
       
   283 apply(simp (no_asm_use))
       
   284 apply(drule_tac x="swap pi t1a" in spec)
       
   285 apply(simp (no_asm_use)) 
       
   286 apply(drule_tac x="swap (pi@[(a,b)]) t2a" in spec)
       
   287 apply(drule conjunct2)+
       
   288 apply(drule_tac x="swap ((swapas pi a, swapas pi b) # pi) t2a" in spec)
       
   289 apply(simp add: swap_append[THEN sym])
       
   290 --B
       
   291 apply(rule pi_comm)
       
   292 apply(force simp only: swap_append)
       
   293 -- A
       
   294 apply(force simp only: swap_append)
       
   295 -- Unit
       
   296 apply(rule equ_unit)
       
   297 -- Atom
       
   298 apply(force)
       
   299 -- Susp
       
   300 apply(force simp only: ds_cancel_pi_front)
       
   301 -- Paar
       
   302 apply(rule allI)
       
   303 apply(rule equ_paar)
       
   304 apply(drule_tac x="depth t1a" in spec)
       
   305 apply(simp only: Suc_max_left)
       
   306 apply(drule_tac x="depth s1" in spec)
       
   307 apply(simp only: Suc_max_right)
       
   308 -- Func
       
   309 apply(best)
       
   310 -- TRANSITIVITY
       
   311 apply(rule impI)
       
   312 apply(erule conjE)
       
   313 apply(ind_cases "nabla \<turnstile> t1 \<approx> t2")
       
   314 apply(simp_all)
       
   315 -- Abst.ab
       
   316 apply(ind_cases "nabla \<turnstile> Abst b t2a \<approx> t3")
       
   317 apply(simp)
       
   318 apply(case_tac "ba=a")
       
   319 apply(simp)
       
   320 apply(rule equ_abst_aa)
       
   321 apply(subgoal_tac "nabla\<turnstile>swap [(a,b)] t2a \<approx> t2b") --A
       
   322 apply(best)
       
   323 --A
       
   324 apply(subgoal_tac "nabla\<turnstile>swap [(a,b)] t2a\<approx> swap ([(a,b)]@[(b,a)]) t2b") --B
       
   325 apply(subgoal_tac "nabla\<turnstile>swap ([(a,b)]@[(b,a)]) t2b \<approx> t2b") --C
       
   326 apply(drule_tac x="depth t1a" in spec)
       
   327 apply(simp)
       
   328 apply(drule_tac x="swap [(a,b)] t2a" in spec)
       
   329 apply(drule equ_depth)
       
   330 apply(simp (no_asm_use))
       
   331 apply(best)
       
   332 --C
       
   333 apply(subgoal_tac "nabla\<turnstile>t2b \<approx> swap ([(a,b)]@[(b,a)]) t2b")--D
       
   334 apply(drule_tac x="depth t1a" in spec)
       
   335 apply(simp)
       
   336 apply(drule_tac x="t2b" in spec)
       
   337 apply(drule mp)
       
   338 apply(force dest!: equ_depth)
       
   339 apply(best)
       
   340 --D
       
   341 apply(rule equ_pi_right[THEN spec, THEN mp])
       
   342 apply(simp add: ds_baab)
       
   343 --B
       
   344 apply(drule_tac x="depth t1a" in spec)
       
   345 apply(simp)
       
   346 apply(drule_tac x="t2a" in spec)
       
   347 apply(drule equ_depth)
       
   348 apply(simp) 
       
   349 apply(drule_tac x="swap [(b, a)] t2b" in spec)
       
   350 apply(drule conjunct2)
       
   351 apply(drule conjunct1)
       
   352 apply(simp)
       
   353 apply(drule_tac x="[(a,b)]" in spec)
       
   354 apply(simp add: swap_append[THEN sym])
       
   355 -- Abst.ab
       
   356 apply(rule equ_abst_ab)
       
   357 -- abst.ab.first.premise
       
   358 apply(force)
       
   359 -- abst.ab.second.premise
       
   360 apply(rule_tac "t1.1"="swap [(b,ba)] t2a" in l3_jud[THEN mp])
       
   361 apply(subgoal_tac "nabla \<turnstile> swap [(b,ba)] t2a \<approx> swap ([(b,ba)]@[(b, ba)]) t2b") --A
       
   362 apply(subgoal_tac "nabla\<turnstile>swap ([(b,ba)]@[(b,ba)]) t2b \<approx> t2b") --B
       
   363 apply(drule_tac x="depth t1a" in spec)
       
   364 apply(simp)
       
   365 apply(drule_tac x="swap [(b, ba)] t2a" in spec)
       
   366 apply(drule mp)
       
   367 apply(force dest!: equ_depth)
       
   368 apply(best)
       
   369 --B
       
   370 apply(subgoal_tac "nabla\<turnstile>t2b \<approx> swap ([(b,ba)] @ [(b,ba)]) t2b")--C
       
   371 apply(drule_tac x="depth t1a" in spec)
       
   372 apply(simp)
       
   373 apply(drule_tac x="t2b" in spec)
       
   374 apply(drule mp)
       
   375 apply(force dest!: equ_depth)
       
   376 apply(best)
       
   377 -- C
       
   378 apply(rule equ_pi_right[THEN spec, THEN mp])
       
   379 apply(simp add: ds_abab)
       
   380 --A
       
   381 apply(drule_tac x="depth t1a" in spec)
       
   382 apply(simp)
       
   383 apply(drule_tac x="t2a" in spec)
       
   384 apply(drule mp)
       
   385 apply(force dest!: equ_depth)
       
   386 apply(drule_tac x="swap [(b,ba)] t2b" in spec)
       
   387 apply(drule conjunct2)
       
   388 apply(drule conjunct1)
       
   389 apply(simp)
       
   390 apply(drule_tac x="[(b,ba)]" in spec)
       
   391 apply(simp add: swap_append[THEN sym])
       
   392 -- abst.ab.third.premise
       
   393 apply(force intro!: fresh_swap_right[THEN mp])
       
   394 -- very.complex
       
   395 apply(subgoal_tac "nabla\<turnstile>t1a \<approx> swap ([(a,b)]@[(b,ba)]) t2b") --A
       
   396 apply(subgoal_tac "nabla\<turnstile>swap ([(a,b)]@[(b,ba)]) t2b \<approx> swap [(a,ba)] t2b") --B
       
   397 apply(drule_tac x="depth t1a" in spec)
       
   398 apply(simp (no_asm_use))
       
   399 apply(best)
       
   400 --B
       
   401 apply(subgoal_tac "nabla\<turnstile>swap [(a, ba)] t2b \<approx> swap [(a,b),(b,ba)] t2b")--C
       
   402 apply(drule_tac x="depth t1a" in spec)
       
   403 apply(simp)
       
   404 apply(drule_tac x="swap [(a, ba)] t2b" in spec)
       
   405 apply(drule mp)
       
   406 apply(force dest!: equ_depth)
       
   407 apply(force)
       
   408 apply(subgoal_tac "nabla\<turnstile>swap [(a,ba)] t2b\<approx> swap [(a,ba)] (swap [(a,ba),(a,b),(b,ba)] t2b)") --D
       
   409 apply(subgoal_tac "nabla\<turnstile>swap (rev [(a,ba)]) (swap [(a,ba)] (swap [(a,b),(b,ba)] t2b)) 
       
   410                         \<approx>swap [(a,b),(b,ba)] t2b") --E
       
   411 apply(simp add: swap_append[THEN sym])
       
   412 apply(drule_tac x="depth t1a" in spec)
       
   413 apply(simp)
       
   414 apply(drule_tac x="swap [(a,ba)] t2b" in spec)
       
   415 apply(drule mp)
       
   416 apply(force dest!: equ_depth)
       
   417 apply(drule_tac x="swap [(a, ba), (a, ba), (a, b), (b, ba)] t2b" in spec)
       
   418 apply(drule conjunct2)+
       
   419 apply(best)
       
   420 -- D
       
   421 apply(rule rev_pi_pi_equ)
       
   422 -- E
       
   423 apply(subgoal_tac "nabla\<turnstile>t2b\<approx>swap [(a, ba), (a, b), (b, ba)] t2b") --F
       
   424 apply(drule_tac x="depth t1a" in spec)
       
   425 apply(simp)
       
   426 apply(drule_tac x="t2b" in spec)
       
   427 apply(drule mp)
       
   428 apply(force dest!: equ_depth)
       
   429 apply(best)
       
   430 --F
       
   431 apply(rule equ_pi_right[THEN spec, THEN mp])
       
   432 apply(subgoal_tac "ds [] [(a,ba),(a,b),(b,ba)]={a,b}") -- G
       
   433 apply(simp)
       
   434 apply(drule_tac "t1.1"="t2a" and "t2.1"="swap [(b, ba)] t2b" and a1="a" in l3_jud[THEN mp])
       
   435 apply(assumption)
       
   436 apply(subgoal_tac "nabla \<turnstile> swapas (rev [(b,ba)]) a \<sharp> t2b") --H
       
   437 apply(simp)
       
   438 apply(case_tac "b=a")
       
   439 apply(force)
       
   440 apply(force)
       
   441 --H
       
   442 apply(rule fresh_swap_left[THEN mp])
       
   443 apply(assumption)
       
   444 --G
       
   445 apply(rule ds_acabbc)
       
   446 apply(assumption)+
       
   447 --A
       
   448 apply(subgoal_tac "nabla\<turnstile>swap [(a,b)] t2a\<approx>swap [(a,b)] (swap [(b,ba)] t2b)")--I
       
   449 apply(drule_tac x="depth t1a" in spec)
       
   450 apply(simp (no_asm_use))
       
   451 apply(drule_tac x="t1a" in spec)
       
   452 apply(simp (no_asm_use))
       
   453 apply(drule_tac x="swap [(a,b)] t2a" in spec)
       
   454 apply(drule conjunct2)+
       
   455 apply(drule_tac x="swap [(a, b)] (swap [(b, ba)] t2b)" in spec)
       
   456 apply(force simp add: swap_append[THEN sym])
       
   457 --I 
       
   458 apply(drule_tac x="depth t1a" in spec)
       
   459 apply(simp (no_asm_use))
       
   460 apply(drule_tac x="t2a" in spec)
       
   461 apply(drule mp)
       
   462 apply(force dest!: equ_depth)
       
   463 apply(drule_tac x="swap [(b,ba)] t2b" in spec)
       
   464 apply(best)
       
   465 -- Abst.ab
       
   466 apply(simp)
       
   467 apply(rule equ_abst_ab)
       
   468 apply(assumption)
       
   469 apply(drule_tac "t1.1"="t2a" and "t2.1"="t2b" and a1="a" in l3_jud[THEN mp])
       
   470 apply(assumption)+
       
   471 apply(subgoal_tac "nabla\<turnstile>swap [(a, b)] t2a\<approx>swap [(a, b)] t2b") --A
       
   472 apply(best)
       
   473 --A
       
   474 apply(drule_tac x="depth t1a" in spec)
       
   475 apply(simp (no_asm_use))
       
   476 apply(drule_tac x="t2a" in spec)
       
   477 apply(drule mp)
       
   478 apply(force dest!: equ_depth)
       
   479 apply(drule_tac x="t2b" in spec)
       
   480 apply(best)
       
   481 -- Abst
       
   482 apply(ind_cases "nabla \<turnstile> Abst a t2a \<approx> t3")
       
   483 apply(best)
       
   484 apply(best)
       
   485 -- Susp
       
   486 apply(ind_cases "nabla \<turnstile> Susp pi2 X \<approx> t3")
       
   487 apply(simp)
       
   488 apply(rule equ_susp)
       
   489 apply(rule ballI)
       
   490 apply(drule_tac "pi2.1"="pi2" in ds_trans[THEN mp])
       
   491 apply(force)
       
   492 -- Paar
       
   493 apply(ind_cases "nabla \<turnstile> Paar t2a s2 \<approx> t3")
       
   494 apply(simp)
       
   495 apply(rule equ_paar)
       
   496 apply(drule_tac x="depth t1a" in spec)
       
   497 apply(simp (no_asm_use) add: Suc_max_left)
       
   498 apply(best)
       
   499 apply(drule_tac x="depth s1" in spec)
       
   500 apply(simp (no_asm_use) add: Suc_max_right)
       
   501 apply(best)
       
   502 -- Func
       
   503 apply(ind_cases "nabla \<turnstile> Func F t2a \<approx> t3")
       
   504 apply(best)
       
   505 done
       
   506 
       
   507 lemma pi_right_equ_help: 
       
   508       "\<forall>t. (n=depth t) \<longrightarrow> (\<forall>pi. nabla\<turnstile>t\<approx>swap pi t\<longrightarrow>(\<forall>a\<in> ds [] pi. nabla\<turnstile>a\<sharp>t))"
       
   509 apply(induct_tac n rule: nat_less_induct)
       
   510 apply(rule allI)+
       
   511 apply(rule impI)
       
   512 apply(rule allI)+
       
   513 apply(rule impI)
       
   514 apply(ind_cases "nabla \<turnstile> t \<approx> swap pi t")
       
   515 apply(simp_all)
       
   516 --Abst.ab
       
   517 apply(rule ballI)
       
   518 apply(case_tac "aa=a")
       
   519 apply(force)
       
   520 apply(rule fresh_abst_ab)
       
   521 apply(case_tac "aa=swapas (rev pi) a")
       
   522 apply(simp)
       
   523 apply(drule fresh_swap_left[THEN mp])
       
   524 apply(assumption)
       
   525 apply(drule_tac x="depth t1" in spec)
       
   526 apply(simp)
       
   527 apply(drule_tac x="t1" in spec)
       
   528 apply(simp add: swap_append[THEN sym])
       
   529 apply(drule_tac x="[(a, swapas pi a)] @ pi" in spec)
       
   530 apply(simp)
       
   531 apply(case_tac "aa=swapas pi a")
       
   532 apply(simp)
       
   533 apply(drule_tac x="swapas pi a" in bspec)
       
   534 apply(simp (no_asm) only: ds_def)
       
   535 apply(simp only: mem_Collect_eq)
       
   536 apply(rule conjI)
       
   537 apply(simp)
       
   538 apply(simp)
       
   539 apply(rule impI)
       
   540 apply(clarify)
       
   541 apply(drule sym)
       
   542 apply(drule swapas_rev_pi_a)
       
   543 apply(force)
       
   544 apply(assumption)
       
   545 apply(drule_tac x="aa" in bspec)
       
   546 apply(subgoal_tac "\<forall>A. aa\<in>A-{swapas pi a} \<and> aa\<noteq>swapas pi a \<longrightarrow>aa\<in>A")--A
       
   547 apply(drule_tac x="ds [] ((a,swapas pi a) # pi)" in spec)
       
   548 apply(simp add: ds_equality[THEN sym])
       
   549 --A
       
   550 apply(force)
       
   551 apply(assumption)+
       
   552 --Abst.aa
       
   553 apply(rule ballI)
       
   554 apply(case_tac "aa=a")
       
   555 apply(force)
       
   556 apply(best)
       
   557 --Unit
       
   558 apply(force)
       
   559 --Atom
       
   560 apply(force simp add: ds_def)
       
   561 --Susp
       
   562 apply(rule ballI)
       
   563 apply(rule fresh_susp)
       
   564 apply(drule_tac x="swapas (rev pi1) a" in bspec)
       
   565 apply(rule ds_cancel_pi_right[of _ _ "[]" _, simplified, THEN mp])
       
   566 apply(simp)
       
   567 apply(assumption)
       
   568 --Paar
       
   569 apply(rule ballI)
       
   570 apply(rule fresh_paar)
       
   571 apply(drule_tac x="depth t1" in spec)
       
   572 apply(force simp add: Suc_max_left)
       
   573 apply(drule_tac x="depth s1" in spec)
       
   574 apply(force simp add: Suc_max_right)
       
   575 --Func
       
   576 apply(best)
       
   577 done
       
   578 
       
   579 end