diff --git a/thys/AutoFocus-Stream/AF_Stream_Exec.thy b/thys/AutoFocus-Stream/AF_Stream_Exec.thy
--- a/thys/AutoFocus-Stream/AF_Stream_Exec.thy
+++ b/thys/AutoFocus-Stream/AF_Stream_Exec.thy
@@ -1,3106 +1,3106 @@
 (*  Title:      AF_Stream_Exec.thy
     Date:       Dec 2006
     Author:     David Trachtenherz
 *)
 
 section \<open>Processing of message streams\<close>
 
 theory AF_Stream_Exec
 imports AF_Stream "List-Infinite.ListInf_Prefix" "List-Infinite.SetIntervalStep"
 begin
 
 subsection \<open>Executing components with state transition functions\<close>
 
 subsubsection \<open>Basic definitions\<close>
 
 text \<open>
   Function type for functions converting
   an input value to an input port message for a component\<close>
 type_synonym ('a, 'in) Port_Input_Value = "'a \<Rightarrow> 'in message_af"
 
 text \<open>
   Function type for functions extracting
   the output value of a single output port from
   a component value\<close>
 type_synonym ('comp, 'out) Port_Output_Value = "'comp \<Rightarrow> 'out message_af"
 
 text \<open>
   Function type for functions extracting
   the local state of a component from
   a component value\<close>
 type_synonym ('comp, 'state) Comp_Local_State = "'comp \<Rightarrow> 'state"
 
 text \<open>
   Function type for transition functions
   computing the component's value after processing
   an input for a single time unit\<close>
 type_synonym ('comp, 'input) Comp_Trans_Fun = "'input \<Rightarrow> 'comp \<Rightarrow> 'comp"
 
 
 \<comment> \<open>Execute a component for all inputs in the input stream @{typ "'input list"}\<close>
 primrec f_Exec_Comp :: "('comp, 'input) Comp_Trans_Fun \<Rightarrow> 'input list \<Rightarrow> 'comp \<Rightarrow> 'comp"
 where
   f_Exec_Nil:  "f_Exec_Comp trans_fun [] c = c"
 | f_Exec_Cons: "f_Exec_Comp trans_fun (x#xs) c = f_Exec_Comp trans_fun xs (trans_fun x c)"
 
 \<comment> \<open>Execute the component for at most n steps\<close>
 definition f_Exec_Comp_N :: "('comp, 'input) Comp_Trans_Fun \<Rightarrow> nat \<Rightarrow> 'input list \<Rightarrow> 'comp \<Rightarrow> 'comp"
   where "f_Exec_Comp_N trans_fun n xs c \<equiv> f_Exec_Comp trans_fun (xs \<down> n) c"
 
 \<comment> \<open>Produce the component stream for all inputs in the input stream\<close>
 primrec f_Exec_Comp_Stream :: "('comp, 'input) Comp_Trans_Fun \<Rightarrow> 'input list \<Rightarrow> 'comp \<Rightarrow> 'comp list"
 where
   f_Exec_Stream_Nil:  "f_Exec_Comp_Stream trans_fun [] c = []"
 | f_Exec_Stream_Cons: "f_Exec_Comp_Stream trans_fun (x # xs) c =
     (trans_fun x c) # ( f_Exec_Comp_Stream trans_fun xs (trans_fun x c) )"
 
 primrec f_Exec_Comp_Stream_Init ::
   "('comp, 'input) Comp_Trans_Fun \<Rightarrow> 'input list \<Rightarrow> 'comp \<Rightarrow> 'comp list"
 where
   f_Exec_Stream_Init_Nil:  "f_Exec_Comp_Stream_Init trans_fun [] c = [c]"
 | f_Exec_Stream_Init_Cons: "f_Exec_Comp_Stream_Init trans_fun (x # xs) c =
     c # ( f_Exec_Comp_Stream_Init trans_fun xs (trans_fun x c) )"
 
 definition i_Exec_Comp_Stream ::
     "('comp, 'input) Comp_Trans_Fun \<Rightarrow> 'input ilist \<Rightarrow> 'comp \<Rightarrow> 'comp ilist"
   where "i_Exec_Comp_Stream \<equiv> \<lambda>trans_fun input c n. f_Exec_Comp trans_fun (input \<Down> Suc n) c"
 
 definition i_Exec_Comp_Stream_Init ::
     "('comp, 'input) Comp_Trans_Fun \<Rightarrow> 'input ilist \<Rightarrow> 'comp \<Rightarrow> 'comp ilist"
   where "i_Exec_Comp_Stream_Init \<equiv> \<lambda>trans_fun input c n. f_Exec_Comp trans_fun (input \<Down> n) c"
 
 
 subsubsection \<open>Basic results\<close>
 
 lemma f_Exec_one: "f_Exec_Comp trans_fun [m] c = trans_fun m c"
 by simp
 
 lemma f_Exec_Stream_length[rule_format, simp]:"
   \<forall>c. length (f_Exec_Comp_Stream trans_fun xs c) = length xs"
 by (induct xs, simp_all)
 
 lemma f_Exec_Stream_empty_conv:"
   (f_Exec_Comp_Stream trans_fun xs c = []) = (xs = [])"
 by (simp add: length_0_conv[symmetric] del: length_0_conv)
 
 lemma f_Exec_Stream_not_empty_conv:"
   (f_Exec_Comp_Stream trans_fun xs c \<noteq> []) = (xs \<noteq> [])"
 by (simp add: f_Exec_Stream_empty_conv)
 
 lemma f_Exec_eq_f_Exec_Stream_last[rule_format]:"
   \<forall>c. f_Exec_Comp trans_fun xs c = last (c # (f_Exec_Comp_Stream trans_fun xs c))"
 by (induct xs, simp_all)
 
 corollary f_Exec_eq_f_Exec_Stream_last2[rule_format]: "
   xs \<noteq> [] \<Longrightarrow>
   f_Exec_Comp trans_fun xs c = last (f_Exec_Comp_Stream trans_fun xs c)"
 by (simp add: f_Exec_eq_f_Exec_Stream_last f_Exec_Stream_empty_conv[symmetric, of xs trans_fun c])
 
 corollary f_Exec_eq_f_Exec_Stream_last_if: "
   f_Exec_Comp trans_fun xs c = (if xs = [] then c else last (f_Exec_Comp_Stream trans_fun xs c))"
 by (simp add: f_Exec_eq_f_Exec_Stream_last2)
 
 corollary f_Exec_take_eq_last_f_Exec_Stream_take:"
   \<lbrakk> xs \<noteq> []; 0 < n \<rbrakk> \<Longrightarrow>
   f_Exec_Comp trans_fun (xs \<down> n) c =
   last (f_Exec_Comp_Stream trans_fun (xs \<down> n) c)"
 by (simp add: f_Exec_eq_f_Exec_Stream_last2 take_not_empty_conv)
 
 corollary f_Exec_N_eq_last_f_Exec_Stream_take:"
   \<lbrakk> xs \<noteq> []; 0 < n \<rbrakk> \<Longrightarrow>
     f_Exec_Comp_N trans_fun n xs c =
     last (f_Exec_Comp_Stream trans_fun (xs \<down> n) c)"
 by (simp add: f_Exec_Comp_N_def f_Exec_take_eq_last_f_Exec_Stream_take)
 
 lemma f_Exec_Stream_nth: "
   \<And>n c. n < length xs \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c ! n = f_Exec_Comp trans_fun (xs \<down> Suc n) c"
 apply (induct xs, simp)
 apply (simp add: nth_Cons')
 done
 
 lemma f_Exec_Stream_nth2: "
   n \<le> length xs \<Longrightarrow>
   (c # f_Exec_Comp_Stream trans_fun xs c) ! n = f_Exec_Comp trans_fun (xs \<down> n) c"
 by (simp add: nth_Cons' f_Exec_Stream_nth)
 
 lemma f_Exec_N_all:"
   length xs \<le> n \<Longrightarrow>
     f_Exec_Comp_N trans_fun n xs c = f_Exec_Comp trans_fun xs c"
 by (simp add: f_Exec_Comp_N_def)
 
 lemma f_Exec_Stream_append[rule_format]:"\<forall>c.
   f_Exec_Comp_Stream trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream trans_fun xs c) @
     (f_Exec_Comp_Stream trans_fun ys (f_Exec_Comp trans_fun xs c))"
 by (induct xs, simp_all)
 
 corollary f_Exec_Stream_append_last_Cons[rule_format]:"
   f_Exec_Comp_Stream trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream trans_fun xs c) @
     (f_Exec_Comp_Stream trans_fun ys (last (c # (f_Exec_Comp_Stream  trans_fun xs c))))"
 by (simp add: f_Exec_Stream_append f_Exec_eq_f_Exec_Stream_last)
 
 corollary f_Exec_Stream_append_last[rule_format]:"
   xs \<noteq> [] \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream trans_fun xs c) @
     (f_Exec_Comp_Stream trans_fun ys (last (f_Exec_Comp_Stream  trans_fun xs c)))"
 by (simp add: f_Exec_Stream_append_last_Cons f_Exec_Stream_empty_conv)
 
 corollary f_Exec_Stream_append_if:"
   f_Exec_Comp_Stream trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream trans_fun xs c) @
     (f_Exec_Comp_Stream trans_fun ys (
       if xs = [] then c else last (f_Exec_Comp_Stream trans_fun xs c)))"
 by (simp add: f_Exec_Stream_append f_Exec_eq_f_Exec_Stream_last_if)
 corollary f_Exec_append:"
   f_Exec_Comp trans_fun (xs @ ys) c =
   f_Exec_Comp trans_fun ys (f_Exec_Comp trans_fun xs c)"
 by (simp add: f_Exec_eq_f_Exec_Stream_last f_Exec_Stream_append_if f_Exec_Stream_empty_conv)
 
 corollary f_Exec_Stream_Cons_rev: "
   xs \<noteq> [] \<Longrightarrow>
   (trans_fun (hd xs) c) #
   f_Exec_Comp_Stream trans_fun (tl xs) (trans_fun (hd xs) c) =
   f_Exec_Comp_Stream trans_fun xs c"
 by (subst f_Exec_Stream_Cons[symmetric], simp)
 
 lemma f_Exec_Stream_snoc: "
   f_Exec_Comp_Stream trans_fun (xs @ [x]) c =
     f_Exec_Comp_Stream trans_fun xs c @
     [trans_fun x (f_Exec_Comp trans_fun xs c)]"
 by (simp add: f_Exec_Stream_append)
 
 lemma f_Exec_snoc: "
   f_Exec_Comp trans_fun (xs @ [x]) c =
   trans_fun x (f_Exec_Comp trans_fun xs c)"
 by (simp add: f_Exec_append)
 
 
 lemma f_Exec_N_append[rule_format]:"
   f_Exec_Comp_N trans_fun (a + b) xs c =
   f_Exec_Comp_N trans_fun b (xs \<up> a) (f_Exec_Comp_N trans_fun a xs c)"
 apply (simp add: f_Exec_Comp_N_def f_Exec_append[symmetric])
 apply (simp add: take_drop add.commute[of b])
 apply (rule subst[of "xs \<down> (a + b) \<down> a" "xs \<down> a" ], simp add: min_eqL)
 apply (subst append_take_drop_id, simp)
 done
 
 corollary f_Exec_N_Suc[rule_format]:"
   f_Exec_Comp_N trans_fun (Suc n) xs c =
   f_Exec_Comp_N trans_fun (Suc 0) (xs \<up> n) (f_Exec_Comp_N trans_fun n xs c)"
 by (simp add: f_Exec_N_append[symmetric])
 
 corollary f_Exec_N_Suc2[rule_format]:"
   n < length xs \<Longrightarrow>
   f_Exec_Comp_N trans_fun (Suc n) xs c =
   trans_fun (xs ! n) (f_Exec_Comp_N trans_fun n xs c)"
 by (simp add: f_Exec_Comp_N_def take_Suc_conv_app_nth f_Exec_append)
 
 theorem f_Exec_Stream_take:"
   (f_Exec_Comp_Stream trans_fun xs c) \<down> n =
   f_Exec_Comp_Stream trans_fun (xs \<down> n) c"
 apply (case_tac "length xs \<le> n", simp)
 apply (rule subst[OF append_take_drop_id, of _ n xs])
 apply (simp add: f_Exec_Stream_append del: append_take_drop_id)
 done
 
 theorem f_Exec_Stream_drop:"
   (f_Exec_Comp_Stream trans_fun xs c) \<up> n =
   f_Exec_Comp_Stream trans_fun (xs \<up> n)
     (f_Exec_Comp trans_fun (xs \<down> n) c)"
 apply (case_tac "length xs \<le> n", simp)
 apply (rule subst[OF append_take_drop_id, of _ n xs])
 apply (simp add: f_Exec_Stream_append del: append_take_drop_id)
 done
 
 lemma i_Exec_Stream_nth: "
   i_Exec_Comp_Stream trans_fun input c n = f_Exec_Comp trans_fun (input \<Down> Suc n) c"
 by (simp add: i_Exec_Comp_Stream_def)
 
 lemma i_Exec_Stream_nth_Suc: "
   i_Exec_Comp_Stream trans_fun input c (Suc n) =
   trans_fun (input (Suc n)) (i_Exec_Comp_Stream trans_fun input c n)"
 by (simp add: i_Exec_Stream_nth i_take_Suc_conv_app_nth f_Exec_append)
 
 lemma i_Exec_Stream_nth_Suc_first: "
   i_Exec_Comp_Stream trans_fun input c (Suc n) =
   (i_Exec_Comp_Stream trans_fun (input \<Up> Suc 0) (trans_fun (input 0) c) n)"
 by (simp add: i_Exec_Stream_nth i_take_Suc)
 
 lemma f_Exec_Stream_nth_eq_i_Exec_Stream_nth: "
   n < n' \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun (input \<Down> n') c ! n =
   i_Exec_Comp_Stream trans_fun input c n"
 by (simp add: f_Exec_Stream_nth i_Exec_Stream_nth min_eqR)
 
 
 lemma i_Exec_Stream_append: "
   i_Exec_Comp_Stream trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream trans_fun xs c \<frown>
   i_Exec_Comp_Stream trans_fun input (f_Exec_Comp trans_fun xs c)"
 by (simp add: ilist_eq_iff i_Exec_Stream_nth f_Exec_Stream_nth f_Exec_append i_append_nth Suc_diff_le)
 
 lemma i_Exec_Stream_append_last_Cons: "
   i_Exec_Comp_Stream trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream trans_fun xs c \<frown>
   i_Exec_Comp_Stream trans_fun input (
     last (c # f_Exec_Comp_Stream trans_fun xs c))"
 by (simp add: f_Exec_eq_f_Exec_Stream_last i_Exec_Stream_append)
 
 lemma i_Exec_Stream_append_last: "
   xs \<noteq> [] \<Longrightarrow>
   i_Exec_Comp_Stream trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream trans_fun xs c \<frown>
   i_Exec_Comp_Stream trans_fun input (
     last (f_Exec_Comp_Stream trans_fun xs c))"
 by (simp add: f_Exec_Stream_empty_conv i_Exec_Stream_append_last_Cons)
 
 lemma i_Exec_Stream_append_if: "
   i_Exec_Comp_Stream trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream trans_fun xs c \<frown>
   i_Exec_Comp_Stream trans_fun input (
     if xs = [] then c
     else last (f_Exec_Comp_Stream trans_fun xs c))"
 by (simp add: i_Exec_Stream_append_last)
 
 corollary i_Exec_Stream_Cons: "
   i_Exec_Comp_Stream trans_fun ([x] \<frown> input) c =
   [trans_fun x c] \<frown> i_Exec_Comp_Stream trans_fun input (trans_fun x c)"
 by (simp add: i_Exec_Stream_append)
 
 corollary i_Exec_Stream_Cons_rev: "
   [trans_fun (input 0) c] \<frown>
   i_Exec_Comp_Stream trans_fun (input \<Up> Suc 0) (trans_fun (input 0) c) =
   i_Exec_Comp_Stream trans_fun input c"
 apply (insert i_Exec_Stream_append[of trans_fun "[input 0]" "input \<Up> Suc 0" c])
 apply (simp add: i_drop_Suc_conv_tl)
 done
 
 theorem i_Exec_Stream_take:"
   (i_Exec_Comp_Stream trans_fun input c) \<Down> n =
   f_Exec_Comp_Stream trans_fun (input \<Down> n) c"
 by (simp add: list_eq_iff f_Exec_Stream_nth i_Exec_Stream_nth min_eqR)
 
 theorem i_Exec_Stream_drop:"
   (i_Exec_Comp_Stream trans_fun input c) \<Up> n =
   i_Exec_Comp_Stream trans_fun (input \<Up> n) (f_Exec_Comp trans_fun (input \<Down> n) c)"
 apply (rule subst[OF i_append_i_take_i_drop_id, of _ n input])
 apply (simp add: i_Exec_Stream_append  i_drop_def del: i_append_i_take_i_drop_id)
 done
 
 lemma f_Exec_Stream_expand_aggregate_map_take: "
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag \<down> n =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((xs \<down> n) \<odot>\<^sub>f k) c)) k ag"
 by (simp add: f_aggregate_take_mult[symmetric] take_map f_Exec_Stream_take f_expand_take_mult)
 
 corollary f_Exec_Stream_expand_aggregate_take: "
   f_aggregate (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c) k ag \<down> n =
   f_aggregate (f_Exec_Comp_Stream trans_fun ((xs \<down> n) \<odot>\<^sub>f k) c) k ag"
 by (insert f_Exec_Stream_expand_aggregate_map_take[of n id trans_fun xs k c ag], simp add: map_id)
 
 lemma i_Exec_Stream_expand_aggregate_map_take: "
   0 < k \<Longrightarrow>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) k ag \<Down> n =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c)) k ag"
 by (simp add: i_aggregate_i_take_mult[symmetric] i_Exec_Stream_take i_expand_i_take_mult)
 
 corollary i_Exec_Stream_expand_aggregate_take: "
   0 < k \<Longrightarrow>
   i_aggregate (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c) k ag \<Down> n =
   f_aggregate (f_Exec_Comp_Stream trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c) k ag"
 by (drule i_Exec_Stream_expand_aggregate_map_take[of k n id trans_fun input c ag], simp add: map_id)
 
 lemma f_Exec_Stream_expand_aggregate_map_drop: "
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag \<up> n =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((xs \<up> n) \<odot>\<^sub>f k) (
     f_Exec_Comp trans_fun ((xs \<down> n) \<odot>\<^sub>f k) c))) k ag"
 by (simp add: f_aggregate_drop_mult[symmetric] drop_map f_Exec_Stream_drop f_expand_take_mult f_expand_drop_mult)
 
 corollary f_Exec_Stream_expand_aggregate_drop: "
   f_aggregate (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c) k ag \<up> n =
   f_aggregate (f_Exec_Comp_Stream trans_fun ((xs \<up> n) \<odot>\<^sub>f k) (
     f_Exec_Comp trans_fun ((xs \<down> n) \<odot>\<^sub>f k) c)) k ag"
 by (insert f_Exec_Stream_expand_aggregate_map_drop[of n id trans_fun xs k c ag], simp add: map_id)
 
 lemma i_Exec_Stream_expand_aggregate_map_drop: "
   0 < k \<Longrightarrow>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) k ag \<Up> n =
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun ((input \<Up> n) \<odot>\<^sub>i k) (
     f_Exec_Comp trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c))) k ag"
 by (simp add: i_aggregate_i_drop_mult[symmetric] i_Exec_Stream_drop i_expand_i_take_mult i_expand_i_drop_mult)
 
 corollary i_Exec_Stream_expand_aggregate_drop: "
   0 < k \<Longrightarrow>
   i_aggregate (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c) k ag \<Up> n =
   i_aggregate (i_Exec_Comp_Stream trans_fun ((input \<Up> n) \<odot>\<^sub>i k) (
     f_Exec_Comp trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c)) k ag"
 by (drule i_Exec_Stream_expand_aggregate_map_drop[of k n id trans_fun input c ag], simp)
 
 
 lemma f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth: "
   \<lbrakk> 0 < k; n < n' \<rbrakk> \<Longrightarrow>
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (input \<Down> n' \<odot>\<^sub>f k) c)) k ag ! n =
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) k ag n"
 apply (simp add: f_aggregate_nth i_aggregate_nth f_Exec_Stream_take f_Exec_Stream_drop i_Exec_Stream_take i_Exec_Stream_drop drop_map take_map)
 apply (simp add: f_expand_take_mod i_expand_i_take_mod f_expand_drop_mod i_expand_i_drop_mod i_drop_i_take_1 drop_take_1 min_eqR)
 done
 
 corollary f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth': "
   0 < k \<Longrightarrow>
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (input \<Down> Suc n \<odot>\<^sub>f k) c)) k ag ! n =
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) k ag n"
 by (simp add: f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth)
 
 corollary f_Exec_Stream_expand_aggregate_nth_eq_i_nth: "
   \<lbrakk> 0 < k; n < n' \<rbrakk> \<Longrightarrow>
   f_aggregate (f_Exec_Comp_Stream trans_fun (input \<Down> n' \<odot>\<^sub>f k) c) k ag ! n =
   i_aggregate (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c) k ag n"
 by (drule f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth[where f=id], simp_all add: map_id)
 
 corollary f_Exec_Stream_expand_aggregate_nth_eq_i_nth': "
   0 < k \<Longrightarrow>
   f_aggregate (f_Exec_Comp_Stream trans_fun (input \<Down> Suc n \<odot>\<^sub>f k) c) k ag ! n =
   i_aggregate (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c) k ag n"
 by (simp add: f_Exec_Stream_expand_aggregate_nth_eq_i_nth)
 
 
 lemma f_Exec_Stream_expand_shrink_last_map_nth_eq_f_Exec_Comp: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c) \<div>\<^bsub>fl\<^esub> k ! n =
   f (f_Exec_Comp trans_fun ((xs \<down> Suc n) \<odot>\<^sub>f k) c)"
 apply (simp add: f_shrink_last_map f_shrink_last_length f_shrink_last_nth)
 apply (subgoal_tac "n * k + k - Suc 0 < length xs * k")
  prefer 2
  apply (drule Suc_leI[of n])
  apply (drule mult_le_mono1[of _ _ k], simp)
 apply (simp add: f_Exec_Stream_nth add.commute[of k] f_expand_take_mult[symmetric])
 done
 
 corollary f_Exec_Stream_expand_shrink_last_nth_eq_f_Exec_Comp: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c \<div>\<^bsub>fl\<^esub> k ! n =
   f_Exec_Comp trans_fun ((xs \<down> Suc n) \<odot>\<^sub>f k) c"
 by (drule f_Exec_Stream_expand_shrink_last_map_nth_eq_f_Exec_Comp[where f=id], simp_all add: map_id)
 
 lemma f_Exec_Stream_expand_aggregate_map_nth: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag ! n =
   ag (map f (f_Exec_Comp_Stream trans_fun (xs ! n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c)))"
 apply (simp add: f_aggregate_nth take_map drop_map)
 apply (simp add: take_map drop_map f_Exec_Stream_drop f_Exec_Stream_take f_expand_take_mod f_expand_drop_mod drop_take_1)
 done
 
 corollary f_Exec_Stream_expand_aggregate_nth: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_aggregate (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c) k ag ! n =
   ag (f_Exec_Comp_Stream trans_fun (xs ! n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c))"
 by (drule f_Exec_Stream_expand_aggregate_map_nth[where f=id], simp_all add: map_id)
 
 corollary f_Exec_Stream_expand_shrink_map_nth: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) \<div>\<^sub>f k ! n =
   last_message (map f (f_Exec_Comp_Stream trans_fun (xs ! n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c)))"
 by (simp add: f_shrink_def f_Exec_Stream_expand_aggregate_map_nth)
 
 lemma i_Exec_Stream_expand_aggregate_map_nth: "
   0 < k \<Longrightarrow>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) k ag n =
   ag (map f (f_Exec_Comp_Stream trans_fun (input n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c)))"
 by (simp add: i_aggregate_nth i_Exec_Stream_drop i_Exec_Stream_take i_expand_i_take_mod i_expand_i_drop_mod i_drop_i_take_1)
 
 corollary i_Exec_Stream_expand_aggregate_nth: "
   0 < k \<Longrightarrow>
   i_aggregate (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c) k ag n =
   ag (f_Exec_Comp_Stream trans_fun (input n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun ((input \<Down> n) \<odot>\<^sub>f k) c))"
 by (drule i_Exec_Stream_expand_aggregate_map_nth[where f=id], simp add: map_id)
 
 corollary i_Exec_Stream_expand_shrink_map_nth: "
   0 < k \<Longrightarrow>
   ((f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) \<div>\<^sub>i k) n =
   last_message (map f (f_Exec_Comp_Stream trans_fun (input n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun (input \<Down> n \<odot>\<^sub>f k) c)))"
 by (simp add: i_shrink_def i_Exec_Stream_expand_aggregate_map_nth)
 
 lemma f_Exec_Stream_expand_snoc: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c \<up> (n * k) \<down> k =
   f_Exec_Comp_Stream trans_fun (xs ! n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>)
     (f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c)"
 by (simp add: f_Exec_Stream_drop f_Exec_Stream_take f_expand_take_mod f_expand_drop_mod drop_take_1)
 
 lemma f_Exec_Stream_expand_map_aggregate_append: "
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((xs @ ys) \<odot>\<^sub>f k) c)) k ag =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag @
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (ys \<odot>\<^sub>f k) (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c))) k ag"
 by (simp add: f_Exec_Stream_append f_aggregate_append_mod)
 
 lemma i_Exec_Stream_expand_map_aggregate_append: "
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun ((xs \<frown> input) \<odot>\<^sub>i k) c)) k ag =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag \<frown>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c))) k ag"
 by (simp add: i_expand_i_append i_Exec_Stream_append i_aggregate_i_append_mod)
 
 lemma f_Exec_Stream_expand_map_aggregate_Cons: "
   0 < k \<Longrightarrow>
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((x # xs) \<odot>\<^sub>f k) c)) k ag =
   ag (map f (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)) #
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c))) k ag"
 apply (subst append_eq_Cons[of x xs, symmetric])
 apply (subst f_Exec_Stream_expand_map_aggregate_append)
 apply (simp add: f_aggregate_one)
 done
 
 lemma f_Exec_Stream_expand_map_aggregate_snoc: "
   0 < k \<Longrightarrow>
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun ((xs @ [x]) \<odot>\<^sub>f k) c)) k ag =
   f_aggregate (map f (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) k ag @
   [ag (map f (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)))]"
 apply (subst f_Exec_Stream_expand_map_aggregate_append)
 apply (simp add: f_aggregate_one)
 done
 
 lemma i_Exec_Stream_expand_map_aggregate_Cons: "
   0 < k \<Longrightarrow>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (([x] \<frown> input) \<odot>\<^sub>i k) c)) k ag =
   [ag (map f (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c))] \<frown>
   i_aggregate (f \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c))) k ag"
 apply (subst i_Exec_Stream_expand_map_aggregate_append)
 apply (simp add: f_aggregate_one)
 done
 
 lemma f_Exec_N_eq_f_Exec_Stream_nth:"
   n \<le> length xs \<Longrightarrow>
   f_Exec_Comp_N trans_fun n xs c = (c # f_Exec_Comp_Stream trans_fun xs c) ! n"
 by (simp add: f_Exec_Comp_N_def f_Exec_Stream_nth2)
 
 theorem f_Exec_Stream_causal: "
   xs \<down> n = ys \<down> n \<Longrightarrow>
   (f_Exec_Comp_Stream trans_fun xs c) \<down> n = (f_Exec_Comp_Stream trans_fun ys c) \<down> n"
 by (simp add: f_Exec_Stream_take)
 theorem i_Exec_Stream_causal: "
   input1 \<Down> n = input2 \<Down> n \<Longrightarrow>
   (i_Exec_Comp_Stream trans_fun input1 c) \<Down> n = (i_Exec_Comp_Stream trans_fun input2 c) \<Down> n"
 by (simp add: i_Exec_Stream_take)
 
 
 text \<open>Results for \<open>f_Exec_Comp_Stream_Init\<close>\<close>
 
 text \<open>
   \<open>f_Exec_Comp_Stream_Init\<close> computes the execution stream of a component
   with the initial value of the component
   at the beginning of the result stream.\<close>
 
 lemma f_Exec_Stream_Init_length[rule_format, simp]:"
   \<forall>c. length (f_Exec_Comp_Stream_Init trans_fun xs c) = Suc (length xs)"
 by (induct xs, simp_all)
 
 lemma f_Exec_Stream_Init_not_empty:"
   (f_Exec_Comp_Stream_Init trans_fun xs c \<noteq> [])"
 by (simp add: length_0_conv[symmetric] del: length_0_conv)
 
 lemma f_Exec_eq_f_Exec_Stream_Init_last[rule_format]:"
   \<forall>c. f_Exec_Comp trans_fun xs c = last (f_Exec_Comp_Stream_Init trans_fun xs c)"
 by (induct xs, simp_all add: f_Exec_Stream_Init_not_empty)
 
 lemma f_Exec_Stream_Init_eq_f_Exec_Stream_Cons[rule_format]: "
   \<forall>c. f_Exec_Comp_Stream_Init trans_fun xs c = c # f_Exec_Comp_Stream trans_fun xs c"
 by (induct xs, simp_all)
 
 corollary f_Exec_Stream_Init_eq_f_Exec_Stream_Cons_output: "
   output_fun c = \<NoMsg> \<Longrightarrow>
   map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c) =
   \<NoMsg> # map output_fun (f_Exec_Comp_Stream trans_fun xs c)"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 corollary f_Exec_Stream_Init_tl_eq_f_Exec_Stream: "
   tl (f_Exec_Comp_Stream_Init trans_fun xs c) = f_Exec_Comp_Stream trans_fun xs c"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 lemma f_Exec_N_eq_last_f_Exec_Stream_Init_take:"
   f_Exec_Comp_N trans_fun n xs c =
   last (f_Exec_Comp_Stream_Init trans_fun (xs \<down> n) c)"
 by (simp add: f_Exec_Comp_N_def f_Exec_eq_f_Exec_Stream_Init_last)
 
 lemma f_Exec_Stream_Init_nth: "
   n \<le> length xs \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c ! n = f_Exec_Comp trans_fun (xs \<down> n) c"
 apply (subst f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 apply (case_tac n, simp)
 apply (simp add: f_Exec_Stream_nth)
 done
 
 lemma f_Exec_Stream_Init_nth_0: "f_Exec_Comp_Stream_Init trans_fun xs c ! 0 = c"
 by (simp add: f_Exec_Stream_Init_nth)
 
 lemma f_Exec_Stream_Init_hd: "hd (f_Exec_Comp_Stream_Init trans_fun xs c) = c"
 by (simp add: hd_conv_nth f_Exec_Stream_Init_not_empty f_Exec_Stream_Init_nth_0)
 
 lemma f_Exec_Stream_Init_nth_Suc_eq_f_Exec_Stream_nth: "
   f_Exec_Comp_Stream_Init trans_fun xs c ! (Suc n) = f_Exec_Comp_Stream trans_fun xs c ! n"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 lemma f_Exec_Stream_Init_append:"
   f_Exec_Comp_Stream_Init trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream_Init trans_fun xs c) @
     tl (f_Exec_Comp_Stream_Init trans_fun ys (f_Exec_Comp trans_fun xs c))"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_Stream_append)
 
 corollary f_Exec_Stream_Init_append_last:"
   f_Exec_Comp_Stream_Init trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream_Init trans_fun xs c) @
     tl (f_Exec_Comp_Stream_Init trans_fun ys (last (f_Exec_Comp_Stream_Init trans_fun xs c)))"
 by (simp add: f_Exec_Stream_Init_append f_Exec_eq_f_Exec_Stream_Init_last)
 
 lemma f_Exec_Stream_Init_f_Exec_Stream_append:"
   f_Exec_Comp_Stream_Init trans_fun (xs @ ys) c =
     (f_Exec_Comp_Stream_Init trans_fun xs c) @
     (f_Exec_Comp_Stream trans_fun ys (f_Exec_Comp trans_fun xs c))"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_Stream_append)
 
 lemma f_Exec_Stream_Init_take:"
   (f_Exec_Comp_Stream_Init trans_fun xs c) \<down> Suc n =
   f_Exec_Comp_Stream_Init trans_fun (xs \<down> n) c"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_Stream_take)
 
 lemma f_Exec_Stream_Init_drop:"
   n \<le> length xs \<Longrightarrow>
   (f_Exec_Comp_Stream_Init trans_fun xs c) \<up> n =
   f_Exec_Comp_Stream_Init trans_fun (xs \<up> n)
     (f_Exec_Comp trans_fun (xs \<down> n) c)"
 apply (case_tac n, simp)
 apply (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_Stream_drop)
 apply (simp add: take_Suc_conv_app_nth f_Exec_append Cons_nth_drop_Suc[symmetric])
 done
 
 lemma f_Exec_Stream_Init_drop_geq_not_valid:"
   length xs \<le> n \<Longrightarrow>
   (f_Exec_Comp_Stream_Init trans_fun xs c) \<up> Suc n \<noteq>
   f_Exec_Comp_Stream_Init trans_fun arbitrary_input arbitrary_comp"
 by (simp add: f_Exec_Stream_Init_not_empty[symmetric])
 
 lemma i_Exec_Stream_Init_nth: "
   i_Exec_Comp_Stream_Init trans_fun input c n = f_Exec_Comp trans_fun (input \<Down> n) c"
 by (simp add: i_Exec_Comp_Stream_Init_def)
 
 lemma i_Exec_Stream_Init_nth_0: "
   i_Exec_Comp_Stream_Init trans_fun input c 0 = c"
 by (simp add: i_Exec_Stream_Init_nth)
 
 lemma i_Exec_Stream_Init_nth_Suc_eq_i_Exec_Stream_nth: "
   i_Exec_Comp_Stream_Init trans_fun input c (Suc n) = i_Exec_Comp_Stream trans_fun input c n"
 by (simp add: i_Exec_Stream_Init_nth i_Exec_Stream_nth)
 
 lemma i_Exec_Stream_Init_eq_i_Exec_Stream_Cons: "
   i_Exec_Comp_Stream_Init trans_fun input c = [c] \<frown> i_Exec_Comp_Stream trans_fun input c"
 by (simp add: ilist_eq_iff i_Exec_Stream_Init_nth i_append_nth i_Exec_Stream_nth)
 
 corollary i_Exec_Stream_Init_eq_i_Exec_Stream_Cons_output: "
   output_fun c = \<NoMsg> \<Longrightarrow>
   output_fun \<circ> i_Exec_Comp_Stream_Init trans_fun input c =
   [\<NoMsg>] \<frown> (output_fun \<circ> i_Exec_Comp_Stream trans_fun input c)"
 by (simp add: i_Exec_Stream_Init_eq_i_Exec_Stream_Cons)
 
 lemma i_Exec_Stream_Init_append:"
   i_Exec_Comp_Stream_Init trans_fun (input1 \<frown> input2) c =
     (f_Exec_Comp_Stream_Init trans_fun input1 c) \<frown>
     ((i_Exec_Comp_Stream_Init trans_fun input2 (f_Exec_Comp trans_fun input1 c)) \<Up> Suc 0)"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons i_Exec_Stream_Init_eq_i_Exec_Stream_Cons i_Exec_Stream_append)
 
 corollary i_Exec_Stream_Init_append_last:"
   i_Exec_Comp_Stream_Init trans_fun (input1 \<frown> input2) c =
     (f_Exec_Comp_Stream_Init trans_fun input1 c) \<frown>
     ((i_Exec_Comp_Stream_Init trans_fun input2 (last (f_Exec_Comp_Stream_Init trans_fun input1 c))) \<Up> Suc 0)"
 by (simp add: i_Exec_Stream_Init_append f_Exec_eq_f_Exec_Stream_Init_last)
 
 lemma i_Exec_Stream_Init_i_Exec_Stream_append:"
   i_Exec_Comp_Stream_Init trans_fun (input1 \<frown> input2) c =
     (f_Exec_Comp_Stream_Init trans_fun input1 c) \<frown>
     (i_Exec_Comp_Stream trans_fun input2 (f_Exec_Comp trans_fun input1 c))"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons i_Exec_Stream_Init_eq_i_Exec_Stream_Cons i_Exec_Stream_append)
 
 lemma i_Exec_Stream_Init_take:"
   (i_Exec_Comp_Stream_Init trans_fun input c) \<Down> Suc n =
   f_Exec_Comp_Stream_Init trans_fun (input \<Down> n) c"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons i_Exec_Stream_Init_eq_i_Exec_Stream_Cons i_Exec_Stream_take)
 lemma i_Exec_Stream_Init_drop:"
   (i_Exec_Comp_Stream_Init trans_fun input c) \<Up> n =
   i_Exec_Comp_Stream_Init trans_fun (input \<Up> n)
     (f_Exec_Comp trans_fun (input \<Down> n) c)"
 apply (case_tac n, simp)
 apply (simp add: i_Exec_Stream_Init_eq_i_Exec_Stream_Cons i_Exec_Stream_drop)
 apply (simp add: ilist_eq_iff i_take_Suc_conv_app_nth f_Exec_append i_Exec_Stream_nth i_append_nth i_take_first i_take_drop_eq_map)
 apply (simp add: upt_conv_Cons)
 done
 
 theorem f_Exec_Stream_Init_strictly_causal: "
   xs \<down> n = ys \<down> n \<Longrightarrow>
   (f_Exec_Comp_Stream_Init trans_fun xs c) \<down> Suc n = (f_Exec_Comp_Stream_Init trans_fun ys c) \<down> Suc n"
 by (simp add: f_Exec_Stream_Init_take)
 
 theorem i_Exec_Stream_Init_strictly_causal: "
   input1 \<Down> n = input2 \<Down> n \<Longrightarrow>
   (i_Exec_Comp_Stream_Init trans_fun input1 c) \<Down> Suc n = (i_Exec_Comp_Stream_Init trans_fun input2 c) \<Down> Suc n"
 by (simp add: i_Exec_Stream_Init_take)
 
 theorem f_Exec_N_eq_f_Exec_Stream_Init_nth:"
   n \<le> length xs \<Longrightarrow>
   f_Exec_Comp_N trans_fun n xs c = f_Exec_Comp_Stream_Init trans_fun xs c ! n"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_N_eq_f_Exec_Stream_nth)
 
 
 text \<open>Basic results for previous element functions\<close>
 
 text \<open>
   The functions \<open>list_Previous\<close> and \<open>ilist_Previous\<close>
   return the previous element of the list relatively to the specified position @{term n}
   or the initial element if @{term n} is 0,\<close>
 
 definition list_Previous :: "'value list \<Rightarrow> 'value \<Rightarrow> nat \<Rightarrow> 'value"
   where "list_Previous xs init n \<equiv>
     case n of
       0 \<Rightarrow> init
     | Suc n' \<Rightarrow> xs ! n'"
 
 definition ilist_Previous :: "'value ilist \<Rightarrow> 'value \<Rightarrow> nat \<Rightarrow> 'value"
   where "ilist_Previous f init n \<equiv>
     case n of
       0 \<Rightarrow> init
     | Suc n' \<Rightarrow> f n'"
 
 abbreviation "list_Previous'" :: "'value list \<Rightarrow> 'value \<Rightarrow> nat \<Rightarrow> 'value"
-    ( "_\<^bsup>\<leftarrow>' _\<^esup> _" [1000, 10, 100] 100)
+    ( "_\<^bsup>\<leftarrow>'' _\<^esup> _" [1000, 10, 100] 100)
   where "xs\<^bsup>\<leftarrow>' init\<^esup> n \<equiv> list_Previous xs init n"
 
 abbreviation "ilist_Previous'" :: "'value ilist \<Rightarrow> 'value \<Rightarrow> nat \<Rightarrow> 'value"
     ( "_\<^bsup>\<leftarrow> _\<^esup> _" [1000, 10, 100] 100)
   where "f\<^bsup>\<leftarrow> init\<^esup> n \<equiv> ilist_Previous f init n"
 
 lemma list_Previous_nth: "xs\<^bsup>\<leftarrow>' init\<^esup> n = (case n of 0 \<Rightarrow> init | Suc n' \<Rightarrow> xs ! n')"
 by (simp add: list_Previous_def)
 
 lemma ilist_Previous_nth: "f\<^bsup>\<leftarrow> init\<^esup> n = (case n of 0 \<Rightarrow> init | Suc n' \<Rightarrow> f n')"
 by (simp add: ilist_Previous_def)
 
 lemma list_Previous_nth_if: "xs\<^bsup>\<leftarrow>' init\<^esup> n = (if n = 0 then init else xs ! (n - Suc 0))"
 by (case_tac n, simp_all add: list_Previous_nth)
 
 lemma ilist_Previous_nth_if: "f\<^bsup>\<leftarrow> init\<^esup> n = (if n = 0 then init else f (n - Suc 0))"
 by (case_tac n, simp_all add: ilist_Previous_nth)
 
 lemma list_Previous_Cons: "xs\<^bsup>\<leftarrow>' init\<^esup> n = (init # xs) ! n"
 by (case_tac n, simp_all add: list_Previous_nth)
 
 lemma ilist_Previous_Cons: "f\<^bsup>\<leftarrow> init\<^esup> n = ([init] \<frown> f) n"
 by (case_tac n, simp_all add: ilist_Previous_nth)
 
 lemma list_Previous_0: "xs\<^bsup>\<leftarrow>' init\<^esup> 0 = init"
 by (simp add: list_Previous_def)
 
 lemma ilist_Previous_0: "f\<^bsup>\<leftarrow> init\<^esup> 0 = init"
 by (simp add: ilist_Previous_def)
 
 lemma list_Previous_gr0: "0 < n \<Longrightarrow> xs\<^bsup>\<leftarrow>' init\<^esup> n = xs ! (n - Suc 0)"
 by (case_tac n, simp_all add: list_Previous_nth)
 
 lemma ilist_Previous_gr0: "0 < n \<Longrightarrow> f\<^bsup>\<leftarrow> init\<^esup> n = f (n - Suc 0)"
 by (case_tac n, simp_all add: ilist_Previous_nth)
 
 lemma list_Previous_Suc: "xs\<^bsup>\<leftarrow>' init\<^esup> (Suc n) = xs ! n"
 by (simp add: list_Previous_def)
 
 lemma ilist_Previous_Suc: "f\<^bsup>\<leftarrow> init\<^esup> (Suc n) = f n"
 by (simp add: ilist_Previous_def)
 
 
 lemma f_Exec_Stream_Previous_f_Exec_Stream_Init: "
   f_Exec_Comp_Stream_Init trans_fun xs c ! n =
   (f_Exec_Comp_Stream trans_fun xs c)\<^bsup>\<leftarrow>' c\<^esup> n"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons list_Previous_Cons)
 
 lemma i_Exec_Stream_Previous_i_Exec_Stream_Init: "
   i_Exec_Comp_Stream_Init trans_fun input c n =
   (i_Exec_Comp_Stream trans_fun input c)\<^bsup>\<leftarrow> c\<^esup> n"
 by (simp add: i_Exec_Stream_Init_eq_i_Exec_Stream_Cons ilist_Previous_Cons)
 
 
 lemma f_Exec_Stream_hd: "
   0 < length xs \<Longrightarrow> hd (f_Exec_Comp_Stream trans_fun xs c) = trans_fun (hd xs) c"
 by (case_tac xs, simp+)
 
 lemma f_Exec_Stream_nth_0: "
   0 < length xs \<Longrightarrow> (f_Exec_Comp_Stream trans_fun xs c) ! 0= trans_fun (xs ! 0) c"
 by (case_tac xs, simp+)
 
 text \<open>
   The calculation of the n-th result stream element
   from the previous result stream element and the current input stream element.\<close>
 lemma f_Exec_Stream_nth_gr0_calc: "
   \<lbrakk> n < length xs; 0 < n \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c ! n =
   trans_fun (xs ! n) (f_Exec_Comp_Stream trans_fun xs c ! (n - 1))"
 by (simp add: f_Exec_Stream_nth take_Suc_conv_app_nth f_Exec_append)
 
 lemma f_Exec_Stream_nth_calc_Previous: "
   n < length xs \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c ! n =
   trans_fun (xs ! n) ((f_Exec_Comp_Stream trans_fun xs c)\<^bsup>\<leftarrow>' c\<^esup> n)"
 apply (case_tac n)
  apply (simp add: list_Previous_0 f_Exec_Stream_nth_0)
 apply (simp add: list_Previous_def f_Exec_Stream_nth_gr0_calc)
 done
 
 
 lemma i_Exec_Stream_nth_0: "
   (i_Exec_Comp_Stream trans_fun input c) 0 = trans_fun (input 0) c"
 by (simp add: i_Exec_Stream_nth i_take_first)
 
 lemma i_Exec_Stream_nth_gr0_calc: "
   0 < n \<Longrightarrow>
   (i_Exec_Comp_Stream trans_fun input c) n =
   trans_fun (input n) ((i_Exec_Comp_Stream trans_fun input c) (n - 1))"
 by (simp add: i_Exec_Stream_nth i_take_Suc_conv_app_nth f_Exec_append)
 
 text \<open>
   The component state (and thus its output) at time point @{term "n"}
   is computed from the previous state
   (the state at time @{term "n-1"} for @{term "n > 0"}
   or the initial state for @{term "n = 0"})
   and the input at time @{term "n"}.\<close>
 lemma i_Exec_Stream_nth_calc_Previous: "
   i_Exec_Comp_Stream trans_fun input c n =
   trans_fun (input n) ((i_Exec_Comp_Stream trans_fun input c)\<^bsup>\<leftarrow> c\<^esup> n)"
 by (simp add: i_Exec_Stream_nth ilist_Previous_nth_if i_take_first i_take_Suc_conv_app_nth f_Exec_append)
 
 lemma f_Exec_Stream_Init_nth_Suc_calc: "
   n < length xs \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c ! Suc n =
   trans_fun (xs ! n) (f_Exec_Comp_Stream_Init trans_fun xs c ! n)"
 by (simp add: f_Exec_Stream_Init_eq_f_Exec_Stream_Cons f_Exec_Stream_nth nth_Cons' length_greater_0_conv[THEN iffD1, OF gr_implies_gr0] take_Suc_conv_app_nth f_Exec_append)
 
 lemma f_Exec_Stream_Init_nth_Plus1_calc: "
   n < length xs \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c ! (n + 1)=
   trans_fun (xs ! n) (f_Exec_Comp_Stream_Init trans_fun xs c ! n)"
 by (simp add: f_Exec_Stream_Init_nth_Suc_calc)
 
 lemma f_Exec_Stream_Init_nth_gr0_calc: "
   \<lbrakk> n \<le> length xs; 0 < n \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c ! n =
   trans_fun (xs ! (n - 1)) (f_Exec_Comp_Stream_Init trans_fun xs c ! (n - 1))"
 by (clarsimp simp: gr0_conv_Suc f_Exec_Stream_Init_nth_Suc_calc)
 
 text \<open>
   At the beginning,
   the component state (and thus its output)
   for the execution stream with initial state
   is represented by the initial state,
   contrary to the @{term "i_Exec_Comp_Stream"}
   that does not contain the initial state.\<close>
 
 text \<open>
   The component state (and thus its output) at time point @{term "n + 1"}
   for the execution stream with initial state
   is computed from the previous state
   (the state at time @{term "n"})
   and the previous input
   (input at time @{term "n"}),
   contrary to the @{term "i_Exec_Comp_Stream"},
   where each state at time @{term "n"}
   represents the resulting state after processing the input at time @{term "n"}.\<close>
 
 lemma i_Exec_Stream_Init_nth_Suc_calc: "
   i_Exec_Comp_Stream_Init trans_fun input c (Suc n) =
   trans_fun (input n) (i_Exec_Comp_Stream_Init trans_fun input c n)"
 by (simp add: i_Exec_Stream_Init_nth i_take_Suc_conv_app_nth f_Exec_append)
 
 lemma i_Exec_Stream_Init_nth_Plus1_calc: "
   i_Exec_Comp_Stream_Init trans_fun input c (n + 1) =
   trans_fun (input n) (i_Exec_Comp_Stream_Init trans_fun input c n)"
 by (simp add: i_Exec_Stream_Init_nth_Suc_calc)
 
 lemma i_Exec_Stream_Init_nth_gr0_calc: "
   0 < n \<Longrightarrow>
   i_Exec_Comp_Stream_Init trans_fun input c n =
   trans_fun (input (n - 1)) (i_Exec_Comp_Stream_Init trans_fun input c (n - 1))"
 by (clarsimp simp: gr0_conv_Suc i_Exec_Stream_Init_nth_Suc_calc)
 
 
 text \<open>Correlation between Pre/Post-Conditions for
   \<open>f_Exec_Comp_Stream\<close> and \<open>f_Exec_Comp_Stream_Init\<close>\<close>
 
 lemma f_Exec_Stream_Pre_Post1: "
   \<lbrakk> n < length xs;
     c_n = (f_Exec_Comp_Stream trans_fun xs c)\<^bsup>\<leftarrow>' c\<^esup> n; x_n = xs ! n \<rbrakk> \<Longrightarrow>
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (f_Exec_Comp_Stream trans_fun xs c ! n)) =
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: f_Exec_Stream_nth_calc_Previous)
 
 text \<open>Direct relation between input and result after transition\<close>
 lemma f_Exec_Stream_Pre_Post2: "
   \<lbrakk> n < length xs;
     c_n = (f_Exec_Comp_Stream trans_fun xs c)\<^bsup>\<leftarrow>' c\<^esup> n; x_n = xs ! n \<rbrakk> \<Longrightarrow>
   (P c_n \<longrightarrow> Q (xs ! n) (f_Exec_Comp_Stream trans_fun xs c ! n)) =
   (P c_n \<longrightarrow> Q x_n (trans_fun x_n c_n))"
 by (simp add: f_Exec_Stream_nth_calc_Previous)
 
 lemma f_Exec_Stream_Pre_Post2_Suc: "
   \<lbrakk> Suc n < length xs;
     c_n = f_Exec_Comp_Stream trans_fun xs c ! n; x_n1 = xs ! Suc n \<rbrakk> \<Longrightarrow>
   (P c_n \<longrightarrow> Q (xs ! Suc n) (f_Exec_Comp_Stream trans_fun xs c ! Suc n)) =
   (P c_n \<longrightarrow> Q x_n1 (trans_fun x_n1 c_n))"
 by (simp add: f_Exec_Stream_nth_gr0_calc)
 
 lemma f_Exec_Stream_Init_Pre_Post1: "
   \<lbrakk> n < length xs;
     c_n = f_Exec_Comp_Stream_Init trans_fun xs c ! n; x_n = xs ! n \<rbrakk> \<Longrightarrow>
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (f_Exec_Comp_Stream_Init trans_fun xs c ! Suc n)) =
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: f_Exec_Stream_Init_nth_Suc_calc)
 
 text \<open>Direct relation between input and state before transition\<close>
 lemma f_Exec_Stream_Init_Pre_Post2: "
   \<lbrakk> n < length xs;
     c_n = f_Exec_Comp_Stream_Init trans_fun xs c ! n; x_n = xs ! n \<rbrakk> \<Longrightarrow>
   (P (xs ! n) (f_Exec_Comp_Stream_Init trans_fun xs c ! n) \<longrightarrow>
      Q (f_Exec_Comp_Stream_Init trans_fun xs c ! Suc n)) =
   (P x_n c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: f_Exec_Stream_Init_nth_Suc_calc)
 
 
 lemma i_Exec_Stream_Pre_Post1: "
   \<lbrakk> c_n = (i_Exec_Comp_Stream trans_fun input c)\<^bsup>\<leftarrow> c\<^esup> n; x_n = input n \<rbrakk> \<Longrightarrow>
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (i_Exec_Comp_Stream trans_fun input c n)) =
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: i_Exec_Stream_nth_calc_Previous)
 
 text \<open>Direct relation between input and result after transition\<close>
 lemma i_Exec_Stream_Pre_Post2: "
   \<lbrakk> c_n = (i_Exec_Comp_Stream trans_fun input c)\<^bsup>\<leftarrow> c\<^esup> n; x_n = input n \<rbrakk> \<Longrightarrow>
   (P c_n \<longrightarrow> Q (input n) (i_Exec_Comp_Stream trans_fun input c n)) =
   (P c_n \<longrightarrow> Q x_n (trans_fun x_n c_n))"
 by (simp add: i_Exec_Stream_nth_calc_Previous)
 
 lemma i_Exec_Stream_Pre_Post2_Suc: "
   \<lbrakk> c_n = i_Exec_Comp_Stream trans_fun input c n; x_n1 = input (Suc n) \<rbrakk> \<Longrightarrow>
   (P c_n \<longrightarrow> Q (input (Suc n)) (i_Exec_Comp_Stream trans_fun input c (Suc n))) =
   (P c_n \<longrightarrow> Q x_n1 (trans_fun x_n1 c_n))"
 by (simp add: i_Exec_Stream_nth_gr0_calc)
 
 lemma i_Exec_Stream_Init_Pre_Post1: "
   \<lbrakk> c_n = i_Exec_Comp_Stream_Init trans_fun input c n; x_n = input n \<rbrakk> \<Longrightarrow>
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (i_Exec_Comp_Stream_Init trans_fun input c (Suc n))) =
   (P1 x_n \<and> P2 c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: i_Exec_Stream_Init_nth_Suc_calc)
 
 text \<open>Direct relation between input and state before transition\<close>
 lemma i_Exec_Stream_Init_Pre_Post2: "
   \<lbrakk> c_n = i_Exec_Comp_Stream_Init trans_fun input c n; x_n = input n \<rbrakk> \<Longrightarrow>
   (P (input n) (i_Exec_Comp_Stream_Init trans_fun input c n) \<longrightarrow>
      Q (i_Exec_Comp_Stream_Init trans_fun input c (Suc n))) =
   (P x_n c_n \<longrightarrow> Q (trans_fun x_n c_n))"
 by (simp add: i_Exec_Stream_Init_nth_Suc_calc)
 
 
 text \<open>Basic results for stream prefices\<close>
 
 lemma f_Exec_Stream_prefix: "
   prefix xs ys \<Longrightarrow>
   prefix (f_Exec_Comp_Stream trans_fun xs c)
          (f_Exec_Comp_Stream trans_fun ys c)"
 by (clarsimp simp: prefix_def f_Exec_Stream_append)
 
 lemma i_Exec_Stream_prefix: "
  xs \<sqsubseteq> input \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c \<sqsubseteq>
   i_Exec_Comp_Stream trans_fun input c"
 by (simp add: iprefix_eq_iprefix_take i_Exec_Stream_take)
 
 lemma f_Exec_N_prefix: "
   \<lbrakk> n \<le> length xs; prefix xs ys \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_N trans_fun n xs c =
   f_Exec_Comp_N trans_fun n ys c"
 by (simp add: f_Exec_Comp_N_def prefix_imp_take_eq)
 
 theorem f_Exec_Stream_prefix_causal[rule_format]:"
   n \<le> length (xs \<sqinter> ys) \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c \<down> n =
   f_Exec_Comp_Stream trans_fun ys c \<down> n"
 by (rule f_Exec_Stream_causal, rule inf_prefix_take_correct)
 
 lemma f_Exec_Stream_Init_prefix:"
   prefix xs ys \<Longrightarrow>
   prefix (f_Exec_Comp_Stream_Init trans_fun xs c)
          (f_Exec_Comp_Stream_Init trans_fun ys c)"
 by (clarsimp simp: prefix_def f_Exec_Stream_Init_append)
 
 lemma i_Exec_Stream_Init_prefix: "
  xs \<sqsubseteq> input \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c \<sqsubseteq>
   i_Exec_Comp_Stream_Init trans_fun input c"
 by (simp add: iprefix_eq_iprefix_take i_Exec_Stream_Init_take)
 
 theorem f_Exec_Stream_Init_prefix_strictly_causal[rule_format]:"
   n \<le> length (xs \<sqinter> ys) \<Longrightarrow>
   f_Exec_Comp_Stream_Init trans_fun xs c \<down> Suc n =
   f_Exec_Comp_Stream_Init trans_fun ys c \<down> Suc n"
 by (rule f_Exec_Stream_Init_strictly_causal, rule inf_prefix_take_correct)
 
 text \<open>
   A predicate indicating
   whether a component is deterministically dependent
   on the local state extracted by the the given local state function.\<close>
 definition Deterministic_Trans_Fun ::
     "('comp, 'input) Comp_Trans_Fun \<Rightarrow> ('comp, 'state) Comp_Local_State \<Rightarrow> bool"
   where "Deterministic_Trans_Fun trans_fun localState \<equiv>
     \<forall>c1 c2 x. localState c1 = localState c2 \<longrightarrow> trans_fun x c1 = trans_fun x c2"
 
 lemma Deterministic_f_Exec: "
   \<lbrakk> Deterministic_Trans_Fun trans_fun localState; localState c1 = localState c2; xs \<noteq> [] \<rbrakk> \<Longrightarrow>
   f_Exec_Comp trans_fun xs c1 = f_Exec_Comp trans_fun xs c2"
 apply (unfold Deterministic_Trans_Fun_def)
 apply (case_tac xs, simp)
 apply (rename_tac y ys)
 apply (drule_tac x=c1 in spec)
 apply (drule_tac x=c2 in spec)
 apply simp
 done
 
 lemma Deterministic_f_Exec_Stream: "
   \<lbrakk> Deterministic_Trans_Fun trans_fun localState; localState c1 = localState c2 \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c1 = f_Exec_Comp_Stream trans_fun xs c2"
 apply (clarsimp simp: list_eq_iff f_Exec_Stream_nth)
 apply (rule Deterministic_f_Exec)
 apply (simp add: length_greater_0_conv[THEN iffD1, OF gr_implies_gr0])+
 done
 
 lemma Deterministic_i_Exec_Stream: "
   \<lbrakk> Deterministic_Trans_Fun trans_fun localState; localState c1 = localState c2 \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream trans_fun input c1 = i_Exec_Comp_Stream trans_fun input c2"
 apply (clarsimp simp: ilist_eq_iff i_Exec_Stream_nth)
 apply (rule Deterministic_f_Exec)
 apply simp+
 done
 
 
 subsubsection \<open>Connected streams\<close>
 
 text \<open>
   A predicate indicating for two message streams,
   that the ports, they correspond to, are connected.
   The predicate implies strict causality.\<close>
 
 definition f_Streams_Connected :: "'a fstream_af \<Rightarrow> 'a fstream_af \<Rightarrow> bool"
   where "f_Streams_Connected outS inS \<equiv> inS = \<NoMsg> # outS"
 
 definition i_Streams_Connected :: "'a istream_af \<Rightarrow> 'a istream_af \<Rightarrow> bool"
   where "i_Streams_Connected outS inS \<equiv> inS = [\<NoMsg>] \<frown> outS"
 
 lemmas Streams_Connected_defs =
   f_Streams_Connected_def
   i_Streams_Connected_def
 
 lemma f_Streams_Connected_imp_not_empty: "f_Streams_Connected outS inS \<Longrightarrow> inS \<noteq> []"
 by (simp add: f_Streams_Connected_def)
 
 lemma f_Streams_Connected_nth_conv: "
   f_Streams_Connected outS inS =
   (length inS = Suc (length outS) \<and>
   (\<forall>i<length inS. inS ! i = (case i of 0 \<Rightarrow> \<NoMsg> | Suc k \<Rightarrow> outS ! k)))"
 by (simp add: f_Streams_Connected_def list_eq_iff nth_Cons)
 
 lemma f_Streams_Connected_nth_conv_if: "
   f_Streams_Connected outS inS =
   (length inS = Suc (length outS) \<and>
   (\<forall>i<length inS. inS ! i = (if i = 0 then \<NoMsg> else outS ! (i - Suc 0))))"
 apply (subst f_Streams_Connected_nth_conv)
 apply (rule conj_cong, simp)
 apply (rule all_imp_eqI, simp)
 apply (rename_tac i, case_tac i, simp+)
 done
 
 lemma i_Streams_Connected_nth_conv: "
   i_Streams_Connected outS inS =
   (\<forall>i. inS i = (case i of 0 \<Rightarrow> \<NoMsg> | Suc k \<Rightarrow> outS k))"
 by (simp add: i_Streams_Connected_def ilist_eq_iff i_append_nth_Cons)
 
 lemma i_Streams_Connected_nth_conv_if: "
   i_Streams_Connected outS inS =
   (\<forall>i. inS i = (if i = 0 then \<NoMsg> else outS (i - Suc 0)))"
 apply (subst i_Streams_Connected_nth_conv)
 apply (rule all_eqI)
 apply (rename_tac i, case_tac i, simp+)
 done
 
 
 lemma f_Exec_Stream_Init_eq_output_channel: "
   \<lbrakk> output_fun c = \<NoMsg>;
     f_Streams_Connected
       (map output_fun (f_Exec_Comp_Stream trans_fun xs c))
       channel \<rbrakk> \<Longrightarrow>
   map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c) = channel"
 by (simp add: f_Streams_Connected_def f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 lemma i_Exec_Stream_Init_eq_output_channel: "
   \<lbrakk> output_fun c = \<NoMsg>;
     i_Streams_Connected
       (output_fun \<circ> (i_Exec_Comp_Stream trans_fun input c))
       channel \<rbrakk> \<Longrightarrow>
   output_fun \<circ> (i_Exec_Comp_Stream_Init trans_fun input c) = channel"
 by (simp add: i_Streams_Connected_def i_Exec_Stream_Init_eq_i_Exec_Stream_Cons)
 
 
 lemma f_Exec_Stream_output_causal: "
   \<lbrakk> xs \<down> n = ys \<down> n;
     output1 = map output_fun (f_Exec_Comp_Stream trans_fun xs c);
     output2 = map output_fun (f_Exec_Comp_Stream trans_fun ys c) \<rbrakk> \<Longrightarrow>
   output1 \<down> n = output2 \<down> n"
 by (simp add: take_map f_Exec_Stream_causal[of n xs])
 
 lemma f_Exec_Stream_Init_output_strictly_causal: "
   \<lbrakk> xs \<down> n = ys \<down> n;
     output1 = map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c);
     output2 = map output_fun (f_Exec_Comp_Stream_Init trans_fun ys c) \<rbrakk> \<Longrightarrow>
   output1 \<down> Suc n = output2 \<down> Suc n"
 by (simp add: take_map f_Exec_Stream_Init_strictly_causal[of n xs])
 
 lemma i_Exec_Stream_output_causal: "
   \<lbrakk> input1 \<Down> n = input2 \<Down> n;
     output1 = output_fun \<circ> i_Exec_Comp_Stream trans_fun input1 c;
     output2 = output_fun \<circ> i_Exec_Comp_Stream trans_fun input2 c \<rbrakk> \<Longrightarrow>
   output1 \<Down> n = output2 \<Down> n"
 by (simp add: i_Exec_Stream_causal[of n input1])
 
 lemma i_Exec_Stream_Init_output_strictly_causal: "
   \<lbrakk> input1 \<Down> n = input2 \<Down> n;
     output1 = output_fun \<circ> i_Exec_Comp_Stream_Init trans_fun input1 c;
     output2 = output_fun \<circ> i_Exec_Comp_Stream_Init trans_fun input2 c \<rbrakk> \<Longrightarrow>
   output1 \<Down> Suc n = output2 \<Down> Suc n"
 by (simp add: i_Exec_Stream_Init_strictly_causal[of n input1])
 
 lemma f_Exec_Stream_Connected_strictly_causal: "
   \<lbrakk> xs \<down> n = ys \<down> n;
     f_Streams_Connected
       (map output_fun (f_Exec_Comp_Stream trans_fun xs c))
       channel1;
     f_Streams_Connected
       (map output_fun (f_Exec_Comp_Stream trans_fun ys c))
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<down> Suc n = channel2 \<down> Suc n"
 by (simp add: f_Streams_Connected_def take_map f_Exec_Stream_take)
 
 lemma i_Exec_Stream_Connected_strictly_causal: "
   \<lbrakk> input1 \<Down> n = input2 \<Down> n;
     i_Streams_Connected
       (portOutput \<circ> (i_Exec_Comp_Stream trans_fun input1 c))
       channel1;
     i_Streams_Connected
       (portOutput \<circ> (i_Exec_Comp_Stream trans_fun input2 c))
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<Down> Suc n = channel2 \<Down> Suc n"
 by (simp add: i_Streams_Connected_def i_take_Suc_Cons i_Exec_Stream_take)
 
 
 text \<open>
   A predicate for the semantics with initial state in result stream
   indicating for two message streams that the ports, they correspond to, are connected.\<close>
 definition f_Streams_Connected_Init :: "'a fstream_af \<Rightarrow> 'a fstream_af \<Rightarrow> bool"
   where "f_Streams_Connected_Init outS inS \<equiv> inS = outS"
 
 definition i_Streams_Connected_Init :: "'a istream_af \<Rightarrow> 'a istream_af \<Rightarrow> bool"
   where "i_Streams_Connected_Init outS inS \<equiv> inS = outS"
 
 lemmas Streams_Connected_Init_defs =
   f_Streams_Connected_Init_def
   i_Streams_Connected_Init_def
 
 lemma f_Streams_Connected_Init_nth_conv: "
   f_Streams_Connected_Init outS inS =
   (length inS = length outS \<and> (\<forall>i<length inS. inS ! i = outS ! i))"
 by (simp add: f_Streams_Connected_Init_def list_eq_iff)
 
 lemma i_Streams_Connected_Init_nth_conv: "
   i_Streams_Connected_Init outS inS =
   (\<forall>i. inS i = outS i)"
 by (simp add: i_Streams_Connected_Init_def ilist_eq_iff)
 
 
 lemma f_Exec_Stream_Init_eq_output_channel2: "
   \<lbrakk> output_fun c = \<NoMsg>;
     f_Streams_Connected_Init
       (map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c))
       channel \<rbrakk> \<Longrightarrow>
   map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c) = channel"
 by (simp add: f_Streams_Connected_Init_def f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 lemma i_Exec_Stream_Init_eq_output_channel2: "
   \<lbrakk> output_fun c = \<NoMsg>;
     i_Streams_Connected_Init
       (output_fun \<circ> (i_Exec_Comp_Stream_Init trans_fun input c))
       channel \<rbrakk> \<Longrightarrow>
   output_fun \<circ> (i_Exec_Comp_Stream_Init trans_fun input c) = channel"
 by (simp add: i_Streams_Connected_Init_def i_Exec_Stream_Init_eq_i_Exec_Stream_Cons)
 
 lemma f_Exec_Stream_Connected_Init_strictly_causal: "
   \<lbrakk> xs \<down> n = ys \<down> n;
     f_Streams_Connected_Init
       (map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c))
       channel1;
     f_Streams_Connected_Init
       (map output_fun (f_Exec_Comp_Stream_Init trans_fun ys c))
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<down> Suc n = channel2 \<down> Suc n"
 by (simp add: f_Streams_Connected_Init_def f_Exec_Stream_Init_eq_f_Exec_Stream_Cons take_map f_Exec_Stream_take)
 
 lemma i_Exec_Stream_Connected_Init_strictly_causal: "
   \<lbrakk> input1 \<Down> n = input2 \<Down> n;
     i_Streams_Connected_Init
       (portOutput \<circ> (i_Exec_Comp_Stream_Init trans_fun input1 c))
       channel1;
     i_Streams_Connected_Init
       (portOutput \<circ> (i_Exec_Comp_Stream_Init trans_fun input2 c))
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<Down> Suc n = channel2 \<Down> Suc n"
 by (simp add: i_Streams_Connected_Init_def i_Exec_Stream_Init_eq_i_Exec_Stream_Cons i_Exec_Stream_take)
 
 
 subsubsection \<open>Additional auxiliary results\<close>
 
 text \<open>The following lemma shows that,
   if the system state is different at some time points
   with respect to a certain predicate @{term P},
   then there exists a defined time point between these two,
   where the state change has taken place\<close>
 
 lemma f_State_Change_exists_set: "
   \<lbrakk> n1 \<le> n2; n1 \<in> I; n2 \<in> I;
     \<not> P (f_Exec_Comp trans_fun (input \<down> n1) c);
     P (f_Exec_Comp trans_fun (input \<down> n2) c) \<rbrakk> \<Longrightarrow>
   \<exists>n\<in>I. n1 \<le> n \<and> n < n2 \<and>
     \<not> P (f_Exec_Comp trans_fun (input \<down> n) c) \<and>
     P (f_Exec_Comp trans_fun (input \<down> (inext n I)) c)"
 by (rule inext_predicate_change_exists)
 
 lemma f_State_Change_exists: "
   \<lbrakk> n1 \<le> n2;
     \<not> P (f_Exec_Comp trans_fun (input \<down> n1) c);
     P (f_Exec_Comp trans_fun (input \<down> n2) c) \<rbrakk> \<Longrightarrow>
   \<exists>n\<ge>n1. n < n2 \<and>
     \<not> P (f_Exec_Comp trans_fun (input \<down> n) c) \<and>
     P (f_Exec_Comp trans_fun (input \<down> (Suc n)) c)"
 by (rule nat_Suc_predicate_change_exists)
 
 lemma i_State_Change_exists_set: "
   \<lbrakk> n1 \<le> n2; n1 \<in> I; n2 \<in> I;
     \<not> P (i_Exec_Comp_Stream trans_fun input c n1);
     P (i_Exec_Comp_Stream trans_fun input c n2) \<rbrakk> \<Longrightarrow>
   \<exists>n\<in>I. n1 \<le> n \<and> n < n2 \<and>
     \<not> P (i_Exec_Comp_Stream trans_fun input c n) \<and>
     P (i_Exec_Comp_Stream trans_fun input c (inext n I))"
 by (rule inext_predicate_change_exists)
 
 lemma i_State_Change_exists: "
   \<lbrakk> n1 \<le> n2;
     \<not> P (i_Exec_Comp_Stream trans_fun input c n1);
     P (i_Exec_Comp_Stream trans_fun input c n2) \<rbrakk> \<Longrightarrow>
   \<exists>n\<ge>n1. n < n2 \<and>
     \<not> P (i_Exec_Comp_Stream trans_fun input c n) \<and>
     P (i_Exec_Comp_Stream trans_fun input c (Suc n))"
 by (rule nat_Suc_predicate_change_exists)
 
 lemma i_State_Change_Init_exists_set: "
   \<lbrakk> n1 \<le> n2; n1 \<in> I; n2 \<in> I;
     \<not> P (i_Exec_Comp_Stream_Init trans_fun input c n1);
     P (i_Exec_Comp_Stream_Init trans_fun input c n2) \<rbrakk> \<Longrightarrow>
   \<exists>n\<in>I. n1 \<le> n \<and> n < n2 \<and>
     \<not> P (i_Exec_Comp_Stream_Init trans_fun input c n) \<and>
     P (i_Exec_Comp_Stream_Init trans_fun input c (inext n I))"
 by (rule inext_predicate_change_exists)
 
 lemma i_State_Change_Init_exists: "
   \<lbrakk> n1 \<le> n2;
     \<not> P (i_Exec_Comp_Stream_Init trans_fun input c n1);
     P (i_Exec_Comp_Stream_Init trans_fun input c n2) \<rbrakk> \<Longrightarrow>
   \<exists>n\<ge>n1. n < n2 \<and>
     \<not> P (i_Exec_Comp_Stream_Init trans_fun input c n) \<and>
     P (i_Exec_Comp_Stream_Init trans_fun input c (Suc n))"
 by (rule nat_Suc_predicate_change_exists)
 
 
 subsection \<open>Components with accelerated execution\<close>
 
 text \<open>
   This section deals with variable execution speed components.
   A component accelerated by a (clocking) factor @{term k}
   processes streams expanded by factor @{term k}
   and its output streams are compressed by factor @{term k}.\<close>
 
 
 subsubsection \<open>Equivalence relation for executions\<close>
 
 text \<open>
   A predicate indicating for
   two components together with transition functions
   and a given equivalence predicate for their local states,
   that the components exhibit equivalent observable behaviour
   after expanding input streams and shrinking output streams
   by a constant factor,
   given that their local states are equivalent
   with respect to the specified equivalence relations.\<close>
 
 definition
   Equiv_Exec :: "
     'input \<Rightarrow>
     ('state1 \<Rightarrow> 'state2 \<Rightarrow> bool) \<Rightarrow> \<comment> \<open>Equivalence predicate for local states\<close>
     ('comp1, 'state1) Comp_Local_State \<Rightarrow>
     ('comp2, 'state2) Comp_Local_State \<Rightarrow>
     ('input, 'input1) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for first component\<close>
     ('input, 'input2) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for second component\<close>
     ('comp1, 'output) Port_Output_Value \<Rightarrow>
     ('comp2, 'output) Port_Output_Value \<Rightarrow>
     ('comp1, 'input1 message_af) Comp_Trans_Fun \<Rightarrow>
     ('comp2, 'input2 message_af) Comp_Trans_Fun \<Rightarrow>
     nat \<Rightarrow> nat \<Rightarrow> 'comp1 \<Rightarrow> 'comp2 \<Rightarrow> bool"
 where
   "Equiv_Exec
     m equiv_states
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2 \<equiv>
     equiv_states (localState1 c1) (localState2 c2) \<longrightarrow> (
       last_message (map output_fun1 (
         f_Exec_Comp_Stream trans_fun1 (input_fun1 m # \<NoMsg>\<^bsup>k1 - Suc 0\<^esup>) c1)) =
       last_message (map output_fun2 (
         f_Exec_Comp_Stream trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2)) \<and>
       equiv_states
         (localState1 (f_Exec_Comp trans_fun1 (input_fun1 m # \<NoMsg>\<^bsup>k1 - Suc 0\<^esup>) c1))
         (localState2 (f_Exec_Comp trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2)))"
 
 text \<open>
   Predicate indicating for
   two components together with transition functions
   and a given equivalence predicate for their local states,
   that the equivalence predicate is stable
   with respect to component execution,
   i.e., it determines the equivalence
   of components' local states
   both for the initial states and after the components
   have processed an arbitrary input.
   The restricting version @{term "Equiv_Exec_stable_set"}
   guarantees stability only for inputs from a given restriction set,
   the not-restricting version guarantees stability for all inputs.\<close>
 definition
   Equiv_Exec_stable_set :: "
     'input set \<Rightarrow>
     ('state1 \<Rightarrow> 'state2 \<Rightarrow> bool) \<Rightarrow> \<comment> \<open>Equivalence predicate for local states\<close>
     ('comp1, 'state1) Comp_Local_State \<Rightarrow>
     ('comp2, 'state2) Comp_Local_State \<Rightarrow>
     ('input, 'input1) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for first component\<close>
     ('input, 'input2) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for second component\<close>
     ('comp1, 'output) Port_Output_Value \<Rightarrow>
     ('comp2, 'output) Port_Output_Value \<Rightarrow>
     ('comp1, 'input1 message_af) Comp_Trans_Fun \<Rightarrow>
     ('comp2, 'input2 message_af) Comp_Trans_Fun \<Rightarrow>
     nat \<Rightarrow> nat \<Rightarrow> 'comp1 \<Rightarrow> 'comp2 \<Rightarrow> bool"
 where
   "Equiv_Exec_stable_set A
     equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 \<equiv>
    \<forall>input m. set input \<subseteq> A \<and> m \<in> A \<longrightarrow>
      Equiv_Exec m
        equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
        trans_fun1 trans_fun2 k1 k2
        (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)
        (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)"
 
 definition
   Equiv_Exec_stable :: "
     ('state1 \<Rightarrow> 'state2 \<Rightarrow> bool) \<Rightarrow> \<comment> \<open>Equivalence predicate for local states\<close>
     ('comp1, 'state1) Comp_Local_State \<Rightarrow>
     ('comp2, 'state2) Comp_Local_State \<Rightarrow>
     ('input, 'input1) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for first component\<close>
     ('input, 'input2) Port_Input_Value \<Rightarrow> \<comment> \<open>Input adaptor for second component\<close>
     ('comp1, 'output) Port_Output_Value \<Rightarrow>
     ('comp2, 'output) Port_Output_Value \<Rightarrow>
     ('comp1, 'input1 message_af) Comp_Trans_Fun \<Rightarrow>
     ('comp2, 'input2 message_af) Comp_Trans_Fun \<Rightarrow>
     nat \<Rightarrow> nat \<Rightarrow> 'comp1 \<Rightarrow> 'comp2 \<Rightarrow> bool"
 where
   "Equiv_Exec_stable
     equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 \<equiv>
    \<forall>input m.
      Equiv_Exec m
        equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
        trans_fun1 trans_fun2 k1 k2
        (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)
        (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)"
 
 lemma Equiv_Exec_equiv_statesI: "
   \<lbrakk> equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec
       m equiv_states
         localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
         trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 (f_Exec_Comp trans_fun1 (input_fun1 m # \<NoMsg>\<^bsup>k1 - Suc 0\<^esup>) c1))
     (localState2 (f_Exec_Comp trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2))"
 by (simp add: Equiv_Exec_def)
 
 lemma Equiv_Exec_output_eqI: "
   \<lbrakk> equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec
       m equiv_states
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
         trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   last_message (map output_fun1 (
     f_Exec_Comp_Stream trans_fun1 (input_fun1 m # \<NoMsg>\<^bsup>k1 - Suc 0\<^esup>) c1)) =
   last_message (map output_fun2 (
     f_Exec_Comp_Stream trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2))"
 by (simp add: Equiv_Exec_def)
 
 lemma Equiv_Exec_equiv_statesI': "
   \<lbrakk> equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec
       m equiv_states
         localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
         trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   equiv_states
    (localState1 (f_Exec_Comp trans_fun1 NoMsg\<^bsup>k1 - Suc 0\<^esup> (trans_fun1 (input_fun1 m) c1)))
    (localState2 (f_Exec_Comp trans_fun2 NoMsg\<^bsup>k2 - Suc 0\<^esup> (trans_fun2 (input_fun2 m) c2)))"
 by (simp add: Equiv_Exec_def)
 
 lemma Equiv_Exec_le1: "
   \<lbrakk> k1 \<le> Suc 0; k2 \<le> Suc 0;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec m
       equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   output_fun1 (trans_fun1 (input_fun1 m) c1) =
   output_fun2 (trans_fun2 (input_fun2 m) c2) \<and>
   equiv_states
     (localState1 (trans_fun1 (input_fun1 m) c1))
     (localState2 (trans_fun2 (input_fun2 m) c2))"
 by (simp add: Equiv_Exec_def)
 
 
 lemma Equiv_Exec_stable_set_UNIV: "
   Equiv_Exec_stable_set
     UNIV equiv_states
     localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 =
   Equiv_Exec_stable
     equiv_states
     localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2"
 by (simp add: Equiv_Exec_stable_set_def Equiv_Exec_stable_def)
 
 lemma Equiv_Exec_stable_setI: "
   \<lbrakk> Equiv_Exec_stable_set A
     equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2;
     set input \<subseteq> A; m \<in> A \<rbrakk> \<Longrightarrow>
   Equiv_Exec
         m equiv_states
         localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
         trans_fun1 trans_fun2 k1 k2
         (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)
         (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)"
 by (simp add: Equiv_Exec_stable_set_def)
 
 lemma Equiv_Exec_stableI: "
   Equiv_Exec_stable
     equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 \<Longrightarrow>
   Equiv_Exec m
     equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2
     (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)
     (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)"
 by (simp add: Equiv_Exec_stable_def)
 
 
 text \<open>Reflexitity, symmetry and transitivity results for @{term "Equiv_Exec"}\<close>
 
 lemma Equiv_Exec_refl: "
   \<lbrakk> \<And>c. equiv_states (localState c) (localState c) \<rbrakk> \<Longrightarrow>
   Equiv_Exec
     m equiv_states
     localState localState input_fun input_fun output_fun output_fun
     trans_fun trans_fun k k c c"
 by (simp add: Equiv_Exec_def)
 
 lemma Equiv_Exec_sym[rule_format]: "
   \<lbrakk> \<forall>c1 c2.
       equiv_states (localState1 c1) (localState2 c2) =
       equiv_states (localState2 c2) (localState1 c1) \<rbrakk> \<Longrightarrow>
   Equiv_Exec
     m equiv_states
     localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 =
   Equiv_Exec
     m equiv_states
     localState2 localState1 input_fun2 input_fun1 output_fun2 output_fun1
     trans_fun2 trans_fun1 k2 k1 c2 c1"
 by (fastforce simp: Equiv_Exec_def)
 
 lemma Equiv_Exec_sym2: "
   \<lbrakk> equiv_states_sym = (\<lambda>s1 s2. equiv_states s2 s1) \<rbrakk> \<Longrightarrow>
   Equiv_Exec
     m equiv_states
     localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
     trans_fun1 trans_fun2 k1 k2 c1 c2 =
   Equiv_Exec
     m equiv_states_sym
     localState2 localState1 input_fun2 input_fun1 output_fun2 output_fun1
     trans_fun2 trans_fun1 k2 k1 c2 c1"
 by (fastforce simp: Equiv_Exec_def)
 
 lemma Equiv_Exec_sym2_ex: "
   \<exists>equiv_states_sym.
     Equiv_Exec
       m equiv_states
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2 =
     Equiv_Exec
       m equiv_states_sym
       localState2 localState1 input_fun2 input_fun1 output_fun2 output_fun1
       trans_fun2 trans_fun1 k2 k1 c2 c1"
 by (rule exI, rule Equiv_Exec_sym2, simp)
 
 lemma Equiv_Exec_trans: "
   \<lbrakk> Equiv_Exec
       m equiv_states12
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2;
     Equiv_Exec
       m equiv_states23
       localState2 localState3 input_fun2 input_fun3 output_fun2 output_fun3
       trans_fun2 trans_fun3 k2 k3 c2 c3;
     equiv_states13 = (\<lambda>s1 s3. (
       if s1 = localState1 c1 \<and> s3 = localState3 c3 then
         equiv_states12 s1 (localState2 c2) \<and>
         equiv_states23 (localState2 c2) s3
       else
         equiv_states12 s1 (
           localState2 (f_Exec_Comp trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2))) \<and>
         equiv_states23 (
           localState2 (f_Exec_Comp trans_fun2 (input_fun2 m # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2)) s3) \<rbrakk> \<Longrightarrow>
     Equiv_Exec
       m equiv_states13
       localState1 localState3 input_fun1 input_fun3 output_fun1 output_fun3
       trans_fun1 trans_fun3 k1 k3 c1 c3"
 by (fastforce simp: Equiv_Exec_def)
 
 lemma Equiv_Exec_trans_ex: "
   \<lbrakk> Equiv_Exec
       m equiv_states12
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2;
     Equiv_Exec
       m equiv_states23
       localState2 localState3 input_fun2 input_fun3 output_fun2 output_fun3
       trans_fun2 trans_fun3 k2 k3 c2 c3 \<rbrakk> \<Longrightarrow>
     \<exists>equiv_states13. Equiv_Exec
       m equiv_states13
       localState1 localState3 input_fun1 input_fun3 output_fun1 output_fun3
       trans_fun1 trans_fun3 k1 k3 c1 c3"
 by (blast intro: Equiv_Exec_trans)
 
 
 text \<open>A predicate indicating for
   a given local state extraction function and
   a given transition function,
   that components, whose states are equal with regard to the
   local state extraction function,
   are transformed into equal componenents,
   when the transition function is applied with the same input.\<close>
 definition Exec_Equal_State ::
     "('comp, 'state) Comp_Local_State \<Rightarrow> ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow> bool"
   where "Exec_Equal_State localState trans_fun \<equiv>
     \<forall>c1 c2 m. localState c1 = localState c2 \<longrightarrow> trans_fun m c1 = trans_fun m c2"
 
 lemma Exec_Equal_StateD: "
   \<lbrakk> Exec_Equal_State localState trans_fun;
     localState c1 = localState c2 \<rbrakk> \<Longrightarrow>
   trans_fun m c1 = trans_fun m c2"
 by (unfold Exec_Equal_State_def, blast)
 
 lemma Exec_Equal_StateD': "
   Exec_Equal_State localState trans_fun \<Longrightarrow>
   \<forall>c1 c2 m. localState c1 = localState c2 \<longrightarrow> trans_fun m c1 = trans_fun m c2"
 by (unfold Exec_Equal_State_def, blast)
 
 lemma Exec_Equal_StateI: "
   (\<And>c1 c2 m. localState c1 = localState c2 \<Longrightarrow> trans_fun m c1 = trans_fun m c2)
   \<Longrightarrow> Exec_Equal_State localState trans_fun"
 by (unfold Exec_Equal_State_def, blast)
 
 lemma f_Exec_Equal_State: "\<And>c1 c2.
   \<lbrakk> Exec_Equal_State localState trans_fun;
     localState c1 = localState c2; xs \<noteq> [] \<rbrakk> \<Longrightarrow>
   f_Exec_Comp trans_fun xs c1 = f_Exec_Comp trans_fun xs c2"
 apply (induct xs, simp)
 apply (case_tac "xs = []")
  apply simp
  apply (rule Exec_Equal_StateD, assumption+)
 apply (drule_tac x="trans_fun a c1" in meta_spec)
 apply (drule_tac x="trans_fun a c2" in meta_spec)
 apply (drule_tac ?c1.0=c1 and ?c2.0=c2 and m=a in Exec_Equal_StateD, assumption)
 apply simp
 done
 
 lemma f_Exec_Stream_Equal_State: "
   \<lbrakk> Exec_Equal_State localState trans_fun;
     localState c1 = localState c2 \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream trans_fun xs c1 =
   f_Exec_Comp_Stream trans_fun xs c2"
 apply (clarsimp simp: list_eq_iff f_Exec_Stream_nth)
 apply (drule gr_implies_gr0)
 apply (rule f_Exec_Equal_State)
 apply simp+
 done
 
 lemma i_Exec_Stream_Equal_State: "
   \<lbrakk> Exec_Equal_State localState trans_fun;
     localState c1 = localState c2 \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream trans_fun input c1 =
   i_Exec_Comp_Stream trans_fun input c2"
 apply (clarsimp simp: ilist_eq_iff i_Exec_Stream_nth)
 apply (rule f_Exec_Equal_State)
 apply simp+
 done
 
 
 subsubsection \<open>Idle states\<close>
 
 definition State_Idle ::
   "('comp, 'state) Comp_Local_State \<Rightarrow> ('comp \<Rightarrow> 'output message_af) \<Rightarrow>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow> 'state \<Rightarrow> bool"
   where "State_Idle localState output_fun trans_fun state \<equiv>
     \<forall>c. localState c = state \<longrightarrow>
       localState (trans_fun \<NoMsg> c) = state \<and>
       output_fun (trans_fun \<NoMsg> c) = \<NoMsg>"
 
 lemma State_IdleD: "
   \<lbrakk> State_Idle localState output_fun trans_fun state;
     localState c = state \<rbrakk> \<Longrightarrow>
   localState (trans_fun \<NoMsg> c) = state \<and>
   output_fun (trans_fun \<NoMsg> c) = \<NoMsg>"
 by (unfold State_Idle_def, blast)
 
 lemma State_IdleD': "
   State_Idle localState output_fun trans_fun state \<Longrightarrow>
   \<forall>c. localState c = state \<longrightarrow>
   localState (trans_fun \<NoMsg> c) = state \<and>
   output_fun (trans_fun \<NoMsg> c) = \<NoMsg>"
 by (unfold State_Idle_def, blast)
 
 lemma State_IdleI: "
   \<lbrakk> \<And>c. localState c = state \<Longrightarrow>
     localState (trans_fun \<NoMsg> c) = state \<and>
     output_fun (trans_fun \<NoMsg> c) = \<NoMsg> \<rbrakk> \<Longrightarrow>
   State_Idle localState output_fun trans_fun state"
 by (unfold State_Idle_def, blast)
 
 lemma State_Idle_step[rule_format]: "
   \<lbrakk> State_Idle localState output_fun trans_fun (localState c) \<rbrakk> \<Longrightarrow>
   State_Idle localState output_fun trans_fun (localState (trans_fun \<NoMsg> c))"
 apply (frule State_IdleD[OF _ refl], erule conjE)
 apply (rule State_IdleI, rename_tac c0)
 apply (drule_tac c=c0 in State_IdleD)
 apply simp+
 done
 
 lemma f_Exec_State_Idle_replicate_NoMsg_state[rule_format]: "
   \<And>c. State_Idle localState output_fun trans_fun (localState c) \<Longrightarrow>
   localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = localState c"
 apply (induct n, simp)
 apply (frule State_Idle_step)
 apply (drule_tac c=c in State_IdleD, rule refl)
 apply simp
 done
 
 
 lemma f_Exec_State_Idle_replicate_NoMsg_gr0_output[rule_format]: "\<And>c.
   \<lbrakk> State_Idle localState output_fun trans_fun (localState c); 0 < n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = \<NoMsg>"
 apply (induct n, simp)
 apply (case_tac "n = 0")
  apply simp
  apply (rule State_IdleD[THEN conjunct2], assumption, simp)
 apply (drule State_Idle_step)
 apply simp
 done
 
 lemma f_Exec_State_Idle_replicate_NoMsg_output[rule_format]: "
   \<lbrakk> State_Idle localState output_fun trans_fun (localState c);
     output_fun c = \<NoMsg> \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = \<NoMsg>"
 apply (case_tac "n = 0", simp)
 apply (simp add: f_Exec_State_Idle_replicate_NoMsg_gr0_output)
 done
 
 lemma f_Exec_Stream_State_Idle_replicate_NoMsg_output[rule_format]: "
   \<lbrakk> State_Idle localState output_fun trans_fun (localState c) \<rbrakk> \<Longrightarrow>
   map output_fun (f_Exec_Comp_Stream trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = \<NoMsg>\<^bsup>n\<^esup>"
 by (simp add: list_eq_iff f_Exec_Stream_nth min_eqL f_Exec_State_Idle_replicate_NoMsg_gr0_output del: replicate.simps)
 
 corollary f_Exec_State_Idle_append_replicate_NoMsg_state: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c)) \<rbrakk> \<Longrightarrow>
   localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) =
   localState (f_Exec_Comp trans_fun xs c)"
 by (simp add: f_Exec_append f_Exec_State_Idle_replicate_NoMsg_state)
 
 corollary f_Exec_State_Idle_append_replicate_NoMsg_ge_state: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>m\<^esup>) c));
     m \<le> n \<rbrakk> \<Longrightarrow>
   localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) =
   localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>m\<^esup>) c)"
 apply (rule_tac t=n and s="m + (n - m)" in subst, simp)
 apply (simp only: replicate_add append_assoc[symmetric])
 apply (rule f_Exec_State_Idle_append_replicate_NoMsg_state, simp)
 done
 
 corollary f_Exec_State_Idle_replicate_NoMsg_ge_state: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>m\<^esup> c));
     m \<le> n \<rbrakk> \<Longrightarrow>
   localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) =
   localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>m\<^esup> c)"
 by (cut_tac f_Exec_State_Idle_append_replicate_NoMsg_ge_state[where xs="[]"], simp+)
 
 corollary f_Exec_State_Idle_append_replicate_NoMsg_gr0_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c));
     0 < n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) = \<NoMsg>"
 by (simp add: f_Exec_append f_Exec_State_Idle_replicate_NoMsg_gr0_output)
 
 corollary f_Exec_Stream_State_Idle_append_replicate_NoMsg_gr0_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c)) \<rbrakk> \<Longrightarrow>
   map output_fun (f_Exec_Comp_Stream trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) =
   map output_fun (f_Exec_Comp_Stream trans_fun xs c) @ \<NoMsg>\<^bsup>n\<^esup>"
 by (simp add: f_Exec_Stream_append f_Exec_Stream_State_Idle_replicate_NoMsg_output)
 
 corollary f_Exec_State_Idle_append_replicate_NoMsg_gr_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>m\<^esup>) c));
     m < n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) = \<NoMsg>"
 apply (rule_tac t=n and s="m + (n - m)" in subst, simp)
 apply (simp only: replicate_add append_assoc[symmetric])
 apply (rule f_Exec_State_Idle_append_replicate_NoMsg_gr0_output, simp+)
 done
 
 corollary f_Exec_State_Idle_append_replicate_NoMsg_ge_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>m\<^esup>) c));
     output_fun (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>m\<^esup>) c) = \<NoMsg>; m \<le> n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c) = \<NoMsg>"
 by (fastforce simp: order_le_less f_Exec_State_Idle_append_replicate_NoMsg_gr_output)
 
 corollary f_Exec_State_Idle_replicate_NoMsg_gr_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>m\<^esup> c));
     m < n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = \<NoMsg>"
 by (cut_tac xs="[]" in f_Exec_State_Idle_append_replicate_NoMsg_gr_output, simp+)
 
 corollary f_Exec_State_Idle_replicate_NoMsg_ge_output: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>m\<^esup> c));
     output_fun (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>m\<^esup> c) = \<NoMsg>; m \<le> n \<rbrakk> \<Longrightarrow>
   output_fun (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c) = \<NoMsg>"
 by (fastforce simp: order_le_less f_Exec_State_Idle_replicate_NoMsg_gr_output)
 
 
 lemma State_Idle_append_replicate_NoMsg_output_last_message: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c)) \<rbrakk> \<Longrightarrow>
   last_message (map output_fun (f_Exec_Comp_Stream trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c)) =
   last_message (map output_fun (f_Exec_Comp_Stream trans_fun xs c))"
 by (simp add: f_Exec_Stream_State_Idle_append_replicate_NoMsg_gr0_output last_message_append_replicate_NoMsg)
 
 lemma State_Idle_append_replicate_NoMsg_output_Msg_eq_last_message: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c));
     output_fun (f_Exec_Comp trans_fun xs c) \<noteq> \<NoMsg>;
     xs \<noteq> [] \<rbrakk> \<Longrightarrow>
   last_message (map output_fun (f_Exec_Comp_Stream trans_fun (xs @ \<NoMsg>\<^bsup>n\<^esup>) c)) =
   output_fun (f_Exec_Comp trans_fun xs c)"
 apply (simp add: State_Idle_append_replicate_NoMsg_output_last_message f_Exec_eq_f_Exec_Stream_last2 )
 apply (subst last_message_Msg_eq_last)
 apply (simp add: map_last f_Exec_Stream_not_empty_conv)+
 done
 
 corollary State_Idle_output_Msg_eq_last_message: "
   \<lbrakk> State_Idle localState output_fun trans_fun (
       localState (f_Exec_Comp trans_fun xs c));
     output_fun (f_Exec_Comp trans_fun xs c) \<noteq> \<NoMsg>;
     xs \<noteq> [] \<rbrakk> \<Longrightarrow>
   last_message (map output_fun (f_Exec_Comp_Stream trans_fun xs c)) =
   output_fun (f_Exec_Comp trans_fun xs c)"
 by (rule_tac n=0 in subst[OF State_Idle_append_replicate_NoMsg_output_Msg_eq_last_message, rule_format], simp+)
 
 lemma State_Idle_imp_exists_state_change: "
   \<lbrakk> \<not> State_Idle localState output_fun trans_fun (localState c);
     State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c)) \<rbrakk> \<Longrightarrow>
   \<exists>i<n. (
     \<not> State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>i\<^esup> c)) \<and> (
     \<forall>j\<le>n. i < j \<longrightarrow> State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>j\<^esup> c))))"
 apply (cut_tac
   a=0 and b=n and
   P="\<lambda>x. State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun NoMsg\<^bsup>x\<^esup> c))"
   in nat_Suc_predicate_change_exists, simp+)
 apply (clarify, rename_tac n1)
 apply (rule_tac x=n1 in exI)
 apply clarsimp
 apply (rule_tac t="j" and s="Suc n1 + (j - Suc n1)" in subst, simp)
 apply (subst replicate_add)
 apply (simp add: replicate_add f_Exec_State_Idle_append_replicate_NoMsg_state)
 done
 
 lemma State_Idle_imp_exists_state_change2: "
   \<lbrakk> \<not> State_Idle localState output_fun trans_fun (localState c);
     State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>n\<^esup> c)) \<rbrakk> \<Longrightarrow>
   \<exists>i<n. (
     (\<forall>j\<le>i. \<not> State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>i\<^esup> c))) \<and>
     (\<forall>j\<le>n. i < j \<longrightarrow> State_Idle localState output_fun trans_fun (localState (f_Exec_Comp trans_fun \<NoMsg>\<^bsup>j\<^esup> c))))"
 apply (frule State_Idle_imp_exists_state_change, assumption)
 apply (clarify, rename_tac i)
 apply (rule_tac x=i in exI)
 apply simp
 done
 
 
 subsubsection \<open>Basic definitions for accelerated execution\<close>
 
 text \<open>Stream processing with accelerated components\<close>
 
 definition f_Exec_Comp_Stream_Acc_Output ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'output message_af) \<Rightarrow> \<comment> \<open>Output extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input fstream_af \<Rightarrow> 'comp \<Rightarrow>
     'output fstream_af"
   where "f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<equiv>
     (map output_fun (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) \<div>\<^sub>f k"
 
 definition f_Exec_Comp_Stream_Acc_LocalState ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'state) \<Rightarrow> \<comment> \<open>Local state extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input fstream_af \<Rightarrow> 'comp \<Rightarrow>
     'state list"
   where "f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c \<equiv>
     (map localState (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) \<div>\<^bsub>fl\<^esub> k"
 
 definition i_Exec_Comp_Stream_Acc_Output ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'output message_af) \<Rightarrow> \<comment> \<open>Output extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input istream_af \<Rightarrow> 'comp \<Rightarrow>
     'output istream_af"
   where "i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c \<equiv>
     (output_fun \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) \<div>\<^sub>i k"
 
 definition i_Exec_Comp_Stream_Acc_LocalState ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'state) \<Rightarrow> \<comment> \<open>Local state extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input istream_af \<Rightarrow> 'comp \<Rightarrow>
     'state ilist"
   where "i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c \<equiv>
     (localState \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) \<div>\<^bsub>il\<^esub> k"
 
 definition f_Exec_Comp_Stream_Acc_Output_Init ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'output message_af) \<Rightarrow> \<comment> \<open>Output extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input fstream_af \<Rightarrow> 'comp \<Rightarrow>
     'output fstream_af"
   where "f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c \<equiv>
     (output_fun c) # f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c"
 
 definition f_Exec_Comp_Stream_Acc_LocalState_Init ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'state) \<Rightarrow> \<comment> \<open>Local state extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow> 'input fstream_af \<Rightarrow> 'comp \<Rightarrow>
     'state list"
   where "f_Exec_Comp_Stream_Acc_LocalState_Init k localState trans_fun xs c \<equiv>
     (localState c) # f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c"
 
 definition i_Exec_Comp_Stream_Acc_Output_Init ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'output message_af) \<Rightarrow> \<comment> \<open>Output extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input istream_af \<Rightarrow> 'comp \<Rightarrow>
     'output istream_af"
   where "i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c \<equiv>
     [output_fun c] \<frown> (i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c)"
 
 definition i_Exec_Comp_Stream_Acc_LocalState_Init ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp \<Rightarrow> 'state) \<Rightarrow> \<comment> \<open>Local state extraction function\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     'input istream_af \<Rightarrow> 'comp \<Rightarrow>
     'state ilist"
   where "i_Exec_Comp_Stream_Acc_LocalState_Init k localState trans_fun input c \<equiv>
     [localState c] \<frown> (i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c)"
 
 lemma f_Exec_Stream_Acc_Output_length[simp]: "
   0 < k \<Longrightarrow>
   length (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c) = length xs"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def f_shrink_length)
 
 lemma f_Exec_Stream_Acc_LocalState_length[simp]: "
   0 < k \<Longrightarrow>
   length (f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c) = length xs"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def f_shrink_last_length)
 
 lemmas f_Exec_Stream_Acc_length =
   f_Exec_Stream_Acc_LocalState_length
   f_Exec_Stream_Acc_Output_length
 
 
 subsubsection \<open>Basic results for accelerated execution\<close>
 
 lemma f_Exec_Stream_Acc_Output_Nil[simp]: "
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun [] c = []"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def)
 
 lemma f_Exec_Stream_Acc_LocalState_Nil[simp]: "
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun [] c = []"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def)
 
 lemmas f_Exec_Stream_Acc_Nil =
   f_Exec_Stream_Acc_LocalState_Nil
   f_Exec_Stream_Acc_Output_Nil
 
 lemma f_Exec_Stream_Acc_Output_0[simp]: "
   f_Exec_Comp_Stream_Acc_Output 0 output_fun trans_fun xs c = []"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def)
 
 lemma f_Exec_Stream_Acc_LocalState_0[simp]: "
   f_Exec_Comp_Stream_Acc_LocalState 0 localState trans_fun xs c = []"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def)
 
 lemmas f_Exec_Stream_Acc_0 =
   f_Exec_Stream_Acc_LocalState_0
   f_Exec_Stream_Acc_Output_0
 
 lemma f_Exec_Stream_Acc_Output_1[simp]: "
   f_Exec_Comp_Stream_Acc_Output (Suc 0) output_fun trans_fun xs c =
   map output_fun (f_Exec_Comp_Stream trans_fun xs c)"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def)
 
 lemma f_Exec_Stream_Acc_LocalState_1[simp]: "
   f_Exec_Comp_Stream_Acc_LocalState (Suc 0) localState trans_fun xs c =
   map localState (f_Exec_Comp_Stream trans_fun xs c)"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def)
 
 lemma i_Exec_Stream_Acc_Output_1[simp]: "
   i_Exec_Comp_Stream_Acc_Output (Suc 0) output_fun trans_fun input c =
   output_fun \<circ> (i_Exec_Comp_Stream trans_fun input c)"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_def)
 
 lemma i_Exec_Stream_Acc_LocalState_1[simp]: "
   i_Exec_Comp_Stream_Acc_LocalState (Suc 0) localState trans_fun input c =
   localState \<circ> (i_Exec_Comp_Stream trans_fun input c)"
 by (simp add: i_Exec_Comp_Stream_Acc_LocalState_def)
 
 lemma f_Exec_Stream_Acc_Output_eq_last_message_hold: "
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c =
   (map output_fun (f_Exec_Comp_Stream trans_fun (xs \<odot>\<^sub>f k) c)) \<longmapsto>\<^sub>f k \<div>\<^bsub>fl\<^esub> k"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def f_shrink_eq_f_last_message_hold_shrink_last)
 
 lemma i_Exec_Stream_Acc_Output_eq_last_message_hold: "0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c =
   (output_fun \<circ> (i_Exec_Comp_Stream trans_fun (input \<odot>\<^sub>i k) c)) \<longmapsto>\<^sub>i k \<div>\<^bsub>il\<^esub> k"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_def i_shrink_eq_i_last_message_hold_shrink_last)
 
 lemma f_Exec_Stream_Acc_Output_take: "
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<down> n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (xs \<down> n) c"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def f_shrink_def f_Exec_Stream_expand_aggregate_map_take)
 
 lemma f_Exec_Stream_Acc_Output_drop: "
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<up> n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (xs \<up> n) (
     f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c)"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def f_shrink_def f_Exec_Stream_expand_aggregate_map_drop)
 
 lemma i_Exec_Stream_Acc_Output_take: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c \<Down> n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (input \<Down> n) c"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def i_Exec_Comp_Stream_Acc_Output_def
   f_shrink_def i_shrink_def i_Exec_Stream_expand_aggregate_map_take)
 
 lemma i_Exec_Stream_Acc_Output_drop: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c \<Up> n =
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (input \<Up> n) (
     f_Exec_Comp trans_fun (input \<Down> n \<odot>\<^sub>f k) c)"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_def i_shrink_def i_Exec_Stream_expand_aggregate_map_drop)
 
 lemma i_Exec_Stream_Acc_LocalState_take: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c \<Down> n =
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (input \<Down> n) c"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def i_Exec_Comp_Stream_Acc_LocalState_def
   f_shrink_last_def i_shrink_last_def i_Exec_Stream_expand_aggregate_map_take)
 
 lemma i_Exec_Stream_Acc_LocalState_drop: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c \<Up> n =
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (input \<Up> n) (
     f_Exec_Comp trans_fun (input \<Down> n \<odot>\<^sub>f k) c)"
 by (simp add: i_Exec_Comp_Stream_Acc_LocalState_def i_shrink_last_def i_Exec_Stream_expand_aggregate_map_drop)
 
 lemma f_Exec_Stream_Acc_Output_append: "
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (xs @ ys) c =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c @
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun ys (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)"
 by (simp only: f_Exec_Comp_Stream_Acc_Output_def f_shrink_def f_Exec_Stream_expand_map_aggregate_append)
 
 lemma f_Exec_Stream_Acc_Output_Cons: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (x # xs) c =
   last_message (map output_fun (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)) #
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)"
 by (simp only: f_Exec_Comp_Stream_Acc_Output_def f_shrink_def f_Exec_Stream_expand_map_aggregate_Cons)
 
 lemma f_Exec_Stream_Acc_Output_one: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun [x] c =
   [last_message (map output_fun (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c))]"
 by (simp add: f_Exec_Stream_Acc_Output_Cons)
 
 lemma f_Exec_Stream_Acc_Output_snoc: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (xs @ [x]) c =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c @
   [last_message (map output_fun (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)))]"
 by (simp add: f_Exec_Stream_Acc_Output_append f_Exec_Stream_Acc_Output_one)
 
 lemma i_Exec_Stream_Acc_Output_append: "
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<frown>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def i_Exec_Comp_Stream_Acc_Output_def f_shrink_def i_shrink_def i_Exec_Stream_expand_map_aggregate_append)
 
 lemma i_Exec_Stream_Acc_Output_Cons: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun ([x] \<frown> input) c =
   [last_message (map output_fun (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c))] \<frown>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)"
 by (simp add: i_Exec_Stream_Acc_Output_append f_Exec_Stream_Acc_Output_one)
 
 lemma f_Exec_Stream_Acc_LocalState_append: "
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (xs @ ys) c =
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c @
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun ys (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)"
 by (simp only: f_Exec_Comp_Stream_Acc_LocalState_def f_shrink_last_def f_Exec_Stream_expand_map_aggregate_append)
 
 lemma f_Exec_Stream_Acc_LocalState_Cons: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (x # xs) c =
   localState (f_Exec_Comp trans_fun (x #  \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c) #
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)"
 apply (unfold f_Exec_Comp_Stream_Acc_LocalState_def)
 apply (simp only: f_shrink_last_map f_expand_Cons append_Cons[symmetric])
 apply (simp add: f_Exec_Stream_append replicate_pred_Cons_length f_shrink_last_Cons del: f_Exec_Stream_Cons append_Cons)
 apply (simp add: f_Exec_eq_f_Exec_Stream_last2[symmetric] f_Exec_Stream_empty_conv)
 done
 
 lemma f_Exec_Stream_Acc_LocalState_one: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun [x] c =
   [localState (f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)]"
 by (simp add: f_Exec_Stream_Acc_LocalState_Cons)
 
 lemma f_Exec_Stream_Acc_LocalState_snoc: "
   0 < k \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (xs @ [x]) c =
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c @
   [localState (f_Exec_Comp trans_fun ((xs @ [x]) \<odot>\<^sub>f k) c)]"
 by (simp add: f_Exec_Stream_Acc_LocalState_append f_Exec_Stream_Acc_LocalState_Cons f_Exec_append)
 
 lemma i_Exec_Stream_Acc_LocalState_append: "
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (xs \<frown> input) c =
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c \<frown>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input (
     f_Exec_Comp trans_fun (xs \<odot>\<^sub>f k) c)"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_def i_Exec_Comp_Stream_Acc_LocalState_def f_shrink_last_def i_shrink_last_def i_Exec_Stream_expand_map_aggregate_append)
 
 lemma i_Exec_Stream_Acc_LocalState_Cons: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun ([x] \<frown> input) c =
   [localState (f_Exec_Comp trans_fun (x #  \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)] \<frown>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input (
     f_Exec_Comp trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)"
 by (simp add: i_Exec_Stream_Acc_LocalState_append f_Exec_Stream_Acc_LocalState_one f_expand_one)
 
 lemma f_Exec_Stream_Acc_Output_nth: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c ! n =
   last_message (map output_fun (
     f_Exec_Comp_Stream trans_fun (xs ! n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) (
       f_Exec_Comp trans_fun (xs \<down> n \<odot>\<^sub>f k) c)))"
 by (unfold f_Exec_Comp_Stream_Acc_Output_def f_shrink_def, rule f_Exec_Stream_expand_aggregate_map_nth)
 
 lemma f_Exec_Stream_Acc_Output_nth_eq_i_nth: "
   \<lbrakk> 0 < k; n < n' \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (input \<Down> n') c ! n =
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c n"
 by (unfold f_Exec_Comp_Stream_Acc_Output_def i_Exec_Comp_Stream_Acc_Output_def f_shrink_def i_shrink_def, rule f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth)
 
 lemma i_Exec_Stream_Acc_Output_nth: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c n =
   last_message (map output_fun (
     f_Exec_Comp_Stream trans_fun (input n # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) (
       f_Exec_Comp trans_fun (input \<Down> n \<odot>\<^sub>f k) c)))"
 by (unfold i_Exec_Comp_Stream_Acc_Output_def i_shrink_def, rule i_Exec_Stream_expand_aggregate_map_nth)
 
 corollary i_Exec_Stream_Acc_Output_nth_f_nth: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (input \<Down> Suc n) c ! n"
 by (simp add: f_Exec_Stream_Acc_Output_nth_eq_i_nth)
 
 corollary i_Exec_Stream_Acc_Output_nth_f_last: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c n =
   last (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun (input \<Down> Suc n) c)"
 by (simp add: i_Exec_Stream_Acc_Output_nth_f_nth last_nth length_greater_0_conv[THEN iffD1])
 
 lemma f_Exec_Stream_Acc_LocalState_nth: "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c ! n =
   localState (f_Exec_Comp trans_fun (xs \<down> Suc n \<odot>\<^sub>f k) c)"
 apply (simp add: f_Exec_Comp_Stream_Acc_LocalState_def f_shrink_last_map)
 apply (simp add: f_shrink_last_nth' f_shrink_last_length del: mult_Suc)
 apply (simp add: f_Exec_Stream_nth less_imp_Suc_mult_pred_less f_expand_take_mod del: mult_Suc)
 done
 
 lemma f_Exec_Stream_Acc_LocalState_nth_eq_i_nth: "
   \<lbrakk> 0 < k; n < n' \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (input \<Down> n') c ! n =
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c n"
 by (unfold f_Exec_Comp_Stream_Acc_LocalState_def i_Exec_Comp_Stream_Acc_LocalState_def f_shrink_last_def i_shrink_last_def, rule f_Exec_Stream_expand_aggregate_map_nth_eq_i_nth)
 
 corollary i_Exec_Stream_Acc_LocalState_nth_f_nth: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k output_fun trans_fun input c n =
   f_Exec_Comp_Stream_Acc_LocalState k output_fun trans_fun (input \<Down> Suc n) c ! n"
 by (simp add: f_Exec_Stream_Acc_LocalState_nth_eq_i_nth)
 
 corollary i_Exec_Stream_Acc_LocalState_nth_f_last: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c n =
   last (f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun (input \<Down> Suc n) c)"
 by (simp add: i_Exec_Stream_Acc_LocalState_nth_f_nth last_nth length_greater_0_conv[THEN iffD1])
 
 lemma i_Exec_Stream_Acc_LocalState_nth: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c n =
   localState (f_Exec_Comp trans_fun (input \<Down> Suc n \<odot>\<^sub>f k) c)"
 by (simp add: i_Exec_Stream_Acc_LocalState_nth_f_nth f_Exec_Stream_Acc_LocalState_nth)
 
 lemma f_Exec_Stream_Acc_Output_causal: "
   xs \<down> n = ys \<down> n \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<down> n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun ys c \<down> n"
 by (simp add: f_Exec_Stream_Acc_Output_take)
 
 lemma i_Exec_Stream_Acc_Output_causal: "
   input1 \<Down> n = input2 \<Down> n \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input1 c \<Down> n =
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input2 c \<Down> n"
 apply (case_tac "k = 0")
  apply (simp add: i_Exec_Comp_Stream_Acc_Output_def)
 apply (simp add: i_Exec_Stream_Acc_Output_take)
 done
 
 lemma f_Exec_Stream_Acc_Output_Connected_strictly_causal: "
   \<lbrakk> xs \<down> n = ys \<down> n;
     f_Streams_Connected
       (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c)
       channel1;
     f_Streams_Connected
       (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun ys c)
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<down> Suc n = channel2 \<down> Suc n"
 by (simp add: f_Streams_Connected_def f_Exec_Stream_Acc_Output_take)
 
 lemma i_Exec_Stream_Acc_Output_Connected_strictly_causal: "
   \<lbrakk> input1 \<Down> n = input2 \<Down> n;
     i_Streams_Connected
       (i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input1 c)
       channel1;
     i_Streams_Connected
       (i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input2 c)
       channel2 \<rbrakk> \<Longrightarrow>
   channel1 \<Down> Suc n = channel2 \<Down> Suc n"
 apply (unfold i_Streams_Connected_def)
 apply (case_tac "k = 0")
  apply (simp add: i_Exec_Comp_Stream_Acc_Output_def)
 apply (simp add: i_Exec_Stream_Acc_Output_take)
 done
 
 
 text \<open>Complete execution cycles/steps of accelrated execution\<close>
 
 definition Acc_Trans_Fun_Step ::
   "nat \<Rightarrow> \<comment> \<open>Acceleration factor\<close>
     ('comp, 'input message_af) Comp_Trans_Fun \<Rightarrow>
     ('comp list \<Rightarrow> 'comp) \<Rightarrow> \<comment> \<open>Pointwise output shrink function\<close>
     'input message_af \<Rightarrow> 'comp \<Rightarrow>
     'comp"
   where "Acc_Trans_Fun_Step k trans_fun pointwise_shrink x c \<equiv>
     pointwise_shrink (f_Exec_Comp_Stream trans_fun (x # \<NoMsg>\<^bsup>k - Suc 0\<^esup>) c)"
 
 definition is_Pointwise_Output_Shrink ::
   "('comp list \<Rightarrow> 'comp) \<Rightarrow> \<comment> \<open>Pointwise output shrink function\<close>
     ('comp \<Rightarrow> 'output message_af) \<Rightarrow> \<comment> \<open>Output extraction function for consideration\<close>
     bool"
   where "is_Pointwise_Output_Shrink pointwise_shrink output_fun \<equiv>
     \<forall>cs. output_fun (pointwise_shrink cs) = last_message (map output_fun cs)"
 
 primrec is_Pointwise_Output_Shrink_list ::
   "('comp list \<Rightarrow> 'comp) \<Rightarrow> \<comment> \<open>Pointwise output shrink function\<close>
     ('comp \<Rightarrow> 'output message_af) list \<Rightarrow> \<comment> \<open>List of output extraction functions for consideration\<close>
     bool"
 where
   "is_Pointwise_Output_Shrink_list pointwise_shrink [] = True"
 | "is_Pointwise_Output_Shrink_list pointwise_shrink (f # fs) =
     (is_Pointwise_Output_Shrink pointwise_shrink f \<and>
      is_Pointwise_Output_Shrink_list pointwise_shrink fs)"
 
 definition is_correct_localState_Pointwise_Output_Shrink ::
   "('comp list \<Rightarrow> 'comp) \<Rightarrow> \<comment> \<open>Pointwise output shrink function\<close>
     ('comp \<Rightarrow> 'state) \<Rightarrow> \<comment> \<open>Local state extraction function\<close>
     bool"
   where "is_correct_localState_Pointwise_Output_Shrink pointwise_shrink localState \<equiv>
     \<forall>cs. cs \<noteq> [] \<longrightarrow> localState (pointwise_shrink cs) = localState (last cs)"
 
 lemma Deterministic_trans_fun_imp_acc_trans_fun:
   "Deterministic_Trans_Fun trans_fun localState \<Longrightarrow>
     Deterministic_Trans_Fun (Acc_Trans_Fun_Step k trans_fun pointwise_shrink) localState"
 apply (simp (no_asm) only: Deterministic_Trans_Fun_def Acc_Trans_Fun_Step_def)
 apply clarify
 apply (subst Deterministic_f_Exec_Stream, simp+)
 done
 
 lemma is_Pointwise_Output_Shrink_list_imp_is_Pointwise_Output_Shrink:
   "\<lbrakk> is_Pointwise_Output_Shrink_list pointwise_shrink fs; output_fun \<in> set fs \<rbrakk> \<Longrightarrow>
     is_Pointwise_Output_Shrink pointwise_shrink output_fun"
 apply (induct fs, simp)
 apply fastforce
 done
 
 lemma is_Pointwise_Output_Shrink_list_eq_is_Pointwise_Output_Shrink_all:
   "(is_Pointwise_Output_Shrink_list pointwise_shrink fs) =
     (\<forall>output_fun \<in> set fs. is_Pointwise_Output_Shrink pointwise_shrink output_fun)"
 apply (rule iffI)
  apply (rule ballI)
  apply (rule is_Pointwise_Output_Shrink_list_imp_is_Pointwise_Output_Shrink)
  apply (simp add: member_def)+
 apply (induct fs, simp)
 apply simp
 done
 
 lemma is_Pointwise_Output_Shrink_subset:
   "\<lbrakk> is_Pointwise_Output_Shrink_list pointwise_shrink fs; set fs' \<subseteq> set fs \<rbrakk> \<Longrightarrow>
     is_Pointwise_Output_Shrink_list pointwise_shrink fs'"
 by (fastforce simp: is_Pointwise_Output_Shrink_list_eq_is_Pointwise_Output_Shrink_all)
 
 lemma f_Exec_Stream_Acc_LocalState_eq_Acc_Trans_Fun_Step_LocalState: "\<And>c.
   \<lbrakk> 0 < k;
     Deterministic_Trans_Fun trans_fun localState;
     is_correct_localState_Pointwise_Output_Shrink pointwise_shrink localState \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c =
   map localState (f_Exec_Comp_Stream (Acc_Trans_Fun_Step k trans_fun pointwise_shrink) xs c)"
 apply (drule Deterministic_trans_fun_imp_acc_trans_fun[of trans_fun localState k pointwise_shrink])
 apply (clarsimp simp: list_eq_iff)
 apply (simp add: f_Exec_Stream_Acc_LocalState_nth f_Exec_Stream_nth)
 apply (induct xs, simp)
 apply (rename_tac x xs c i)
 apply (simp add: Acc_Trans_Fun_Step_def f_expand_Cons f_Exec_append)
 apply (case_tac i)
  apply simp
  apply (simp only: is_correct_localState_Pointwise_Output_Shrink_def)
  apply (drule_tac x="f_Exec_Comp_Stream trans_fun (x # NoMsg\<^bsup>k - Suc 0\<^esup>) c" in spec)
  apply (simp add: f_Exec_Stream_not_empty_conv f_Exec_eq_f_Exec_Stream_last)
 apply (rename_tac i2)
 apply (drule_tac x="f_Exec_Comp trans_fun \<NoMsg>\<^bsup>k - Suc 0\<^esup> (trans_fun x c)" in meta_spec)
 apply (drule_tac x=i2 in meta_spec)
 apply (simp add: is_correct_localState_Pointwise_Output_Shrink_def)
 apply (drule_tac x="f_Exec_Comp_Stream trans_fun (x # NoMsg\<^bsup>k - Suc 0\<^esup>) c" in spec)
 apply (simp add: f_Exec_Stream_not_empty_conv)
 apply (rule arg_cong[where f=localState])
 apply (rule Deterministic_f_Exec)
   apply assumption
  apply (simp add: f_Exec_eq_f_Exec_Stream_last)
 apply (simp add: length_greater_0_conv[symmetric] del: length_greater_0_conv)
 done
 
 lemma f_Exec_Stream_Acc_Output_eq_Acc_Trans_Fun_Step_Output: "\<And>c.
   \<lbrakk> 0 < k;
     Deterministic_Trans_Fun trans_fun localState;
     is_correct_localState_Pointwise_Output_Shrink pointwise_shrink localState;
     is_Pointwise_Output_Shrink pointwise_shrink output_fun \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c =
   map output_fun (f_Exec_Comp_Stream (Acc_Trans_Fun_Step k trans_fun pointwise_shrink) xs c)"
 apply (drule Deterministic_trans_fun_imp_acc_trans_fun[of trans_fun localState k pointwise_shrink])
 apply (clarsimp simp: list_eq_iff)
 apply (simp add: f_Exec_Stream_Acc_Output_nth f_Exec_Stream_nth del: f_Exec_Stream_Cons)
 apply (induct xs, simp)
 apply (rename_tac x xs c i)
 apply (simp add: Acc_Trans_Fun_Step_def del: f_Exec_Stream_Cons)
 apply (case_tac i)
  apply (simp add: is_Pointwise_Output_Shrink_def)
 apply (rename_tac i2)
 apply (simp add: f_Exec_append)
 apply (drule_tac x="f_Exec_Comp trans_fun \<NoMsg>\<^bsup>k - Suc 0\<^esup> (trans_fun x c)" in meta_spec)
 apply (drule_tac x=i2 in meta_spec)
 apply (simp add: is_correct_localState_Pointwise_Output_Shrink_def)
 apply (drule_tac x="f_Exec_Comp_Stream trans_fun (x # NoMsg\<^bsup>k - Suc 0\<^esup>) c" in spec)
 apply (simp add: f_Exec_Stream_not_empty_conv)
 apply (rule arg_cong[where f=output_fun])
 apply (rule Deterministic_f_Exec)
   apply assumption
  apply (simp add: f_Exec_eq_f_Exec_Stream_last)
 apply (simp add: length_greater_0_conv[symmetric] del: length_greater_0_conv)
 done
 
 lemma i_Exec_Stream_Acc_LocalState_eq_Acc_Trans_Fun_Step_LocalState: "\<And>c.
   \<lbrakk> 0 < k;
     Deterministic_Trans_Fun trans_fun localState;
     is_correct_localState_Pointwise_Output_Shrink pointwise_shrink localState \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c =
   localState \<circ> (i_Exec_Comp_Stream (Acc_Trans_Fun_Step k trans_fun pointwise_shrink) input c)"
 apply (rule ilist_i_take_eq_conv[THEN iffD2], rule allI)
 apply (simp add: i_Exec_Stream_Acc_LocalState_take i_Exec_Stream_take f_Exec_Stream_Acc_LocalState_eq_Acc_Trans_Fun_Step_LocalState)
 done
 
 lemma i_Exec_Stream_Acc_Output_eq_Acc_Trans_Fun_Step_Output: "\<And>c.
   \<lbrakk> 0 < k;
     Deterministic_Trans_Fun trans_fun localState;
     is_correct_localState_Pointwise_Output_Shrink pointwise_shrink localState;
     is_Pointwise_Output_Shrink pointwise_shrink output_fun \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c =
   output_fun \<circ> (i_Exec_Comp_Stream (Acc_Trans_Fun_Step k trans_fun pointwise_shrink) input c)"
 apply (rule ilist_i_take_eq_conv[THEN iffD2], rule allI)
 apply (simp add: i_Exec_Stream_Acc_Output_take i_Exec_Stream_take f_Exec_Stream_Acc_Output_eq_Acc_Trans_Fun_Step_Output)
 done
 
 
 subsubsection \<open>Basic results for accelerated execution with initial state in the resulting stream\<close>
 
 lemma f_Exec_Stream_Acc_Output_Init_length: "
   0 < k \<Longrightarrow>
   length (f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c) = Suc (length xs)"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def)
 
 lemma f_Exec_Stream_Acc_LocalState_Init_length: "
   0 < k \<Longrightarrow>
   length (f_Exec_Comp_Stream_Acc_LocalState_Init k localState trans_fun xs c) = Suc (length xs)"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_Init_def)
 
 lemma f_Exec_Stream_Acc_Output_Init_Nil: "
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun [] c = [output_fun c]"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def)
 
 lemma f_Exec_Stream_Acc_LocalState_Init_Nil: "
   f_Exec_Comp_Stream_Acc_LocalState_Init k localState trans_fun [] c = [localState c]"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_Init_def)
 
 lemma f_Exec_Stream_Acc_Output_Init_1: "
   f_Exec_Comp_Stream_Acc_Output_Init (Suc 0) output_fun trans_fun xs c =
   map output_fun (f_Exec_Comp_Stream_Init trans_fun xs c)"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 lemma f_Exec_Stream_Acc_LocalState_Init_1: "
   f_Exec_Comp_Stream_Acc_LocalState_Init (Suc 0) localState trans_fun xs c =
   map localState (f_Exec_Comp_Stream_Init trans_fun xs c)"
 by (simp add: f_Exec_Comp_Stream_Acc_LocalState_Init_def f_Exec_Stream_Init_eq_f_Exec_Stream_Cons)
 
 lemma i_Exec_Stream_Acc_Output_Init_1: "
   i_Exec_Comp_Stream_Acc_Output_Init (Suc 0) output_fun trans_fun input c =
   output_fun \<circ> (i_Exec_Comp_Stream_Init trans_fun input c)"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_Init_def i_Exec_Stream_Init_eq_i_Exec_Stream_Cons)
 
 lemma i_Exec_Stream_Acc_LocalState_Init_1: "
   i_Exec_Comp_Stream_Acc_LocalState_Init (Suc 0) localState trans_fun input c =
   localState \<circ> (i_Exec_Comp_Stream_Init trans_fun input c)"
 by (simp add: i_Exec_Comp_Stream_Acc_LocalState_Init_def i_Exec_Stream_Init_eq_i_Exec_Stream_Cons)
 
 lemma f_Exec_Stream_Acc_Output_Init_take: "
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c \<down> (Suc n) =
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun (xs \<down> n) c"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def f_Exec_Stream_Acc_Output_take)
 
 lemma f_Exec_Stream_Acc_Output_Init_drop': "
   \<lbrakk> 0 < k; n < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c \<up> Suc n =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<up> n"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def)
 
 
 lemma i_Exec_Stream_Acc_Output_Init_take: "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c \<Down> (Suc n) =
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun (input \<Down> n) c"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def i_Exec_Comp_Stream_Acc_Output_Init_def i_Exec_Stream_Acc_Output_take)
 
 lemma i_Exec_Stream_Acc_Output_Init_drop': "
   0 < k \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c \<Up> Suc n =
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c \<Up> n"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_Init_def)
 
 lemma f_Exec_Stream_Acc_Output_Init_strictly_causal: "
   xs \<down> n = ys \<down> n \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c \<down> Suc n =
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun ys c \<down> Suc n"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_Init_def, rule f_Exec_Stream_Acc_Output_causal)
 
 lemma i_Exec_Stream_Acc_Output_Init_strictly_causal: "
   input1 \<Down> n = input2 \<Down> n \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input1 c \<Down> Suc n =
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input2 c \<Down> Suc n"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_Init_def, rule i_Exec_Stream_Acc_Output_causal)
 
 lemma f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons: "
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c =
   output_fun c # f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c"
 by (simp add: f_Exec_Comp_Stream_Acc_Output_def f_Exec_Comp_Stream_Acc_Output_Init_def)
 
 lemma f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons_output: "
   output_fun c = \<NoMsg> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c =
   \<NoMsg> # f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c"
 by (simp add: f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons)
 
 lemma f_Exec_Stream__Acc_OutputInit_tl_eq_f_Exec_Stream_Acc_Output: "
   tl (f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c) =
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c"
 by (simp add: f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons)
 
 lemma f_Exec_Stream_Previous_f_Exec_Stream_Acc_Output_Init: "
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c ! n =
   (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c)\<^bsup>\<leftarrow>' output_fun c\<^esup> n"
 by (simp add: f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons list_Previous_nth_if nth_Cons')
 
 lemma f_Exec_Stream_Acc_Output_Init_eq_output_channel: "
   \<lbrakk> output_fun c = \<NoMsg>;
     f_Streams_Connected
       (f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c)
       channel \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun xs c = channel"
 by (simp add: f_Streams_Connected_def f_Exec_Stream_Acc_Output_Init_eq_f_Exec_Stream_Acc_Output_Cons_output)
 
 
 lemma i_Exec_Stream_Acc_Output_Init_eq_i_Exec_Stream_Acc_Output_Cons: "
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c =
   [output_fun c] \<frown> i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c"
 by (simp add: i_Exec_Comp_Stream_Acc_Output_def i_Exec_Comp_Stream_Acc_Output_Init_def)
 
 lemma i_Exec_Stream_Acc_Output_Init_eq_i_Exec_Stream_Acc_Output_Cons_output: "
   output_fun c = \<NoMsg> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c =
   [\<NoMsg> ] \<frown> i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c"
 by (simp add: i_Exec_Stream_Acc_Output_Init_eq_i_Exec_Stream_Acc_Output_Cons)
 
 lemma i_Exec_Stream_Previous_i_Exec_Stream_Acc_Output_Init: "
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c n =
   (i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c)\<^bsup>\<leftarrow> output_fun c\<^esup> n"
 by (simp add: i_Exec_Stream_Acc_Output_Init_eq_i_Exec_Stream_Acc_Output_Cons ilist_Previous_nth_if)
 
 lemma i_Exec_Stream_Acc_Output_Init_eq_output_channel: "
   \<lbrakk> output_fun c = \<NoMsg>;
     i_Streams_Connected
       (i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c)
       channel \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output_Init k output_fun trans_fun input c = channel"
 by (simp add: i_Streams_Connected_def i_Exec_Stream_Acc_Output_Init_eq_i_Exec_Stream_Acc_Output_Cons_output)
 
 
 subsubsection \<open>Rules for proving execution equivalence\<close>
 
 text \<open>
   A required precondition is that the @{term equiv_states} relation,
   which indicates whether the local states of @{term c1} and @{term c2}
   are equivalent with respect to observable behaviour,
   is preserved also after executing an input stream,
   because the @{term equiv_states} relation
   should deliver valid results not only at the time point @{term 0}
   but at every time point.\<close>
 
 lemma f_Equiv_Exec_Stream_expand_shrink_equiv_state_set[rule_format]: "
   \<And>c1 c2 i. \<lbrakk>
    0 < k1; 0 < k2;
    equiv_states (localState1 c1) (localState2 c2);
    \<forall>input0. set input0 \<subseteq> A \<longrightarrow> (\<forall>m\<in>A.
       Equiv_Exec m equiv_states
       localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2
       (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
       (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2));
       \<comment> \<open>\<open>equiv_states\<close> relation implies equivalent executions\<close>
       \<comment> \<open>not only at the beginning but also after processing an input\<close>
    set input \<subseteq> A; i < length input \<rbrakk> \<Longrightarrow>
    equiv_states
      (localState1 ((f_Exec_Comp_Stream trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1) \<div>\<^bsub>fl\<^esub> k1 ! i))
      (localState2 ((f_Exec_Comp_Stream trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2) \<div>\<^bsub>fl\<^esub> k2 ! i))"
 apply (induct input, simp)
 apply (clarsimp simp: append_Cons[symmetric] f_Exec_Stream_append_if f_shrink_last_Cons nth_Cons simp del: last.simps f_Exec_Stream_Cons append_Cons)
 apply (case_tac i)
  apply (drule_tac x="[]" in spec)
  apply (drule mp, simp)
  apply (drule_tac x=a in bspec, assumption)
  apply (simp del: last.simps f_Exec_Stream_Cons)
  apply (subst f_Exec_eq_f_Exec_Stream_last2[symmetric], simp)+
  apply (rule Equiv_Exec_equiv_statesI[of equiv_states localState1 _ localState2 _ _ input_fun1], assumption+)
 apply (rename_tac i')
 apply (subst f_Exec_eq_f_Exec_Stream_last2[symmetric], simp)+
 apply (drule_tac x="f_Exec_Comp trans_fun1 (input_fun1 a # \<NoMsg>\<^bsup>k1 - Suc 0\<^esup>) c1" in meta_spec)
 apply (drule_tac x="f_Exec_Comp trans_fun2 (input_fun2 a # \<NoMsg>\<^bsup>k2 - Suc 0\<^esup>) c2" in meta_spec)
 apply (drule_tac x=i' in meta_spec)
 apply (drule meta_mp, simp)+
  apply (drule_tac x="[]" in spec, simp)
  apply (drule_tac x=a in bspec, assumption)
  apply (rule Equiv_Exec_equiv_statesI'[of equiv_states localState1 _ localState2 _ _ input_fun1], simp+)
 apply clarsimp
 apply (drule meta_mp)
  apply clarify
  apply (drule_tac x="a # input0" in spec)
  apply (simp add: f_Exec_append)
 apply simp
 done
 
 corollary f_Equiv_Exec_Stream_expand_shrink_equiv_state: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m. Equiv_Exec m
        equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
        trans_fun1 trans_fun2 k1 k2
        (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
        (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2);
     i<length input \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 ((f_Exec_Comp_Stream trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1) \<div>\<^bsub>fl\<^esub> k1 ! i))
     (localState2 ((f_Exec_Comp_Stream trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2) \<div>\<^bsub>fl\<^esub> k2 ! i))"
 by (rule f_Equiv_Exec_Stream_expand_shrink_equiv_state_set[of k1 k2 equiv_states localState1 c1 localState2 c2 UNIV input_fun1 input_fun2 output_fun1 output_fun2], simp+)
 
 lemma f_Equiv_Exec_expand_shrink_equiv_state_set:"
   \<lbrakk> 0 < k1; 0 < k2; equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m. \<lbrakk>set input0 \<subseteq> A; m \<in> A\<rbrakk> \<Longrightarrow>
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2);
     set input \<subseteq> A \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1))
     (localState2 (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2))"
 apply (case_tac "input = []", simp)
 apply (subgoal_tac "map input_fun1 input \<odot>\<^sub>f k1 \<noteq> [] \<and> map input_fun2 input \<odot>\<^sub>f k2 \<noteq> []")
  prefer 2
  apply (simp add: length_greater_0_conv[symmetric] del: length_greater_0_conv)
 apply (simp add: f_Exec_eq_f_Exec_Stream_last2 last_nth f_Exec_Stream_not_empty_conv)
 apply (insert f_shrink_last_nth[of "length input - Suc 0" "f_Exec_Comp_Stream trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1" k1, symmetric])
 apply (insert f_shrink_last_nth[of "length input - Suc 0" "f_Exec_Comp_Stream trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2" k2, symmetric])
 apply (simp add: diff_mult_distrib gr0_imp_self_le_mult2)
 apply (rule f_Equiv_Exec_Stream_expand_shrink_equiv_state_set[of k1 k2 equiv_states localState1 _ localState2 _ A input_fun1 input_fun2 output_fun1 output_fun2])
 apply simp+
 done
 
 lemma f_Equiv_Exec_expand_shrink_equiv_state:"
   \<lbrakk> 0 < k1; 0 < k2; equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m.
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2) \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 (f_Exec_Comp trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1))
     (localState2 (f_Exec_Comp trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2))"
 by (rule f_Equiv_Exec_expand_shrink_equiv_state_set[of k1 k2 equiv_states localState1 _ localState2 _ UNIV input_fun1 input_fun2 output_fun1 output_fun2], simp+)
 
 lemma i_Equiv_Exec_Stream_expand_shrink_equiv_state_set[rule_format]: "
   \<lbrakk> 0 < k1; 0 < k2; equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m. \<lbrakk>set input0 \<subseteq> A; m \<in> A\<rbrakk> \<Longrightarrow>
        Equiv_Exec
         m equiv_states localState1 localState2
         input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
        (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
        (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2);
     range input \<subseteq> A \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 ((i_Exec_Comp_Stream trans_fun1 ((input_fun1 \<circ> input) \<odot>\<^sub>i k1) c1 \<div>\<^bsub>il\<^esub> k1) i))
     (localState2 ((i_Exec_Comp_Stream trans_fun2 ((input_fun2 \<circ> input) \<odot>\<^sub>i k2) c2 \<div>\<^bsub>il\<^esub> k2) i))"
 apply (simp add: i_shrink_last_nth i_Exec_Stream_nth i_expand_i_take_mod)
 apply (rule f_Equiv_Exec_expand_shrink_equiv_state_set[of
   k1 k2 equiv_states localState1 c1 localState2 c2 A input_fun1 input_fun2 output_fun1 output_fun2])
 apply (simp add: subset_trans[OF set_i_take_subset])+
 done
 
 lemma i_Equiv_Exec_Stream_expand_shrink_equiv_state: "
   \<lbrakk> 0 < k1; 0 < k2; equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m.
        Equiv_Exec
         m equiv_states localState1 localState2
         input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
        (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
        (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2) \<rbrakk> \<Longrightarrow>
   equiv_states
     (localState1 ((i_Exec_Comp_Stream trans_fun1 ((input_fun1 \<circ> input) \<odot>\<^sub>i k1) c1 \<div>\<^bsub>il\<^esub> k1) i))
     (localState2 ((i_Exec_Comp_Stream trans_fun2 ((input_fun2 \<circ> input) \<odot>\<^sub>i k2) c2 \<div>\<^bsub>il\<^esub> k2) i))"
 by (rule i_Equiv_Exec_Stream_expand_shrink_equiv_state_set[of k1 k2 equiv_states localState1 c1 localState2 c2 UNIV input_fun1 input_fun2 output_fun1 output_fun2], simp+)
 
 lemma f_Equiv_Exec_Stream_expand_shrink_output_set_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m. \<lbrakk> set input0 \<subseteq> A; m \<in> A \<rbrakk> \<Longrightarrow>
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2);
     set input \<subseteq> A \<rbrakk> \<Longrightarrow>
   (map output_fun1 (
     f_Exec_Comp_Stream trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)) \<div>\<^sub>f k1 =
   (map output_fun2 (
     f_Exec_Comp_Stream trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)) \<div>\<^sub>f k2"
 apply (subst list_eq_iff)
 apply (clarsimp simp: f_shrink_length)
 apply (simp del: last.simps f_Exec_Stream_Cons add: f_shrink_nth take_map drop_map f_Exec_Stream_take f_Exec_Stream_drop f_expand_take_mod f_expand_drop_mod take_first)
 apply (frule_tac n=i in subset_trans[OF set_take_subset, rule_format])
 apply (unfold atomize_all atomize_imp, intro allI impI)
 apply (frule_tac x="take i input" in spec)
 apply (drule_tac x="input ! i" in spec)
 apply (erule impE, assumption)
 apply (erule impE)
  apply (blast intro: nth_mem)
 apply (simp del: last.simps f_Exec_Stream_Cons)
 apply (rule Equiv_Exec_output_eqI[of equiv_states localState1 _ localState2 _ _ input_fun1 input_fun2])
  apply (case_tac i, simp)
  apply (simp add: take_map[symmetric] f_Exec_Stream_expand_shrink_last_nth_eq_f_Exec_Comp[symmetric])
  apply (frule Suc_lessD)
  apply (simp add: f_Equiv_Exec_Stream_expand_shrink_equiv_state_set[of k1 k2 equiv_states localState1 _ localState2 _ A input_fun1 input_fun2 output_fun1 output_fun2])
 apply simp
 done
 
 lemma f_Equiv_Exec_Stream_expand_shrink_output_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m.
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2
          trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2) \<rbrakk> \<Longrightarrow>
   (map output_fun1 (
     f_Exec_Comp_Stream trans_fun1 (map input_fun1 input \<odot>\<^sub>f k1) c1)) \<div>\<^sub>f k1 =
   (map output_fun2 (
     f_Exec_Comp_Stream trans_fun2 (map input_fun2 input \<odot>\<^sub>f k2) c2)) \<div>\<^sub>f k2"
 by (rule f_Equiv_Exec_Stream_expand_shrink_output_set_eq[of k1 k2 equiv_states localState1 _ localState2 _ UNIV], simp+)
 
 lemma i_Equiv_Exec_Stream_expand_shrink_output_set_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m. \<lbrakk> set input0 \<subseteq> A; m \<in> A \<rbrakk> \<Longrightarrow>
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2
          trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2);
     range input \<subseteq> A \<rbrakk> \<Longrightarrow>
   (output_fun1 \<circ>
     i_Exec_Comp_Stream trans_fun1 ((input_fun1 \<circ> input) \<odot>\<^sub>i k1) c1) \<div>\<^sub>i k1 =
   (output_fun2 \<circ>
     i_Exec_Comp_Stream trans_fun2 ((input_fun2 \<circ> input) \<odot>\<^sub>i k2) c2) \<div>\<^sub>i k2"
 apply (clarsimp simp: ilist_eq_iff, rename_tac i)
 apply (simp del: last.simps f_Exec_Stream_Cons add: i_shrink_nth i_Exec_Stream_take i_Exec_Stream_drop i_expand_i_take_mod i_expand_i_drop_mod i_take_first map_one f_expand_one)
 apply (rule Equiv_Exec_output_eqI[of
   equiv_states localState1 _ localState2 _ _
   input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2])
 apply (rule f_Equiv_Exec_expand_shrink_equiv_state_set[of
   k1 k2 equiv_states localState1 _ localState2 _ A
   input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2])
 apply (simp add: subset_trans[OF set_i_take_subset] subsetD[OF _ rangeI])+
 done
 
 lemma i_Equiv_Exec_Stream_expand_shrink_output_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     \<And>input0 m.
        Equiv_Exec
          m equiv_states localState1 localState2
          input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2
          (f_Exec_Comp trans_fun1 (map input_fun1 input0 \<odot>\<^sub>f k1) c1)
          (f_Exec_Comp trans_fun2 (map input_fun2 input0 \<odot>\<^sub>f k2) c2) \<rbrakk> \<Longrightarrow>
   (output_fun1 \<circ>
     i_Exec_Comp_Stream trans_fun1 ((input_fun1 \<circ> input) \<odot>\<^sub>i k1) c1) \<div>\<^sub>i k1 =
   (output_fun2 \<circ>
     i_Exec_Comp_Stream trans_fun2 ((input_fun2 \<circ> input) \<odot>\<^sub>i k2) c2) \<div>\<^sub>i k2"
 apply (rule i_Equiv_Exec_Stream_expand_shrink_output_set_eq[of
   k1 k2 equiv_states localState1 c1 localState2 c2 UNIV
   input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2])
 apply simp+
 done
 
 
 lemma f_Equiv_Exec_Stream_Acc_LocalState_set: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable_set A
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2;
       \<comment> \<open>\<open>equiv_states\<close> relation implies equivalent executions\<close>
       \<comment> \<open>not only at the beginning but also after processing an input\<close>
     set input \<subseteq> A;
     i < length input \<rbrakk> \<Longrightarrow>
   equiv_states
     (f_Exec_Comp_Stream_Acc_LocalState k1 localState1 trans_fun1 (map input_fun1 input) c1 ! i)
     (f_Exec_Comp_Stream_Acc_LocalState k2 localState2 trans_fun2 (map input_fun2 input) c2 ! i)"
 apply (unfold f_Exec_Comp_Stream_Acc_LocalState_def Equiv_Exec_stable_set_def)
 apply (simp add: f_shrink_last_map f_shrink_last_length)
 apply (rule f_Equiv_Exec_Stream_expand_shrink_equiv_state_set[of
   k1 k2 equiv_states localState1 c1 localState2 c2 A
   input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 input, rule_format])
 apply simp+
 done
 
 lemma f_Equiv_Exec_Stream_Acc_LocalState: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2;
       \<comment> \<open>\<open>equiv_states\<close> relation implies equivalent executions\<close>
       \<comment> \<open>not only at the beginning but also after processing an input\<close>
     i < length input \<rbrakk> \<Longrightarrow>
   equiv_states
     (f_Exec_Comp_Stream_Acc_LocalState k1 localState1 trans_fun1 (map input_fun1 input) c1 ! i)
     (f_Exec_Comp_Stream_Acc_LocalState k2 localState2 trans_fun2 (map input_fun2 input) c2 ! i)"
 apply (rule f_Equiv_Exec_Stream_Acc_LocalState_set[where A=UNIV])
 apply (simp add: Equiv_Exec_stable_set_UNIV)+
 done
 
 lemma f_Equiv_Exec_Stream_Acc_Output_set_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable_set A
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2 c1 c2;
     set input \<subseteq> A \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k1 output_fun1 trans_fun1 (map input_fun1 input) c1 =
   f_Exec_Comp_Stream_Acc_Output k2 output_fun2 trans_fun2 (map input_fun2 input) c2"
 apply (unfold f_Exec_Comp_Stream_Acc_Output_def Equiv_Exec_stable_set_def)
 apply (rule f_Equiv_Exec_Stream_expand_shrink_output_set_eq[of
   k1 k2 equiv_states localState1 c1 localState2 c2
   A input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 input])
 apply simp+
 done
 
 lemma f_Equiv_Exec_Stream_Acc_Output_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k1 output_fun1 trans_fun1 (map input_fun1 input) c1 =
   f_Exec_Comp_Stream_Acc_Output k2 output_fun2 trans_fun2 (map input_fun2 input) c2"
 apply (rule f_Equiv_Exec_Stream_Acc_Output_set_eq[of k1 k2 equiv_states localState1 c1 localState2 c2 UNIV])
 apply (simp add: Equiv_Exec_stable_set_UNIV)+
 done
 
 
 lemma i_Equiv_Exec_Stream_Acc_LocalState_set: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable_set A
       equiv_states localState1 localState2 input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2;
     range input \<subseteq> A \<rbrakk> \<Longrightarrow>
   equiv_states
     (i_Exec_Comp_Stream_Acc_LocalState k1 localState1 trans_fun1 (input_fun1 \<circ> input) c1 i)
     (i_Exec_Comp_Stream_Acc_LocalState k2 localState2 trans_fun2 (input_fun2 \<circ> input) c2 i)"
 apply (simp add: i_Exec_Stream_Acc_LocalState_nth_f_nth)
 apply (rule f_Equiv_Exec_Stream_Acc_LocalState_set)
 apply (simp add:  subset_trans[OF set_i_take_subset])+
 done
 
 lemma i_Equiv_Exec_Stream_Acc_LocalState: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2
       trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   equiv_states
     (i_Exec_Comp_Stream_Acc_LocalState k1 localState1 trans_fun1 (input_fun1 \<circ> input) c1 i)
     (i_Exec_Comp_Stream_Acc_LocalState k2 localState2 trans_fun2 (input_fun2 \<circ> input) c2 i)"
 apply (rule i_Equiv_Exec_Stream_Acc_LocalState_set[where A=UNIV])
 apply (simp add: Equiv_Exec_stable_set_UNIV)+
 done
 
 lemma i_Equiv_Exec_Stream_Acc_Output_set_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable_set A
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2 c1 c2;
     range input \<subseteq> A \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k1 output_fun1 trans_fun1 (input_fun1 \<circ> input) c1 =
   i_Exec_Comp_Stream_Acc_Output k2 output_fun2 trans_fun2 (input_fun2 \<circ> input) c2"
 apply (clarsimp simp: ilist_eq_iff i_Exec_Stream_Acc_Output_nth_f_nth, rename_tac i)
 apply (drule_tac n="Suc i" in subset_trans[OF set_i_take_subset, rule_format])
 apply (simp add: f_Equiv_Exec_Stream_Acc_Output_set_eq[where equiv_states=equiv_states])
 done
 
 lemma i_Equiv_Exec_Stream_Acc_Output_eq: "
   \<lbrakk> 0 < k1; 0 < k2;
     equiv_states (localState1 c1) (localState2 c2);
     Equiv_Exec_stable
       equiv_states localState1 localState2
       input_fun1 input_fun2 output_fun1 output_fun2 trans_fun1 trans_fun2 k1 k2 c1 c2 \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k1 output_fun1 trans_fun1 (input_fun1 \<circ> input) c1 =
   i_Exec_Comp_Stream_Acc_Output k2 output_fun2 trans_fun2 (input_fun2 \<circ> input) c2"
 apply (rule i_Equiv_Exec_Stream_Acc_Output_set_eq[of k1 k2 equiv_states localState1 c1 localState2 c2 UNIV])
 apply (simp add: Equiv_Exec_stable_set_UNIV)+
 done
 
 
 subsubsection \<open>Idle states and accelerated execution\<close>
 
 lemma f_Exec_Stream_Acc_LocalState__State_Idle_nth[rule_format]: "
   \<And>c i.
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n\<le>i. State_Idle localState output_fun trans_fun (
       f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c ! n);
     i < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c ! i =
   f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c ! i"
 apply (frule length_greater_0_conv[THEN iffD1, OF gr_implies_gr0])
 apply (simp only: f_Exec_Stream_Acc_LocalState_nth take_Suc_conv_app_nth)
 apply (simp only: f_expand_snoc f_Exec_append)
 apply (rule_tac s="\<NoMsg>\<^bsup>l - Suc 0\<^esup> @ \<NoMsg>\<^bsup>k-l\<^esup>" and t="\<NoMsg>\<^bsup>k - Suc 0\<^esup>" in subst)
  apply (simp add: replicate_le_diff2)
 apply (subst append_Cons[symmetric])
 apply (induct xs, simp)
 apply (case_tac i)
  apply (simp add: f_Exec_Stream_Acc_LocalState_Cons f_Exec_State_Idle_append_replicate_NoMsg_state)
 apply (rename_tac n)
 apply (drule_tac x="f_Exec_Comp trans_fun (a # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c" in meta_spec)
 apply (drule_tac x=n in meta_spec)
 apply (simp del: f_Exec_Cons)
 apply (frule length_greater_imp_not_empty)
 apply (drule meta_mp)
  apply (simp add: f_Exec_Stream_Acc_LocalState_nth f_Exec_append)
 apply (simp add: append_Cons[symmetric] f_expand_Cons f_Exec_append del: append_Cons)
 apply (subgoal_tac "
   localState (f_Exec_Comp trans_fun (a # NoMsg\<^bsup>k - Suc 0\<^esup>) c) =
   localState (f_Exec_Comp trans_fun (a # NoMsg\<^bsup>l - Suc 0\<^esup>) c)")
  prefer 2
  apply (drule_tac x=0 in spec)
  apply (simp add: f_Exec_Stream_Acc_LocalState_Cons)
  apply (subst replicate_le_diff2[OF Suc_leI, symmetric], assumption+)
  apply (simp add: append_Cons[symmetric] f_Exec_append del: append_Cons)
  apply (rule f_Exec_State_Idle_replicate_NoMsg_state, assumption)
 apply (case_tac "n = 0")
  apply (frule_tac
    ?c1.0="f_Exec_Comp trans_fun (a # NoMsg\<^bsup>k - Suc 0\<^esup>) c" and
    xs = "xs ! 0 # NoMsg\<^bsup>l - Suc 0\<^esup>" in f_Exec_Equal_State)
  apply simp+
 apply (frule_tac
   ?c1.0="f_Exec_Comp trans_fun (a # NoMsg\<^bsup>k - Suc 0\<^esup>) c" and
   xs = "xs \<down> n \<odot>\<^sub>f k" in f_Exec_Equal_State)
 apply (simp add: f_expand_not_empty_conv)+
 done
 
 corollary f_Exec_Stream_Acc_LocalState__State_Idle_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n<length xs. State_Idle localState output_fun trans_fun (
       f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c ! n) \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c =
   f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c"
 apply (clarsimp simp: list_eq_iff)
 apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply simp
 done
 
 lemma i_Exec_Stream_Acc_LocalState__State_Idle_nth[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n\<le>i. State_Idle localState output_fun trans_fun (
       i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c n) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c i =
   i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c i"
 apply (simp only: f_Exec_Stream_Acc_LocalState_nth_eq_i_nth[of _ _ "Suc i", symmetric])
 apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply (simp add: f_Exec_Stream_Acc_LocalState_nth_eq_i_nth)
 done
 
 corollary i_Exec_Stream_Acc_LocalState__State_Idle_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n. State_Idle localState output_fun trans_fun (
       i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c n) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun input c =
   i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c"
 apply (clarsimp simp: ilist_eq_iff)
 apply (rule i_Exec_Stream_Acc_LocalState__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply simp
 done
 
 lemma f_Exec_Stream_Acc_Output__State_Idle_nth[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n\<le>i. State_Idle localState output_fun trans_fun (
       f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c ! n);
     i < length xs \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c ! i =
   f_Exec_Comp_Stream_Acc_Output l output_fun trans_fun xs c ! i"
 apply (drule order_le_less[THEN iffD1], erule disjE)
  prefer 2
  apply simp
 apply (frule zero_less_diff[of k l, THEN iffD2])
 apply (frule length_greater_imp_not_empty)
 apply (simp add: f_Exec_Stream_Acc_Output_nth del: f_Exec_Stream_Cons)
 apply (subst replicate_le_diff2[OF Suc_leI, symmetric])
  apply (simp del: f_Exec_Stream_Cons)+
 apply (subst append_Cons[symmetric])
 apply (case_tac i)
  apply (drule_tac x=0 in spec)
  apply (simp add: f_Exec_Stream_Acc_LocalState_nth take_first f_expand_one del: last.simps f_Exec_Cons f_Exec_Stream_Cons append_Cons replicate.simps)
  apply (simp only: f_Exec_Stream_append map_append last_message_append)
  apply (rule if_P')
   apply (clarsimp simp: last_message_NoMsg_conv f_Exec_Stream_nth min_eqL simp del: last.simps f_Exec_Comp.simps append_Cons replicate.simps)
   apply (rule f_Exec_State_Idle_replicate_NoMsg_gr0_output)
   apply (simp del: last.simps f_Exec_Comp_Stream.simps append_Cons)+
 apply (rename_tac n)
 apply (simp only: f_Exec_Stream_append map_append last_message_append)
 apply (subgoal_tac "
   localState (f_Exec_Comp trans_fun (xs \<down> Suc n \<odot>\<^sub>f k) c) =
   localState (f_Exec_Comp trans_fun (xs \<down> Suc n \<odot>\<^sub>f l) c)")
  prefer 2
  apply (simp add: f_Exec_Stream_Acc_LocalState_nth[symmetric])
  apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_nth)
  apply simp+
  apply (rename_tac n, drule_tac x=n in spec, simp)
  apply simp
 apply (rule if_P')
  apply (simp add: last_message_NoMsg_conv f_Exec_Stream_nth min_eqL del: f_Exec_Comp.simps replicate.simps)
  apply (clarify, rename_tac j)
  apply (frule_tac x="Suc n" in spec)
  apply (simp only: f_Exec_Stream_Acc_LocalState_nth)
  apply (rule_tac
    ?c1.0="f_Exec_Comp trans_fun (xs \<down> Suc n \<odot>\<^sub>f l) c"
    and ?c2.0="f_Exec_Comp trans_fun (xs \<down> Suc n \<odot>\<^sub>f k) c"
    in subst[OF f_Exec_Equal_State, rule_format])
   apply (simp del: f_Exec_Comp.simps replicate.simps)+
  apply (simp only: take_Suc_conv_app_nth f_expand_snoc f_Exec_append)
  apply (rule f_Exec_State_Idle_replicate_NoMsg_gr0_output, assumption)
  apply simp
 apply (rule arg_cong[where f="\<lambda>x. last_message (map output_fun x)"])
 apply (rule f_Exec_Stream_Equal_State, assumption+)
 done
 
 lemma f_Exec_Stream_Acc_Output__State_Idle_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n<length xs. State_Idle localState output_fun trans_fun (
       f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c ! n) \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c =
   f_Exec_Comp_Stream_Acc_Output l output_fun trans_fun xs c"
 apply (clarsimp simp: list_eq_iff)
 apply (rule f_Exec_Stream_Acc_Output__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply simp
 done
 
 lemma i_Exec_Stream_Acc_Output__State_Idle_nth[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n\<le>i. State_Idle localState output_fun trans_fun (
       i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c n) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c i =
   i_Exec_Comp_Stream_Acc_Output l output_fun trans_fun input c i"
 apply (simp only: i_Exec_Stream_Acc_Output_nth_f_nth)
 apply (rule f_Exec_Stream_Acc_Output__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply (simp add: f_Exec_Stream_Acc_LocalState_nth_eq_i_nth)
 done
 
 lemma i_Exec_Stream_Acc_Output__State_Idle_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     \<forall>n. State_Idle localState output_fun trans_fun (
       i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun input c n) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c =
   i_Exec_Comp_Stream_Acc_Output l output_fun trans_fun input c"
 apply (clarsimp simp: ilist_eq_iff)
 apply (rule i_Exec_Stream_Acc_Output__State_Idle_nth)
 apply simp_all
 apply (drule_tac x=n in spec)
 apply simp
 done
 
 
 text \<open>
   When a certain number @{term l} of steps suffices to reach
   an idle state from any other idle state,
   than for any acceleration factor @{term "k \<ge> l"}
   the accelerated processing of every input message
   will be finished in an idle state.\<close>
 lemma f_Exec_Stream_Acc_LocalState__State_Idle_all[rule_format]: "
   \<And>c xs. \<lbrakk> 0 < l; l \<le> k;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c));
     i < length xs \<rbrakk> \<Longrightarrow>
   State_Idle localState output_fun trans_fun (
     f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c ! i)"
 apply (frule length_greater_imp_not_empty)
 apply (subgoal_tac "
   State_Idle localState output_fun trans_fun (
     localState (f_Exec_Comp trans_fun (hd xs # NoMsg\<^bsup>k - Suc 0\<^esup>) c))")
  prefer 2
  apply (drule_tac x=c in spec, drule_tac x="hd xs" in spec)
  apply (rule subst[OF replicate_le_diff2[OF Suc_leI], of 0 l k], assumption+)
  apply (simp add: f_Exec_append f_Exec_State_Idle_replicate_NoMsg_state)
 apply (induct i)
  apply (simp add: f_Exec_Stream_Acc_LocalState_nth take_first hd_eq_first)
 apply (drule_tac x="f_Exec_Comp trans_fun (hd xs # NoMsg\<^bsup>k - Suc 0\<^esup>) c" in meta_spec)
 apply (drule_tac x="tl xs" in meta_spec)
 apply (subgoal_tac "i < length (tl xs) \<and> tl xs \<noteq> []", elim conjE)
  prefer 2
  apply (simp add: length_greater_0_conv[symmetric] del: length_greater_0_conv)
 apply (simp add: f_Exec_Stream_Acc_LocalState_nth)
 apply (rule_tac n="Suc i" in ssubst[OF take_Suc, rule_format], assumption)
 apply (simp add: append_Cons[symmetric] f_Exec_append del: append_Cons)
 apply (drule meta_mp)
  apply (drule_tac x="f_Exec_Comp trans_fun (hd xs # NoMsg\<^bsup>k - Suc 0\<^esup>) c" in spec)
  apply (drule mp, simp)
  apply (drule_tac x="hd (tl xs)" in spec)
  apply (subst replicate_le_diff2[OF Suc_leI, of 0 l k, symmetric], simp+)
  apply (simp add: f_Exec_append f_Exec_State_Idle_replicate_NoMsg_state)
 apply (simp add: f_Exec_Stream_Acc_LocalState_nth)
 done
 
 lemma i_Exec_Stream_Acc_LocalState__State_Idle_all[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c)) \<rbrakk> \<Longrightarrow>
   State_Idle localState output_fun trans_fun (
     i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c i)"
 apply (simp only: i_Exec_Stream_Acc_LocalState_nth_f_nth)
 apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_all)
 apply simp_all
 apply (rename_tac c' m, drule_tac x=c' in spec)
 apply simp
 done
 
 lemma f_Exec_Stream_Acc_Output__State_Idle_all_imp_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c)) \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_Output k output_fun trans_fun xs c =
   f_Exec_Comp_Stream_Acc_Output l output_fun trans_fun xs c"
 apply (rule f_Exec_Stream_Acc_Output__State_Idle_eq, assumption+)
 apply (simp add: f_Exec_Stream_Acc_LocalState__State_Idle_all)
 done
 
 lemma i_Exec_Stream_Acc_Output__State_Idle_all_imp_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c)) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_Output k output_fun trans_fun input c =
   i_Exec_Comp_Stream_Acc_Output l output_fun trans_fun input c"
 apply (rule i_Exec_Stream_Acc_Output__State_Idle_eq, assumption+)
 apply (simp add: i_Exec_Stream_Acc_LocalState__State_Idle_all)
 done
 
 lemma f_Exec_Stream_Acc_LocalState__State_Idle_all_imp_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c)) \<rbrakk> \<Longrightarrow>
   f_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c =
   f_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c"
 apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_eq, assumption+)
 apply (rule f_Exec_Stream_Acc_LocalState__State_Idle_all)
 apply simp+
 done
 
 lemma i_Exec_Stream_Acc_LocalState__State_Idle_all_imp_eq[rule_format]: "
   \<lbrakk> 0 < l; l \<le> k; Exec_Equal_State localState trans_fun;
     State_Idle localState output_fun trans_fun (localState c);
     \<forall>c m. State_Idle localState output_fun trans_fun (localState c) \<longrightarrow>
       State_Idle localState output_fun trans_fun (
         localState (f_Exec_Comp trans_fun (m # \<NoMsg>\<^bsup>l - Suc 0\<^esup>) c)) \<rbrakk> \<Longrightarrow>
   i_Exec_Comp_Stream_Acc_LocalState k localState trans_fun xs c =
   i_Exec_Comp_Stream_Acc_LocalState l localState trans_fun xs c"
 apply (rule i_Exec_Stream_Acc_LocalState__State_Idle_eq, assumption+)
 apply (rule i_Exec_Stream_Acc_LocalState__State_Idle_all)
 apply simp+
 done
 
 
 text \<open>Converting inputs\<close>
 
 lemma f_Exec_input_map: "\<And>c.
   f_Exec_Comp trans_fun (map f xs) c = f_Exec_Comp (trans_fun \<circ> f) xs c"
 by (induct xs, simp+)
 lemma f_Exec_Stream_input_map: "
   f_Exec_Comp_Stream trans_fun (map f xs) c =
   f_Exec_Comp_Stream (trans_fun \<circ> f) xs c"
 by (simp add: list_eq_iff f_Exec_Stream_nth take_map f_Exec_input_map)
 lemma i_Exec_Stream_input_map: "
   i_Exec_Comp_Stream trans_fun (f \<circ> input) c =
   i_Exec_Comp_Stream (trans_fun \<circ> f) input c"
 by (simp add: ilist_eq_iff i_Exec_Stream_nth f_Exec_input_map)
 
 end
diff --git a/thys/Category2/Functors.thy b/thys/Category2/Functors.thy
--- a/thys/Category2/Functors.thy
+++ b/thys/Category2/Functors.thy
@@ -1,507 +1,507 @@
 (*
 Author: Alexander Katovsky
 *)
 
 section "Functor"
 
 theory Functors
 imports Category
 begin
 
 record ('o1, 'o2, 'm1, 'm2, 'a, 'b) Functor = 
   CatDom :: "('o1,'m1,'a)Category_scheme" 
   CatCod :: "('o2,'m2,'b)Category_scheme" 
   MapM :: "'m1 \<Rightarrow> 'm2" 
 
 abbreviation
   FunctorMorApp :: "('o1, 'o2, 'm1, 'm2, 'a1, 'a2, 'a) Functor_scheme \<Rightarrow> 'm1 \<Rightarrow> 'm2" (infixr "##" 70) where
   "FunctorMorApp F m \<equiv> (MapM F) m"
 
 definition
   MapO :: "('o1, 'o2, 'm1, 'm2, 'a1, 'a2, 'a) Functor_scheme \<Rightarrow> 'o1 \<Rightarrow> 'o2"  where
   "MapO F X \<equiv> THE Y . Y \<in> Obj(CatCod F) \<and>  F ## (Id (CatDom F) X) = Id (CatCod F) Y"
 
 abbreviation
   FunctorObjApp :: "('o1, 'o2, 'm1, 'm2, 'a1, 'a2, 'a) Functor_scheme \<Rightarrow> 'o1 \<Rightarrow> 'o2" (infixr "@@" 70) where
   "FunctorObjApp F X \<equiv> (MapO F X)"
 
 locale PreFunctor = 
   fixes F :: "('o1, 'o2, 'm1, 'm2, 'a1, 'a2, 'a) Functor_scheme"  (structure) 
   assumes FunctorComp: "f \<approx>>\<^bsub>CatDom F\<^esub> g \<Longrightarrow> F ## (f ;;\<^bsub>CatDom F\<^esub> g) = (F ## f) ;;\<^bsub>CatCod F\<^esub> (F ## g)"
   and     FunctorId:   "X \<in> obj\<^bsub>CatDom F\<^esub> \<Longrightarrow> \<exists> Y \<in> obj\<^bsub>CatCod F\<^esub> . F ## (id\<^bsub>CatDom F\<^esub> X) = id\<^bsub>CatCod F\<^esub> Y"
   and     CatDom[simp]:      "Category(CatDom F)"
   and     CatCod[simp]:      "Category(CatCod F)"
 
 locale FunctorM = PreFunctor +
   assumes     FunctorCompM: "f maps\<^bsub>CatDom F\<^esub> X to Y \<Longrightarrow> (F ## f) maps\<^bsub>CatCod F\<^esub> (F @@ X) to (F @@ Y)"
 
 locale FunctorExt = 
   fixes F :: "('o1, 'o2, 'm1, 'm2, 'a1, 'a2, 'a) Functor_scheme"  (structure) 
   assumes FunctorMapExt: "(MapM F) \<in> extensional (Mor (CatDom F))"
 
 locale Functor = FunctorM + FunctorExt
 
 definition 
   MakeFtor :: "('o1, 'o2, 'm1, 'm2, 'a, 'b,'r) Functor_scheme \<Rightarrow> ('o1, 'o2, 'm1, 'm2, 'a, 'b,'r) Functor_scheme" where
   "MakeFtor F \<equiv> \<lparr>
       CatDom = CatDom F , 
       CatCod = CatCod F , 
       MapM = restrict (MapM F) (Mor (CatDom F)) , 
       \<dots> = Functor.more F
   \<rparr>"
 
 lemma PreFunctorFunctor[simp]: "Functor F \<Longrightarrow> PreFunctor F"
 by (simp add: Functor_def FunctorM_def)
 
 lemmas functor_simps = PreFunctor.FunctorComp PreFunctor.FunctorId
 
 definition 
   functor_abbrev ("Ftor _ : _ \<longrightarrow> _" [81]) where
   "Ftor F : A \<longrightarrow> B \<equiv> (Functor F) \<and> (CatDom F = A) \<and> (CatCod F = B)"
 
 lemma functor_abbrevE[elim]: "\<lbrakk>Ftor F : A \<longrightarrow> B ; \<lbrakk>(Functor F) ; (CatDom F = A) ; (CatCod F = B)\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by (auto simp add: functor_abbrev_def)
 
 definition
   functor_comp_def ("_ \<approx>>;;; _" [81]) where
   "functor_comp_def F G \<equiv> (Functor F) \<and> (Functor G) \<and> (CatDom G = CatCod F)"
 
 lemma functor_comp_def[elim]: "\<lbrakk>F \<approx>>;;; G ; \<lbrakk>Functor F ; Functor G ; CatDom G = CatCod F\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by (auto simp add: functor_comp_def_def)
 
 lemma (in Functor) FunctorMapsTo:
   assumes "f \<in> mor\<^bsub>CatDom F\<^esub>"
   shows   "F ## f maps\<^bsub>CatCod F\<^esub> (F @@ (dom\<^bsub>CatDom F\<^esub> f)) to (F @@ (cod\<^bsub>CatDom F\<^esub> f))"
 proof-
   have "f maps\<^bsub>CatDom F\<^esub> (dom\<^bsub>CatDom F\<^esub> f) to (cod\<^bsub>CatDom F\<^esub> f)" using assms by auto
   thus ?thesis by (simp add: FunctorCompM[of f "dom\<^bsub>CatDom F\<^esub> f" "cod\<^bsub>CatDom F\<^esub> f"])
 qed
 
 lemma (in Functor) FunctorCodDom: 
   assumes "f \<in> mor\<^bsub>CatDom F\<^esub>"
   shows "dom\<^bsub>CatCod F\<^esub>(F ## f) = F @@ (dom\<^bsub>CatDom F\<^esub> f)" and "cod\<^bsub>CatCod F\<^esub>(F ## f) = F @@ (cod\<^bsub>CatDom F\<^esub> f)"
 proof-
   have "F ## f maps\<^bsub>CatCod F\<^esub> (F @@ (dom\<^bsub>CatDom F\<^esub> f)) to (F @@ (cod\<^bsub>CatDom F\<^esub> f))" using assms by (simp add: FunctorMapsTo)
   thus "dom\<^bsub>CatCod F\<^esub>(F ## f) = F @@ (dom\<^bsub>CatDom F\<^esub> f)" and "cod\<^bsub>CatCod F\<^esub>(F ## f) = F @@ (cod\<^bsub>CatDom F\<^esub> f)"
     by auto
 qed
 
 lemma (in Functor) FunctorCompPreserved: "f \<in> mor\<^bsub>CatDom F\<^esub> \<Longrightarrow> F ## f \<in> mor\<^bsub>CatCod F\<^esub>"
 by (auto dest:FunctorMapsTo)
 
 lemma (in Functor) FunctorCompDef: 
   assumes "f \<approx>>\<^bsub>CatDom F\<^esub> g" shows "(F ## f) \<approx>>\<^bsub>CatCod F\<^esub> (F ## g)"
 proof(auto simp add: CompDefined_def)
   show "F ## f \<in> mor\<^bsub>CatCod F\<^esub>" and "F ## g \<in> mor\<^bsub>CatCod F\<^esub>" using assms by (auto simp add: FunctorCompPreserved)
   have "f \<in> mor\<^bsub>CatDom F\<^esub>" and "g \<in> mor\<^bsub>CatDom F\<^esub>" using assms by auto
   hence a: "cod\<^bsub>CatCod F\<^esub> (F ## f) = F @@ (cod\<^bsub>CatDom F\<^esub> f)" and b: "dom\<^bsub>CatCod F\<^esub>(F ## g) = F @@ (dom\<^bsub>CatDom F\<^esub> g)"
     by (simp add: FunctorCodDom)+
   have "cod\<^bsub>CatCod F\<^esub> (F ## f) = F @@ (dom\<^bsub>CatDom F\<^esub> g)" using assms a by auto
   also have "... = dom\<^bsub>CatCod F\<^esub> (F ## g)" using b by simp
   finally show "cod\<^bsub>CatCod F\<^esub> (F ## f) = dom\<^bsub>CatCod F\<^esub> (F ## g)" .
 qed
 
 lemma FunctorComp: "\<lbrakk>Ftor F : A \<longrightarrow> B ; f \<approx>>\<^bsub>A\<^esub> g\<rbrakk> \<Longrightarrow> F ## (f ;;\<^bsub>A\<^esub> g) = (F ## f) ;;\<^bsub>B\<^esub> (F ## g)"
 by (auto simp add: PreFunctor.FunctorComp)
 
 lemma FunctorCompDef: "\<lbrakk>Ftor F : A \<longrightarrow> B ; f \<approx>>\<^bsub>A\<^esub> g\<rbrakk> \<Longrightarrow> (F ## f) \<approx>>\<^bsub>B\<^esub> (F ## g)"
 by (auto simp add: Functor.FunctorCompDef)
 
 lemma FunctorMapsTo: 
   assumes "Ftor F : A \<longrightarrow> B" and "f maps\<^bsub>A\<^esub> X to Y" 
   shows "(F ## f) maps\<^bsub>B\<^esub> (F @@ X) to (F @@ Y)"
 proof-
   have b: "CatCod F = B" and a: "CatDom F = A" and ff: "Functor F" using assms by auto
   have df: "(dom\<^bsub>CatDom F\<^esub> f) = X" and cf: "(cod\<^bsub>CatDom F\<^esub> f) = Y" using a assms by auto
   have "f \<in> mor\<^bsub>CatDom F\<^esub>" using assms by auto
   hence "F ## f maps\<^bsub>CatCod F\<^esub> (F @@ (dom\<^bsub>CatDom F\<^esub> f)) to (F @@ (cod\<^bsub>CatDom F\<^esub> f))" using ff
     by (simp add: Functor.FunctorMapsTo) 
   thus ?thesis using df cf b by simp
 qed
 
 lemma (in PreFunctor) FunctorId2: 
   assumes "X \<in> obj\<^bsub>CatDom F\<^esub>"
   shows   "F @@ X \<in> obj\<^bsub>CatCod F\<^esub> \<and> F ## (id\<^bsub>CatDom F\<^esub> X) = id\<^bsub>CatCod F\<^esub> (F @@ X)"
 proof-
   let ?Q = "\<lambda> E Y . Y \<in> obj\<^bsub>CatCod F\<^esub> \<and> E = id\<^bsub>CatCod F\<^esub> Y"
   let ?P = "?Q (F ## (id\<^bsub>CatDom F\<^esub> X))"
   from assms FunctorId obtain Y where "?P Y" by auto
   moreover  { 
     fix y e z have "\<lbrakk>?Q e y ; ?Q e z\<rbrakk> \<Longrightarrow> y = z"
       by (auto intro: Category.IdInj[of "CatCod F" y z])
   }
   ultimately have "\<exists>! Z . ?P Z" by auto
   hence "?P (THE Y . ?P Y)" by (rule theI')
   thus ?thesis by (auto simp add: MapO_def)
 qed
 
 lemma FunctorId:
   assumes "Ftor F : C \<longrightarrow> D" and "X \<in> Obj C"
   shows "F ## (Id C X) = Id D (F @@ X)"
 proof-
   have "CatDom F = C" and "CatCod F = D" and "PreFunctor F" using assms by auto
   thus ?thesis using assms PreFunctor.FunctorId2[of F X] by simp
 qed
 
 lemma (in Functor) DomFunctor: "f \<in> mor\<^bsub>CatDom F\<^esub> \<Longrightarrow> dom\<^bsub>CatCod F\<^esub> (F ## f) = F @@ (dom\<^bsub>CatDom F\<^esub> f)"
 by (simp add: FunctorCodDom)
 
 lemma (in Functor) CodFunctor: "f \<in> mor\<^bsub>CatDom F\<^esub> \<Longrightarrow> cod\<^bsub>CatCod F\<^esub> (F ## f) = F @@ (cod\<^bsub>CatDom F\<^esub> f)"
 by (simp add: FunctorCodDom) 
 
 lemma (in Functor) FunctorId3Dom:
   assumes "f \<in> mor\<^bsub>CatDom F\<^esub>"
   shows   "F ## (id\<^bsub>CatDom F\<^esub> (dom\<^bsub>CatDom F\<^esub> f)) = id\<^bsub>CatCod F\<^esub> (dom\<^bsub>CatCod F\<^esub> (F ## f))"
 proof-
   have "(dom\<^bsub>CatDom F\<^esub> f) \<in> obj\<^bsub>CatDom F\<^esub>" using assms by (simp add: Category.Cdom)
   hence "F ## (id\<^bsub>CatDom F\<^esub> (dom\<^bsub>CatDom F\<^esub> f)) = id\<^bsub>CatCod F\<^esub> (F @@ (dom\<^bsub>CatDom F\<^esub> f))" by (simp add: FunctorId2)
   also have "... = id\<^bsub>CatCod F\<^esub> (dom\<^bsub>CatCod F\<^esub> (F ## f))" using assms by (simp add: DomFunctor)
   finally show ?thesis by simp
 qed
 
 lemma (in Functor) FunctorId3Cod:
   assumes "f \<in> mor\<^bsub>CatDom F\<^esub>"
   shows   "F ## (id\<^bsub>CatDom F\<^esub> (cod\<^bsub>CatDom F\<^esub> f)) = id\<^bsub>CatCod F\<^esub> (cod\<^bsub>CatCod F\<^esub> (F ## f))"
 proof-
   have "(cod\<^bsub>CatDom F\<^esub> f) \<in> obj\<^bsub>CatDom F\<^esub>" using assms by (simp add: Category.Ccod)
   hence "F ## (id\<^bsub>CatDom F\<^esub> (cod\<^bsub>CatDom F\<^esub> f)) = id\<^bsub>CatCod F\<^esub> (F @@ (cod\<^bsub>CatDom F\<^esub> f))" by (simp add: FunctorId2)
   also have "... = id\<^bsub>CatCod F\<^esub> (cod\<^bsub>CatCod F\<^esub> (F ## f))" using assms by (simp add: CodFunctor)
   finally show ?thesis by simp
 qed
 
 lemma (in PreFunctor) FmToFo: "\<lbrakk>X \<in> obj\<^bsub>CatDom F\<^esub> ; Y \<in> obj\<^bsub>CatCod F\<^esub> ; F ## (id\<^bsub>CatDom F\<^esub> X) = id\<^bsub>CatCod F\<^esub> Y\<rbrakk> \<Longrightarrow> F @@ X = Y"
   by (auto simp add: FunctorId2 intro: Category.IdInj[of "CatCod F" "F @@ X" Y])
 
 lemma MakeFtorPreFtor: 
   assumes "PreFunctor F" shows "PreFunctor (MakeFtor F)"
 proof-
   {
     fix X assume a: "X \<in> obj\<^bsub>CatDom F\<^esub>" have "id\<^bsub>CatDom F \<^esub>X \<in> mor\<^bsub>CatDom F\<^esub>"
     proof-
       have "Category (CatDom F)" using assms by (simp add: PreFunctor_def)
       hence "id\<^bsub>CatDom F \<^esub>X maps\<^bsub>CatDom F\<^esub> X to X" using a by (simp add: Category.Cidm)
       thus ?thesis using a by (auto)
     qed
   }
   thus "PreFunctor (MakeFtor F)" using assms
     by(auto simp add: PreFunctor_def MakeFtor_def Category.MapsToMorDomCod)
 qed
 
 lemma MakeFtorMor: "f \<in> mor\<^bsub>CatDom F\<^esub> \<Longrightarrow> MakeFtor F ## f = F ## f"
 by(simp add: MakeFtor_def)
 
 lemma MakeFtorObj: 
   assumes "PreFunctor F" and "X \<in> obj\<^bsub>CatDom F\<^esub>"
   shows "MakeFtor F @@ X = F @@ X"
 proof-
   have "X \<in> obj\<^bsub>CatDom (MakeFtor F)\<^esub>" using assms(2) by (simp add: MakeFtor_def)
   moreover have "(F @@ X) \<in> obj\<^bsub>CatCod (MakeFtor F)\<^esub>" using assms by (simp add: PreFunctor.FunctorId2 MakeFtor_def)
   moreover have "MakeFtor F ## id\<^bsub>CatDom (MakeFtor F) \<^esub>X = id\<^bsub>CatCod (MakeFtor F) \<^esub>(F @@ X)" 
   proof-
     have "Category (CatDom F)" using assms(1) by (simp add: PreFunctor_def)
     hence "id\<^bsub>CatDom F \<^esub>X  maps\<^bsub>CatDom F\<^esub> X to X" using assms(2) by (auto simp add: Category.Cidm)
     hence "id\<^bsub>CatDom F \<^esub>X \<in> mor\<^bsub>CatDom F\<^esub>" by auto
     hence "MakeFtor F ## id\<^bsub>CatDom (MakeFtor F) \<^esub>X = F ## id\<^bsub>CatDom F \<^esub>X" by (simp add: MakeFtor_def)
     also have "... = id\<^bsub>CatCod F \<^esub>(F @@ X)" using assms by (simp add: PreFunctor.FunctorId2)
     finally show ?thesis by (simp add: MakeFtor_def)
   qed
   moreover have "PreFunctor (MakeFtor F)" using assms(1) by (simp add: MakeFtorPreFtor)
   ultimately show ?thesis by (simp add: PreFunctor.FmToFo)
 qed
 
 lemma MakeFtor: assumes "FunctorM F" shows "Functor (MakeFtor F)" 
 proof(intro_locales)
   show "PreFunctor (MakeFtor F)" using assms by (simp add: MakeFtorPreFtor FunctorM_def)
   show "FunctorM_axioms (MakeFtor F)"
   proof(auto simp add: FunctorM_axioms_def)
     {
       fix f X Y assume aa: "f maps\<^bsub>CatDom (MakeFtor F)\<^esub> X to Y"
       show "((MakeFtor F) ## f) maps\<^bsub>CatCod (MakeFtor F)\<^esub> ((MakeFtor F) @@ X) to ((MakeFtor F) @@ Y)"
       proof-
         have "((MakeFtor F) ## f) = F ## f" using aa by (auto simp add: MakeFtor_def)
         moreover have "((MakeFtor F) @@ X) = F @@ X" and "((MakeFtor F) @@ Y) = F @@ Y"
         proof-
           have "Category (CatDom F)" using assms by (simp add: FunctorM_def PreFunctor_def)
           hence "X \<in> obj\<^bsub>CatDom F\<^esub>" and "Y \<in> obj\<^bsub>CatDom F\<^esub>" 
             using aa by (auto simp add: Category.MapsToObj MakeFtor_def)
           moreover have "PreFunctor F" using assms(1) by (simp add: FunctorM_def)
           ultimately show "((MakeFtor F) @@ X) = F @@ X" and "((MakeFtor F) @@ Y) = F @@ Y"
             by (simp add: MakeFtorObj)+
         qed
         moreover have "F ## f maps\<^bsub>CatCod F\<^esub> (F @@ X) to (F @@ Y)" using assms(1) aa 
           by (simp add: FunctorM.FunctorCompM MakeFtor_def)
         ultimately show ?thesis by (simp add: MakeFtor_def)
       qed
     }
   qed
   show "FunctorExt (MakeFtor F)" by(simp add: FunctorExt_def MakeFtor_def)
 qed
 
 definition 
-  IdentityFunctor' :: "('o,'m,'a) Category_scheme \<Rightarrow> ('o,'o,'m,'m,'a,'a) Functor" ("FId' _" [70]) where
+  IdentityFunctor' :: "('o,'m,'a) Category_scheme \<Rightarrow> ('o,'o,'m,'m,'a,'a) Functor" ("FId'' _" [70]) where
   "IdentityFunctor' C \<equiv> \<lparr>CatDom = C , CatCod = C , MapM = (\<lambda> f . f) \<rparr>"
 
 definition 
   IdentityFunctor ("FId _" [70]) where
   "IdentityFunctor C \<equiv> MakeFtor(IdentityFunctor' C)"
 
 lemma IdFtor'PreFunctor: "Category C \<Longrightarrow> PreFunctor (FId' C)"
 by(auto simp add: PreFunctor_def IdentityFunctor'_def)
 
 lemma IdFtor'Obj:
   assumes "Category C" and "X \<in> obj\<^bsub>CatDom (FId' C)\<^esub>"
   shows "(FId' C) @@ X = X"
 proof-
   have "(FId' C) ## id\<^bsub>CatDom (FId' C)\<^esub> X = id\<^bsub>CatCod (FId' C)\<^esub> X" by(simp add: IdentityFunctor'_def)
   moreover have "X \<in> obj\<^bsub>CatCod (FId' C)\<^esub>" using assms by (simp add: IdentityFunctor'_def)
   ultimately show ?thesis using assms by (simp add: PreFunctor.FmToFo IdFtor'PreFunctor)
 qed
 
 lemma IdFtor'FtorM:  
   assumes "Category C" shows "FunctorM (FId' C)"
 proof(auto simp add: FunctorM_def IdFtor'PreFunctor assms FunctorM_axioms_def)
   {
     fix f X Y assume a: "f maps\<^bsub>CatDom (FId' C)\<^esub> X to Y" 
     show "((FId' C) ## f) maps\<^bsub>CatCod (FId' C)\<^esub> ((FId' C) @@ X) to ((FId' C) @@ Y)"
     proof-
       have "X \<in> obj\<^bsub>CatDom (FId' C)\<^esub>" and "Y \<in> obj\<^bsub>CatDom (FId' C)\<^esub>"
         using a assms by (simp add: Category.MapsToObj IdentityFunctor'_def)+
       moreover have "(FId' C) ## f = f" and "CatDom (FId' C) = CatCod (FId' C)" by (simp add: IdentityFunctor'_def)+
       ultimately show ?thesis using assms a by(simp add: IdFtor'Obj)
     qed
   }
 qed
 
 lemma IdFtorFtor:  "Category C \<Longrightarrow> Functor (FId C)"
 by (auto simp add: IdentityFunctor_def IdFtor'FtorM intro: MakeFtor)
 
 definition 
   ConstFunctor' :: "('o1,'m1,'a) Category_scheme \<Rightarrow> 
                   ('o2,'m2,'b) Category_scheme \<Rightarrow> 'o2 \<Rightarrow> ('o1,'o2,'m1,'m2,'a,'b) Functor"  where
   "ConstFunctor' A B b \<equiv> \<lparr>
          CatDom = A , 
          CatCod = B , 
          MapM = (\<lambda> f . (Id B) b)
   \<rparr>"
 
 definition "ConstFunctor A B b \<equiv> MakeFtor(ConstFunctor' A B b)"
 
 lemma ConstFtor' : 
   assumes "Category A" "Category B" "b \<in> (Obj B)"
   shows   "PreFunctor (ConstFunctor' A B b)"
   and     "FunctorM (ConstFunctor' A B b)"
 proof-
   show "PreFunctor (ConstFunctor' A B b)" using assms
     apply (subst PreFunctor_def)
     apply (rule conjI)+
     by (auto simp add: ConstFunctor'_def Category.Simps Category.CatIdCompId)
   moreover 
   {
     fix X  assume "X \<in> obj\<^bsub>A\<^esub>" "b \<in> obj\<^bsub>B\<^esub>" "PreFunctor (ConstFunctor' A B b)" 
     hence "(ConstFunctor' A B b) @@ X = b"
       by (auto simp add: ConstFunctor'_def PreFunctor.FmToFo Category.Simps)
   }
   ultimately show "FunctorM (ConstFunctor' A B b)" using assms
     by (intro_locales, auto simp add: ConstFunctor'_def Category.Simps FunctorM_axioms_def)
 qed
 
 lemma ConstFtor: 
   assumes "Category A" "Category B" "b \<in> (Obj B)"
   shows "Functor (ConstFunctor A B b)"
 by (auto simp add: assms ConstFtor' ConstFunctor_def MakeFtor)
 
 definition 
   UnitFunctor :: "('o,'m,'a) Category_scheme \<Rightarrow> ('o,unit,'m,unit,'a,unit) Functor"  where
   "UnitFunctor C \<equiv> ConstFunctor C UnitCategory ()"
 
 lemma UnitFtor: 
   assumes "Category C" 
   shows "Functor(UnitFunctor C)"
 proof-
   have "() \<in> obj\<^bsub>UnitCategory\<^esub>" by (simp add: UnitCategory_def MakeCatObj)
   hence "Functor(ConstFunctor C UnitCategory ())" using assms 
     by (simp add: ConstFtor)
   thus ?thesis by (simp add: UnitFunctor_def)
 qed
 
 definition
   FunctorComp' :: "('o1,'o2,'m1,'m2,'a1,'a2) Functor \<Rightarrow> ('o2,'o3,'m2,'m3,'b1,'b2) Functor
                     \<Rightarrow> ('o1,'o3,'m1,'m3,'a1,'b2) Functor" (infixl ";;:" 71) where
   "FunctorComp' F G \<equiv> \<lparr>
         CatDom = CatDom F , 
         CatCod = CatCod G ,
         MapM   = \<lambda> f . (MapM G)((MapM F) f)
   \<rparr>"
 
 definition FunctorComp (infixl ";;;" 71) where "FunctorComp F G \<equiv> MakeFtor (FunctorComp' F G)"
 
 lemma FtorCompComp':
   assumes "f \<approx>>\<^bsub>CatDom F\<^esub> g"
   and "F \<approx>>;;; G"
   shows "G ## (F ## (f ;;\<^bsub>CatDom F\<^esub> g)) = (G ## (F ## f)) ;;\<^bsub>CatCod G\<^esub> (G ## (F ## g))"
 proof-
   have [simp]: "PreFunctor G \<and> PreFunctor F" using assms by auto
   have [simp]: "(F ## f) \<approx>>\<^bsub>CatDom G\<^esub> (F ## g)" using assms by (auto simp add: Functor.FunctorCompDef[of F f g])
   have "F ## (f ;;\<^bsub>CatDom F\<^esub> g) = (F ## f) ;;\<^bsub>CatCod F\<^esub> (F ## g)" using assms
     by (auto simp add: PreFunctor.FunctorComp)
   hence "G ## (F ## (f ;;\<^bsub>CatDom F\<^esub> g)) = G ## ((F ## f) ;;\<^bsub>CatCod F\<^esub> (F ## g))" by simp
   also have "... = G ## ((F ## f) ;;\<^bsub>CatDom G\<^esub> (F ## g))" using assms by auto
   also have "... = (G ## (F ## f)) ;;\<^bsub>CatCod G\<^esub> (G ## (F ## g))"
     by (simp add: PreFunctor.FunctorComp[of G "(F ## f)" "(F ## g)"])
   finally show ?thesis by simp
 qed
 
 lemma FtorCompId: 
   assumes a: "X \<in> (Obj (CatDom F))"
   and "F \<approx>>;;; G"
   shows "G ## (F ## (id\<^bsub>CatDom F \<^esub>X)) = id\<^bsub>CatCod G\<^esub>(G @@ (F @@ X)) \<and> G @@ (F @@ X) \<in> (Obj (CatCod G))"
 proof-
   have [simp]: "PreFunctor G \<and> PreFunctor F" using assms by auto
   have b: "(F @@ X) \<in> obj\<^bsub>CatDom G\<^esub>" using assms
     by (auto simp add: PreFunctor.FunctorId2)
   have "G ## F ## (id\<^bsub>CatDom F \<^esub>X) = G ## (id\<^bsub>CatCod F\<^esub>(F @@ X))" using b a
     by (simp add: PreFunctor.FunctorId2[of F "X"])
   also have "... = G ## (id\<^bsub>CatDom G\<^esub>(F @@ X))" using assms by auto
   also have "... = id\<^bsub>CatCod G\<^esub>(G @@ (F @@ X)) \<and> G @@ (F @@ X) \<in> (Obj (CatCod G))" using b
     by (simp add: PreFunctor.FunctorId2[of G "(F @@ X)"])
   finally show ?thesis by simp
 qed
 
 lemma FtorCompIdDef: 
   assumes a: "X \<in> (Obj (CatDom F))" and b: "PreFunctor (F ;;: G)" 
   and "F \<approx>>;;; G"
   shows "(F ;;: G) @@ X = (G @@ (F @@ X))"
 proof-
   have "(F ;;: G) ## (id\<^bsub>CatDom (F ;;: G)\<^esub>(X)) = G ## (F ## (id\<^bsub>CatDom F\<^esub>(X)))" using assms
     by (simp add: FunctorComp'_def)
   also have "... = id\<^bsub>CatCod G\<^esub>(G @@ (F @@ (X)))" using assms a
     by(auto simp add: FtorCompId[of _ F G])
   finally have "(F ;;: G) ## (id\<^bsub>CatDom (F ;;: G)\<^esub>(X)) = id\<^bsub>CatCod (F ;;: G)\<^esub>(G @@ (F @@ X))" using assms
     by (simp add: FunctorComp'_def)
   moreover have "G @@ (F @@ (X)) \<in> (Obj (CatCod (F ;;: G)))" using assms a
     by(auto simp add: FtorCompId[of _ F G] FunctorComp'_def)
   moreover have "X \<in> obj\<^bsub>CatDom (F ;;: G)\<^esub>" using a by (simp add: FunctorComp'_def)
   ultimately show ?thesis using b 
     by (simp add: PreFunctor.FmToFo[of "F ;;: G" X "G @@ (F @@ X)"])
 qed
 
 lemma FunctorCompMapsTo: 
   assumes "f \<in> mor\<^bsub>CatDom (F ;;: G)\<^esub>" and "F \<approx>>;;; G"
   shows "(G ## (F ## f)) maps\<^bsub>CatCod G\<^esub> (G @@ (F @@ (dom\<^bsub>CatDom F\<^esub> f))) to (G @@ (F @@ (cod\<^bsub>CatDom F\<^esub> f)))"
 proof-
   have "f \<in> mor\<^bsub>CatDom F \<^esub>\<and> Functor F" using assms by (auto simp add: FunctorComp'_def)
   hence "(F ## f) maps\<^bsub>CatDom G\<^esub> (F @@ (dom\<^bsub>CatDom F\<^esub> f)) to (F @@ (cod\<^bsub>CatDom F\<^esub> f))" using assms 
     by (auto simp add: Functor.FunctorMapsTo[of F f])
   moreover have "FunctorM G" using assms by (auto simp add: FunctorComp_def Functor_def)
   ultimately show ?thesis by(simp add: FunctorM.FunctorCompM[of G "F ## f" "F @@ (dom\<^bsub>CatDom F\<^esub> f)" "F @@ (cod\<^bsub>CatDom F\<^esub> f)"])
 qed
 
 lemma FunctorCompMapsTo2:
   assumes "f \<in> mor\<^bsub>CatDom (F ;;: G)\<^esub>" 
   and "F \<approx>>;;; G"
   and "PreFunctor (F ;;: G)" 
   shows "((F ;;: G) ## f) maps\<^bsub>CatCod (F ;;: G)\<^esub> ((F ;;: G) @@ (dom\<^bsub>CatDom (F ;;: G)\<^esub> f)) to 
                                                ((F ;;: G) @@ (cod\<^bsub>CatDom (F ;;: G)\<^esub> f))"
 proof-
   have "Category (CatDom (F ;;: G))" using assms by (simp add: PreFunctor_def) 
   hence 1: "(dom\<^bsub>CatDom (F ;;: G)\<^esub> f) \<in> obj\<^bsub>CatDom F \<^esub>\<and> (cod\<^bsub>CatDom (F ;;: G)\<^esub> f) \<in> obj\<^bsub>CatDom F\<^esub>" using assms 
     by (auto simp add: Category.Simps FunctorComp'_def)
   have "(G ## (F ## f)) maps\<^bsub>CatCod G\<^esub> (G @@ (F @@ (dom\<^bsub>CatDom F\<^esub> f))) to (G @@ (F @@ (cod\<^bsub>CatDom F\<^esub> f)))"
     using assms by (auto simp add: FunctorCompMapsTo[of f F G])
   moreover have "CatDom F = CatDom(F ;;: G) \<and> CatCod G = CatCod(F ;;: G) \<and> (G ## (F ## f)) = ((F ;;: G) ## f)" using assms
     by (simp add: FunctorComp'_def)
   moreover have "(F ;;: G) @@ (dom\<^bsub>CatDom (F ;;: G)\<^esub> f) = (G @@ (F @@ (dom\<^bsub>CatDom(F ;;: G)\<^esub> f))) \<and>
         (F ;;: G) @@ (cod\<^bsub>CatDom (F ;;: G)\<^esub> f) = (G @@ (F @@ (cod\<^bsub>CatDom(F ;;: G)\<^esub> f)))" 
     by (auto simp add: FtorCompIdDef[of _ F G] 1 assms)
   ultimately show ?thesis by auto
 qed
 
 lemma FunctorCompMapsTo3:
   assumes "f maps\<^bsub>CatDom (F ;;: G)\<^esub> X to Y"
   and "F \<approx>>;;; G"
   and "PreFunctor (F ;;: G)" 
   shows "F ;;: G ## f maps\<^bsub>CatCod (F ;;: G)\<^esub> F ;;: G @@ X to F ;;: G @@ Y"
 proof-
   have  "f \<in> mor\<^bsub>CatDom (F ;;: G)\<^esub>" 
     and "dom\<^bsub>CatDom (F ;;: G)\<^esub> f = X" 
     and "cod\<^bsub>CatDom (F ;;: G)\<^esub> f = Y" using assms by auto
   thus ?thesis using assms by (auto intro: FunctorCompMapsTo2)
 qed
 
 lemma FtorCompPreFtor:
   assumes "F \<approx>>;;; G"
   shows   "PreFunctor (F ;;: G)"
 proof-
   have 1: "PreFunctor G \<and> PreFunctor F" using assms by auto
   show "PreFunctor (F ;;: G)" using assms
   proof(auto simp add: PreFunctor_def FunctorComp'_def Category.Simps
        FtorCompId[of _ F G] intro:FtorCompComp')
     show "Category (CatDom F)" and "Category (CatCod G)" using assms 1 by (auto simp add: PreFunctor_def)
   qed
 qed
 
 lemma FtorCompM : 
   assumes "F \<approx>>;;; G"
   shows   "FunctorM (F ;;: G)"
 proof(auto simp only: FunctorM_def)
   show 1: "PreFunctor (F ;;: G)" using assms by (rule FtorCompPreFtor)
   {
     fix X Y f assume a: "f maps\<^bsub>CatDom (F ;;: G)\<^esub> X to Y"
     have "F ;;: G ## f maps\<^bsub>CatCod (F ;;: G)\<^esub> F ;;: G @@ X to F ;;: G @@ Y" 
       using a assms 1 by (rule FunctorCompMapsTo3)
   }
   thus "FunctorM_axioms (F ;;: G)" 
     by(auto simp add: 1 FunctorM_axioms_def)
 qed
 
 lemma FtorComp:   
   assumes "F \<approx>>;;; G"
   shows   "Functor (F ;;; G)"
 proof-
   have "FunctorM (F ;;: G)" using assms by (rule FtorCompM)
   thus ?thesis by (simp add: FunctorComp_def MakeFtor)
 qed
 
 lemma (in Functor) FunctorPreservesIso: 
   assumes     "ciso\<^bsub>CatDom F\<^esub> k"
   shows       "ciso\<^bsub>CatCod F\<^esub> (F ## k)"
 proof-
   have [simp]: "k \<in> mor\<^bsub>CatDom F\<^esub>" using assms by (simp add: Category.IsoIsMor)
   have "cinv\<^bsub>CatCod F\<^esub> (F ## k) (F ## (Cinv\<^bsub>CatDom F\<^esub> k))" 
     proof(rule Category.Inverse_relI)
       show "Category (CatCod F)" by simp
       show "(F ## k) \<approx>>\<^bsub>CatCod F\<^esub> (F ## (Cinv\<^bsub>CatDom F\<^esub> k))" 
         by (rule FunctorCompDef, simp add: Category.IsoCompInv assms)
       show "(F ## k) ;;\<^bsub>CatCod F\<^esub> (F ## (Cinv\<^bsub>CatDom F\<^esub> k)) = id\<^bsub>CatCod F\<^esub> (dom\<^bsub>CatCod F\<^esub> (F ## k))" 
       proof-
         have      "(F ## k) ;;\<^bsub>CatCod F\<^esub> (F ## (Cinv\<^bsub>CatDom F\<^esub> k)) = F ## (k ;;\<^bsub>CatDom F\<^esub> (Cinv\<^bsub>CatDom F\<^esub> k))" using assms
           by(auto simp add: FunctorComp Category.IsoCompInv)
         also have "... = F ## (id\<^bsub>CatDom F\<^esub> (dom\<^bsub>CatDom F\<^esub> k))" using assms by (simp add: Category.IsoInvId2)
         also have "... = id\<^bsub>CatCod F\<^esub> (dom\<^bsub>CatCod F\<^esub> (F ## k))" by (simp add: FunctorId3Dom) 
         finally show ?thesis by simp
       qed 
       show "(F ## (Cinv\<^bsub>CatDom F\<^esub> k)) ;;\<^bsub>CatCod F\<^esub> (F ## k) = id\<^bsub>CatCod F\<^esub> (cod\<^bsub>CatCod F\<^esub> (F ## k))" 
       proof-
         have      "(F ## (Cinv\<^bsub>CatDom F\<^esub> k)) ;;\<^bsub>CatCod F\<^esub> (F ## k) = F ## ((Cinv\<^bsub>CatDom F\<^esub> k) ;;\<^bsub>CatDom F\<^esub>  k)" using assms
           by(auto simp add: FunctorComp Category.InvCompIso)
         also have "... = F ## (id\<^bsub>CatDom F\<^esub> (cod\<^bsub>CatDom F\<^esub> k))" using assms by (simp add: Category.IsoInvId1)
         also have "... = id\<^bsub>CatCod F\<^esub> (cod\<^bsub>CatCod F\<^esub> (F ## k))" using assms by (simp add: FunctorId3Cod) 
         finally show ?thesis by simp
       qed   
     qed
   thus ?thesis by(auto simp add: isomorphism_def)
 qed
 
 declare PreFunctor.CatDom[simp] PreFunctor.CatCod [simp]
 
 lemma FunctorMFunctor[simp]: "Functor F \<Longrightarrow> FunctorM F"
 by (simp add: Functor_def)
 
 locale Equivalence = Functor +
   assumes Full: "\<lbrakk>A \<in> Obj (CatDom F) ; B \<in> Obj (CatDom F) ; 
                   h maps\<^bsub>CatCod F\<^esub> (F @@ A) to (F @@ B)\<rbrakk> \<Longrightarrow>
                  \<exists> f . (f maps\<^bsub>CatDom F\<^esub> A to B) \<and> (F ## f = h)"
   and Faithful: "\<lbrakk>f maps\<^bsub>CatDom F\<^esub> A to B ; g maps\<^bsub>CatDom F\<^esub> A to B ; F ## f = F ## g\<rbrakk> \<Longrightarrow> f = g"
   and IsoDense: "C \<in> Obj (CatCod F) \<Longrightarrow> \<exists> A \<in> Obj (CatDom F) . ObjIso (CatCod F) (F @@ A) C"
 
 end
diff --git a/thys/Category3/SetCategory.thy b/thys/Category3/SetCategory.thy
--- a/thys/Category3/SetCategory.thy
+++ b/thys/Category3/SetCategory.thy
@@ -1,2443 +1,2443 @@
 (*  Title:       SetCategory
     Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2016
     Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
 *)
 
 chapter SetCategory
 
 theory SetCategory
 imports Category Functor
 begin
 
   text\<open>
     This theory defines a locale \<open>set_category\<close> that axiomatizes the notion
     ``category of all @{typ 'a}-sets and functions between them'' in the context of HOL.
     A primary reason for doing this is to make it possible to prove results
     (such as the Yoneda Lemma) that use such categories without having to commit to a
     particular element type @{typ 'a} and without having the results depend on the
     concrete details of a particular construction.
     The axiomatization given here is categorical, in the sense that if categories
     @{term S} and @{term S'} each interpret the \<open>set_category\<close> locale,
     then a bijection between the sets of terminal objects of @{term S} and @{term S'}
     extends to an isomorphism of @{term S} and @{term S'} as categories.
 
     The axiomatization is based on the following idea: if, for some type @{typ 'a},
     category @{term S} is the category of all @{typ 'a}-sets and functions between
     them, then the elements of type @{typ 'a} are in bijective correspondence with
     the terminal objects of category @{term S}.  In addition, if @{term unity}
     is an arbitrarily chosen terminal object of @{term S}, then for each object @{term a},
     the hom-set @{term "hom unity a"} (\emph{i.e.} the set of ``points'' or
     ``global elements'' of @{term a}) is in bijective correspondence with a subset
     of the terminal objects of @{term S}.  By making a specific, but arbitrary,
     choice of such a correspondence, we can then associate with each object @{term a}
     of @{term S} a set @{term "set a"} that consists of all terminal objects @{term t}
     that correspond to some point @{term x} of @{term a}.  Each arrow @{term f}
     then induces a function \<open>Fun f \<in> set (dom f) \<rightarrow> set (cod f)\<close>,
     defined on terminal objects of @{term S} by passing to points of @{term "dom f"},
     composing with @{term f}, then passing back from points of @{term "cod f"}
     to terminal objects.  Once we can associate a set with each object of @{term S}
     and a function with each arrow, we can force @{term S} to be isomorphic to the
     category of @{typ 'a}-sets by imposing suitable extensionality and completeness axioms.
 \<close>
  
   section "Some Lemmas about Restriction"
 
     text\<open>
       \sloppypar
       The development of the \<open>set_category\<close> locale makes heavy use of the
       theory @{theory "HOL-Library.FuncSet"}.  However, in some cases, I found that
       that theory did not provide results about restriction in the form that was
       most useful to me. I used the following additional results in various places.
 \<close>
 
   (* This variant of FuncSet.restrict_ext is sometimes useful. *)
 
   lemma restr_eqI:
   assumes "A = A'" and "\<And>x. x \<in> A \<Longrightarrow> F x = F' x"
   shows "restrict F A = restrict F' A'"
     using assms by force
 
   (* This rule avoided a long proof in at least one instance
      where FuncSet.restrict_apply did not work.
    *)
   lemma restr_eqE [elim]:
   assumes "restrict F A = restrict F' A" and "x \<in> A"
   shows "F x = F' x"
     using assms restrict_def by metis
 
   (* This seems more useful than compose_eq in FuncSet. *)
   lemma compose_eq' [simp]:
   shows "compose A G F = restrict (G o F) A"
     unfolding compose_def restrict_def by auto
 
   section "Set Categories"
 
   text\<open>
     We first define the locale \<open>set_category_data\<close>, which sets out the basic
     data and definitions for the \<open>set_category\<close> locale, without imposing any conditions
     other than that @{term S} is a category and that @{term img} is a function defined
     on the arrow type of @{term S}.  The function @{term img} should be thought of
     as a mapping that takes a point @{term "x \<in> hom unity a"} to a corresponding
     terminal object @{term "img x"}.  Eventually, assumptions will be introduced so
     that this is in fact the case.
 \<close>
 
   locale set_category_data = category S
   for S :: "'s comp"      (infixr "\<cdot>" 55)
   and img :: "'s \<Rightarrow> 's"
   begin
 
     notation in_hom       ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
 
     text\<open>
       Call the set of all terminal objects of S the ``universe''.
 \<close>
     abbreviation Univ :: "'s set"
     where "Univ \<equiv> Collect terminal"
   
     text\<open>
       Choose an arbitrary element of the universe and call it @{term unity}.
 \<close>
     definition unity :: 's
     where "unity = (SOME t. terminal t)"
     
     text\<open>
       Each object @{term a} determines a subset @{term "set a"} of the universe,
       consisting of all those terminal objects @{term t} such that @{term "t = img x"}
       for some @{term "x \<in> hom unity a"}.
 \<close>
     definition set :: "'s \<Rightarrow> 's set"
     where "set a = img ` hom unity a"
 
     text\<open>
       The inverse of the map @{term set} is a map @{term mkIde} that takes each subset
       of the universe to an identity of @{term[source=true] S}.
 \<close>
     definition mkIde :: "'s set \<Rightarrow> 's"
     where "mkIde A = (if A \<subseteq> Univ then inv_into (Collect ide) set A else null)"
 
   end
 
   text\<open>
     Next, we define a locale \<open>set_category_given_img\<close> that augments the
     \<open>set_category_data\<close> locale with assumptions that serve to define
     the notion of a set category with a chosen correspondence between points
     and terminal objects.  The assumptions require that the universe be nonempty
     (so that the definition of @{term unity} makes sense), that the map
     @{term img} is a locally injective map taking points to terminal objects,
     that each terminal object @{term t} belongs to @{term "set t"},
     that two objects of @{term S} are equal if they determine the same set,
     that two parallel arrows of @{term S} are equal if they determine the same
     function, that there is an object corresponding to each subset of the universe,
     and for any objects @{term a} and @{term b} and function
     @{term "F \<in> hom unity a \<rightarrow> hom unity b"} there is an arrow @{term "f \<in> hom a b"}
     whose action under the composition of @{term S} coincides with the function @{term F}.
 \<close>
     
   locale set_category_given_img = set_category_data S img
   for S :: "'s comp"      (infixr "\<cdot>" 55)
   and img :: "'s \<Rightarrow> 's" +
   assumes nonempty_Univ: "Univ \<noteq> {}"
   and img_mapsto: "ide a \<Longrightarrow> img \<in> hom unity a \<rightarrow> Univ"
   and inj_img: "ide a \<Longrightarrow> inj_on img (hom unity a)"
   and stable_img: "terminal t \<Longrightarrow> t \<in> img ` hom unity t"
   and extensional_set: "\<lbrakk> ide a; ide b; set a = set b \<rbrakk> \<Longrightarrow> a = b"
   and extensional_arr: "\<lbrakk> par f f'; \<And>x. \<guillemotleft>x : unity \<rightarrow> dom f\<guillemotright> \<Longrightarrow> f \<cdot> x = f' \<cdot> x \<rbrakk> \<Longrightarrow> f = f'"
   and set_complete: "A \<subseteq> Univ \<Longrightarrow> \<exists>a. ide a \<and> set a = A"
   and fun_complete1: "\<lbrakk> ide a; ide b; F \<in> hom unity a \<rightarrow> hom unity b \<rbrakk>
                           \<Longrightarrow> \<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> (\<forall>x. \<guillemotleft>x : unity \<rightarrow> dom f\<guillemotright> \<longrightarrow> f \<cdot> x = F x)"
   begin
   
     text\<open>
       Each arrow @{term "f \<in> hom a b"} determines a function @{term "Fun f \<in> Univ \<rightarrow> Univ"},
       by passing from @{term Univ} to @{term "hom a unity"}, composing with @{term f},
       then passing back to @{term Univ}.
 \<close>
 
     definition Fun :: "'s \<Rightarrow> 's \<Rightarrow> 's"
     where "Fun f = restrict (img o S f o inv_into (hom unity (dom f)) img) (set (dom f))"
 
     lemma comp_arr_point:
     assumes "arr f" and "\<guillemotleft>x : unity \<rightarrow> dom f\<guillemotright>"
     shows "f \<cdot> x = inv_into (hom unity (cod f)) img (Fun f (img x))"
     proof -
       have "\<guillemotleft>f \<cdot> x : unity \<rightarrow> cod f\<guillemotright>"
         using assms by blast
       thus ?thesis
         using assms Fun_def inj_img set_def by simp
     qed
       
     text\<open>
       Parallel arrows that determine the same function are equal.
 \<close>
 
     lemma arr_eqI:
     assumes "par f f'" and "Fun f = Fun f'"
     shows "f = f'"
       using assms comp_arr_point extensional_arr by metis
 
     lemma terminal_unity:
     shows "terminal unity"
       using unity_def nonempty_Univ by (simp add: someI_ex)
 
     lemma ide_unity [simp]:
     shows "ide unity"
       using terminal_unity terminal_def by blast
 
     lemma set_subset_Univ [simp]:
     assumes "ide a"
     shows "set a \<subseteq> Univ"
       using assms set_def img_mapsto by auto
   
     lemma inj_on_set:
     shows "inj_on set (Collect ide)"
       using extensional_set by (intro inj_onI, auto)
       
     text\<open>
       The mapping @{term mkIde}, which takes subsets of the universe to identities,
       and @{term set}, which takes identities to subsets of the universe, are inverses.
 \<close>
 
     lemma mkIde_set [simp]:
     assumes "ide a"
     shows "mkIde (set a) = a"
       using assms mkIde_def inj_on_set inv_into_f_f by simp
 
     lemma set_mkIde [simp]:
     assumes "A \<subseteq> Univ"
     shows "set (mkIde A) = A"
       using assms mkIde_def set_complete someI_ex [of "\<lambda>a. a \<in> Collect ide \<and> set a = A"]
       by (simp add: inv_into_def)
       
     lemma ide_mkIde [simp]:
     assumes "A \<subseteq> Univ"
     shows "ide (mkIde A)"
       using assms mkIde_def mkIde_set set_complete by metis
       
     lemma arr_mkIde [iff]:
     shows "arr (mkIde A) \<longleftrightarrow> A \<subseteq> Univ"
       using not_arr_null mkIde_def ide_mkIde by auto
     
     lemma dom_mkIde [simp]:
     assumes "A \<subseteq> Univ"
     shows "dom (mkIde A) = mkIde A"
       using assms ide_mkIde by simp
     
     lemma cod_mkIde [simp]:
     assumes "A \<subseteq> Univ"
     shows "cod (mkIde A) = mkIde A"
       using assms ide_mkIde by simp
       
     text\<open>
       Each arrow @{term f} determines an extensional function from
       @{term "set (dom f)"} to @{term "set (cod f)"}.
 \<close>
 
     lemma Fun_mapsto:
     assumes "arr f"
     shows "Fun f \<in> extensional (set (dom f)) \<inter> (set (dom f) \<rightarrow> set (cod f))"
     proof
       show "Fun f \<in> extensional (set (dom f))" using Fun_def by fastforce
       show "Fun f \<in> set (dom f) \<rightarrow> set (cod f)"
       proof
         fix t
         assume t: "t \<in> set (dom f)"
         have "Fun f t = img (f \<cdot> inv_into (hom unity (dom f)) img t)"
           using assms t Fun_def comp_def by simp
         moreover have "... \<in> set (cod f)"
           using assms t set_def inv_into_into [of t img "hom unity (dom f)"] by blast
         ultimately show "Fun f t \<in> set (cod f)" by auto
       qed
     qed
     
     text\<open>
       Identities of @{term[source=true] S} correspond to restrictions of the identity function.
 \<close>
 
     lemma Fun_ide [simp]:
     assumes "ide a"
     shows "Fun a = restrict (\<lambda>x. x) (set a)"
       using assms Fun_def inj_img set_def comp_cod_arr by fastforce
     
     lemma Fun_mkIde [simp]:
     assumes "A \<subseteq> Univ"
     shows "Fun (mkIde A) = restrict (\<lambda>x. x) A"
       using assms by simp
     
     text\<open>
       Composition in @{term S} corresponds to extensional function composition.
 \<close>
 
     lemma Fun_comp [simp]:
     assumes "seq g f"
     shows "Fun (g \<cdot> f) = restrict (Fun g o Fun f) (set (dom f))"
     proof -
       have "restrict (img o S (g \<cdot> f) o (inv_into (hom unity (dom (g \<cdot> f))) img))
                      (set (dom (g \<cdot> f)))
               = restrict (Fun g o Fun f) (set (dom f))"
       proof -
         have 1: "set (dom (g \<cdot> f)) = set (dom f)"
           using assms by auto
         let ?img' = "\<lambda>a. \<lambda>t. inv_into (hom unity a) img t"
         have 2: "\<And>t. t \<in> set (dom (g \<cdot> f)) \<Longrightarrow>
                      (img o S (g \<cdot> f) o ?img' (dom (g \<cdot> f))) t = (Fun g o Fun f) t"
         proof -
           fix t
           assume "t \<in> set (dom (g \<cdot> f))"
           hence t: "t \<in> set (dom f)" by (simp add: 1)
           have 3: "\<And>a x. x \<in> hom unity a \<Longrightarrow> ?img' a (img x) = x"
             using assms img_mapsto inj_img ide_cod inv_into_f_eq
             by (metis arrI in_homE mem_Collect_eq)
           have 4: "?img' (dom f) t \<in> hom unity (dom f)"
             using assms t inv_into_into [of t img "hom unity (dom f)"] set_def by simp
           have "(img o S (g \<cdot> f) o ?img' (dom (g \<cdot> f))) t = img (g \<cdot> f \<cdot> ?img' (dom f) t)"
             using assms dom_comp comp_assoc by simp
           also have "... = img (g \<cdot> ?img' (dom g) (Fun f t))"
             using assms t 3 Fun_def set_def comp_arr_point by auto
           also have "... = Fun g (Fun f t)"
           proof -
             have "Fun f t \<in> img ` hom unity (cod f)"
               using assms t Fun_mapsto set_def by fast
             thus ?thesis using assms by (auto simp add: set_def Fun_def)
           qed
           finally show "(img o S (g \<cdot> f) o ?img' (dom (g \<cdot> f))) t = (Fun g o Fun f) t"
             by auto
         qed
         show ?thesis using 1 2 by auto
       qed
       thus ?thesis using Fun_def by auto
     qed
 
     text\<open>
       The constructor @{term mkArr} is used to obtain an arrow given subsets
       @{term A} and @{term B} of the universe and a function @{term "F \<in> A \<rightarrow> B"}.
 \<close>
     
     definition mkArr :: "'s set \<Rightarrow> 's set \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> 's"
     where "mkArr A B F = (if A \<subseteq> Univ \<and> B \<subseteq> Univ \<and> F \<in> A \<rightarrow> B
                           then (THE f. f \<in> hom (mkIde A) (mkIde B) \<and> Fun f = restrict F A)
                           else null)"
 
     text\<open>
       Each function @{term "F \<in> set a \<rightarrow> set b"} determines a unique arrow @{term "f \<in> hom a b"},
       such that @{term "Fun f"} is the restriction of @{term F} to @{term "set a"}.
 \<close>
 
     lemma fun_complete:
     assumes "ide a" and "ide b" and "F \<in> set a \<rightarrow> set b"
     shows "\<exists>!f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> Fun f = restrict F (set a)"
     proof -
       let ?P = "\<lambda>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> Fun f = restrict F (set a)"
       show "\<exists>!f. ?P f"
       proof
         have "\<exists>f. ?P f"
         proof -
           let ?F' = "\<lambda>x. inv_into (hom unity b) img (F (img x))"
           have "?F' \<in> hom unity a \<rightarrow> hom unity b"
           proof
             fix x
             assume x: "x \<in> hom unity a"
             have "F (img x) \<in> set b" using assms(3) x set_def by auto
             thus "inv_into (hom unity b) img (F (img x)) \<in> hom unity b"
               using assms img_mapsto inj_img set_def by auto
           qed
           hence "\<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> (\<forall>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<longrightarrow> f \<cdot> x = ?F' x)"
             using assms fun_complete1 by force
           from this obtain f where f: "\<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> (\<forall>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<longrightarrow> f \<cdot> x = ?F' x)"
             by blast
           let ?img' = "\<lambda>a. \<lambda>t. inv_into (hom unity a) img t"
           have "Fun f = restrict F (set a)"
           proof (unfold Fun_def, intro restr_eqI)
             show "set (dom f) = set a" using f by auto
             show "\<And>t. t \<in> set (dom f) \<Longrightarrow> (img \<circ> S f \<circ> ?img' (dom f)) t = F t"
             proof -
               fix t
               assume t: "t \<in> set (dom f)"
               have "(img \<circ> S f \<circ> ?img' (dom f)) t = img (f \<cdot> ?img' (dom f) t)"
                 by simp
               also have "... = img (?F' (?img' (dom f) t))"
               proof -
                 have "?img' (dom f) t \<in> hom unity (dom f)"
                   using t set_def inv_into_into by metis
                 thus ?thesis using f by auto
               qed
               also have "... = img (?img' (cod f) (F t))"
                 using f t set_def inj_img by auto
               also have "... = F t"
               proof -
                 have "F t \<in> set (cod f)"
                   using assms f t by auto
                 thus ?thesis
                   using f t set_def inj_img by auto
               qed
               finally show "(img \<circ> S f \<circ> ?img' (dom f)) t = F t" by auto
             qed
           qed
           thus ?thesis using f by blast
         qed
         thus F: "?P (SOME f. ?P f)" using someI_ex [of ?P] by fast
         show "\<And>f'. ?P f' \<Longrightarrow> f' = (SOME f. ?P f)"
           using F arr_eqI
           by (metis (no_types, lifting) in_homE)
       qed
     qed
                           
     lemma mkArr_in_hom:
     assumes "A \<subseteq> Univ" and "B \<subseteq> Univ" and "F \<in> A \<rightarrow> B"
     shows "\<guillemotleft>mkArr A B F : mkIde A \<rightarrow> mkIde B\<guillemotright>"
       using assms mkArr_def fun_complete [of "mkIde A" "mkIde B" F]
             theI' [of "\<lambda>f. f \<in> hom (mkIde A) (mkIde B) \<and> Fun f = restrict F A"]
       by simp
 
     text\<open>
       The ``only if'' direction of the next lemma can be achieved only if there exists a
       non-arrow element of type @{typ 's}, which can be used as the value of @{term "mkArr A B F"}
       in cases where @{term "F \<notin> A \<rightarrow> B"}.  Nevertheless, it is essential to have this,
       because without the ``only if'' direction, we can't derive any useful
       consequences from an assumption of the form @{term "arr (mkArr A B F)"};
       instead we have to obtain @{term "F \<in> A \<rightarrow> B"} some other way.
       This is is usually highly inconvenient and it makes the theory very weak and almost
       unusable in practice.  The observation that having a non-arrow value of type @{typ 's}
       solves this problem is ultimately what led me to incorporate @{term null} first into the
       definition of the \<open>set_category\<close> locale and then, ultimately, into the definition
       of the \<open>category\<close> locale.  I believe this idea is critical to the usability of the
       entire development.
 \<close>
 
     (* TODO: This gets used as an introduction rule, but the conjunction on the right-hand side
        is not very convenient. *)
     lemma arr_mkArr [iff]:
     shows "arr (mkArr A B F) \<longleftrightarrow> A \<subseteq> Univ \<and> B \<subseteq> Univ \<and> F \<in> A \<rightarrow> B"
     proof
       show "arr (mkArr A B F) \<Longrightarrow> A \<subseteq> Univ \<and> B \<subseteq> Univ \<and> F \<in> A \<rightarrow> B"
         using mkArr_def not_arr_null ex_un_null someI_ex [of "\<lambda>f. \<not>arr f"] by metis
       show "A \<subseteq> Univ \<and> B \<subseteq> Univ \<and> F \<in> A \<rightarrow> B \<Longrightarrow> arr (mkArr A B F)"
         using mkArr_in_hom by auto
     qed
     
     lemma Fun_mkArr':
     assumes "arr (mkArr A B F)"
     shows "\<guillemotleft>mkArr A B F : mkIde A \<rightarrow> mkIde B\<guillemotright>"
     and "Fun (mkArr A B F) = restrict F A"
     proof -
       have 1: "A \<subseteq> Univ \<and> B \<subseteq> Univ \<and> F \<in> A \<rightarrow> B" using assms by fast
       have 2: "mkArr A B F \<in> hom (mkIde A) (mkIde B) \<and>
                      Fun (mkArr A B F) = restrict F (set (mkIde A))"
       proof -
         have "\<exists>!f. f \<in> hom (mkIde A) (mkIde B) \<and> Fun f = restrict F (set (mkIde A))"
           using 1 fun_complete [of "mkIde A" "mkIde B" F] by simp
         thus ?thesis using 1 mkArr_def theI' by simp
       qed
       show "\<guillemotleft>mkArr A B F : mkIde A \<rightarrow> mkIde B\<guillemotright>" using 1 2 by auto
       show "Fun (mkArr A B F) = restrict F A" using 1 2 by auto
     qed
 
     lemma mkArr_Fun [simp]:
     assumes "arr f"
     shows "mkArr (set (dom f)) (set (cod f)) (Fun f) = f"
     proof -
       have 1: "set (dom f) \<subseteq> Univ \<and> set (cod f) \<subseteq> Univ \<and> ide (dom f) \<and> ide (cod f) \<and>
                Fun f \<in> extensional (set (dom f)) \<inter> (set (dom f) \<rightarrow> set (cod f))"
         using assms Fun_mapsto by force
       hence "\<exists>!f'. f' \<in> hom (dom f) (cod f) \<and> Fun f' = restrict (Fun f) (set (dom f))"
         using fun_complete by force
       moreover have "f \<in> hom (dom f) (cod f) \<and> Fun f = restrict (Fun f) (set (dom f))"
         using assms 1 extensional_restrict by force
       ultimately have "f = (THE f'. f' \<in> hom (dom f) (cod f) \<and>
                                     Fun f' = restrict (Fun f) (set (dom f)))"
         using theI' [of "\<lambda>f'. f' \<in> hom (dom f) (cod f) \<and> Fun f' = restrict (Fun f) (set (dom f))"]
         by blast
       also have "... = mkArr (set (dom f)) (set (cod f)) (Fun f)"
         using assms 1 mkArr_def by simp
       finally show ?thesis by auto
     qed
     
     lemma dom_mkArr [simp]:
     assumes "arr (mkArr A B F)"
     shows "dom (mkArr A B F) = mkIde A"
       using assms Fun_mkArr' by auto
         
     lemma cod_mkArr [simp]:
     assumes "arr (mkArr A B F)"
     shows "cod (mkArr A B F) = mkIde B"
       using assms Fun_mkArr' by auto
      
     lemma Fun_mkArr [simp]:
     assumes "arr (mkArr A B F)"
     shows "Fun (mkArr A B F) = restrict F A"
       using assms Fun_mkArr' by auto
 
     text\<open>
       The following provides the basic technique for showing that arrows
       constructed using @{term mkArr} are equal.
 \<close>
 
     lemma mkArr_eqI [intro]:
     assumes "arr (mkArr A B F)"
     and "A = A'" and "B = B'" and "\<And>x. x \<in> A \<Longrightarrow> F x = F' x"
     shows "mkArr A B F = mkArr A' B' F'"
       using assms arr_mkArr Fun_mkArr
       by (intro arr_eqI, auto simp add: Pi_iff)
 
     text\<open>
       This version avoids trivial proof obligations when the domain and codomain
       sets are identical from the context.
 \<close>
     
     lemma mkArr_eqI' [intro]:
     assumes "arr (mkArr A B F)" and "\<And>x. x \<in> A \<Longrightarrow> F x = F' x"
     shows "mkArr A B F = mkArr A B F'"
       using assms mkArr_eqI by simp
     
     lemma mkArr_restrict_eq [simp]:
     assumes "arr (mkArr A B F)"
     shows "mkArr A B (restrict F A) = mkArr A B F"
       using assms by (intro mkArr_eqI', auto)
       
     lemma mkArr_restrict_eq':
     assumes "arr (mkArr A B (restrict F A))"
     shows "mkArr A B (restrict F A) = mkArr A B F"
       using assms by (intro mkArr_eqI', auto)
       
     lemma mkIde_as_mkArr [simp]:
     assumes "A \<subseteq> Univ"
     shows "mkArr A A (\<lambda>x. x) = mkIde A"
       using assms by (intro arr_eqI, auto)
 
     lemma comp_mkArr [simp]:
     assumes "arr (mkArr A B F)" and "arr (mkArr B C G)"
     shows "mkArr B C G \<cdot> mkArr A B F = mkArr A C (G \<circ> F)"
     proof (intro arr_eqI)
       have 1: "seq (mkArr B C G) (mkArr A B F)" using assms by force
       have 2: "G o F \<in> A \<rightarrow> C" using assms by auto
       show "par (mkArr B C G \<cdot> mkArr A B F) (mkArr A C (G \<circ> F))"
         using 1 2 by auto
       show "Fun (mkArr B C G \<cdot> mkArr A B F) = Fun (mkArr A C (G \<circ> F))"
         using 1 2 by fastforce
     qed
     
     text\<open>
       The locale assumption @{prop stable_img} forces @{term "t \<in> set t"} in case
       @{term t} is a terminal object.  This is very convenient, as it results in the
       characterization of terminal objects as identities @{term t} for which
       @{term "set t = {t}"}.  However, it is not absolutely necessary to have this.
       The following weaker characterization of terminal objects can be proved without
       the @{prop stable_img} assumption.
 \<close>
 
     lemma terminal_char1:
     shows "terminal t \<longleftrightarrow> ide t \<and> (\<exists>!x. x \<in> set t)"
     proof -
       have "terminal t \<Longrightarrow> ide t \<and> (\<exists>!x. x \<in> set t)"
       proof -
         assume t: "terminal t"
         have "ide t" using t terminal_def by auto
         moreover have "\<exists>!x. x \<in> set t"
         proof -
           have "\<exists>!x. x \<in> hom unity t"
             using t terminal_unity terminal_def by auto
           thus ?thesis using set_def by auto
         qed
         ultimately show "ide t \<and> (\<exists>!x. x \<in> set t)" by auto
       qed
       moreover have "ide t \<and> (\<exists>!x. x \<in> set t) \<Longrightarrow> terminal t"
       proof -
         assume t: "ide t \<and> (\<exists>!x. x \<in> set t)"
         from this obtain t' where "set t = {t'}" by blast
         hence t': "set t = {t'} \<and> {t'} \<subseteq> Univ \<and> t = mkIde {t'}"
           using t set_subset_Univ mkIde_set by metis
         show "terminal t"
         proof
           show "ide t" using t by simp
           show "\<And>a. ide a \<Longrightarrow> \<exists>!f. \<guillemotleft>f : a \<rightarrow> t\<guillemotright>"
           proof -
             fix a
             assume a: "ide a"
             show "\<exists>!f. \<guillemotleft>f : a \<rightarrow> t\<guillemotright>"
             proof
               show 1: "\<guillemotleft>mkArr (set a) {t'} (\<lambda>x. t') : a \<rightarrow> t\<guillemotright>"
                 using a t t' mkArr_in_hom
                 by (metis Pi_I' mkIde_set set_subset_Univ singletonD)
               show "\<And>f. \<guillemotleft>f : a \<rightarrow> t\<guillemotright> \<Longrightarrow> f = mkArr (set a) {t'} (\<lambda>x. t')"
               proof -
                 fix f
                 assume f: "\<guillemotleft>f : a \<rightarrow> t\<guillemotright>"
                 show "f = mkArr (set a) {t'} (\<lambda>x. t')"
                 proof (intro arr_eqI)
                   show 1: "par f (mkArr (set a) {t'} (\<lambda>x. t'))" using 1 f in_homE by metis
                   show "Fun f = Fun (mkArr (set a) {t'} (\<lambda>x. t'))"
                   proof -
                     have "Fun (mkArr (set a) {t'} (\<lambda>x. t')) = (\<lambda>x\<in>set a. t')"
                       using 1 Fun_mkArr by simp
                     also have "... = Fun f"
                     proof -
                       have "\<And>x. x \<in> set a \<Longrightarrow> Fun f x = t'"
                         using f t' Fun_def mkArr_Fun arr_mkArr
                         by (metis PiE in_homE singletonD)
                       moreover have "\<And>x. x \<notin> set a \<Longrightarrow> Fun f x = undefined"
                         using f Fun_def by auto
                       ultimately show ?thesis by auto
                     qed
                     finally show ?thesis by force
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
       ultimately show ?thesis by blast
     qed
     
     text\<open>
       As stated above, in the presence of the @{prop stable_img} assumption we have
       the following stronger characterization of terminal objects.
 \<close>
 
     lemma terminal_char2:
     shows "terminal t \<longleftrightarrow> ide t \<and> set t = {t}"
     proof
       assume t: "terminal t"
       show "ide t \<and> set t = {t}"
       proof
         show "ide t" using t terminal_char1 by auto
         show "set t = {t}"
         proof -
           have "\<exists>!x. x \<in> hom unity t" using t terminal_def terminal_unity by force
           moreover have "t \<in> img ` hom unity t" using t stable_img set_def by simp
           ultimately show ?thesis using set_def by auto
         qed
       qed
       next
       assume "ide t \<and> set t = {t}"
       thus "terminal t" using terminal_char1 by force
     qed
 
   end
 
   text\<open>
     At last, we define the \<open>set_category\<close> locale by existentially quantifying
     out the choice of a particular @{term img} map.  We need to know that such a map
     exists, but it does not matter which one we choose.
 \<close>
 
   locale set_category = category S
   for S :: "'s comp"      (infixr "\<cdot>" 55) +
   assumes ex_img: "\<exists>img. set_category_given_img S img"
   begin
 
     notation in_hom ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
   
     definition some_img
     where "some_img = (SOME img. set_category_given_img S img)"
    
   end
   
   sublocale set_category \<subseteq> set_category_given_img S some_img
   proof -
     have "\<exists>img. set_category_given_img S img" using ex_img by auto
     thus "set_category_given_img S some_img" 
       using someI_ex [of "\<lambda>img. set_category_given_img S img"] some_img_def
       by metis
   qed
 
   context set_category
   begin
 
     text\<open>
       The arbitrary choice of @{term img} induces a system of inclusions,
       which are arrows corresponding to inclusions of subsets.
 \<close>
 
     definition incl :: "'s \<Rightarrow> bool"
     where "incl f = (arr f \<and> set (dom f) \<subseteq> set (cod f) \<and>
                      f = mkArr (set (dom f)) (set (cod f)) (\<lambda>x. x))"
 
     lemma Fun_incl:
     assumes "incl f"
     shows "Fun f = (\<lambda>x \<in> set (dom f). x)"
       using assms incl_def by (metis Fun_mkArr)
 
     lemma ex_incl_iff_subset:
     assumes "ide a" and "ide b"
     shows "(\<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> incl f) \<longleftrightarrow> set a \<subseteq> set b"
     proof
       show "\<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> incl f \<Longrightarrow> set a \<subseteq> set b"
         using incl_def by auto
       show "set a \<subseteq> set b \<Longrightarrow> \<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> incl f"
       proof
         assume 1: "set a \<subseteq> set b"
         show "\<guillemotleft>mkArr (set a) (set b) (\<lambda>x. x) : a \<rightarrow> b\<guillemotright> \<and> incl (mkArr (set a) (set b) (\<lambda>x. x))"
         proof
           show "\<guillemotleft>mkArr (set a) (set b) (\<lambda>x. x) : a \<rightarrow> b\<guillemotright>"
           proof -
             have "(\<lambda>x. x) \<in> set a \<rightarrow> set b" using 1 by auto
             thus ?thesis
               using assms mkArr_in_hom set_subset_Univ in_homI by auto
           qed
           thus "incl (mkArr (set a) (set b) (\<lambda>x. x))"
             using 1 incl_def by force
         qed
       qed
     qed
 
   end
 
   section "Categoricity"
 
   text\<open>
     In this section we show that the \<open>set_category\<close> locale completely characterizes
     the structure of its interpretations as categories, in the sense that for any two
     interpretations @{term S} and @{term S'}, a bijection between the universe of @{term S}
     and the universe of @{term S'} extends to an isomorphism of @{term S} and @{term S'}.
 \<close>
   
   locale two_set_categories_bij_betw_Univ =
     S: set_category S +
     S': set_category S'
   for S :: "'s comp"      (infixr "\<cdot>" 55)
   and S' :: "'t comp"     (infixr "\<cdot>\<acute>" 55)
   and \<phi> :: "'s \<Rightarrow> 't" +
   assumes bij_\<phi>: "bij_betw \<phi> S.Univ S'.Univ"
   begin
 
     notation S.in_hom     ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
-    notation S'.in_hom    ("\<guillemotleft>_ : _ \<rightarrow>' _\<guillemotright>")
+    notation S'.in_hom    ("\<guillemotleft>_ : _ \<rightarrow>'' _\<guillemotright>")
 
     abbreviation \<psi>
     where "\<psi> \<equiv> inv_into S.Univ \<phi>"
 
     lemma \<psi>_\<phi>:
     assumes "t \<in> S.Univ"
     shows "\<psi> (\<phi> t) = t"
       using assms bij_\<phi> bij_betw_inv_into_left by metis
 
     lemma \<phi>_\<psi>:
     assumes "t' \<in> S'.Univ"
     shows "\<phi> (\<psi> t') = t'"
       using assms bij_\<phi> bij_betw_inv_into_right by metis
     
     lemma \<psi>_img_\<phi>_img:
     assumes "A \<subseteq> S.Univ"
     shows "\<psi> ` \<phi> ` A = A"
       using assms bij_\<phi> by (simp add: bij_betw_def)
       
     lemma \<phi>_img_\<psi>_img:
     assumes "A' \<subseteq> S'.Univ"
     shows "\<phi> ` \<psi> ` A' = A'"
       using assms bij_\<phi> by (simp add: bij_betw_def image_inv_into_cancel)
   
     text\<open>
       The object map @{term \<Phi>o} of a functor from @{term[source=true] S}
       to @{term[source=true] S'}.
 \<close>
 
     definition \<Phi>o
     where "\<Phi>o = (\<lambda>a \<in> Collect S.ide. S'.mkIde (\<phi> ` S.set a))"
 
     lemma set_\<Phi>o:
     assumes "S.ide a"
     shows "S'.set (\<Phi>o a) = \<phi> ` S.set a"
     proof -
       from assms have "S.set a \<subseteq> S.Univ" by simp
       then show ?thesis
       using S'.set_mkIde \<Phi>o_def assms bij_\<phi> bij_betw_def image_mono mem_Collect_eq restrict_def
       by (metis (no_types, lifting))
     qed
 
     lemma \<Phi>o_preserves_ide:
     assumes "S.ide a"
     shows "S'.ide (\<Phi>o a)"
       using assms S'.ide_mkIde S.set_subset_Univ bij_\<phi> bij_betw_def image_mono restrict_apply'
       unfolding \<Phi>o_def
       by (metis (mono_tags, lifting) mem_Collect_eq)
       
     text\<open>
       The map @{term \<Phi>a} assigns to each arrow @{term f} of @{term[source=true] S} the function on
       the universe of @{term[source=true] S'} that is the same as the function induced by @{term f}
       on the universe of @{term[source=true] S}, up to the bijection @{term \<phi>} between the two
       universes.
 \<close>
 
     definition \<Phi>a
     where "\<Phi>a = (\<lambda>f. \<lambda>x' \<in> \<phi> ` S.set (S.dom f). \<phi> (S.Fun f (\<psi> x')))"
     
     lemma \<Phi>a_mapsto:
     assumes "S.arr f"
     shows "\<Phi>a f \<in> S'.set (\<Phi>o (S.dom f)) \<rightarrow> S'.set (\<Phi>o (S.cod f))"
     proof -
       have "\<Phi>a f \<in> \<phi> ` S.set (S.dom f) \<rightarrow> \<phi> ` S.set (S.cod f)"
       proof
         fix x
         assume x: "x \<in> \<phi> ` S.set (S.dom f)"
         have "\<psi> x \<in> S.set (S.dom f)"
           using assms x \<psi>_img_\<phi>_img [of "S.set (S.dom f)"] S.set_subset_Univ by auto
         hence "S.Fun f (\<psi> x) \<in> S.set (S.cod f)" using assms S.Fun_mapsto by auto
         hence "\<phi> (S.Fun f (\<psi> x)) \<in> \<phi> ` S.set (S.cod f)" by simp
         thus "\<Phi>a f x \<in> \<phi> ` S.set (S.cod f)" using x \<Phi>a_def by auto
       qed
       thus ?thesis using assms set_\<Phi>o \<Phi>o_preserves_ide by auto
     qed
     
     text\<open>
       The map @{term \<Phi>a} takes composition of arrows to extensional
       composition of functions.
 \<close>
 
     lemma \<Phi>a_comp:
     assumes gf: "S.seq g f"
     shows "\<Phi>a (g \<cdot> f) = restrict (\<Phi>a g o \<Phi>a f) (S'.set (\<Phi>o (S.dom f)))"
     proof -
       have "\<Phi>a (g \<cdot> f) = (\<lambda>x' \<in> \<phi> ` S.set (S.dom f). \<phi> (S.Fun (S g f) (\<psi> x')))"
         using gf \<Phi>a_def by auto
       also have "... = (\<lambda>x' \<in> \<phi> ` S.set (S.dom f).
                            \<phi> (restrict (S.Fun g o S.Fun f) (S.set (S.dom f)) (\<psi> x')))"
         using gf set_\<Phi>o S.Fun_comp by simp
       also have "... = restrict (\<Phi>a g o \<Phi>a f) (S'.set (\<Phi>o (S.dom f)))"
       proof -
         have "\<And>x'. x' \<in> \<phi> ` S.set (S.dom f)
                  \<Longrightarrow> \<phi> (restrict (S.Fun g o S.Fun f) (S.set (S.dom f)) (\<psi> x')) = \<Phi>a g (\<Phi>a f x')"
         proof -
           fix x'
           assume X': "x' \<in> \<phi> ` S.set (S.dom f)"
           hence 1: "\<psi> x' \<in> S.set (S.dom f)"
             using gf \<psi>_img_\<phi>_img [of "S.set (S.dom f)"] S.set_subset_Univ S.ide_dom by blast
           hence "\<phi> (restrict (S.Fun g o S.Fun f) (S.set (S.dom f)) (\<psi> x'))
                    = \<phi> (S.Fun g (S.Fun f (\<psi> x')))"
             using restrict_apply by auto
           also have "... = \<phi> (S.Fun g (\<psi> (\<phi> (S.Fun f (\<psi> x')))))"
           proof -
             have "S.Fun f (\<psi> x') \<in> S.set (S.cod f)"
               using gf 1 S.Fun_mapsto by fast
             hence "\<psi> (\<phi> (S.Fun f (\<psi> x'))) = S.Fun f (\<psi> x')"
               using assms bij_\<phi> S.set_subset_Univ bij_betw_def inv_into_f_f subsetCE S.ide_cod
               by (metis S.seqE)
             thus ?thesis by auto
           qed
           also have "... = \<Phi>a g (\<Phi>a f x')"
           proof -
             have "\<Phi>a f x' \<in> \<phi> ` S.set (S.cod f)"
               using gf S.ide_dom S.ide_cod X' \<Phi>a_mapsto [of f] set_\<Phi>o [of "S.dom f"]
                     set_\<Phi>o [of "S.cod f"]
               by blast
             thus ?thesis using gf X' \<Phi>a_def by auto
           qed
           finally show "\<phi> (restrict (S.Fun g o S.Fun f) (S.set (S.dom f)) (\<psi> x')) =
                         \<Phi>a g (\<Phi>a f x')"
             by auto
         qed
         thus ?thesis using assms set_\<Phi>o by fastforce
       qed
       finally show ?thesis by auto
     qed
     
     text\<open>
       Finally, we use @{term \<Phi>o} and @{term \<Phi>a} to define a functor @{term \<Phi>}.
 \<close>
 
     definition \<Phi>
     where "\<Phi> f = (if S.arr f then
                      S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod f))) (\<Phi>a f)
                    else S'.null)"
     
     lemma \<Phi>_in_hom:
     assumes "S.arr f"
     shows "\<Phi> f \<in> S'.hom (\<Phi>o (S.dom f)) (\<Phi>o (S.cod f))"
     proof -
       have "\<guillemotleft>\<Phi> f : S'.dom (\<Phi> f) \<rightarrow>' S'.cod (\<Phi> f)\<guillemotright>"
         using assms \<Phi>_def \<Phi>a_mapsto \<Phi>o_preserves_ide
         by (intro S'.in_homI, auto)
       thus ?thesis
         using assms \<Phi>_def \<Phi>a_mapsto \<Phi>o_preserves_ide by auto
     qed
 
     lemma \<Phi>_ide [simp]:
     assumes "S.ide a"
     shows "\<Phi> a = \<Phi>o a"
     proof -
       have "\<Phi> a = S'.mkArr (S'.set (\<Phi>o a)) (S'.set (\<Phi>o a)) (\<lambda>x'. x')"
       proof -
         have "\<guillemotleft>\<Phi> a : \<Phi>o a \<rightarrow>' \<Phi>o a\<guillemotright>"
           using assms \<Phi>_in_hom S.ide_in_hom by fastforce
         moreover have "\<Phi>a a = restrict (\<lambda>x'. x') (S'.set (\<Phi>o a))"
         proof -
           have "\<Phi>a a = (\<lambda>x' \<in> \<phi> ` S.set a. \<phi> (S.Fun a (\<psi> x')))"
             using assms \<Phi>a_def restrict_apply by auto
           also have "... = (\<lambda>x' \<in> S'.set (\<Phi>o a). \<phi> (\<psi> x'))"
           proof -
             have "S.Fun a = (\<lambda>x \<in> S.set a. x)" using assms S.Fun_ide by simp
             moreover have "\<And>x'. x' \<in> \<phi> ` S.set a \<Longrightarrow> \<psi> x' \<in> S.set a"
               using assms bij_\<phi> S.set_subset_Univ image_iff by (metis \<psi>_img_\<phi>_img)
             ultimately show ?thesis
               using assms set_\<Phi>o by auto
           qed
           also have "... = restrict (\<lambda>x'. x') (S'.set (\<Phi>o a))"
             using assms S'.set_subset_Univ \<Phi>o_preserves_ide \<phi>_\<psi>
             by (meson restr_eqI subsetCE)
           ultimately show ?thesis by auto
         qed
         ultimately show ?thesis
           using assms \<Phi>_def \<Phi>o_preserves_ide S'.mkArr_restrict_eq'
           by (metis S'.arrI S.ide_char)
       qed
       thus ?thesis
         using assms S'.mkIde_as_mkArr \<Phi>o_preserves_ide \<Phi>_in_hom by simp
     qed
     
     lemma set_dom_\<Phi>:
     assumes "S.arr f"
     shows "S'.set (S'.dom (\<Phi> f)) = \<phi> ` (S.set (S.dom f))"
       using assms S.ide_dom \<Phi>_in_hom \<Phi>_ide set_\<Phi>o by fastforce
     
     lemma \<Phi>_comp:
     assumes "S.seq g f"
     shows "\<Phi> (g \<cdot> f) = \<Phi> g \<cdot>\<acute> \<Phi> f"
     proof -
       have "\<Phi> (g \<cdot> f) = S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod g))) (\<Phi>a (S g f))"
         using \<Phi>_def assms by auto
       also have "... = S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod g)))
                                 (restrict (\<Phi>a g o \<Phi>a f) (S'.set (\<Phi>o (S.dom f))))"
         using assms \<Phi>a_comp set_\<Phi>o by force
       also have "... = S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod g))) (\<Phi>a g o \<Phi>a f)"
       proof -
         have "S'.arr (S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod g))) (\<Phi>a g o \<Phi>a f))"
           using assms \<Phi>a_mapsto [of f] \<Phi>a_mapsto [of g] \<Phi>o_preserves_ide S'.arr_mkArr
           by (elim S.seqE, auto)
         thus ?thesis
           using assms S'.mkArr_restrict_eq by auto
       qed
       also have "... = S' (S'.mkArr (S'.set (\<Phi>o (S.dom g))) (S'.set (\<Phi>o (S.cod g))) (\<Phi>a g))
                           (S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod f))) (\<Phi>a f))"
       proof -
         have "S'.arr (S'.mkArr (S'.set (\<Phi>o (S.dom f))) (S'.set (\<Phi>o (S.cod f))) (\<Phi>a f))"
           using assms \<Phi>a_mapsto set_\<Phi>o S.ide_dom S.ide_cod \<Phi>o_preserves_ide
                 S'.arr_mkArr S'.set_subset_Univ S.seqE
           by metis
         moreover have "S'.arr (S'.mkArr (S'.set (\<Phi>o (S.dom g))) (S'.set (\<Phi>o (S.cod g)))
                               (\<Phi>a g))"
           using assms \<Phi>a_mapsto set_\<Phi>o S.ide_dom S.ide_cod \<Phi>o_preserves_ide S'.arr_mkArr
                 S'.set_subset_Univ S.seqE
           by metis
         ultimately show ?thesis using assms S'.comp_mkArr by force
       qed
       also have "... = \<Phi> g \<cdot>\<acute> \<Phi> f" using assms \<Phi>_def by force
       finally show ?thesis by fast
     qed
       
     interpretation \<Phi>: "functor" S S' \<Phi>
       apply unfold_locales
       using \<Phi>_def
           apply simp
       using \<Phi>_in_hom \<Phi>_comp
       by auto
 
     lemma \<Phi>_is_functor:
     shows "functor S S' \<Phi>" ..
       
     lemma Fun_\<Phi>:
     assumes "S.arr f" and "x \<in> S.set (S.dom f)"
     shows "S'.Fun (\<Phi> f) (\<phi> x) = \<Phi>a f (\<phi> x)"
       using assms \<Phi>_def \<Phi>.preserves_arr set_\<Phi>o by auto
       
     lemma \<Phi>_acts_elementwise:
     assumes "S.ide a"
     shows "S'.set (\<Phi> a) = \<Phi> ` S.set a"
     proof
       have 0: "S'.set (\<Phi> a) = \<phi> ` S.set a"
         using assms \<Phi>_ide set_\<Phi>o by simp
       have 1: "\<And>x. x \<in> S.set a \<Longrightarrow> \<Phi> x = \<phi> x"
       proof -
         fix x
         assume x: "x \<in> S.set a"
         have 1: "S.terminal x" using assms x S.set_subset_Univ by blast
         hence 2: "S'.terminal (\<phi> x)"
           by (metis CollectD CollectI bij_\<phi> bij_betw_def image_iff)
         have "\<Phi> x = \<Phi>o x"
           using assms x 1 \<Phi>_ide S.terminal_def by auto
         also have "... = \<phi> x"
         proof -
           have "\<Phi>o x = S'.mkIde (\<phi> ` S.set x)"
             using assms 1 x \<Phi>o_def S.terminal_def by auto
           moreover have "S'.mkIde (\<phi> ` S.set x) = \<phi> x"
             using assms x 1 2 S.terminal_char2 S'.terminal_char2 S'.mkIde_set bij_\<phi>
             by (metis image_empty image_insert)
           ultimately show ?thesis by auto
         qed
         finally show "\<Phi> x = \<phi> x" by auto
       qed
       show "S'.set (\<Phi> a) \<subseteq> \<Phi> ` S.set a" using 0 1 by force
       show "\<Phi> ` S.set a \<subseteq> S'.set (\<Phi> a)" using 0 1 by force
     qed
 
     lemma \<Phi>_preserves_incl:
     assumes "S.incl m"
     shows "S'.incl (\<Phi> m)"
     proof -
       have 1: "S.arr m \<and> S.set (S.dom m) \<subseteq> S.set (S.cod m) \<and>
                m = S.mkArr (S.set (S.dom m)) (S.set (S.cod m)) (\<lambda>x. x)"
         using assms S.incl_def by blast
       have "S'.arr (\<Phi> m)" using 1 by auto
       moreover have 2: "S'.set (S'.dom (\<Phi> m)) \<subseteq> S'.set (S'.cod (\<Phi> m))"
         using 1 \<Phi>.preserves_dom \<Phi>.preserves_cod \<Phi>_acts_elementwise
         by (metis (full_types) S.ide_cod S.ide_dom image_mono)
       moreover have "\<Phi> m =
                      S'.mkArr (S'.set (S'.dom (\<Phi> m))) (S'.set (S'.cod (\<Phi> m))) (\<lambda>x'. x')"
       proof -
         have "\<Phi> m = S'.mkArr (S'.set (\<Phi>o (S.dom m))) (S'.set (\<Phi>o (S.cod m))) (\<Phi>a m)"
           using 1 \<Phi>_def by simp
         also have "... = S'.mkArr (S'.set (S'.dom (\<Phi> m))) (S'.set (S'.cod (\<Phi> m))) (\<Phi>a m)"
           using 1 \<Phi>_ide by auto
         finally have 3: "\<Phi> m =
                          S'.mkArr (S'.set (S'.dom (\<Phi> m))) (S'.set (S'.cod (\<Phi> m))) (\<Phi>a m)"
           by auto
         also have "... = S'.mkArr (S'.set (S'.dom (\<Phi> m))) (S'.set (S'.cod (\<Phi> m))) (\<lambda>x'. x')"
         proof -
           have 4: "S.Fun m = restrict (\<lambda>x. x) (S.set (S.dom m))"
             using assms S.incl_def by (metis (full_types) S.Fun_mkArr)
           hence "\<Phi>a m = restrict (\<lambda>x'. x') (\<phi> ` (S.set (S.dom m)))"
           proof -
             have 5: "\<And>x'. x' \<in> \<phi> ` S.set (S.dom m) \<Longrightarrow> \<phi> (\<psi> x') = x'"
               using 1 bij_\<phi> bij_betw_def S'.set_subset_Univ S.ide_dom \<Phi>o_preserves_ide
                     f_inv_into_f set_\<Phi>o
               by (metis subsetCE)
             have "\<Phi>a m = restrict (\<lambda>x'. \<phi> (S.Fun m (\<psi> x'))) (\<phi> ` S.set (S.dom m))"
               using \<Phi>a_def by simp
             also have "... = restrict (\<lambda>x'. x') (\<phi> ` S.set (S.dom m))"
             proof -
               have "\<And>x. x \<in> \<phi> ` (S.set (S.dom m)) \<Longrightarrow> \<phi> (S.Fun m (\<psi> x)) = x"
               proof -
                 fix x
                 assume x: "x \<in> \<phi> ` (S.set (S.dom m))"
                 hence "\<psi> x \<in> S.set (S.dom m)"
                   using 1 S.ide_dom S.set_subset_Univ \<psi>_img_\<phi>_img image_eqI by metis
                 thus "\<phi> (S.Fun m (\<psi> x)) = x" using 1 4 5 x by simp
               qed
               thus ?thesis by auto
             qed
             finally show ?thesis by auto
           qed
           hence "\<Phi>a m = restrict (\<lambda>x'. x') (S'.set (S'.dom (\<Phi> m)))"
             using 1 set_dom_\<Phi> by auto
           thus ?thesis
             using 2 3 \<open>S'.arr (\<Phi> m)\<close> S'.mkArr_restrict_eq S'.ide_cod S'.ide_dom S'.incl_def
             by (metis S'.arr_mkArr image_restrict_eq image_subset_iff_funcset)
         qed
         finally show ?thesis by auto
       qed
       ultimately show ?thesis using S'.incl_def by blast
     qed
 
     text\<open>
       Interchange the role of @{term \<phi>} and @{term \<psi>} to obtain a functor \<open>\<Psi>\<close>
       from @{term[source=true] S'} to @{term[source=true] S}.
 \<close>
 
     interpretation INV: two_set_categories_bij_betw_Univ S' S \<psi>
       apply unfold_locales by (simp add: bij_\<phi> bij_betw_inv_into)
 
     abbreviation \<Psi>o
     where "\<Psi>o \<equiv> INV.\<Phi>o"
 
     abbreviation \<Psi>a
     where "\<Psi>a \<equiv> INV.\<Phi>a"
 
     abbreviation \<Psi>
     where "\<Psi> \<equiv> INV.\<Phi>"
 
     interpretation \<Psi>: "functor" S' S \<Psi>
       using INV.\<Phi>_is_functor by auto
 
     text\<open>
       The functors @{term \<Phi>} and @{term \<Psi>} are inverses.
 \<close>
 
     lemma Fun_\<Psi>:
     assumes "S'.arr f'" and "x' \<in> S'.set (S'.dom f')"
     shows "S.Fun (\<Psi> f') (\<psi> x') = \<Psi>a f' (\<psi> x')"
       using assms INV.Fun_\<Phi> by blast
           
     lemma \<Psi>o_\<Phi>o:
     assumes "S.ide a"
     shows "\<Psi>o (\<Phi>o a) = a"
       using assms \<Phi>o_def INV.\<Phi>o_def \<psi>_img_\<phi>_img \<Phi>o_preserves_ide set_\<Phi>o by force
      
     lemma \<Phi>\<Psi>:
     assumes "S.arr f"
     shows "\<Psi> (\<Phi> f) = f"
     proof (intro S.arr_eqI)
       show par: "S.par (\<Psi> (\<Phi> f)) f"
         using assms \<Phi>o_preserves_ide \<Psi>o_\<Phi>o by auto
       show "S.Fun (\<Psi> (\<Phi> f)) = S.Fun f"
       proof -
         have "S.arr (\<Psi> (\<Phi> f))" using assms by auto
         moreover have "\<Psi> (\<Phi> f) = S.mkArr (S.set (S.dom f)) (S.set (S.cod f)) (\<Psi>a (\<Phi> f))"
           using assms INV.\<Phi>_def \<Phi>_in_hom \<Psi>o_\<Phi>o by auto
         moreover have "\<Psi>a (\<Phi> f) = (\<lambda>x \<in> S.set (S.dom f). \<psi> (S'.Fun (\<Phi> f) (\<phi> x)))"
         proof -
           have "\<Psi>a (\<Phi> f) = (\<lambda>x \<in> \<psi> ` S'.set (S'.dom (\<Phi> f)). \<psi> (S'.Fun (\<Phi> f) (\<phi> x)))"
           proof -
             have "\<And>x. x \<in> \<psi> ` S'.set (S'.dom (\<Phi> f)) \<Longrightarrow> INV.\<psi> x = \<phi> x"
               using assms S.ide_dom S.set_subset_Univ \<Psi>.preserves_reflects_arr par bij_\<phi>
                     inv_into_inv_into_eq subsetCE INV.set_dom_\<Phi>
               by metis
             thus ?thesis
               using INV.\<Phi>a_def by auto
           qed
           moreover have "\<psi> ` S'.set (S'.dom (\<Phi> f)) = S.set (S.dom f)"
             using assms by (metis par \<Psi>.preserves_reflects_arr INV.set_dom_\<Phi>)
           ultimately show ?thesis by auto
         qed
         ultimately have 1: "S.Fun (\<Psi> (\<Phi> f)) = (\<lambda>x \<in> S.set (S.dom f). \<psi> (S'.Fun (\<Phi> f) (\<phi> x)))"
           using S'.Fun_mkArr by simp
         show ?thesis
         proof
           fix x
           have "x \<notin> S.set (S.dom f) \<Longrightarrow> S.Fun (\<Psi> (\<Phi> f)) x = S.Fun f x"
             using 1 assms extensional_def S.Fun_mapsto S.Fun_def by auto
           moreover have "x \<in> S.set (S.dom f) \<Longrightarrow> S.Fun (\<Psi> (\<Phi> f)) x = S.Fun f x"
           proof -
             assume x: "x \<in> S.set (S.dom f)"
             have "S.Fun (\<Psi> (\<Phi> f)) x = \<psi> (\<phi> (S.Fun f (\<psi> (\<phi> x))))"
               using assms x 1 Fun_\<Phi> bij_\<phi> \<Phi>a_def by auto
             also have "... = S.Fun f x"
             proof -
               have 2: "\<And>x. x \<in> S.Univ \<Longrightarrow> \<psi> (\<phi> x) = x"
                 using bij_\<phi> bij_betw_inv_into_left by fast
               have "S.Fun f (\<psi> (\<phi> x)) = S.Fun f x"
                 using assms x 2
                 by (metis S.ide_dom S.set_subset_Univ subsetCE)
               moreover have "S.Fun f x \<in> S.Univ"
                 using x assms S.Fun_mapsto S.set_subset_Univ S.ide_cod by blast
               ultimately show ?thesis using 2 by auto
             qed
             finally show ?thesis by auto
           qed
           ultimately show "S.Fun (\<Psi> (\<Phi> f)) x = S.Fun f x" by auto
         qed
       qed
     qed
 
     lemma \<Phi>o_\<Psi>o:
     assumes "S'.ide a'"
     shows "\<Phi>o (\<Psi>o a') = a'"
       using assms \<Phi>o_def INV.\<Phi>o_def \<phi>_img_\<psi>_img INV.\<Phi>o_preserves_ide \<psi>_\<phi> INV.set_\<Phi>o
       by force
 
     lemma \<Psi>\<Phi>:
     assumes "S'.arr f'"
     shows "\<Phi> (\<Psi> f') = f'"
     proof (intro S'.arr_eqI)
       show par: "S'.par (\<Phi> (\<Psi> f')) f'"
         using assms \<Phi>.preserves_ide \<Psi>.preserves_ide \<Phi>_ide INV.\<Phi>_ide \<Phi>o_\<Psi>o by auto
       show "S'.Fun (\<Phi> (\<Psi> f')) = S'.Fun f'"
       proof -
         have "S'.arr (\<Phi> (\<Psi> f'))" using assms by blast
         moreover have "\<Phi> (\<Psi> f') =
                        S'.mkArr (S'.set (S'.dom f')) (S'.set (S'.cod f')) (\<Phi>a (\<Psi> f'))"
           using assms \<Phi>_def INV.\<Phi>_in_hom \<Phi>o_\<Psi>o by simp
         moreover have "\<Phi>a (\<Psi> f') = (\<lambda>x' \<in> S'.set (S'.dom f'). \<phi> (S.Fun (\<Psi> f') (\<psi> x')))"
           unfolding \<Phi>a_def
           using assms par \<Psi>.preserves_arr set_dom_\<Phi> by metis
         ultimately have 1: "S'.Fun (\<Phi> (\<Psi> f')) =
                             (\<lambda>x' \<in> S'.set (S'.dom f'). \<phi> (S.Fun (\<Psi> f') (\<psi> x')))"
           using S'.Fun_mkArr by simp
         show ?thesis
         proof
           fix x'
           have "x' \<notin> S'.set (S'.dom f') \<Longrightarrow> S'.Fun (\<Phi> (\<Psi> f')) x' = S'.Fun f' x'"
             using 1 assms S'.Fun_mapsto extensional_def by (simp add: S'.Fun_def)
           moreover have "x' \<in> S'.set (S'.dom f') \<Longrightarrow> S'.Fun (\<Phi> (\<Psi> f')) x' = S'.Fun f' x'"
           proof -
             assume x': "x' \<in> S'.set (S'.dom f')"
             have "S'.Fun (\<Phi> (\<Psi> f')) x' = \<phi> (S.Fun (\<Psi> f') (\<psi> x'))"
               using x' 1 by auto
             also have "... = \<phi> (\<Psi>a f' (\<psi> x'))"
               using Fun_\<Psi> x' assms S'.set_subset_Univ bij_\<phi> by metis
             also have "... = \<phi> (\<psi> (S'.Fun f' (\<phi> (\<psi> x'))))"
             proof -
               have "\<phi> (\<Psi>a f' (\<psi> x')) = \<phi> (\<psi> (S'.Fun f' x'))"
               proof -
                 have "x' \<in> S'.Univ"
                   by (meson S'.ide_dom S'.set_subset_Univ assms subsetCE x')
                 thus ?thesis
                   by (simp add: INV.\<Phi>a_def INV.\<psi>_\<phi> x')
               qed
               also have "... = \<phi> (\<psi> (S'.Fun f' (\<phi> (\<psi> x'))))"
                 using assms x' \<phi>_\<psi> S'.set_subset_Univ S'.ide_dom by (metis subsetCE)
               finally show ?thesis by auto
             qed
             also have "... = S'.Fun f' x'"
             proof -
               have 2: "\<And>x'. x' \<in> S'.Univ \<Longrightarrow> \<phi> (\<psi> x') = x'"
                 using bij_\<phi> bij_betw_inv_into_right by fast
               have "S'.Fun f' (\<phi> (\<psi> x')) = S'.Fun f' x'"
                 using assms x' 2 S'.set_subset_Univ S'.ide_dom by (metis subsetCE)
               moreover have "S'.Fun f' x' \<in> S'.Univ"
                 using x' assms S'.Fun_mapsto S'.set_subset_Univ S'.ide_cod by blast
               ultimately show ?thesis using 2 by auto
             qed
             finally show ?thesis by auto
           qed
           ultimately show "S'.Fun (\<Phi> (\<Psi> f')) x' = S'.Fun f' x'" by auto
         qed
       qed
     qed
           
     lemma inverse_functors_\<Phi>_\<Psi>:
     shows "inverse_functors S S' \<Phi> \<Psi>"
     proof -
       interpret \<Phi>\<Psi>: composite_functor S S' S \<Phi> \<Psi> ..
       have inv: "\<Psi> o \<Phi> = S.map"
         using \<Phi>\<Psi> S.map_def \<Phi>\<Psi>.is_extensional by auto
     
       interpret \<Psi>\<Phi>: composite_functor S' S S' \<Psi> \<Phi> ..
       have inv': "\<Phi> o \<Psi> = S'.map"
         using \<Psi>\<Phi> S'.map_def \<Psi>\<Phi>.is_extensional by auto
     
       show ?thesis
         using inv inv' by (unfold_locales, auto)
     qed
       
     lemma are_isomorphic:
     shows "\<exists>\<Phi>. invertible_functor S S' \<Phi> \<and> (\<forall>m. S.incl m \<longrightarrow> S'.incl (\<Phi> m))"
     proof -
       interpret inverse_functors S S' \<Phi> \<Psi>
         using inverse_functors_\<Phi>_\<Psi> by auto
       have 1: "inverse_functors S S' \<Phi> \<Psi>" ..
       interpret invertible_functor S S' \<Phi>
         apply unfold_locales using 1 by auto
       have "invertible_functor S S' \<Phi>" ..
       thus ?thesis using \<Phi>_preserves_incl by auto
     qed
     
   end
   
   (*
    * The main result: set_category is categorical, in the following (logical) sense:
    * If S and S' are two "set categories", and if the sets of terminal objects of S and S'
    * are in bijective correspondence, then S and S' are isomorphic as categories,
    * via a functor that preserves inclusion maps, hence the inclusion relation between sets.
    *)
   theorem set_category_is_categorical:
   assumes "set_category S" and "set_category S'"
   and "bij_betw \<phi> (set_category_data.Univ S) (set_category_data.Univ S')"
   shows "\<exists>\<Phi>. invertible_functor S S' \<Phi> \<and>
              (\<forall>m. set_category.incl S m \<longrightarrow> set_category.incl S' (\<Phi> m))"
   proof -
     interpret S: set_category S using assms(1) by auto
     interpret S': set_category S' using assms(2) by auto
     interpret two_set_categories_bij_betw_Univ S S' \<phi>
       apply (unfold_locales) using assms(3) by auto
     show ?thesis using are_isomorphic by auto
   qed
   
   section "Further Properties of Set Categories"
 
   text\<open>
     In this section we further develop the consequences of the \<open>set_category\<close>
     axioms, and establish characterizations of a number of standard category-theoretic
     notions for a \<open>set_category\<close>.
 \<close>
 
   context set_category
   begin
   
     abbreviation Dom
     where "Dom f \<equiv> set (dom f)"
     
     abbreviation Cod
     where "Cod f \<equiv> set (cod f)"
 
     subsection "Initial Object"
 
     text\<open>
       The object corresponding to the empty set is an initial object.
 \<close>
 
     definition empty
     where "empty = mkIde {}"
 
     lemma initial_empty:
     shows "initial empty"
     proof
       show 0: "ide empty" using empty_def by auto
       show "\<And>b. ide b \<Longrightarrow> \<exists>!f. \<guillemotleft>f : empty \<rightarrow> b\<guillemotright>"
       proof -
         fix b
         assume b: "ide b"
         show "\<exists>!f. \<guillemotleft>f : empty \<rightarrow> b\<guillemotright>"
         proof
           show 1: "\<guillemotleft>mkArr {} (set b) (\<lambda>x. x) : empty \<rightarrow> b\<guillemotright>"
             using b empty_def mkArr_in_hom mkIde_set set_subset_Univ
             by (metis 0 Pi_empty UNIV_I arr_mkIde)
           show "\<And>f. \<guillemotleft>f : empty \<rightarrow> b\<guillemotright> \<Longrightarrow> f = mkArr {} (set b) (\<lambda>x. x)"
           proof -
             fix f
             assume f: "\<guillemotleft>f : empty \<rightarrow> b\<guillemotright>"
             show "f = mkArr {} (set b) (\<lambda>x. x)"
             proof (intro arr_eqI)
               show 1: "par f (mkArr {} (set b) (\<lambda>x. x))"
                 using 1 f by force
               show "Fun f = Fun (mkArr {} (set b) (\<lambda>x. x))"
                 using empty_def 1 f Fun_mapsto by fastforce
             qed
           qed
         qed
       qed
     qed
 
     subsection "Identity Arrows"
     
     text\<open>
       Identity arrows correspond to restrictions of the identity function.
 \<close>
 
     lemma ide_char:
     assumes "arr f"
     shows "ide f \<longleftrightarrow> Dom f = Cod f \<and> Fun f = (\<lambda>x \<in> Dom f. x)"
       using assms mkIde_as_mkArr mkArr_Fun Fun_ide in_homE ide_cod mkArr_Fun mkIde_set
       by (metis ide_char)
 
     lemma ideI:
     assumes "arr f" and "Dom f = Cod f" and "\<And>x. x \<in> Dom f \<Longrightarrow> Fun f x = x"
     shows "ide f"
     proof -
       have "Fun f = (\<lambda>x \<in> Dom f. x)"
         using assms Fun_def by auto
       thus ?thesis using assms ide_char by blast
     qed
 
     subsection "Inclusions"
     
     lemma ide_implies_incl:
     assumes "ide a"
     shows "incl a"
     proof -
       have "arr a \<and> Dom a \<subseteq> Cod a" using assms by auto
       moreover have "a = mkArr (Dom a) (Cod a) (\<lambda>x. x)"
         using assms by simp
       ultimately show ?thesis using incl_def by simp
     qed
     
     definition incl_in :: "'s \<Rightarrow> 's \<Rightarrow> bool"
     where "incl_in a b = (ide a \<and> ide b \<and> set a \<subseteq> set b)"
     
     abbreviation incl_of
     where "incl_of a b \<equiv> mkArr (set a) (set b) (\<lambda>x. x)"
 
     lemma elem_set_implies_set_eq_singleton:
     assumes "a \<in> set b"
     shows "set a = {a}"
     proof -
       have "ide b" using assms set_def by auto
       thus ?thesis using assms set_subset_Univ terminal_char2
         by (metis mem_Collect_eq subsetCE)
     qed
 
     lemma elem_set_implies_incl_in:
     assumes "a \<in> set b"
     shows "incl_in a b"
     proof -
       have b: "ide b" using assms set_def by auto
       hence "set b \<subseteq> Univ" by simp
       hence "a \<in> Univ \<and> set a \<subseteq> set b"
         using assms elem_set_implies_set_eq_singleton by auto
       hence "ide a \<and> set a \<subseteq> set b"
         using b terminal_char1 by simp
       thus ?thesis using b incl_in_def by simp
     qed
     
     lemma incl_incl_of [simp]:
     assumes "incl_in a b"
     shows "incl (incl_of a b)"
     and "\<guillemotleft>incl_of a b : a \<rightarrow> b\<guillemotright>"
     proof -
       show "\<guillemotleft>incl_of a b : a \<rightarrow> b\<guillemotright>"
         using assms incl_in_def mkArr_in_hom
         by (metis image_ident image_subset_iff_funcset mkIde_set set_subset_Univ)
       thus "incl (incl_of a b)"
         using assms incl_def incl_in_def by fastforce
     qed
     
     text\<open>
       There is at most one inclusion between any pair of objects.
 \<close>
 
     lemma incls_coherent:
     assumes "par f f'" and "incl f" and "incl f'"
     shows "f = f'"
       using assms incl_def fun_complete by auto
 
     text\<open>
       The set of inclusions is closed under composition.
 \<close>
 
     lemma incl_comp [simp]:
     assumes "incl f" and "incl g" and "cod f = dom g"
     shows "incl (g \<cdot> f)"
     proof -
       have 1: "seq g f" using assms incl_def by auto
       moreover have "Dom (g \<cdot> f) \<subseteq> Cod (g \<cdot> f)"
         using assms 1 incl_def by auto
       moreover have "g \<cdot> f = mkArr (Dom f) (Cod g) (restrict (\<lambda>x. x) (Dom f))"
         using assms 1 Fun_comp incl_def Fun_mkArr mkArr_Fun Fun_ide comp_cod_arr
               ide_dom dom_comp cod_comp
         by metis
       ultimately show ?thesis using incl_def by force
     qed
 
     subsection "Image Factorization"
 
     text\<open>
       The image of an arrow is the object that corresponds to the set-theoretic
       image of the domain set under the function induced by the arrow.
 \<close>
 
     abbreviation Img
     where "Img f \<equiv> Fun f ` Dom f"
 
     definition img
     where "img f = mkIde (Img f)"
 
     lemma ide_img [simp]:
     assumes "arr f"
     shows "ide (img f)"
     proof -
       have "Fun f ` Dom f \<subseteq> Cod f" using assms Fun_mapsto by blast
       moreover have "Cod f \<subseteq> Univ" using assms by simp
       ultimately show ?thesis using img_def by simp
     qed
     
     lemma set_img [simp]:
     assumes "arr f"
     shows "set (img f) = Img f"
     proof -
       have "Fun f ` set (dom f) \<subseteq> set (cod f) \<and> set (cod f) \<subseteq> Univ"
         using assms Fun_mapsto by auto
       hence "Fun f ` set (dom f) \<subseteq> Univ" by auto
       thus ?thesis using assms img_def set_mkIde by auto
     qed
 
     lemma img_point_in_Univ:
     assumes "\<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
     shows "img x \<in> Univ"
     proof -
       have "set (img x) = {Fun x unity}"
         using assms img_def terminal_unity terminal_char2
               image_empty image_insert mem_Collect_eq set_img
         by force
       thus "img x \<in> Univ" using assms terminal_char1 by auto
     qed
 
     lemma incl_in_img_cod:
     assumes "arr f"
     shows "incl_in (img f) (cod f)"
     proof (unfold img_def)
       have 1: "Img f \<subseteq> Cod f \<and> Cod f \<subseteq> Univ"
         using assms Fun_mapsto by auto
       hence 2: "ide (mkIde (Img f))" by fastforce
       moreover have "ide (cod f)" using assms by auto
       moreover have "set (mkIde (Img f)) \<subseteq> Cod f"
         using 1 2 by force
       ultimately show "incl_in (mkIde (Img f)) (cod f)"
         using incl_in_def by blast
     qed
 
     lemma img_point_elem_set:
     assumes "\<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
     shows "img x \<in> set a"
     proof -
       have "incl_in (img x) a"
         using assms incl_in_img_cod by auto
       hence "set (img x) \<subseteq> set a"
         using incl_in_def by blast
       moreover have "img x \<in> set (img x)"
         using assms img_point_in_Univ terminal_char2 by simp
       ultimately show ?thesis by auto
     qed
 
     text\<open>
       The corestriction of an arrow @{term f} is the arrow
       @{term "corestr f \<in> hom (dom f) (img f)"} that induces the same function
       on the universe as @{term f}.
 \<close>
 
     definition corestr
     where "corestr f = mkArr (Dom f) (Img f) (Fun f)"
     
     lemma corestr_in_hom:
     assumes "arr f"
     shows "\<guillemotleft>corestr f : dom f \<rightarrow> img f\<guillemotright>"
     proof -
       have "Fun f \<in> Dom f \<rightarrow> Fun f ` Dom f \<and> Dom f \<subseteq> Univ"
         using assms by auto
       moreover have "Fun f ` Dom f \<subseteq> Univ"
       proof -
         have "Fun f ` Dom f \<subseteq> Cod f \<and> Cod f \<subseteq> Univ"
           using assms Fun_mapsto by auto
         thus ?thesis by blast
       qed
       ultimately have "mkArr (Dom f) (Fun f ` Dom f) (Fun f) \<in> hom (dom f) (img f)"
         using assms img_def mkArr_in_hom [of "Dom f" "Fun f ` Dom f" "Fun f"] by simp
       thus ?thesis using corestr_def by fastforce
     qed
     
     text\<open>
       Every arrow factors as a corestriction followed by an inclusion.
 \<close>
 
     lemma img_fact:
     assumes "arr f"
     shows "S (incl_of (img f) (cod f)) (corestr f) = f"
     proof (intro arr_eqI)
       have 1: "\<guillemotleft>corestr f : dom f \<rightarrow> img f\<guillemotright>"
         using assms corestr_in_hom by blast
       moreover have 2: "\<guillemotleft>incl_of (img f) (cod f) : img f \<rightarrow> cod f\<guillemotright>"
         using assms incl_in_img_cod incl_incl_of by fast
       ultimately show P: "par (incl_of (img f) (cod f) \<cdot> corestr f) f"
         using assms in_homE by blast
       show "Fun (incl_of (img f) (cod f) \<cdot> corestr f) = Fun f"
       proof -
         have "Fun (incl_of (img f) (cod f) \<cdot> corestr f)
                  = restrict (Fun (incl_of (img f) (cod f)) o Fun (corestr f)) (Dom f)"
           using Fun_comp 1 2 P by auto
         also have
            "... = restrict (restrict (\<lambda>x. x) (Img f) o restrict (Fun f) (Dom f)) (Dom f)"
         proof -
           have "Fun (corestr f) = restrict (Fun f) (Dom f)"
             using assms corestr_def Fun_mkArr corestr_in_hom by force
           moreover have "Fun (incl_of (img f) (cod f)) = restrict (\<lambda>x. x) (Img f)"
           proof -
             have "arr (incl_of (img f) (cod f))" using incl_incl_of P by blast
             moreover have "incl_of (img f) (cod f) = mkArr (Img f) (Cod f) (\<lambda>x. x)"
               using assms by fastforce
             ultimately show ?thesis using assms img_def Fun_mkArr by metis
           qed
           ultimately show ?thesis by argo
         qed
         also have "... = Fun f"
          proof
           fix x
           show "restrict (restrict (\<lambda>x. x) (Img f) o restrict (Fun f) (Dom f)) (Dom f) x = Fun f x"
             using assms extensional_restrict Fun_mapsto extensional_arb [of "Fun f" "Dom f" x]
             by (cases "x \<in> Dom f", auto)
         qed
         finally show ?thesis by auto
       qed
     qed
 
     lemma Fun_corestr:
     assumes "arr f"
     shows "Fun (corestr f) = Fun f"
     proof -
       have 1: "f = incl_of (img f) (cod f) \<cdot> corestr f"
         using assms img_fact by auto
       hence 2: "Fun f = restrict (Fun (incl_of (img f) (cod f)) o Fun (corestr f)) (Dom f)"
         using assms by (metis Fun_comp dom_comp)
       also have "... = restrict (Fun (corestr f)) (Dom f)"
         using assms by (metis 1 2 Fun_mkArr seqE mkArr_Fun corestr_def)
       also have "... = Fun (corestr f)"
         using assms 1 by (metis Fun_def dom_comp extensional_restrict restrict_extensional)
       finally show ?thesis by auto
     qed
     
     subsection "Points and Terminal Objects"
 
     text\<open>
       To each element @{term t} of @{term "set a"} is associated a point
       @{term "mkPoint a t \<in> hom unity a"}.  The function induced by such
       a point is the constant-@{term t} function on the set @{term "{unity}"}.
 \<close>
 
     definition mkPoint
     where "mkPoint a t \<equiv> mkArr {unity} (set a) (\<lambda>_. t)"
 
     lemma mkPoint_in_hom:
     assumes "ide a" and "t \<in> set a"
     shows "\<guillemotleft>mkPoint a t : unity \<rightarrow> a\<guillemotright>"
       using assms mkArr_in_hom
       by (metis Pi_I mkIde_set set_subset_Univ terminal_char2 terminal_unity mkPoint_def)
 
     lemma Fun_mkPoint:
     assumes "ide a" and "t \<in> set a"
     shows "Fun (mkPoint a t) = (\<lambda>_ \<in> {unity}. t)"
       using assms mkPoint_def terminal_unity by force
 
     text\<open>
       For each object @{term a} the function @{term "mkPoint a"} has as its inverse
       the restriction of the function @{term img} to @{term "hom unity a"}
 \<close>
 
     lemma mkPoint_img:
     shows "img \<in> hom unity a \<rightarrow> set a"
     and "\<And>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<Longrightarrow> mkPoint a (img x) = x"
     proof -
       show "img \<in> hom unity a \<rightarrow> set a"
         using img_point_elem_set by simp
       show "\<And>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<Longrightarrow> mkPoint a (img x) = x"
       proof -
         fix x
         assume x: "\<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
         show "mkPoint a (img x) = x"
         proof (intro arr_eqI)
           have 0: "img x \<in> set a"
             using x img_point_elem_set by metis
           hence 1: "mkPoint a (img x) \<in> hom unity a"
             using x mkPoint_in_hom by force
           thus 2: "par (mkPoint a (img x)) x"
             using x by fastforce
           have "Fun (mkPoint a (img x)) = (\<lambda>_ \<in> {unity}. img x)"
             using 1 mkPoint_def by auto
           also have "... = Fun x"
           proof
             fix z
             have "z \<noteq> unity \<Longrightarrow> (\<lambda>_ \<in> {unity}. img x) z = Fun x z"
               using x Fun_mapsto Fun_def restrict_apply singletonD terminal_char2 terminal_unity
               by auto
             moreover have "(\<lambda>_ \<in> {unity}. img x) unity = Fun x unity"
               using x 0 elem_set_implies_set_eq_singleton set_img terminal_char2 terminal_unity
               by (metis 2 image_insert in_homE restrict_apply singletonI singleton_insert_inj_eq)
             ultimately show "(\<lambda>_ \<in> {unity}. img x) z = Fun x z" by auto
           qed
           finally show "Fun (mkPoint a (img x)) = Fun x" by auto
         qed
       qed
     qed
 
     lemma img_mkPoint:
     assumes "ide a"
     shows "mkPoint a \<in> set a \<rightarrow> hom unity a"
     and "\<And>t. t \<in> set a \<Longrightarrow> img (mkPoint a t) = t"
     proof -
       show "mkPoint a \<in> set a \<rightarrow> hom unity a"
         using assms(1) mkPoint_in_hom by simp
       show "\<And>t. t \<in> set a \<Longrightarrow> img (mkPoint a t) = t"
         proof -
         fix t
         assume t: "t \<in> set a"
         show "img (mkPoint a t) = t"
         proof -
           have 1: "arr (mkPoint a t)"
             using assms t mkPoint_in_hom by auto
           have "Fun (mkPoint a t) ` {unity} = {t}"
             using 1 mkPoint_def by simp
           thus ?thesis
             by (metis 1 t elem_set_implies_incl_in elem_set_implies_set_eq_singleton img_def
                       incl_in_def dom_mkArr mkIde_set terminal_char2 terminal_unity mkPoint_def)
         qed
       qed
     qed
 
     text\<open>
       For each object @{term a} the elements of @{term "hom unity a"} are therefore in
       bijective correspondence with @{term "set a"}.
 \<close>
 
     lemma bij_betw_points_and_set:
     assumes "ide a"
     shows "bij_betw img (hom unity a) (set a)"
     proof (intro bij_betwI)
       show "img \<in> hom unity a \<rightarrow> set a"
         using assms mkPoint_img by auto
       show "mkPoint a \<in> set a \<rightarrow> hom unity a"
         using assms img_mkPoint by auto
       show "\<And>x. x \<in> hom unity a \<Longrightarrow> mkPoint a (img x) = x"
         using assms mkPoint_img by auto
       show "\<And>t. t \<in> set a \<Longrightarrow> img (mkPoint a t) = t"
         using assms img_mkPoint by auto
     qed
 
     text\<open>
       The function on the universe induced by an arrow @{term f} agrees, under the bijection
       between @{term "hom unity (dom f)"} and @{term "Dom f"}, with the action of @{term f}
       by composition on @{term "hom unity (dom f)"}.
 \<close>
 
     lemma Fun_point:
     assumes "\<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
     shows "Fun x = (\<lambda>_ \<in> {unity}. img x)"
       using assms mkPoint_img img_mkPoint Fun_mkPoint [of a "img x"] img_point_elem_set
       by auto
 
     lemma comp_arr_mkPoint:
     assumes "arr f" and "t \<in> Dom f"
     shows "f \<cdot> mkPoint (dom f) t = mkPoint (cod f) (Fun f t)"
     proof (intro arr_eqI)
       have 0: "seq f (mkPoint (dom f) t)"
         using assms mkPoint_in_hom [of "dom f" t] by auto
       have 1: "\<guillemotleft>f \<cdot> mkPoint (dom f) t : unity \<rightarrow> cod f\<guillemotright>"
         using assms mkPoint_in_hom [of "dom f" t] by auto
       show "par (f \<cdot> mkPoint (dom f) t) (mkPoint (cod f) (Fun f t))"
       proof -
         have "\<guillemotleft>mkPoint (cod f) (Fun f t) : unity \<rightarrow> cod f\<guillemotright>"
           using assms Fun_mapsto mkPoint_in_hom [of "cod f" "Fun f t"] by auto
         thus ?thesis using 1 by fastforce
       qed
       show "Fun (f \<cdot> mkPoint (dom f) t) = Fun (mkPoint (cod f) (Fun f t))"
       proof -
         have "Fun (f \<cdot> mkPoint (dom f) t) = restrict (Fun f o Fun (mkPoint (dom f) t)) {unity}"
           using assms 0 1 Fun_comp terminal_char2 terminal_unity by auto
         also have "... = (\<lambda>_ \<in> {unity}. Fun f t)"
           using assms Fun_mkPoint by auto
         also have "... = Fun (mkPoint (cod f) (Fun f t))"
           using assms Fun_mkPoint [of "cod f" "Fun f t"] Fun_mapsto by fastforce
         finally show ?thesis by auto
       qed
     qed
 
     lemma comp_arr_point:
     assumes "arr f" and "\<guillemotleft>x : unity \<rightarrow> dom f\<guillemotright>"
     shows "f \<cdot> x = mkPoint (cod f) (Fun f (img x))"
     proof -
       have "x = mkPoint (dom f) (img x)" using assms mkPoint_img by simp
       thus ?thesis using assms comp_arr_mkPoint [of f "img x"]
         by (simp add: img_point_elem_set)
     qed
 
     text\<open>
       This agreement allows us to express @{term "Fun f"} in terms of composition.
 \<close>
 
     lemma Fun_in_terms_of_comp:
     assumes "arr f"
     shows "Fun f = restrict (img o S f o mkPoint (dom f)) (Dom f)"
     proof
       fix t
       have "t \<notin> Dom f \<Longrightarrow> Fun f t = restrict (img o S f o mkPoint (dom f)) (Dom f) t"
         using assms by (simp add: Fun_def)
       moreover have "t \<in> Dom f \<Longrightarrow>
                      Fun f t = restrict (img o S f o mkPoint (dom f)) (Dom f) t"
       proof -
         assume t: "t \<in> Dom f"
         have 1: "f \<cdot> mkPoint (dom f) t = mkPoint (cod f) (Fun f t)"
           using assms t comp_arr_mkPoint by simp
         hence "img (f \<cdot> mkPoint (dom f) t) = img (mkPoint (cod f) (Fun f t))" by simp
         thus ?thesis
         proof -
           have "Fun f t \<in> Cod f" using assms t Fun_mapsto by auto
           thus ?thesis using assms t 1 img_mkPoint by auto
         qed
       qed
       ultimately show "Fun f t = restrict (img o S f o mkPoint (dom f)) (Dom f) t" by auto
     qed
 
     text\<open>
       We therefore obtain a rule for proving parallel arrows equal by showing
       that they have the same action by composition on points.
 \<close>
 
     (*
      * TODO: Find out why attempts to use this as the main rule for a proof loop
      * unless the specific instance is given.
      *)
     lemma arr_eqI':
     assumes "par f f'" and "\<And>x. \<guillemotleft>x : unity \<rightarrow> dom f\<guillemotright> \<Longrightarrow> f \<cdot> x = f' \<cdot> x"
     shows "f = f'"
       using assms Fun_in_terms_of_comp mkPoint_in_hom by (intro arr_eqI, auto)
 
     text\<open>
       An arrow can therefore be specified by giving its action by composition on points.
       In many situations, this is more natural than specifying it as a function on the universe.
 \<close>
 
     definition mkArr'
     where "mkArr' a b F = mkArr (set a) (set b) (img o F o mkPoint a)"
 
     lemma mkArr'_in_hom:
     assumes "ide a" and "ide b" and "F \<in> hom unity a \<rightarrow> hom unity b"
     shows "\<guillemotleft>mkArr' a b F : a \<rightarrow> b\<guillemotright>"
     proof -
       have "img o F o mkPoint a \<in> set a \<rightarrow> set b"
       proof
         fix t
         assume t: "t \<in> set a"
         thus "(img o F o mkPoint a) t \<in> set b"
           using assms mkPoint_in_hom img_point_elem_set [of "F (mkPoint a t)" b]
           by auto
       qed
       thus ?thesis
         using assms mkArr'_def mkArr_in_hom [of "set a" "set b"] by simp
     qed
 
     lemma comp_point_mkArr':
     assumes "ide a" and "ide b" and "F \<in> hom unity a \<rightarrow> hom unity b"
     shows "\<And>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<Longrightarrow> mkArr' a b F \<cdot> x = F x"
     proof -
       fix x
       assume x: "\<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
       have "Fun (mkArr' a b F) (img x) = img (F x)"
         unfolding mkArr'_def
         using assms x Fun_mkArr arr_mkArr img_point_elem_set mkPoint_img mkPoint_in_hom
         by (simp add: Pi_iff)
       hence "mkArr' a b F \<cdot> x = mkPoint b (img (F x))"
         using assms x mkArr'_in_hom [of a b F] comp_arr_point by auto
       thus "mkArr' a b F \<cdot> x = F x"
         using assms x mkPoint_img(2) by auto
     qed
 
     text\<open>
       A third characterization of terminal objects is as those objects whose set of
       points is a singleton.
 \<close>
 
     lemma terminal_char3:
     assumes "\<exists>!x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright>"
     shows "terminal a"
     proof -
       have a: "ide a"
         using assms ide_cod mem_Collect_eq by blast
       hence 1: "bij_betw img (hom unity a) (set a)"
         using assms bij_betw_points_and_set by auto
       hence "img ` (hom unity a) = set a"
         by (simp add: bij_betw_def)
       moreover have "hom unity a = {THE x. x \<in> hom unity a}"
         using assms theI' [of "\<lambda>x. x \<in> hom unity a"] by auto
       ultimately have "set a = {img (THE x. x \<in> hom unity a)}"
         by (metis image_empty image_insert)
       thus ?thesis using a terminal_char1 by simp
     qed
 
     text\<open>
       The following is an alternative formulation of functional completeness, which says that
       any function on points uniquely determines an arrow.
 \<close>
 
     lemma fun_complete':
     assumes "ide a" and "ide b" and "F \<in> hom unity a \<rightarrow> hom unity b"
     shows "\<exists>!f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> (\<forall>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<longrightarrow> f \<cdot> x = F x)"
     proof
       have 1: "\<guillemotleft>mkArr' a b F : a \<rightarrow> b\<guillemotright>" using assms mkArr'_in_hom by auto
       moreover have 2: "\<And>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<Longrightarrow> mkArr' a b F \<cdot> x = F x"
         using assms comp_point_mkArr' by auto
       ultimately show "\<guillemotleft>mkArr' a b F : a \<rightarrow> b\<guillemotright> \<and>
                        (\<forall>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<longrightarrow> mkArr' a b F \<cdot> x = F x)" by blast
       fix f
       assume f: "\<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> (\<forall>x. \<guillemotleft>x : unity \<rightarrow> a\<guillemotright> \<longrightarrow> f \<cdot> x = F x)"
       show "f = mkArr' a b F"
         using f 1 2 by (intro arr_eqI' [of f "mkArr' a b F"], fastforce, auto)
     qed
 
     subsection "The `Determines Same Function' Relation on Arrows"
 
     text\<open>
       An important part of understanding the structure of a category of sets and functions
       is to characterize when it is that two arrows ``determine the same function''.
       The following result provides one answer to this: two arrows with a common domain
       determine the same function if and only if they can be rendered equal by composing with
       a cospan of inclusions.
 \<close>
 
     lemma eq_Fun_iff_incl_joinable:
     assumes "span f f'"
     shows "Fun f = Fun f' \<longleftrightarrow>
            (\<exists>m m'. incl m \<and> incl m' \<and> seq m f \<and> seq m' f' \<and> m \<cdot> f = m' \<cdot> f')"
     proof
       assume ff': "Fun f = Fun f'"
       let ?b = "mkIde (Cod f \<union> Cod f')"
       let ?m = "incl_of (cod f) ?b"
       let ?m' = "incl_of (cod f') ?b"
       have "incl ?m"
         using assms incl_incl_of [of "cod f" ?b] incl_in_def by simp
       have "incl ?m'"
         using assms incl_incl_of [of "cod f'" ?b] incl_in_def by simp
       have m: "?m = mkArr (Cod f) (Cod f \<union> Cod f') (\<lambda>x. x)"
         by (simp add: assms)
       have m': "?m' = mkArr (Cod f') (Cod f \<union> Cod f') (\<lambda>x. x)"
         by (simp add: assms)
       have seq: "seq ?m f \<and> seq ?m' f'"
         using assms m m' by simp
       have "?m \<cdot> f = ?m' \<cdot> f'"
       proof (intro arr_eqI)
         show par: "par (?m \<cdot> f) (?m' \<cdot> f')"
           using assms m m' by simp
         show "Fun (?m \<cdot> f) = Fun (?m' \<cdot> f')"
           using assms seq par ff' Fun_mapsto Fun_comp seqE
           by (metis Fun_ide Fun_mkArr comp_cod_arr ide_cod)
       qed
       hence "incl ?m \<and> incl ?m' \<and> seq ?m f \<and> seq ?m' f' \<and> ?m \<cdot> f = ?m' \<cdot> f'"
         using seq \<open>incl ?m\<close> \<open>incl ?m'\<close> by simp
       thus "\<exists>m m'. incl m \<and> incl m' \<and> seq m f \<and> seq m' f' \<and> m \<cdot> f = m' \<cdot> f'" by auto
       next
       assume ff': "\<exists>m m'. incl m \<and> incl m' \<and> seq m f \<and> seq m' f' \<and> m \<cdot> f = m' \<cdot> f'"
       show "Fun f = Fun f'"
       proof -
         from ff' obtain m m'
         where mm': "incl m \<and> incl m' \<and> seq m f \<and> seq m' f' \<and> m \<cdot> f = m' \<cdot> f'"
           by blast
         show ?thesis
           using ff' mm' Fun_incl seqE
           by (metis Fun_comp Fun_ide comp_cod_arr ide_cod)
       qed
     qed
 
     text\<open>
       Another answer to the same question: two arrows with a common domain determine the
       same function if and only if their corestrictions are equal.
 \<close>
 
     lemma eq_Fun_iff_eq_corestr:
     assumes "span f f'"
     shows "Fun f = Fun f' \<longleftrightarrow> corestr f = corestr f'"
       using assms corestr_def Fun_corestr by metis
 
     subsection "Retractions, Sections, and Isomorphisms"
 
     text\<open>
       An arrow is a retraction if and only if its image coincides with its codomain.
 \<close>
 
     lemma retraction_if_Img_eq_Cod:
     assumes "arr g" and "Img g = Cod g"
     shows "retraction g"
     and "ide (g \<cdot> mkArr (Cod g) (Dom g) (inv_into (Dom g) (Fun g)))"
     proof -
       let ?F = "inv_into (Dom g) (Fun g)"
       let ?f = "mkArr (Cod g) (Dom g) ?F"
       have f: "arr ?f"
       proof
         have "Cod g \<subseteq> Univ \<and> Dom g \<subseteq> Univ" using assms by auto
         moreover have "?F \<in> Cod g \<rightarrow> Dom g"
         proof
           fix y
           assume y: "y \<in> Cod g"
           let ?P = "\<lambda>x. x \<in> Dom g \<and> Fun g x = y"
           have "\<exists>x. ?P x" using y assms by force
           hence "?P (SOME x. ?P x)" using someI_ex [of ?P] by fast
           hence "?P (?F y)" using Hilbert_Choice.inv_into_def by metis
           thus "?F y \<in> Dom g" by auto
         qed
         ultimately show "Cod g \<subseteq> Univ \<and> Dom g \<subseteq> Univ \<and> ?F \<in> Cod g \<rightarrow> Dom g" by auto
       qed
       show "ide (g \<cdot> ?f)"
       proof -
         have "g = mkArr (Dom g) (Cod g) (Fun g)" using assms by auto
         hence "g \<cdot> ?f = mkArr (Cod g) (Cod g) (Fun g o ?F)"
           using assms(1) f comp_mkArr by metis
         moreover have "mkArr (Cod g) (Cod g) (\<lambda>y. y) = ..."
         proof (intro mkArr_eqI')
           show "arr (mkArr (Cod g) (Cod g) (\<lambda>y. y))"
             using assms arr_cod_iff_arr by auto
           show "\<And>y. y \<in> Cod g \<Longrightarrow> y = (Fun g o ?F) y"
             using assms by (simp add: f_inv_into_f)
         qed
         ultimately show ?thesis using assms f by auto
       qed
       thus "retraction g" by auto
     qed
 
     lemma retraction_char:
     shows "retraction g \<longleftrightarrow> arr g \<and> Img g = Cod g"
     proof
       assume G: "retraction g"
       show "arr g \<and> Img g = Cod g"
       proof
         show "arr g" using G by blast
         show "Img g = Cod g"
         proof -
           from G obtain f where f: "ide (g \<cdot> f)" by blast
           have "restrict (Fun g o Fun f) (Cod g) = restrict (\<lambda>x. x) (Cod g)"
             using f Fun_comp Fun_ide ide_compE by metis
           hence "Fun g ` Fun f ` Cod g = Cod g"
             by (metis image_comp image_ident image_restrict_eq)
           moreover have "Fun f ` Cod g \<subseteq> Dom g"
             using f Fun_mapsto arr_mkArr mkArr_Fun funcset_image
             by (metis seqE ide_compE ide_compE)
           moreover have "Img g \<subseteq> Cod g"
             using f Fun_mapsto by blast
           ultimately show ?thesis by blast
         qed
       qed
       next
       assume "arr g \<and> Img g = Cod g"
       thus "retraction g" using retraction_if_Img_eq_Cod by blast
     qed
 
     text\<open>
       Every corestriction is a retraction.
 \<close>
 
     lemma retraction_corestr:
     assumes "arr f"
     shows "retraction (corestr f)"
       using assms retraction_char Fun_corestr corestr_in_hom by fastforce
 
     text\<open>
       An arrow is a section if and only if it induces an injective function on its
       domain, except in the special case that it has an empty domain set and a
       nonempty codomain set.
 \<close>
 
     lemma section_if_inj:
     assumes "arr f" and "inj_on (Fun f) (Dom f)" and "Dom f = {} \<longrightarrow> Cod f = {}"
     shows "section f"
     and "ide (mkArr (Cod f) (Dom f)
                     (\<lambda>y. if y \<in> Img f then SOME x. x \<in> Dom f \<and> Fun f x = y
                          else SOME x. x \<in> Dom f)
                 \<cdot> f)"
     proof -
       let ?P= "\<lambda>y. \<lambda>x. x \<in> Dom f \<and> Fun f x = y"
       let ?G = "\<lambda>y. if y \<in> Img f then SOME x. ?P y x else SOME x. x \<in> Dom f"
       let ?g = "mkArr (Cod f) (Dom f) ?G"
       have g: "arr ?g"
       proof -
         have 1: "Cod f \<subseteq> Univ" using assms by simp
         have 2: "Dom f \<subseteq> Univ" using assms by simp
         have 3: "?G \<in> Cod f \<rightarrow> Dom f"
         proof
           fix y
           assume Y: "y \<in> Cod f"
           show "?G y \<in> Dom f"
           proof (cases "y \<in> Img f")
             assume "y \<in> Img f"
             hence "(\<exists>x. ?P y x) \<and> ?G y = (SOME x. ?P y x)" using Y by auto
             hence "?P y (?G y)" using someI_ex [of "?P y"] by argo
             thus "?G y \<in> Dom f" by auto
             next
             assume "y \<notin> Img f"
             hence "(\<exists>x. x \<in> Dom f) \<and> ?G y = (SOME x. x \<in> Dom f)" using assms Y by auto
             thus "?G y \<in> Dom f" using someI_ex [of "\<lambda>x. x \<in> Dom f"] by argo
           qed
         qed
         show ?thesis using 1 2 3 by simp
       qed
       show "ide (?g \<cdot> f)"
       proof -
         have "f = mkArr (Dom f) (Cod f) (Fun f)" using assms by auto
         hence "?g \<cdot> f = mkArr (Dom f) (Dom f) (?G o Fun f)"
           using assms(1) g comp_mkArr [of "Dom f" "Cod f" "Fun f" "Dom f" ?G] by argo
         moreover have "mkArr (Dom f) (Dom f) (\<lambda>x. x) = ..."
         proof (intro mkArr_eqI')
           show "arr (mkArr (Dom f) (Dom f) (\<lambda>x. x))" using assms by auto
           show "\<And>x. x \<in> Dom f \<Longrightarrow> x = (?G o Fun f) x"
           proof -
             fix x
             assume x: "x \<in> Dom f"
             have "Fun f x \<in> Img f" using x by blast
             hence *: "(\<exists>x'. ?P (Fun f x) x') \<and> ?G (Fun f x) = (SOME x'. ?P (Fun f x) x')"
               by auto
             then have "?P (Fun f x) (?G (Fun f x))"
               using someI_ex [of "?P (Fun f x)"] by argo
             with * have "x = ?G (Fun f x)"
               using assms x inj_on_def [of "Fun f" "Dom f"] by simp
             thus "x = (?G o Fun f) x" by simp
           qed
         qed
         ultimately show ?thesis using assms by auto
       qed
       thus "section f" by auto
     qed
 
     lemma section_char:
     shows "section f \<longleftrightarrow> arr f \<and> (Dom f = {} \<longrightarrow> Cod f = {}) \<and> inj_on (Fun f) (Dom f)"
     proof
       assume f: "section f"
       from f obtain g where g: "ide (g \<cdot> f)" using section_def by blast
       show "arr f \<and> (Dom f = {} \<longrightarrow> Cod f = {}) \<and> inj_on (Fun f) (Dom f)"
       proof -
         have "arr f" using f by blast
         moreover have "Dom f = {} \<longrightarrow> Cod f = {}"
         proof -
           have "Cod f \<noteq> {} \<longrightarrow> Dom f \<noteq> {}"
           proof
             assume "Cod f \<noteq> {}"
             from this obtain y where "y \<in> Cod f" by blast
             hence "Fun g y \<in> Dom f"
               using g Fun_mapsto
               by (metis seqE ide_compE image_eqI retractionI retraction_char)
             thus "Dom f \<noteq> {}" by blast
           qed
           thus ?thesis by auto
         qed
         moreover have "inj_on (Fun f) (Dom f)"
         proof -
           have "restrict (Fun g o Fun f) (Dom f) = Fun (g \<cdot> f)"
             using g Fun_comp by (metis Fun_comp ide_compE)
           also have "... = restrict (\<lambda>x. x) (Dom f)"
             using g Fun_ide by auto
           finally have "restrict (Fun g o Fun f) (Dom f) = restrict (\<lambda>x. x) (Dom f)" by auto
           thus ?thesis using inj_onI inj_on_imageI2 inj_on_restrict_eq by metis
         qed
         ultimately show ?thesis by auto
       qed
       next
       assume F: "arr f \<and> (Dom f = {} \<longrightarrow> Cod f = {}) \<and> inj_on (Fun f) (Dom f)"
       thus "section f" using section_if_inj by auto
     qed
 
     text\<open>
       Section-retraction pairs can also be characterized by an inverse relationship
       between the functions they induce.
 \<close>
 
     lemma section_retraction_char:
     shows "ide (g \<cdot> f) \<longleftrightarrow> antipar f g \<and> compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x)"
     proof
       show "ide (g \<cdot> f) \<Longrightarrow> antipar f g \<and> compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x)"
       proof -
         assume fg: "ide (g \<cdot> f)"
         have 1: "antipar f g" using fg by force
         moreover have "compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x)"
         proof
           fix x
           have "x \<notin> Dom f \<Longrightarrow> compose (Dom f) (Fun g) (Fun f) x = (\<lambda>x \<in> Dom f. x) x"
             by (simp add: compose_def)
           moreover have "x \<in> Dom f \<Longrightarrow>
                          compose (Dom f) (Fun g) (Fun f) x = (\<lambda>x \<in> Dom f. x) x"
             using fg 1 Fun_comp by (metis Fun_comp Fun_ide compose_eq' ide_compE)
           ultimately show "compose (Dom f) (Fun g) (Fun f) x = (\<lambda>x \<in> Dom f. x) x" by auto
         qed
         ultimately show ?thesis by auto
       qed
       show "antipar f g \<and> compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x) \<Longrightarrow> ide (g \<cdot> f)"
       proof -
         assume fg: "antipar f g \<and> compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x)"
         show "ide (g \<cdot> f)"
         proof -
           have 1: "arr (g \<cdot> f)" using fg by auto
           moreover have "Dom (g \<cdot> f) = Cod (S g f)"
             using fg 1 by force
           moreover have "Fun (g \<cdot> f) = (\<lambda>x \<in> Dom (g \<cdot> f). x)"
             using fg 1 by force
           ultimately show ?thesis using 1 ide_char by blast
         qed
       qed
     qed
 
     text\<open>
       Antiparallel arrows @{term f} and @{term g} are inverses if the functions
       they induce are inverses.
 \<close>
 
     lemma inverse_arrows_char:
     shows "inverse_arrows f g \<longleftrightarrow>
              antipar f g \<and> compose (Dom f) (Fun g) (Fun f) = (\<lambda>x \<in> Dom f. x)
                          \<and> compose (Dom g) (Fun f) (Fun g) = (\<lambda>y \<in> Dom g. y)"
       using section_retraction_char by blast
 
     text\<open>
       An arrow is an isomorphism if and only if the function it induces is a bijection.
 \<close>
 
     lemma iso_char:
     shows "iso f \<longleftrightarrow> arr f \<and> bij_betw (Fun f) (Dom f) (Cod f)"
     proof -
       have "iso f \<longleftrightarrow> section f \<and> retraction f"
         using iso_iff_section_and_retraction by auto
       also have "... \<longleftrightarrow> arr f \<and> inj_on (Fun f) (Dom f) \<and> Img f = Cod f"
         using section_char retraction_char by force
       also have "... \<longleftrightarrow> arr f \<and> bij_betw (Fun f) (Dom f) (Cod f)"
         using inj_on_def bij_betw_def [of "Fun f" "Dom f" "Cod f"] by meson
       finally show ?thesis by auto
     qed
 
     text\<open>
       The inverse of an isomorphism is constructed by inverting the induced function.
 \<close>
 
     lemma inv_char:
     assumes "iso f"
     shows "inv f = mkArr (Cod f) (Dom f) (inv_into (Dom f) (Fun f))"
     proof -
       let ?g = "mkArr (Cod f) (Dom f) (inv_into (Dom f) (Fun f))"
       have "ide (f \<cdot> ?g)"
         using assms iso_is_retraction retraction_char retraction_if_Img_eq_Cod by simp
       moreover have "ide (?g \<cdot> f)"
       proof -
         let ?g' = "mkArr (Cod f) (Dom f)
                          (\<lambda>y. if y \<in> Img f then SOME x. x \<in> Dom f \<and> Fun f x = y
                               else SOME x. x \<in> Dom f)"
         have 1: "ide (?g' \<cdot> f)"
           using assms iso_is_section section_char section_if_inj by simp
         moreover have "?g' = ?g"
         proof
           show "arr ?g'" using 1 ide_compE by blast
           show "\<And>y. y \<in> Cod f \<Longrightarrow> (if y \<in> Img f then SOME x. x \<in> Dom f \<and> Fun f x = y
                                                   else SOME x. x \<in> Dom f)
                                      = inv_into (Dom f) (Fun f) y"
           proof -
             fix y
             assume "y \<in> Cod f"
             hence "y \<in> Img f" using assms iso_is_retraction retraction_char by metis
             thus "(if y \<in> Img f then SOME x. x \<in> Dom f \<and> Fun f x = y
                    else SOME x. x \<in> Dom f)
                      = inv_into (Dom f) (Fun f) y"
               using inv_into_def by metis
           qed
         qed
         ultimately show ?thesis by auto
       qed
       ultimately have "inverse_arrows f ?g" by auto
       thus ?thesis using inverse_unique by blast
     qed
 
     lemma Fun_inv:
     assumes "iso f"
     shows "Fun (inv f) = restrict (inv_into (Dom f) (Fun f)) (Cod f)"
       using assms inv_in_hom inv_char iso_inv_iso iso_is_arr Fun_mkArr by metis
 
     subsection "Monomorphisms and Epimorphisms"
 
     text\<open>
       An arrow is a monomorphism if and only if the function it induces is injective.
 \<close>
 
     lemma mono_char:
     shows "mono f \<longleftrightarrow> arr f \<and> inj_on (Fun f) (Dom f)"
     proof
       assume f: "mono f"
       hence "arr f" using mono_def by auto
       moreover have "inj_on (Fun f) (Dom f)"
       proof (intro inj_onI)
         have 0: "inj_on (S f) (hom unity (dom f))"
         proof -
           have "hom unity (dom f) \<subseteq> {g. seq f g}"
             using f mono_def arrI by auto
           hence "\<exists>A. hom unity (dom f) \<subseteq> A \<and> inj_on (S f) A"
             using f mono_def by auto
           thus ?thesis
             by (meson subset_inj_on)
         qed
         fix x x'
         assume x: "x \<in> Dom f" and x': "x' \<in> Dom f" and xx': "Fun f x = Fun f x'"
         have 1: "mkPoint (dom f) x \<in> hom unity (dom f) \<and>
                  mkPoint (dom f) x' \<in> hom unity (dom f)"
           using x x' \<open>arr f\<close> mkPoint_in_hom by simp
         have "f \<cdot> mkPoint (dom f) x = f \<cdot> mkPoint (dom f) x'"
           using \<open>arr f\<close> x x' xx' comp_arr_mkPoint by simp
         hence "mkPoint (dom f) x = mkPoint (dom f) x'"
           using 0 1 inj_onD [of "S f" "hom unity (dom f)" "mkPoint (dom f) x"] by simp
         thus "x = x'"
           using \<open>arr f\<close> x x' img_mkPoint(2) img_mkPoint(2) ide_dom by metis
       qed
       ultimately show "arr f \<and> inj_on (Fun f) (Dom f)" by auto
       next
       assume f: "arr f \<and> inj_on (Fun f) (Dom f)"
       show "mono f"
       proof
         show "arr f" using f by auto
         show "\<And>g g'. seq f g \<and> seq f g' \<and> f \<cdot> g = f \<cdot> g' \<Longrightarrow> g = g'"
         proof -
           fix g g'
           assume gg': "seq f g \<and> seq f g' \<and> f \<cdot> g = f \<cdot> g'"
           show "g = g'"
           proof (intro arr_eqI)
             show par: "par g g'"
               using gg' dom_comp by (metis seqE)
             show "Fun g = Fun g'"
             proof
               fix x
               have "x \<notin> Dom g \<Longrightarrow> Fun g x = Fun g' x"
                 using gg' by (simp add: par Fun_def)
               moreover have "x \<in> Dom g \<Longrightarrow> Fun g x = Fun g' x"
               proof -
                 assume x: "x \<in> Dom g"
                 have "Fun f (Fun g x) = Fun (f \<cdot> g) x"
                   using gg' x Fun_comp [of f g] by auto
                 also have "... = Fun f (Fun g' x)"
                   using par f gg' x monoE by simp
                 finally have "Fun f (Fun g x) = Fun f (Fun g' x)" by auto
                 moreover have "Fun g x \<in> Dom f \<and> Fun g' x \<in> Dom f"
                   using par gg' x Fun_mapsto by fastforce
                 ultimately show "Fun g x = Fun g' x"
                   using f gg' inj_onD [of "Fun f" "Dom f" "Fun g x" "Fun g' x"]
                   by simp
               qed
               ultimately show "Fun g x = Fun g' x" by auto
             qed
           qed
         qed
       qed
     qed
 
     text\<open>
       Inclusions are monomorphisms.
 \<close>
 
     lemma mono_imp_incl:
     assumes "incl f"
     shows "mono f"
       using assms incl_def Fun_incl mono_char by auto
 
     text\<open>
       A monomorphism is a section, except in case it has an empty domain set and
       a nonempty codomain set.
 \<close>
 
     lemma mono_imp_section:
     assumes "mono f" and "Dom f = {} \<longrightarrow> Cod f = {}"
     shows "section f"
       using assms mono_char section_char by auto
 
     text\<open>
       An arrow is an epimorphism if and only if either its image coincides with its
       codomain, or else the universe has only a single element (in which case all arrows
       are epimorphisms).
 \<close>
   
     lemma epi_char:
     shows "epi f \<longleftrightarrow> arr f \<and> (Img f = Cod f \<or> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t'))"
     proof
       assume epi: "epi f"
       show "arr f \<and> (Img f = Cod f \<or> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t'))"
       proof -
         have f: "arr f" using epi epi_implies_arr by auto
         moreover have "\<not>(\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t') \<Longrightarrow> Img f = Cod f"
         proof -
           assume "\<not>(\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t')"
           from this obtain tt and ff
             where B: "tt \<in> Univ \<and> ff \<in> Univ \<and> tt \<noteq> ff" by blast
           show "Img f = Cod f"
           proof
             show "Img f \<subseteq> Cod f" using f Fun_mapsto by auto
             show "Cod f \<subseteq> Img f"
             proof
               let ?g = "mkArr (Cod f) {ff, tt} (\<lambda>y. tt)"
               let ?g' = "mkArr (Cod f) {ff, tt} (\<lambda>y. if \<exists>x. x \<in> Dom f \<and> Fun f x = y
                                                      then tt else ff)"
               let ?b = "mkIde {ff, tt}"
               have g: "\<guillemotleft>?g : cod f \<rightarrow> ?b\<guillemotright> \<and> Fun ?g = (\<lambda>y \<in> Cod f. tt)"
                 using f B in_homI [of ?g] by simp
               have g': "?g' \<in> hom (cod f) ?b \<and>
                         Fun ?g' = (\<lambda>y \<in> Cod f. if \<exists>x. x \<in> Dom f \<and> Fun f x = y then tt else ff)"
                 using f B in_homI [of ?g'] by simp
               have "?g \<cdot> f = ?g' \<cdot> f"
               proof (intro arr_eqI)
                 show "par (?g \<cdot> f) (?g' \<cdot> f)"
                   using f g g' by auto
                 show "Fun (?g \<cdot> f) = Fun (?g' \<cdot> f)"
                   using f g g' Fun_comp comp_mkArr by force
               qed
               hence gg': "?g = ?g'"
                 using epi f g g' epiE [of f ?g ?g'] by fastforce
               fix y
               assume y: "y \<in> Cod f"
               have "Fun ?g' y = tt" using gg' g y by simp
               hence "(if \<exists>x. x \<in> Dom f \<and> Fun f x = y then tt else ff) = tt"
                 using g' y by simp
               hence "\<exists>x. x \<in> Dom f \<and> Fun f x = y"
                 using B by argo
               thus "y \<in> Img f" by blast
             qed
           qed
         qed
         ultimately show "arr f \<and> (Img f = Cod f \<or> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t'))"
           by fast
       qed
       next
       show "arr f \<and> (Img f = Cod f \<or> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t')) \<Longrightarrow> epi f"
       proof -
         have "arr f \<and> Img f = Cod f \<Longrightarrow> epi f"
         proof -
           assume f: "arr f \<and> Img f = Cod f"
           show "epi f"
             using f arr_eqI' epiE retractionI retraction_if_Img_eq_Cod retraction_is_epi
             by meson
         qed
         moreover have "arr f \<and> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t') \<Longrightarrow> epi f"
         proof -
           assume f: "arr f \<and> (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t')"
           have "\<And>f f'. par f f' \<Longrightarrow> f = f'"
           proof -
             fix f f'
             assume ff': "par f f'"
             show "f = f'"
             proof (intro arr_eqI)
               show "par f f'" using ff' by simp
               have "\<And>t t'. t \<in> Cod f \<and> t' \<in> Cod f \<Longrightarrow> t = t'"
                 using f ff' set_subset_Univ ide_cod subsetD by blast
               thus "Fun f = Fun f'"
                 using ff' Fun_mapsto [of f] Fun_mapsto [of f']
                       extensional_arb [of "Fun f" "Dom f"] extensional_arb [of "Fun f'" "Dom f"]
                 by fastforce
             qed
           qed
           moreover have "\<And>g g'. par (g \<cdot> f) (g' \<cdot> f) \<Longrightarrow> par g g'"
             by force
           ultimately show "epi f"
             using f by (intro epiI; metis)
         qed
         ultimately show "arr f \<and> (Img f = Cod f \<or>  (\<forall>t t'. t \<in> Univ \<and> t' \<in> Univ \<longrightarrow> t = t'))
                            \<Longrightarrow> epi f"
           by auto
       qed
     qed
 
     text\<open>
       An epimorphism is a retraction, except in the case of a degenerate universe with only
       a single element.
 \<close>
 
     lemma epi_imp_retraction:
     assumes "epi f" and "\<exists>t t'. t \<in> Univ \<and> t' \<in> Univ \<and> t \<noteq> t'"
     shows "retraction f"
       using assms epi_char retraction_char by auto
 
     text\<open>
       Retraction/inclusion factorization is unique (not just up to isomorphism -- remember
       that the notion of inclusion is not categorical but depends on the arbitrarily chosen
       @{term img}).
 \<close>
 
     lemma unique_retr_incl_fact:
     assumes "seq m e" and "seq m' e'" and "m \<cdot> e = m' \<cdot> e'"
     and "incl m" and "incl m'" and "retraction e" and "retraction e'"
     shows "m = m'" and "e = e'"
     proof -
       have 1: "cod m = cod m' \<and> dom e = dom e'"
         using assms(1-3) by (metis dom_comp cod_comp)
       hence 2: "span e e'" using assms(1-2) by blast
       hence 3: "Fun e = Fun e'"
         using assms eq_Fun_iff_incl_joinable by meson
       hence "img e = img e'" using assms 1 img_def by auto
       moreover have "img e = cod e \<and> img e' = cod e'"
         using assms(6-7) retraction_char img_def by simp
       ultimately have "par e e'" using 2 by simp
       thus "e = e'" using 3 arr_eqI by blast
       hence "par m m'" using assms(1) assms(2) 1 by fastforce
       thus "m = m'" using assms(4) assms(5) incls_coherent by blast
     qed
 
   end
 
   section "Concrete Set Categories"
 
   text\<open>
     The \<open>set_category\<close> locale is useful for stating results that depend on a
     category of @{typ 'a}-sets and functions, without having to commit to a particular
     element type @{typ 'a}.  However, in applications we often need to work with a
     category of sets and functions that is guaranteed to contain sets corresponding
     to the subsets of some extrinsically given type @{typ 'a}.
     A \emph{concrete set category} is a set category \<open>S\<close> that is equipped
     with an injective function @{term \<iota>} from type @{typ 'a} to \<open>S.Univ\<close>.
     The following locale serves to facilitate some of the technical aspects of passing
     back and forth between elements of type @{typ 'a} and the elements of \<open>S.Univ\<close>.
 \<close>
 
   locale concrete_set_category = set_category S
     for S :: "'s comp"      (infixr "\<cdot>\<^sub>S" 55)
     and U :: "'a set"
     and \<iota> :: "'a \<Rightarrow> 's" +
     assumes \<iota>_mapsto: "\<iota> \<in> U \<rightarrow> Univ"
     and inj_\<iota>: "inj_on \<iota> U"
   begin
 
     abbreviation \<o>
     where "\<o> \<equiv> inv_into U \<iota>"
 
     lemma \<o>_mapsto:
     shows "\<o> \<in> \<iota> ` U \<rightarrow> U"
       by (simp add: inv_into_into)
 
     lemma \<o>_\<iota> [simp]:
     assumes "x \<in> U"
     shows "\<o> (\<iota> x) = x"
       using assms inj_\<iota> inv_into_f_f by simp
       
     lemma \<iota>_\<o> [simp]:
     assumes "t \<in> \<iota> ` U"
     shows "\<iota> (\<o> t) = t"
       using assms o_def inj_\<iota> by auto
 
   end
 
 end
diff --git a/thys/CoreC++/Progress.thy b/thys/CoreC++/Progress.thy
--- a/thys/CoreC++/Progress.thy
+++ b/thys/CoreC++/Progress.thy
@@ -1,1042 +1,1042 @@
 (*  Title:       CoreC++
 
     Author:      Daniel Wasserrab
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 
     Based on the Jinja theory J/Progress.thy by Tobias Nipkow 
 *)
 
 section \<open>Progress of Small Step Semantics\<close>
 
 theory Progress imports Equivalence DefAss Conform begin
 
 
 subsection \<open>Some pre-definitions\<close>
 
 lemma final_refE:
   "\<lbrakk> P,E,h \<turnstile> e : Class C; final e;
     \<And>r. e = ref r \<Longrightarrow> Q;
     \<And>r. e = Throw r \<Longrightarrow> Q \<rbrakk> \<Longrightarrow> Q"
 by (simp add:final_def,auto,case_tac v,auto)
 
 
 lemma finalRefE:
   "\<lbrakk> P,E,h \<turnstile> e : T; is_refT T; final e;
   e = null \<Longrightarrow> Q;
   \<And>r. e = ref r \<Longrightarrow> Q;
   \<And>r. e = Throw r \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
 
 apply (cases T)
 apply (simp add:is_refT_def)+
  apply (simp add:final_def)
  apply (erule disjE)
   apply clarsimp
  apply (erule exE)+
 apply fastforce
 apply (auto simp:final_def is_refT_def)
 apply (case_tac v)
 apply auto
 done
 
 
 lemma subE:
   "\<lbrakk> P \<turnstile> T \<le> T'; is_type P T'; wf_prog wf_md P;
      \<lbrakk> T = T'; \<forall>C. T \<noteq> Class C \<rbrakk> \<Longrightarrow> Q;
      \<And>C D. \<lbrakk> T = Class C; T' = Class D; P \<turnstile> Path C to D unique \<rbrakk> \<Longrightarrow> Q;
      \<And>C. \<lbrakk> T = NT; T' = Class C \<rbrakk> \<Longrightarrow> Q \<rbrakk> \<Longrightarrow> Q"
 
 apply(cases T')
 apply auto
 apply(drule_tac T = "T" in widen_Class)
 apply auto
 done
 
 
 lemma assumes wf:"wf_prog wf_md P"
   and typeof:" P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T'"
   and type:"is_type P T"
 shows sub_casts:"P \<turnstile> T' \<le> T \<Longrightarrow> \<exists>v'. P \<turnstile> T casts v to v'"
 
 proof(erule subE)
   from type show "is_type P T" .
 next
   from wf show "wf_prog wf_md P" .
 next
   assume "T' = T" and "\<forall>C. T' \<noteq> Class C"
   thus "\<exists>v'. P \<turnstile> T casts v to v'" by(fastforce intro:casts_prim)
 next
   fix C D
   assume T':"T' = Class C" and T:"T = Class D"
     and path_unique:"P \<turnstile> Path C to D unique"
   from T' typeof obtain a Cs where v:"v = Ref(a,Cs)" and last:"last Cs = C"
     by(auto dest!:typeof_Class_Subo)
   from last path_unique obtain Cs' where "P \<turnstile> Path last Cs to D via Cs'"
     by(auto simp:path_unique_def path_via_def)
   hence "P \<turnstile> Class D casts Ref(a,Cs) to Ref(a,Cs@\<^sub>pCs')"
     by -(rule casts_ref,simp_all)
   with T v show "\<exists>v'. P \<turnstile> T casts v to v'" by auto
 next
   fix C
   assume "T' = NT" and T:"T = Class C"
   with typeof have "v = Null" by simp
   with T show "\<exists>v'. P \<turnstile> T casts v to v'" by(fastforce intro:casts_null)
 qed
 
 
 
 text\<open>Derivation of new induction scheme for well typing:\<close>
 
 inductive
   WTrt' :: "[prog,env,heap,expr,     ty     ] \<Rightarrow> bool"
-        ("_,_,_ \<turnstile> _ :' _"   [51,51,51]50)
+        ("_,_,_ \<turnstile> _ :'' _"   [51,51,51]50)
   and WTrts':: "[prog,env,heap,expr list,ty list] \<Rightarrow> bool"
         ("_,_,_ \<turnstile> _ [:''] _" [51,51,51]50)
   for P :: prog
 where
   "is_class P C \<Longrightarrow>  P,E,h \<turnstile> new C :' Class C"
 | "\<lbrakk>is_class P C; P,E,h \<turnstile> e :' T; is_refT T\<rbrakk> 
    \<Longrightarrow> P,E,h \<turnstile> Cast C e :' Class C"
 | "\<lbrakk>is_class P C; P,E,h \<turnstile> e :' T; is_refT T\<rbrakk> 
    \<Longrightarrow> P,E,h \<turnstile> \<lparr>C\<rparr>e :' Class C"
 | "P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T \<Longrightarrow> P,E,h \<turnstile> Val v :' T"
 | "E V = Some T  \<Longrightarrow>  P,E,h \<turnstile> Var V :' T"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2 :' T\<^sub>2;
     case bop of Eq \<Rightarrow> T = Boolean
     | Add \<Rightarrow> T\<^sub>1 = Integer \<and> T\<^sub>2 = Integer \<and> T = Integer \<rbrakk>
    \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 :' T"
 | "\<lbrakk> P,E,h \<turnstile> Var V :' T; P,E,h \<turnstile> e :' T' \<^cancel>\<open>V \<noteq> This\<close>; P \<turnstile> T' \<le> T \<rbrakk>
    \<Longrightarrow> P,E,h \<turnstile> V:=e :' T"
 | "\<lbrakk>P,E,h \<turnstile> e :' Class C; Cs \<noteq> []; P \<turnstile> C has least F:T via Cs\<rbrakk> 
   \<Longrightarrow> P,E,h \<turnstile> e\<bullet>F{Cs} :' T"
 | "P,E,h \<turnstile> e :' NT \<Longrightarrow> P,E,h \<turnstile> e\<bullet>F{Cs} :' T"
 | "\<lbrakk>P,E,h \<turnstile> e\<^sub>1 :' Class C; Cs \<noteq> []; P \<turnstile> C has least F:T via Cs;
     P,E,h \<turnstile> e\<^sub>2 :' T'; P \<turnstile> T' \<le> T \<rbrakk> 
   \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2 :' T"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1:'NT; P,E,h \<turnstile> e\<^sub>2 :' T'; P \<turnstile> T' \<le> T \<rbrakk> 
    \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2 :' T"
 | "\<lbrakk> P,E,h \<turnstile> e :' Class C;  P \<turnstile> C has least M = (Ts,T,m) via Cs;
     P,E,h \<turnstile> es [:'] Ts'; P \<turnstile> Ts' [\<le>] Ts \<rbrakk>
     \<Longrightarrow> P,E,h \<turnstile> e\<bullet>M(es) :' T" 
 | "\<lbrakk> P,E,h \<turnstile> e :' Class C'; P \<turnstile> Path C' to C unique;
     P \<turnstile> C has least M = (Ts,T,m) via Cs; 
     P,E,h \<turnstile> es [:'] Ts'; P \<turnstile> Ts' [\<le>] Ts \<rbrakk>
     \<Longrightarrow> P,E,h \<turnstile> e\<bullet>(C::)M(es) :' T"
 | "\<lbrakk>P,E,h \<turnstile> e :' NT; P,E,h \<turnstile> es [:'] Ts\<rbrakk> \<Longrightarrow> P,E,h \<turnstile> Call e Copt M es :' T"
 | "\<lbrakk> P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T'; P,E(V\<mapsto>T),h \<turnstile> e\<^sub>2 :' T\<^sub>2; P \<turnstile> T' \<le> T; is_type P T \<rbrakk>
    \<Longrightarrow>  P,E,h \<turnstile> {V:T := Val v; e\<^sub>2} :' T\<^sub>2"
 | "\<lbrakk> P,E(V\<mapsto>T),h \<turnstile> e :' T'; \<not> assigned V e; is_type P T \<rbrakk>
    \<Longrightarrow>  P,E,h \<turnstile> {V:T; e} :' T'"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' T\<^sub>1; P,E,h \<turnstile> e\<^sub>2 :' T\<^sub>2 \<rbrakk>  \<Longrightarrow>  P,E,h \<turnstile> e\<^sub>1;;e\<^sub>2 :' T\<^sub>2"
 | "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> e\<^sub>1:' T;  P,E,h \<turnstile> e\<^sub>2:' T \<rbrakk>
    \<Longrightarrow> P,E,h \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :' T"
 | "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> c:' T \<rbrakk>
    \<Longrightarrow>  P,E,h \<turnstile> while(e) c :' Void"
 | "\<lbrakk> P,E,h \<turnstile> e :' T'; is_refT T'\<rbrakk>  \<Longrightarrow>  P,E,h \<turnstile> throw e :' T"
 
 | "P,E,h \<turnstile> [] [:'] []"
 | "\<lbrakk> P,E,h \<turnstile> e :' T;  P,E,h \<turnstile> es [:'] Ts \<rbrakk> \<Longrightarrow>  P,E,h \<turnstile> e#es [:'] T#Ts"
 
 
 
 lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
   and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]
 
 inductive_cases WTrt'_elim_cases[elim!]:
   "P,E,h \<turnstile> V :=e :' T"
 
 
 text\<open>... and some easy consequences:\<close>
 
 lemma [iff]: "P,E,h \<turnstile> e\<^sub>1;;e\<^sub>2 :' T\<^sub>2 = (\<exists>T\<^sub>1. P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1 \<and> P,E,h \<turnstile> e\<^sub>2:' T\<^sub>2)"
 
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 
 
 lemma [iff]: "P,E,h \<turnstile> Val v :' T = (P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T)"
 
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 
 
 lemma [iff]: "P,E,h \<turnstile> Var V :' T = (E V = Some T)"
 
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 
 
 
 lemma wt_wt': "P,E,h \<turnstile> e : T \<Longrightarrow> P,E,h \<turnstile> e :' T"
 and wts_wts': "P,E,h \<turnstile> es [:] Ts \<Longrightarrow> P,E,h \<turnstile> es [:'] Ts"
 
 proof (induct rule:WTrt_inducts)
   case (WTrtBlock E V T h e T')
   thus ?case
     apply(case_tac "assigned V e")
     apply(auto intro:WTrt'_WTrts'.intros 
           simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
     done
 qed(auto intro:WTrt'_WTrts'.intros simp del:fun_upd_apply)
 
 
 lemma wt'_wt: "P,E,h \<turnstile> e :' T \<Longrightarrow> P,E,h \<turnstile> e : T"
 and wts'_wts: "P,E,h \<turnstile> es [:'] Ts \<Longrightarrow> P,E,h \<turnstile> es [:] Ts"
 
 apply (induct rule:WTrt'_inducts)
 apply (fastforce intro: WTrt_WTrts.intros)+
 done
 
 
 
 corollary wt'_iff_wt: "(P,E,h \<turnstile> e :' T) = (P,E,h \<turnstile> e : T)"
 by(blast intro:wt_wt' wt'_wt)
 
 
 corollary wts'_iff_wts: "(P,E,h \<turnstile> es [:'] Ts) = (P,E,h \<turnstile> es [:] Ts)"
 by(blast intro:wts_wts' wts'_wts)
 
 lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
   case_names WTrtNew WTrtDynCast WTrtStaticCast WTrtVal WTrtVar WTrtBinOp 
   WTrtLAss WTrtFAcc WTrtFAccNT WTrtFAss WTrtFAssNT WTrtCall WTrtStaticCall WTrtCallNT 
   WTrtInitBlock WTrtBlock WTrtSeq WTrtCond WTrtWhile WTrtThrow 
   WTrtNil WTrtCons, consumes 1]
 
 
 subsection\<open>The theorem \<open>progress\<close>\<close>
 
 
 lemma mdc_leq_dyn_type:
 "P,E,h \<turnstile> e : T \<Longrightarrow> 
   \<forall>C a Cs D S. T = Class C \<and> e = ref(a,Cs) \<and> h a = Some(D,S) \<longrightarrow> P \<turnstile> D \<preceq>\<^sup>* C"
 and "P,E,h \<turnstile> es [:] Ts \<Longrightarrow>
   \<forall>T Ts' e es' C a Cs D S. Ts = T#Ts' \<and> es = e#es' \<and> 
                            T = Class C \<and> e = ref(a,Cs) \<and> h a = Some(D,S)
       \<longrightarrow> P \<turnstile> D \<preceq>\<^sup>* C"
 
 proof (induct rule:WTrt_inducts2)
   case (WTrtVal h v T E)
   have type:"P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T" by fact
   { fix C a Cs D S
     assume "T = Class C" and "Val v = ref(a,Cs)" and "h a = Some(D,S)"
     with type have "Subobjs P D Cs" and "C = last Cs" by (auto split:if_split_asm)
     hence "P \<turnstile> D \<preceq>\<^sup>* C" by simp (rule Subobjs_subclass) }
   thus ?case by blast
 qed auto
 
 
 
 lemma appendPath_append_last:
   assumes notempty:"Ds \<noteq> []" 
   shows"(Cs @\<^sub>p Ds) @\<^sub>p [last Ds] = (Cs @\<^sub>p Ds)"
 
 proof -
   have "last Cs = hd Ds \<Longrightarrow> last (Cs @ tl Ds) = last Ds"
   proof(cases "tl Ds = []")
     case True
     assume last:"last Cs = hd Ds"
     with True notempty have "Ds = [last Cs]" by (fastforce dest:hd_Cons_tl)
     hence "last Ds = last Cs" by simp
     with True show ?thesis by simp
   next
     case False
     assume last:"last Cs = hd Ds"
     from notempty False have "last (tl Ds) = last Ds"
       by -(drule hd_Cons_tl,drule_tac x="hd Ds" in last_ConsR,simp)
     with False show ?thesis by simp
   qed
   thus ?thesis by(simp add:appendPath_def)
 qed
 
 
 
 
 theorem assumes wf: "wwf_prog P"
 shows progress: "P,E,h \<turnstile> e : T \<Longrightarrow>
  (\<And>l. \<lbrakk> P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D> e \<lfloor>dom l\<rfloor>; \<not> final e \<rbrakk> \<Longrightarrow> \<exists>e' s'. P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>)"
 and "P,E,h \<turnstile> es [:] Ts \<Longrightarrow>
  (\<And>l. \<lbrakk> P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es \<rbrakk> \<Longrightarrow> \<exists>es' s'. P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>)"
 proof (induct rule:WTrt_inducts2)
   case (WTrtNew C E h)
   show ?case
   proof cases
     assume "\<exists>a. h a = None"
     with WTrtNew show ?thesis
       by (fastforce del:exE intro!:RedNew simp:new_Addr_def)
   next
     assume "\<not>(\<exists>a. h a = None)"
     with WTrtNew show ?thesis
       by(fastforce intro:RedNewFail simp add:new_Addr_def)
   qed
 next
   case (WTrtDynCast C E h e T)
   have wte: "P,E,h \<turnstile> e : T" and refT: "is_refT T" and "class": "is_class P C"
     and IH: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                 \<Longrightarrow> \<exists>e' s'. P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
     and D: "\<D> (Cast C e) \<lfloor>dom l\<rfloor>" 
     and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>" by fact+
   from D have De: "\<D> e \<lfloor>dom l\<rfloor>" by auto
   show ?case
   proof cases
     assume "final e"
     with wte refT show ?thesis
     proof (rule finalRefE)
       assume "e = null" thus ?case by(fastforce intro:RedDynCastNull)
     next
       fix r assume "e = ref r"
       then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
       with wte obtain D S where h:"h a = Some(D,S)" by auto
       show ?thesis
       proof (cases "P \<turnstile> Path D to C unique")
         case True
         then obtain Cs' where path:"P \<turnstile> Path D to C via Cs'"
           by (fastforce simp:path_via_def path_unique_def)
         then obtain Ds where "Ds = appendPath Cs Cs'" by simp
         with h path True ref show ?thesis by (fastforce intro:RedDynCast)
       next
         case False
         hence path_not_unique:"\<not> P \<turnstile> Path D to C unique" .
         show ?thesis
         proof(cases "P \<turnstile> Path last Cs to C unique")
           case True
           then obtain Cs' where "P \<turnstile> Path last Cs to C via Cs'"
             by(auto simp:path_via_def path_unique_def)
           with True ref show ?thesis by(fastforce intro:RedStaticUpDynCast)
         next
           case False
           hence path_not_unique':"\<not> P \<turnstile> Path last Cs to C unique" .
           thus ?thesis
           proof(cases "C \<notin> set Cs")
             case False
             then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
               by (auto simp:in_set_conv_decomp)
             with ref show ?thesis by(fastforce intro:RedStaticDownDynCast)
           next
             case True
             with path_not_unique path_not_unique' h ref 
             show ?thesis by (fastforce intro:RedDynCastFail)
           qed
         qed
       qed
     next
       fix r assume "e = Throw r"
       thus ?thesis by(blast intro!:red_reds.DynCastThrow)
     qed
   next
     assume nf: "\<not> final e"
     from IH[OF hconf envconf De nf] show ?thesis by (blast intro:DynCastRed)
   qed
 next
   case (WTrtStaticCast C E h e T)
   have wte: "P,E,h \<turnstile> e : T" and refT: "is_refT T" and "class": "is_class P C"
    and IH: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                 \<Longrightarrow> \<exists>e' s'. P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and D: "\<D> (\<lparr>C\<rparr>e) \<lfloor>dom l\<rfloor>" 
     and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>" by fact+
   from D have De: "\<D> e \<lfloor>dom l\<rfloor>" by auto
   show ?case
   proof cases
     assume "final e"
     with wte refT show ?thesis
     proof (rule finalRefE)
       assume "e = null" with "class" show ?case by(fastforce intro:RedStaticCastNull)
     next
       fix r assume "e = ref r"
       then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
       with wte wf have "class":"is_class P (last Cs)" 
         by (auto intro:Subobj_last_isClass split:if_split_asm)
       show ?thesis
       proof(cases "P \<turnstile> (last Cs) \<preceq>\<^sup>* C")
         case True
         with "class" wf obtain Cs'  where "P \<turnstile> Path last Cs to C via Cs'"
           by(fastforce dest:leq_implies_path)
         with True ref show ?thesis by(fastforce intro:RedStaticUpCast)
       next
         case False
         have notleq:"\<not> P \<turnstile> last Cs \<preceq>\<^sup>* C" by fact
         thus ?thesis
         proof(cases "C \<notin> set Cs")
           case False
           then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
             by (auto simp:in_set_conv_decomp)
           with ref show ?thesis
             by(fastforce intro:RedStaticDownCast)
         next
           case True
           with ref notleq show ?thesis by (fastforce intro:RedStaticCastFail)
         qed
       qed
     next
       fix r assume "e = Throw r"
       thus ?thesis by(blast intro!:red_reds.StaticCastThrow)
     qed
   next
     assume nf: "\<not> final e"
     from IH[OF hconf envconf De nf] show ?thesis by (blast intro:StaticCastRed)
   qed
 next
   case WTrtVal thus ?case by(simp add:final_def)
 next
   case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
 next
   case (WTrtBinOp E h e1 T1 e2 T2 bop T')
   have bop:"case bop of Eq \<Rightarrow> T' = Boolean
                       | Add \<Rightarrow> T1 = Integer \<and> T2 = Integer \<and> T' = Integer"
     and wte1:"P,E,h \<turnstile> e1 : T1" and wte2:"P,E,h \<turnstile> e2 : T2" by fact+
   show ?case
   proof cases
     assume "final e1"
     thus ?thesis
     proof (rule finalE)
       fix v1 assume e1 [simp]:"e1 = Val v1"
       show ?thesis
       proof cases
         assume "final e2"
         thus ?thesis
         proof (rule finalE)
           fix v2 assume e2 [simp]:"e2 = Val v2"
           show ?thesis
           proof (cases bop)
             assume "bop = Eq"
             thus ?thesis using WTrtBinOp by(fastforce intro:RedBinOp)
           next
             assume Add:"bop = Add"
             with e1 e2 wte1 wte2 bop obtain i1 i2 
               where "v1 = Intg i1" and "v2 = Intg i2"
               by (auto dest!:typeof_Integer)
             with Add obtain v where "binop(bop,v1,v2) = Some v" by simp
             with e1 e2 show ?thesis by (fastforce intro:RedBinOp)
           qed
         next
           fix a assume "e2 = Throw a"
           thus ?thesis by(auto intro:red_reds.BinOpThrow2)
         qed
       next
         assume "\<not> final e2" with WTrtBinOp show ?thesis
           by simp (fast intro!:BinOpRed2)
       qed
     next
       fix r assume "e1 = Throw r"
       thus ?thesis by simp (fast intro:red_reds.BinOpThrow1)
     qed
   next
     assume "\<not> final e1" with WTrtBinOp show ?thesis
       by simp (fast intro:BinOpRed1)
   qed
 next
   case (WTrtLAss E h V T e T')
   have wte:"P,E,h \<turnstile> e : T'"
     and wtvar:"P,E,h \<turnstile> Var V : T"
     and sub:"P \<turnstile> T' \<le> T"
     and envconf:"P \<turnstile> E \<surd>" by fact+
   from envconf wtvar have type:"is_type P T" by(auto simp:envconf_def)
   show ?case
   proof cases
     assume fin:"final e"
     from fin show ?case
     proof (rule finalE)
       fix v assume e:"e = Val v"
       from sub type wf show ?case
       proof(rule subE)
         assume eq:"T' = T" and "\<forall>C. T' \<noteq> Class C"
         hence "P \<turnstile> T casts v to v"
           by simp(rule casts_prim)
         with wte wtvar eq e show ?thesis
           by(auto intro!:RedLAss)
       next
         fix C D
         assume T':"T' = Class C" and T:"T = Class D"
           and path_unique:"P \<turnstile> Path C to D unique"
         from wte e T' obtain a Cs where ref:"e = ref(a,Cs)"
           and last:"last Cs = C" 
           by (auto dest!:typeof_Class_Subo)
         from path_unique obtain Cs' where path_via:"P \<turnstile> Path C to D via Cs'"
           by(auto simp:path_unique_def path_via_def)
         with last have "P \<turnstile> Class D casts Ref(a,Cs) to Ref(a,Cs@\<^sub>pCs')"
           by (fastforce intro:casts_ref simp:path_via_def)
         with wte wtvar T ref show ?thesis
           by(auto intro!:RedLAss)
       next
         fix C
         assume T':"T' = NT" and T:"T = Class C"
         with wte e have null:"e = null" by auto
         have "P \<turnstile> Class C casts Null to Null"
           by -(rule casts_null)
         with wte wtvar T null show ?thesis
           by(auto intro!:RedLAss)
       qed
     next
       fix r assume "e = Throw r"
       thus ?thesis by(fastforce intro:red_reds.LAssThrow)
     qed
   next
     assume "\<not> final e" with WTrtLAss show ?thesis
       by simp (fast intro:LAssRed)
   qed
 next
   case (WTrtFAcc E h e C Cs F T)
   have wte: "P,E,h \<turnstile> e : Class C" 
     and field: "P \<turnstile> C has least F:T via Cs"
     and notemptyCs:"Cs \<noteq> []"
     and hconf: "P \<turnstile> h \<surd>" by fact+
   show ?case
   proof cases
     assume "final e"
     with wte show ?thesis
     proof (rule final_refE)
       fix r assume e: "e = ref r"
       then obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
       with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
         and last:"last Cs' = C"
         by (fastforce split:if_split_asm)
       from field obtain Bs fs ms
         where "class": "class P (last Cs) = Some(Bs,fs,ms)"
         and fs:"map_of fs F = Some T"
         by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
       obtain Ds where Ds:"Ds = Cs'@\<^sub>pCs" by simp
       with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
         by (drule_tac Cs'="Cs'" in appendPath_last) simp
       from field suboD last Ds wf have subo:"Subobjs P D Ds"
         by(fastforce intro:Subobjs_appendPath simp:LeastFieldDecl_def FieldDecls_def)
       with hconf h have "P,h \<turnstile> (D,S) \<surd>" by (auto simp:hconf_def)
       with class' subo obtain fs' where S:"(Ds,fs') \<in> S"
         and "P,h \<turnstile> fs' (:\<le>) map_of fs"
         apply (auto simp:oconf_def)
         apply (erule_tac x="Ds" in allE)
         apply auto
         apply (erule_tac x="Ds" in allE)
         apply (erule_tac x="fs'" in allE)
         apply auto
         done
       with fs obtain v where "fs' F = Some v"
         by (fastforce simp:fconf_def)
       with h last Ds S
       have "P,E \<turnstile> \<langle>(ref (a,Cs'))\<bullet>F{Cs}, (h,l)\<rangle> \<rightarrow> \<langle>Val v,(h,l)\<rangle>"
         by (fastforce intro:RedFAcc)
       with ref show ?thesis by blast
     next
       fix r assume "e = Throw r"
       thus ?thesis by(fastforce intro:red_reds.FAccThrow)
     qed
   next
     assume "\<not> final e" with WTrtFAcc show ?thesis
       by(fastforce intro!:FAccRed)
   qed
 next
   case (WTrtFAccNT E h e F Cs T)
   show ?case
   proof cases
     assume "final e"  \<comment> \<open>@{term e} is @{term null} or @{term throw}\<close>
     with WTrtFAccNT show ?thesis
       by(fastforce simp:final_def intro: RedFAccNull red_reds.FAccThrow 
                   dest!:typeof_NT)
   next
     assume "\<not> final e" \<comment> \<open>@{term e} reduces by IH\<close>
     with WTrtFAccNT show ?thesis by simp (fast intro:FAccRed)
   qed
 next
   case (WTrtFAss E h e\<^sub>1 C Cs F T e\<^sub>2 T')
   have wte1:"P,E,h \<turnstile> e\<^sub>1 : Class C"
     and wte2:"P,E,h \<turnstile> e\<^sub>2 : T'"
     and field:"P \<turnstile> C has least F:T via Cs" 
     and notemptyCs:"Cs \<noteq> []"
     and sub:"P \<turnstile> T' \<le> T"
     and hconf:"P \<turnstile> h \<surd>" by fact+
   from field wf have type:"is_type P T" by(rule least_field_is_type)
   show ?case
   proof cases
     assume "final e\<^sub>1"
     with wte1 show ?thesis
     proof (rule final_refE)
       fix r assume e1: "e\<^sub>1 = ref r"
       show ?thesis
       proof cases
         assume "final e\<^sub>2"
         thus ?thesis
         proof (rule finalE)
           fix v assume e2:"e\<^sub>2 = Val v"
           from e1 obtain a Cs' where ref:"e\<^sub>1 = ref(a,Cs')" by (cases r) auto
           with wte1 obtain D S where h:"h a = Some(D,S)" 
             and suboD:"Subobjs P D Cs'" and last:"last Cs' = C"
             by (fastforce split:if_split_asm)
           from field obtain Bs fs ms
             where "class": "class P (last Cs) = Some(Bs,fs,ms)"
             and fs:"map_of fs F = Some T"
             by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
           obtain Ds where Ds:"Ds = Cs'@\<^sub>pCs" by simp
           with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
             by (drule_tac Cs'="Cs'" in appendPath_last) simp
           from field suboD last Ds wf have subo:"Subobjs P D Ds"
             by(fastforce intro:Subobjs_appendPath 
               simp:LeastFieldDecl_def FieldDecls_def)
           with hconf h have "P,h \<turnstile> (D,S) \<surd>" by (auto simp:hconf_def)
           with class' subo obtain fs' where S:"(Ds,fs') \<in> S"
             by (auto simp:oconf_def)
           from sub type wf show ?thesis
           proof(rule subE)
             assume eq:"T' = T" and "\<forall>C. T' \<noteq> Class C"
             hence "P \<turnstile> T casts v to v"
               by simp(rule casts_prim)
             with h last field Ds notemptyCs S eq
             have "P,E \<turnstile> \<langle>(ref (a,Cs'))\<bullet>F{Cs}:=(Val v), (h,l)\<rangle> \<rightarrow> 
               \<langle>Val v, (h(a \<mapsto> (D,insert (Ds,fs'(F\<mapsto>v)) (S -  {(Ds,fs')}))),l)\<rangle>"
               by (fastforce intro:RedFAss)
             with ref e2 show ?thesis by blast
           next
             fix C' D'
             assume T':"T' = Class C'" and T:"T = Class D'"
             and path_unique:"P \<turnstile> Path C' to D' unique"
             from wte2 e2 T' obtain a' Cs'' where ref2:"e\<^sub>2 = ref(a',Cs'')"
               and last':"last Cs'' = C'"
               by (auto dest!:typeof_Class_Subo)
             from path_unique obtain Ds' where "P \<turnstile> Path C' to D' via Ds'"
               by(auto simp:path_via_def path_unique_def)
             with last' 
             have casts:"P \<turnstile> Class D' casts Ref(a',Cs'') to Ref(a',Cs''@\<^sub>pDs')"
               by (fastforce intro:casts_ref simp:path_via_def)
             obtain v' where "v' = Ref(a',Cs''@\<^sub>pDs')" by simp
             with h last field Ds notemptyCs S ref e2 ref2 T casts
             have "P,E \<turnstile> \<langle>(ref (a,Cs'))\<bullet>F{Cs}:=(Val v), (h,l)\<rangle> \<rightarrow> 
                         \<langle>Val v',(h(a \<mapsto> (D,insert (Ds,fs'(F\<mapsto>v'))(S-{(Ds,fs')}))),l)\<rangle>"
               by (fastforce intro:RedFAss)
             with ref e2 show ?thesis by blast
           next
             fix C'
             assume T':"T' = NT" and T:"T = Class C'"
             from e2 wte2 T' have null:"e\<^sub>2 = null" by auto
             have casts:"P \<turnstile> Class C' casts Null to Null"
               by -(rule casts_null)
             obtain v' where "v' = Null" by simp
             with h last field Ds notemptyCs S ref e2 null T casts
             have "P,E \<turnstile> \<langle>(ref (a,Cs'))\<bullet>F{Cs}:=(Val v), (h,l)\<rangle> \<rightarrow> 
                   \<langle>Val v', (h(a \<mapsto> (D,insert (Ds,fs'(F\<mapsto>v')) (S -  {(Ds,fs')}))),l)\<rangle>"
               by (fastforce intro:RedFAss)
             with ref e2 show ?thesis by blast
           qed
         next
           fix r assume "e\<^sub>2 = Throw r"
           thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
         qed
       next
         assume "\<not> final e\<^sub>2" with WTrtFAss e1 show ?thesis
           by simp (fast intro!:FAssRed2)
       qed
     next
       fix r assume "e\<^sub>1 = Throw r"
       thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
     qed
   next
     assume "\<not> final e\<^sub>1" with WTrtFAss show ?thesis
       by simp (blast intro!:FAssRed1)
   qed
 next
   case (WTrtFAssNT E h e\<^sub>1 e\<^sub>2 T' T F Cs)
   show ?case
   proof cases
     assume e1: "final e\<^sub>1"  \<comment> \<open>@{term e\<^sub>1} is @{term null} or @{term throw}\<close>
     show ?thesis
     proof cases
       assume "final e\<^sub>2"  \<comment> \<open>@{term e\<^sub>2} is @{term Val} or @{term throw}\<close>
       with WTrtFAssNT e1 show ?thesis
         by(fastforce simp:final_def intro:RedFAssNull red_reds.FAssThrow1 
                                          red_reds.FAssThrow2 dest!:typeof_NT)
     next
       assume  "\<not> final e\<^sub>2" \<comment> \<open>@{term e\<^sub>2} reduces by IH\<close>
       with WTrtFAssNT e1 show ?thesis
         by (fastforce simp:final_def intro!:red_reds.FAssRed2 red_reds.FAssThrow1)
     qed
   next
     assume "\<not> final e\<^sub>1" \<comment> \<open>@{term e\<^sub>1} reduces by IH\<close>
     with WTrtFAssNT show ?thesis by (fastforce intro:FAssRed1)
   qed
 next
   case (WTrtCall E h e C M Ts T pns body Cs es Ts')
   have wte: "P,E,h \<turnstile> e : Class C"
     and "method":"P \<turnstile> C has least M = (Ts, T, pns, body) via Cs"
     and wtes: "P,E,h \<turnstile> es [:] Ts'"and sub: "P \<turnstile> Ts' [\<le>] Ts"
     and IHes: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es\<rbrakk>
              \<Longrightarrow> \<exists>es' s'. P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>"
     and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>" 
     and D: "\<D> (e\<bullet>M(es)) \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume final:"final e"
     with wte show ?thesis
     proof (rule final_refE)
       fix r assume ref: "e = ref r"
       show ?thesis
       proof cases
         assume es: "\<exists>vs. es = map Val vs"
         from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
         with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
           and last:"last Cs' = C"
           by (fastforce split:if_split_asm)
         from wte ref h have subcls:"P \<turnstile> D \<preceq>\<^sup>* C" by -(drule mdc_leq_dyn_type,auto)
         from "method" have has:"P \<turnstile> C has M = (Ts,T,pns,body) via Cs"
             by(rule has_least_method_has_method)
         from es obtain vs where vs:"es = map Val vs" by auto
         obtain Cs'' Ts'' T' pns' body' where 
           ass:"P \<turnstile> (D,Cs'@\<^sub>pCs) selects M = (Ts'',T',pns',body') via Cs'' \<and>
            length Ts'' = length pns' \<and> length vs = length pns' \<and> P \<turnstile> T' \<le> T"
         proof (cases "\<exists>Ts'' T' pns' body' Ds. P \<turnstile> D has least M = (Ts'',T',pns',body') via Ds")
           case True
           then obtain Ts'' T' pns' body' Cs'' 
             where least:"P \<turnstile> D has least M = (Ts'',T',pns',body') via Cs''"
             by auto
           hence select:"P \<turnstile> (D,Cs'@\<^sub>pCs) selects M = (Ts'',T',pns',body') via Cs''"
             by(rule dyn_unique)
           from subcls least wf has have "Ts = Ts''" and leq:"P \<turnstile> T' \<le> T"
             by -(drule leq_method_subtypes,simp_all,blast)+
           hence "length Ts = length Ts''" by (simp add:list_all2_iff)
           with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
           with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
             by simp
           from has_least_wf_mdecl[OF wf least] 
           have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
           with length have "length vs = length pns'" by simp
           with select lengthParams leq show ?thesis using that by blast
         next
           case False
           hence non_dyn:"\<forall>Ts'' T' pns' body' Ds. 
               \<not> P \<turnstile> D has least M = (Ts'',T',pns',body') via Ds" by auto
           from suboD last have path:"P \<turnstile> Path D to C via Cs'" 
             by(simp add:path_via_def)
           from "method" have notempty:"Cs \<noteq> []" 
             by(fastforce intro!:Subobjs_nonempty 
                         simp:LeastMethodDef_def MethodDefs_def)
           from suboD have "class": "is_class P D" by(rule Subobjs_isClass)
           from suboD last have path:"P \<turnstile> Path D to C via Cs'"
             by(simp add:path_via_def)
           with "method" wf have "P \<turnstile> D has M = (Ts,T,pns,body) via Cs'@\<^sub>pCs"
             by(auto intro:has_path_has has_least_method_has_method)
           with "class" wf obtain Cs'' Ts'' T' pns' body' where overrider:
             "P \<turnstile> (D,Cs'@\<^sub>pCs) has overrider M = (Ts'',T',pns',body') via Cs''"
             by(auto dest!:class_wf simp:is_class_def wf_cdecl_def,blast)
           with non_dyn
           have select:"P \<turnstile> (D,Cs'@\<^sub>pCs) selects M = (Ts'',T',pns',body') via Cs''"
             by-(rule dyn_ambiguous,simp_all)
           from notempty have eq:"(Cs' @\<^sub>p Cs) @\<^sub>p [last Cs] = (Cs' @\<^sub>p Cs)"
             by(rule appendPath_append_last)
           from "method" wf
           have "P \<turnstile> last Cs has least M = (Ts,T,pns,body) via [last Cs]"
             by(auto dest:Subobj_last_isClass intro:Subobjs_Base subobjs_rel
                     simp:LeastMethodDef_def MethodDefs_def)
           with notempty
           have "P \<turnstile> last(Cs'@\<^sub>pCs) has least M = (Ts,T,pns,body) via [last Cs]"
             by -(drule_tac Cs'="Cs'" in appendPath_last,simp)
           with overrider wf eq
           have "(Cs'',(Ts'',T',pns',body')) \<in> MinimalMethodDefs P D M"
             and "P,D \<turnstile> Cs'' \<sqsubseteq> Cs'@\<^sub>pCs"
             by(auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def)
               (drule wf_sees_method_fun,auto)
           with subcls wf notempty has path have "Ts = Ts''" and leq:"P \<turnstile> T' \<le> T"
             by -(drule leq_methods_subtypes,simp_all,blast)+
           hence "length Ts = length Ts''" by (simp add:list_all2_iff)
           with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
           with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
             by simp
           from select_method_wf_mdecl[OF wf select]
           have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
           with length have "length vs = length pns'" by simp
           with select lengthParams leq show ?thesis using that by blast
         qed
         obtain new_body where "case T of Class D \<Rightarrow> 
            new_body = \<lparr>D\<rparr>blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')
     | _ \<Rightarrow> new_body = blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')"
           by(cases T) auto
         with h "method" last ass ref vs
           show ?thesis by (auto intro!:exI RedCall)
       next
         assume "\<not>(\<exists>vs. es = map Val vs)"
         hence not_all_Val: "\<not>(\<forall>e \<in> set es. \<exists>v. e = Val v)"
           by(simp add:ex_map_conv)
         let ?ves = "takeWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?rest = "dropWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?ex = "hd ?rest" let ?rst = "tl ?rest"
         from not_all_Val have nonempty: "?rest \<noteq> []" by auto
         hence es: "es = ?ves @ ?ex # ?rst" by simp
         have "\<forall>e \<in> set ?ves. \<exists>v. e = Val v" by(fastforce dest:set_takeWhileD)
         then obtain vs where ves: "?ves = map Val vs"
           using ex_map_conv by blast
         show ?thesis
         proof cases
           assume "final ?ex"
           moreover from nonempty have "\<not>(\<exists>v. ?ex = Val v)"
             by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
               (simp add:dropWhile_eq_Cons_conv)
           ultimately obtain r' where ex_Throw: "?ex = Throw r'"
             by(fast elim!:finalE)
           show ?thesis using ref es ex_Throw ves
             by(fastforce intro:red_reds.CallThrowParams)
         next
           assume not_fin: "\<not> final ?ex"
           have "finals es = finals(?ves @ ?ex # ?rst)" using es
             by(rule arg_cong)
           also have "\<dots> = finals(?ex # ?rst)" using ves by simp
           finally have "finals es = finals(?ex # ?rst)" .
           hence "\<not> finals es" using not_finals_ConsI[OF not_fin] by blast
           thus ?thesis using ref D IHes[OF hconf envconf]
             by(fastforce intro!:CallParams)
         qed
       qed
     next
       fix r assume "e = Throw r"
       with WTrtCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
     qed
   next
     assume "\<not> final e"
     with WTrtCall show ?thesis by simp (blast intro!:CallObj)
   qed
 next
   case (WTrtStaticCall E h e C' C M Ts T pns body Cs es Ts')
   have wte: "P,E,h \<turnstile> e : Class C'"
     and path_unique:"P \<turnstile> Path C' to C unique"
     and "method":"P \<turnstile> C has least M = (Ts, T, pns, body) via Cs"
     and wtes: "P,E,h \<turnstile> es [:] Ts'"and sub: "P \<turnstile> Ts' [\<le>] Ts"
     and IHes: "\<And>l.
               \<lbrakk>P \<turnstile> h \<surd>; envconf P E; \<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es\<rbrakk>
               \<Longrightarrow> \<exists>es' s'. P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>"
     and hconf: "P \<turnstile> h \<surd>" and envconf:"envconf P E"
     and D: "\<D> (e\<bullet>(C::)M(es)) \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume final:"final e"
     with wte show ?thesis
     proof (rule final_refE)
       fix r assume ref: "e = ref r"
       show ?thesis
       proof cases
         assume es: "\<exists>vs. es = map Val vs"
         from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
         with wte have last:"last Cs' = C'"
           by (fastforce split:if_split_asm)
         with path_unique obtain Cs''
           where path_via:"P \<turnstile> Path (last Cs') to C via Cs''"
           by (auto simp add:path_via_def path_unique_def)
         obtain Ds where Ds:"Ds = (Cs'@\<^sub>pCs'')@\<^sub>pCs" by simp
         from es obtain vs where vs:"es = map Val vs" by auto
         from sub have "length Ts' = length Ts" by (simp add:list_all2_iff)
         with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts"
           by simp
         from has_least_wf_mdecl[OF wf "method"]
         have lengthParams:"length Ts = length pns" by (simp add:wf_mdecl_def)
         with "method" last path_unique path_via Ds length ref vs show ?thesis
           by (auto intro!:exI RedStaticCall)
       next
         assume "\<not>(\<exists>vs. es = map Val vs)"
         hence not_all_Val: "\<not>(\<forall>e \<in> set es. \<exists>v. e = Val v)"
           by(simp add:ex_map_conv)
         let ?ves = "takeWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?rest = "dropWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?ex = "hd ?rest" let ?rst = "tl ?rest"
         from not_all_Val have nonempty: "?rest \<noteq> []" by auto
         hence es: "es = ?ves @ ?ex # ?rst" by simp
         have "\<forall>e \<in> set ?ves. \<exists>v. e = Val v" by(fastforce dest:set_takeWhileD)
         then obtain vs where ves: "?ves = map Val vs"
           using ex_map_conv by blast
         show ?thesis
         proof cases
           assume "final ?ex"
           moreover from nonempty have "\<not>(\<exists>v. ?ex = Val v)"
             by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
               (simp add:dropWhile_eq_Cons_conv)
           ultimately obtain r' where ex_Throw: "?ex = Throw r'"
             by(fast elim!:finalE)
           show ?thesis using ref es ex_Throw ves
             by(fastforce intro:red_reds.CallThrowParams)
         next
           assume not_fin: "\<not> final ?ex"
           have "finals es = finals(?ves @ ?ex # ?rst)" using es
             by(rule arg_cong)
           also have "\<dots> = finals(?ex # ?rst)" using ves by simp
           finally have "finals es = finals(?ex # ?rst)" .
           hence "\<not> finals es" using not_finals_ConsI[OF not_fin] by blast
           thus ?thesis using ref D IHes[OF hconf envconf]
             by(fastforce intro!:CallParams)
         qed
       qed
     next
       fix r assume "e = Throw r"
       with WTrtStaticCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
     qed
   next
     assume "\<not> final e"
     with WTrtStaticCall show ?thesis by simp (blast intro!:CallObj)
   qed
 next
   case (WTrtCallNT E h e es Ts Copt M T)
   show ?case
   proof cases
     assume "final e"
     moreover
     { fix v assume e: "e = Val v"
       hence "e = null" using WTrtCallNT by simp
       have ?case
       proof cases
         assume "finals es"
         moreover
         { fix vs assume "es = map Val vs"
           with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull dest!:typeof_NT) }
         moreover
         { fix vs a es' assume "es = map Val vs @ Throw a # es'"
           with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
         ultimately show ?thesis by(fastforce simp:finals_def)
       next
         assume "\<not> finals es" \<comment> \<open>@{term es} reduces by IH\<close>
         with WTrtCallNT e show ?thesis by(fastforce intro: CallParams)
       qed
     }
     moreover
     { fix r assume "e = Throw r"
       with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
     ultimately show ?thesis by(fastforce simp:final_def)
   next
     assume "\<not> final e" \<comment> \<open>@{term e} reduces by IH\<close>
     with WTrtCallNT show ?thesis by (fastforce intro:CallObj)
   qed
 next
   case (WTrtInitBlock h v T' E V T e\<^sub>2 T\<^sub>2)
   have IH2: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E(V \<mapsto> T) \<surd>; \<D> e\<^sub>2 \<lfloor>dom l\<rfloor>; \<not> final e\<^sub>2\<rbrakk>
                   \<Longrightarrow> \<exists>e' s'. P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>2,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
     and typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T'"
     and type:"is_type P T" and sub:"P \<turnstile> T' \<le> T"
     and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>"
     and D: "\<D> {V:T := Val v; e\<^sub>2} \<lfloor>dom l\<rfloor>" by fact+
   from wf typeof type sub obtain v' where casts:"P \<turnstile> T casts v to v'"
     by(auto dest:sub_casts)
   show ?case
   proof cases
     assume fin:"final e\<^sub>2"
     with casts show ?thesis
       by(fastforce elim:finalE intro:RedInitBlock red_reds.InitBlockThrow)
   next
     assume not_fin2: "\<not> final e\<^sub>2"
     from D have D2: "\<D> e\<^sub>2 \<lfloor>dom(l(V\<mapsto>v'))\<rfloor>" by (auto simp:hyperset_defs)
     from envconf type have "P \<turnstile> E(V \<mapsto> T) \<surd>" by(auto simp:envconf_def)
     from IH2[OF hconf this D2 not_fin2]
     obtain h' l' e' where red2: "P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>2,(h, l(V\<mapsto>v'))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
       by auto
     from red_lcl_incr[OF red2] have "V \<in> dom l'" by auto
     with red2 casts show ?thesis by(fastforce intro:InitBlockRed)
   qed
 next
   case (WTrtBlock E V T h e T')
   have IH: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E(V \<mapsto> T) \<surd>; \<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                  \<Longrightarrow> \<exists>e' s'. P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and unass: "\<not> assigned V e" and type:"is_type P T"
    and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>" 
     and D: "\<D> {V:T; e} \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume "e = Val v" with type show ?thesis by(fast intro:RedBlock)
     next
       fix r assume "e = Throw r"
       with type show ?thesis by(fast intro:red_reds.BlockThrow)
     qed
   next
     assume not_fin: "\<not> final e"
     from D have De: "\<D> e \<lfloor>dom(l(V:=None))\<rfloor>" by(simp add:hyperset_defs)
     from envconf type have "P \<turnstile> E(V \<mapsto> T) \<surd>" by(auto simp:envconf_def)
     from IH[OF hconf this De not_fin]
     obtain h' l' e' where red: "P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h,l(V:=None))\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
       by auto
     show ?thesis
     proof (cases "l' V")
       assume "l' V = None"
       with red unass show ?thesis by(blast intro: BlockRedNone)
     next
       fix v assume "l' V = Some v"
       with red unass type show ?thesis by(blast intro: BlockRedSome)
     qed
   qed
 next
   case (WTrtSeq E h e\<^sub>1 T\<^sub>1 e\<^sub>2 T\<^sub>2)
   show ?case
   proof cases
     assume "final e\<^sub>1"
     thus ?thesis
       by(fast elim:finalE intro:intro:RedSeq red_reds.SeqThrow)
   next
     assume "\<not> final e\<^sub>1" with WTrtSeq show ?thesis
       by simp (blast intro:SeqRed)
   qed
 next
   case (WTrtCond E h e e\<^sub>1 T e\<^sub>2)
   have wt: "P,E,h \<turnstile> e : Boolean" by fact
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume val: "e = Val v"
       then obtain b where v: "v = Bool b" using wt by (fastforce dest:typeof_Boolean)
       show ?thesis
       proof (cases b)
         case True with val v show ?thesis by(auto intro:RedCondT)
       next
         case False with val v show ?thesis by(auto intro:RedCondF)
       qed
     next
       fix r assume "e = Throw r"
       thus ?thesis by(fast intro:red_reds.CondThrow)
     qed
   next
     assume "\<not> final e" with WTrtCond show ?thesis
       by simp (fast intro:CondRed)
   qed
 next
   case WTrtWhile show ?case by(fast intro:RedWhile)
 next
   case (WTrtThrow E h e T' T)
   show ?case
   proof cases
     assume "final e" \<comment> \<open>Then @{term e} must be @{term throw} or @{term null}\<close>
     with WTrtThrow show ?thesis
       by(fastforce simp:final_def is_refT_def
                   intro:red_reds.ThrowThrow red_reds.RedThrowNull
                   dest!:typeof_NT typeof_Class_Subo)
   next
     assume "\<not> final e" \<comment> \<open>Then @{term e} must reduce\<close>
     with WTrtThrow show ?thesis by simp (blast intro:ThrowRed)
   qed
 next
   case WTrtNil thus ?case by simp
 next
   case (WTrtCons E h e T es Ts)
   have IHe: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                 \<Longrightarrow> \<exists>e' s'. P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and IHes: "\<And>l. \<lbrakk>P \<turnstile> h \<surd>; P \<turnstile> E \<surd>; \<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es\<rbrakk>
              \<Longrightarrow> \<exists>es' s'. P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>"
    and hconf: "P \<turnstile> h \<surd>" and envconf:"P \<turnstile> E \<surd>"
     and D: "\<D>s (e#es) \<lfloor>dom l\<rfloor>"
    and not_fins: "\<not> finals(e # es)" by fact+
   have De: "\<D> e \<lfloor>dom l\<rfloor>" and Des: "\<D>s es (\<lfloor>dom l\<rfloor> \<squnion> \<A> e)"
     using D by auto
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume e: "e = Val v"
       hence Des': "\<D>s es \<lfloor>dom l\<rfloor>" using De Des by auto
       have not_fins_tl: "\<not> finals es" using not_fins e by simp
       show ?thesis using e IHes[OF hconf envconf Des' not_fins_tl]
         by (blast intro!:ListRed2)
     next
       fix r assume "e = Throw r"
       hence False using not_fins by simp
       thus ?thesis ..
     qed
   next
     assume "\<not> final e"
     from IHe[OF hconf envconf De this] show ?thesis by(fast intro!:ListRed1)
   qed
 qed
 
 
 end
diff --git a/thys/Differential_Dynamic_Logic/Syntax.thy b/thys/Differential_Dynamic_Logic/Syntax.thy
--- a/thys/Differential_Dynamic_Logic/Syntax.thy
+++ b/thys/Differential_Dynamic_Logic/Syntax.thy
@@ -1,358 +1,358 @@
 theory Syntax
 imports
   Complex_Main
   "Ids"
 begin 
 section \<open>Syntax\<close>
 text \<open>
   We define the syntax of dL terms, formulas and hybrid programs. As in
   CADE'15, the syntax allows arbitrarily nested differentials. However, 
   the semantics of such terms is very surprising (e.g. (x')' is zero in
   every state), so we define predicates dfree and dsafe to describe terms
   with no differentials and no nested differentials, respectively.
 
   In keeping with the CADE'15 presentation we currently make the simplifying
   assumption that all terms are smooth, and thus division and arbitrary
   exponentiation are absent from the syntax. Several other standard logical
   constructs are implemented as derived forms to reduce the soundness burden.
   
   The types of formulas and programs are parameterized by three finite types 
   ('a, 'b, 'c) used as identifiers for function constants, context constants, and
   everything else, respectively. These type variables are distinct because some
   substitution operations affect one type variable while leaving the others unchanged.
   Because these types will be finite in practice, it is more useful to think of them
   as natural numbers that happen to be represented as types (due to HOL's lack of dependent types).
   The types of terms and ODE systems follow the same approach, but have only two type 
   variables because they cannot contain contexts.
 \<close>
 datatype ('a, 'c) trm =
 \<comment> \<open>Real-valued variables given meaning by the state and modified by programs.\<close>
   Var 'c
 \<comment> \<open>N.B. This is technically more expressive than true dL since most reals\<close>
 \<comment> \<open>can't be written down.\<close>
 | Const real
 \<comment> \<open>A function (applied to its arguments) consists of an identifier for the function\<close>
 \<comment> \<open>and a function \<open>'c \<Rightarrow> ('a, 'c) trm\<close> (where \<open>'c\<close> is a finite type) which specifies one\<close>
 \<comment> \<open>argument of the function for each element of type \<open>'c\<close>. To simulate a function with\<close>
 \<comment> \<open>less than \<open>'c\<close> arguments, set the remaining arguments to a constant, such as \<open>Const 0\<close>\<close>
 | Function 'a "'c \<Rightarrow> ('a, 'c) trm" ("$f")
 | Plus "('a, 'c) trm" "('a, 'c) trm"
 | Times "('a, 'c) trm" "('a, 'c) trm"
 \<comment> \<open>A (real-valued) variable standing for a differential, such as \<open>x'\<close>, given meaning by the state\<close>
 \<comment> \<open>and modified by programs.\<close>
-| DiffVar 'c ("$'")
+| DiffVar 'c ("$''")
 \<comment> \<open>The differential of an arbitrary term \<open>(\<theta>)'\<close>\<close>
 | Differential "('a, 'c) trm"
 
 datatype('a, 'c) ODE =
 \<comment> \<open>Variable standing for an ODE system, given meaning by the interpretation\<close>
 OVar 'c
 \<comment> \<open>Singleton ODE defining \<open>x' = \<theta>\<close>, where \<open>\<theta>\<close> may or may not contain \<open>x\<close>\<close>
 \<comment> \<open>(but must not contain differentials)\<close>
 | OSing 'c "('a, 'c) trm"
 \<comment> \<open>The product \<open>OProd ODE1 ODE2\<close> composes two ODE systems in parallel, e.g.\<close>
 \<comment> \<open>\<open>OProd (x' = y) (y' = -x)\<close> is the system \<open>{x' = y, y' = -x}\<close>\<close>
 | OProd "('a, 'c) ODE" "('a, 'c) ODE"
 
 datatype ('a, 'b, 'c) hp =
 \<comment> \<open>Variables standing for programs, given meaning by the interpretation.\<close>
   Pvar 'c                           ("$\<alpha>")
 \<comment> \<open>Assignment to a real-valued variable \<open>x := \<theta>\<close>\<close>
 | Assign 'c "('a, 'c) trm"                (infixr ":=" 10)
 \<comment> \<open>Assignment to a differential variable\<close>
 | DiffAssign 'c "('a, 'c) trm"
 \<comment> \<open>Program \<open>?\<phi>\<close> succeeds iff \<open>\<phi>\<close> holds in current state.\<close>
 | Test "('a, 'b, 'c) formula"                 ("?")
 \<comment> \<open>An ODE program is an ODE system with some evolution domain.\<close>
 | EvolveODE "('a, 'c) ODE" "('a, 'b, 'c) formula"
 \<comment> \<open>Non-deterministic choice between two programs \<open>a\<close> and \<open>b\<close>\<close>
 | Choice "('a, 'b, 'c) hp" "('a, 'b, 'c) hp"            (infixl "\<union>\<union>" 10)
 \<comment> \<open>Sequential composition of two programs \<open>a\<close> and \<open>b\<close>\<close>
 | Sequence "('a, 'b, 'c) hp"  "('a, 'b, 'c) hp"         (infixr ";;" 8)
 \<comment> \<open>Nondeterministic repetition of a program \<open>a\<close>, zero or more times.\<close>
 | Loop "('a, 'b, 'c) hp"                      ("_**")
 
 and ('a, 'b, 'c) formula =
   Geq "('a, 'c) trm" "('a, 'c) trm"
 | Prop 'c "'c \<Rightarrow> ('a, 'c) trm"      ("$\<phi>")
 | Not "('a, 'b, 'c) formula"            ("!")
 | And "('a, 'b, 'c) formula" "('a, 'b, 'c) formula"    (infixl "&&" 8)
 | Exists 'c "('a, 'b, 'c) formula"
 \<comment> \<open>\<open>\<langle>\<alpha>\<rangle>\<phi>\<close> iff exists run of \<open>\<alpha>\<close> where \<open>\<phi>\<close> is true in end state\<close>
 | Diamond "('a, 'b, 'c) hp" "('a, 'b, 'c) formula"         ("(\<langle> _ \<rangle> _)" 10)
 \<comment> \<open>Contexts \<open>C\<close> are symbols standing for functions from (the semantics of) formulas to\<close>
 \<comment> \<open>(the semantics of) formulas, thus \<open>C(\<phi>)\<close> is another formula. While not necessary\<close>
 \<comment> \<open>in terms of expressiveness, contexts allow for more efficient reasoning principles.\<close>
 | InContext 'b "('a, 'b, 'c) formula"
     
 \<comment> \<open>Derived forms\<close>
 definition Or :: "('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula" (infixl "||" 7)
 where "Or P Q = Not (And (Not P) (Not Q))"
 
 definition Implies :: "('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula" (infixr "\<rightarrow>" 10)
 where "Implies P Q = Or Q (Not P)"
 
 definition Equiv :: "('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula" (infixl "\<leftrightarrow>" 10)
 where "Equiv P Q = Or (And P Q) (And (Not P) (Not Q))"
 
 definition Forall :: "'c \<Rightarrow> ('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula"
 where "Forall x P = Not (Exists x (Not P))"
 
 definition Equals :: "('a, 'c) trm \<Rightarrow> ('a, 'c) trm \<Rightarrow> ('a, 'b, 'c) formula"
 where "Equals \<theta> \<theta>' = ((Geq \<theta> \<theta>') && (Geq \<theta>' \<theta>))"
 
 definition Greater :: "('a, 'c) trm \<Rightarrow> ('a, 'c) trm \<Rightarrow> ('a, 'b, 'c) formula"
 where "Greater \<theta> \<theta>' = ((Geq \<theta> \<theta>') && (Not (Geq \<theta>' \<theta>)))"
   
 definition Box :: "('a, 'b, 'c) hp \<Rightarrow> ('a, 'b, 'c) formula \<Rightarrow> ('a, 'b, 'c) formula" ("([[_]]_)" 10)
 where "Box \<alpha> P = Not (Diamond \<alpha> (Not P))"
   
 definition TT ::"('a,'b,'c) formula" 
 where "TT = Geq (Const 0) (Const 0)"
 
 definition FF ::"('a,'b,'c) formula" 
 where "FF = Geq (Const 0) (Const 1)"
 
 type_synonym ('a,'b,'c) sequent = "('a,'b,'c) formula list * ('a,'b,'c) formula list"
 \<comment> \<open>Rule: assumptions, then conclusion\<close>
 type_synonym ('a,'b,'c) rule = "('a,'b,'c) sequent list * ('a,'b,'c) sequent"
 
   
 \<comment> \<open>silliness to enable proving disequality lemmas\<close>
 primrec sizeF::"('sf,'sc, 'sz) formula \<Rightarrow> nat"
   and   sizeP::"('sf,'sc, 'sz) hp \<Rightarrow> nat"
 where 
   "sizeP (Pvar a) = 1"
 | "sizeP (Assign x \<theta>) = 1"
 | "sizeP (DiffAssign x \<theta>) = 1"
 | "sizeP (Test \<phi>) = Suc (sizeF \<phi>)"
 | "sizeP (EvolveODE ODE \<phi>) = Suc (sizeF \<phi>)"
 | "sizeP (Choice \<alpha> \<beta>) = Suc (sizeP \<alpha> + sizeP \<beta>)"
 | "sizeP (Sequence \<alpha> \<beta>) = Suc (sizeP \<alpha> + sizeP \<beta>)"
 | "sizeP (Loop \<alpha>) = Suc (sizeP \<alpha>)"
 | "sizeF (Geq p q) = 1"
 | "sizeF (Prop p args) = 1"
 | "sizeF (Not p) = Suc (sizeF p)"
 | "sizeF (And p q) = sizeF p + sizeF q"
 | "sizeF (Exists x p) = Suc (sizeF p)"
 | "sizeF (Diamond p q) = Suc (sizeP p + sizeF q)"
 | "sizeF (InContext C \<phi>) = Suc (sizeF \<phi>)"
 
 lemma sizeF_diseq:"sizeF p \<noteq> sizeF q \<Longrightarrow> p \<noteq> q" by auto
   
 named_theorems "expr_diseq" "Structural disequality rules for expressions"  
 lemma [expr_diseq]:"p \<noteq> And p q" by(induction p, auto)
 lemma [expr_diseq]:"q \<noteq> And p q" by(induction q, auto)
 lemma [expr_diseq]:"p \<noteq> Not p" by(induction p, auto)
 lemma [expr_diseq]:"p \<noteq> Or p q" by(rule sizeF_diseq, auto simp add: Or_def)
 lemma [expr_diseq]:"q \<noteq> Or p q" by(rule sizeF_diseq, auto simp add: Or_def)
 lemma [expr_diseq]:"p \<noteq> Implies p q" by(rule sizeF_diseq, auto simp add: Implies_def Or_def)
 lemma [expr_diseq]:"q \<noteq> Implies p q" by(rule sizeF_diseq, auto simp add: Implies_def Or_def)
 lemma [expr_diseq]:"p \<noteq> Equiv p q" by(rule sizeF_diseq, auto simp add: Equiv_def Or_def)
 lemma [expr_diseq]:"q \<noteq> Equiv p q" by(rule sizeF_diseq, auto simp add: Equiv_def Or_def)
 lemma [expr_diseq]:"p \<noteq> Exists x p" by(induction p, auto)
 lemma [expr_diseq]:"p \<noteq> Diamond a p" by(induction p, auto)
 lemma [expr_diseq]:"p \<noteq> InContext C p" by(induction p, auto)
 
 \<comment> \<open>A predicational is like a context with no argument, i.e. a variable standing for a\<close>
 \<comment> \<open>state-dependent formula, given meaning by the interpretation. This differs from a predicate\<close>
 \<comment> \<open>because predicates depend only on their arguments (which might then indirectly depend on the state).\<close>
 \<comment> \<open>We encode a predicational as a context applied to a formula whose truth value is constant with\<close>
 \<comment> \<open>respect to the state (specifically, always true)\<close>
 fun Predicational :: "'b \<Rightarrow> ('a, 'b, 'c) formula" ("Pc")
 where "Predicational P = InContext P (Geq (Const 0) (Const 0))"
 
 \<comment> \<open>Abbreviations for common syntactic constructs in order to make axiom definitions, etc. more\<close>
 \<comment> \<open>readable.\<close>
 context ids begin
 \<comment> \<open>"Empty" function argument tuple, encoded as tuple where all arguments assume a constant value.\<close>
 definition empty::" 'b \<Rightarrow> ('a, 'b) trm"
 where "empty \<equiv> \<lambda>i.(Const 0)"
 
 \<comment> \<open>Function argument tuple with (effectively) one argument, where all others have a constant value.\<close>
 fun singleton :: "('a, 'sz) trm \<Rightarrow> ('sz \<Rightarrow> ('a, 'sz) trm)"
 where "singleton t i = (if i = vid1 then t else (Const 0))"
 
 lemma expand_singleton:"singleton t = (\<lambda>i. (if i = vid1 then t else (Const 0)))"
   by auto
 
 \<comment> \<open>Function applied to one argument\<close>
 definition f1::"'sf \<Rightarrow> 'sz \<Rightarrow> ('sf,'sz) trm"
 where "f1 f x = Function f (singleton (Var x))"
 
 \<comment> \<open>Function applied to zero arguments (simulates a constant symbol given meaning by the interpretation)\<close>
 definition f0::"'sf \<Rightarrow> ('sf,'sz) trm"
 where "f0 f = Function f empty"
 
 \<comment> \<open>Predicate applied to one argument\<close>
 definition p1::"'sz \<Rightarrow> 'sz \<Rightarrow> ('sf, 'sc, 'sz) formula"
 where "p1 p x = Prop p (singleton (Var x))"
 
 \<comment> \<open>Predicational\<close>
 definition P::"'sc \<Rightarrow> ('sf, 'sc, 'sz) formula"
 where "P p = Predicational p"
 end
 
 subsection \<open>Well-Formedness predicates\<close>
 inductive dfree :: "('a, 'c) trm \<Rightarrow> bool"
 where
   dfree_Var: "dfree (Var i)"
 | dfree_Const: "dfree (Const r)"
 | dfree_Fun: "(\<And>i. dfree (args i)) \<Longrightarrow> dfree (Function i args)"
 | dfree_Plus: "dfree \<theta>\<^sub>1 \<Longrightarrow> dfree \<theta>\<^sub>2 \<Longrightarrow> dfree (Plus \<theta>\<^sub>1 \<theta>\<^sub>2)"
 | dfree_Times: "dfree \<theta>\<^sub>1 \<Longrightarrow> dfree \<theta>\<^sub>2 \<Longrightarrow> dfree (Times \<theta>\<^sub>1 \<theta>\<^sub>2)"
   
 inductive dsafe :: "('a, 'c) trm \<Rightarrow> bool"
 where
   dsafe_Var: "dsafe (Var i)"
 | dsafe_Const: "dsafe (Const r)"
 | dsafe_Fun: "(\<And>i. dsafe (args i)) \<Longrightarrow> dsafe (Function i args)"
 | dsafe_Plus: "dsafe \<theta>\<^sub>1 \<Longrightarrow> dsafe \<theta>\<^sub>2 \<Longrightarrow> dsafe (Plus \<theta>\<^sub>1 \<theta>\<^sub>2)"
 | dsafe_Times: "dsafe \<theta>\<^sub>1 \<Longrightarrow> dsafe \<theta>\<^sub>2 \<Longrightarrow> dsafe (Times \<theta>\<^sub>1 \<theta>\<^sub>2)"
 | dsafe_Diff: "dfree \<theta> \<Longrightarrow> dsafe (Differential \<theta>)"
 | dsafe_DiffVar: "dsafe ($' i)"
 
 \<comment> \<open>Explictly-written variables that are bound by the ODE. Needed to compute whether\<close>
 \<comment> \<open>ODE's are valid (e.g. whether they bind the same variable twice)\<close>
 fun ODE_dom::"('a, 'c) ODE \<Rightarrow> 'c set"
 where 
   "ODE_dom (OVar c) =  {}"
 | "ODE_dom (OSing x \<theta>) = {x}"
 | "ODE_dom (OProd ODE1 ODE2) = ODE_dom ODE1 \<union> ODE_dom ODE2"
 
 inductive osafe:: "('a, 'c) ODE \<Rightarrow> bool"
 where
   osafe_Var:"osafe (OVar c)"
 | osafe_Sing:"dfree \<theta> \<Longrightarrow> osafe (OSing x \<theta>)"
 | osafe_Prod:"osafe ODE1 \<Longrightarrow> osafe ODE2 \<Longrightarrow> ODE_dom ODE1 \<inter> ODE_dom ODE2 = {} \<Longrightarrow> osafe (OProd ODE1 ODE2)"
 
 \<comment> \<open>Programs/formulas without any differential terms. This definition not currently used but may\<close>
 \<comment> \<open>be useful in the future.\<close>
 inductive hpfree:: "('a, 'b, 'c) hp \<Rightarrow> bool"
   and     ffree::  "('a, 'b, 'c) formula \<Rightarrow> bool"
 where
   "hpfree (Pvar x)"
 | "dfree e \<Longrightarrow> hpfree (Assign x e)"
 \<comment> \<open>Differential programs allowed but not differential terms\<close>
 | "dfree e \<Longrightarrow> hpfree (DiffAssign x e)"
 | "ffree P \<Longrightarrow> hpfree (Test P)" 
 \<comment> \<open>Differential programs allowed but not differential terms\<close>
 | "osafe ODE \<Longrightarrow> ffree P \<Longrightarrow> hpfree (EvolveODE ODE P)"
 | "hpfree a \<Longrightarrow> hpfree b \<Longrightarrow> hpfree (Choice a b )"
 | "hpfree a \<Longrightarrow> hpfree b \<Longrightarrow> hpfree (Sequence a b)"
 | "hpfree a \<Longrightarrow> hpfree (Loop a)"
 | "ffree f \<Longrightarrow> ffree (InContext C f)"
 | "(\<And>arg. arg \<in> range args \<Longrightarrow> dfree arg) \<Longrightarrow> ffree (Prop p args)"
 | "ffree p \<Longrightarrow> ffree (Not p)"
 | "ffree p \<Longrightarrow> ffree q \<Longrightarrow> ffree (And p q)"
 | "ffree p \<Longrightarrow> ffree (Exists x p)"
 | "hpfree a \<Longrightarrow> ffree p \<Longrightarrow> ffree (Diamond a p)"
 | "ffree (Predicational P)"
 | "dfree t1 \<Longrightarrow> dfree t2 \<Longrightarrow> ffree (Geq t1 t2)"
 
 inductive hpsafe:: "('a, 'b, 'c) hp \<Rightarrow> bool"
   and     fsafe::  "('a, 'b, 'c) formula \<Rightarrow> bool"
 where
    hpsafe_Pvar:"hpsafe (Pvar x)"
  | hpsafe_Assign:"dsafe e \<Longrightarrow> hpsafe (Assign x e)"
  | hpsafe_DiffAssign:"dsafe e \<Longrightarrow> hpsafe (DiffAssign x e)"
  | hpsafe_Test:"fsafe P \<Longrightarrow> hpsafe (Test P)" 
  | hpsafe_Evolve:"osafe ODE \<Longrightarrow> fsafe P \<Longrightarrow> hpsafe (EvolveODE ODE P)"
  | hpsafe_Choice:"hpsafe a \<Longrightarrow> hpsafe b \<Longrightarrow> hpsafe (Choice a b )"
  | hpsafe_Sequence:"hpsafe a \<Longrightarrow> hpsafe b \<Longrightarrow> hpsafe (Sequence a b)"
  | hpsafe_Loop:"hpsafe a \<Longrightarrow> hpsafe (Loop a)"
 
  | fsafe_Geq:"dsafe t1 \<Longrightarrow> dsafe t2 \<Longrightarrow> fsafe (Geq t1 t2)"
  | fsafe_Prop:"(\<And>i. dsafe (args i)) \<Longrightarrow> fsafe (Prop p args)"
  | fsafe_Not:"fsafe p \<Longrightarrow> fsafe (Not p)"
  | fsafe_And:"fsafe p \<Longrightarrow> fsafe q \<Longrightarrow> fsafe (And p q)"
  | fsafe_Exists:"fsafe p \<Longrightarrow> fsafe (Exists x p)"
  | fsafe_Diamond:"hpsafe a \<Longrightarrow> fsafe p \<Longrightarrow> fsafe (Diamond a p)"
  | fsafe_InContext:"fsafe f \<Longrightarrow> fsafe (InContext C f)"
 
 \<comment> \<open>Auto-generated simplifier rules for safety predicates\<close>
 inductive_simps
       dfree_Plus_simps[simp]: "dfree (Plus a b)"
   and dfree_Times_simps[simp]: "dfree (Times a b)"
   and dfree_Var_simps[simp]: "dfree (Var x)"
   and dfree_DiffVar_simps[simp]: "dfree (DiffVar x)"
   and dfree_Differential_simps[simp]: "dfree (Differential x)"
   and dfree_Fun_simps[simp]: "dfree (Function i args)"
   and dfree_Const_simps[simp]: "dfree (Const r)"
 
 inductive_simps
       dsafe_Plus_simps[simp]: "dsafe (Plus a b)"
   and dsafe_Times_simps[simp]: "dsafe (Times a b)"
   and dsafe_Var_simps[simp]: "dsafe (Var x)"
   and dsafe_DiffVar_simps[simp]: "dsafe (DiffVar x)"
   and dsafe_Fun_simps[simp]: "dsafe (Function i args)"
   and dsafe_Diff_simps[simp]: "dsafe (Differential a)"
   and dsafe_Const_simps[simp]: "dsafe (Const r)"
 
 inductive_simps
       osafe_OVar_simps[simp]:"osafe (OVar c)"
   and osafe_OSing_simps[simp]:"osafe (OSing x \<theta>)"
   and osafe_OProd_simps[simp]:"osafe (OProd ODE1 ODE2)"
 
 inductive_simps
       hpsafe_Pvar_simps[simp]: "hpsafe (Pvar a)"
   and hpsafe_Sequence_simps[simp]: "hpsafe (a ;; b)"
   and hpsafe_Loop_simps[simp]: "hpsafe (a**)"
   and hpsafe_ODE_simps[simp]: "hpsafe (EvolveODE ODE p)"
   and hpsafe_Choice_simps[simp]: "hpsafe (a \<union>\<union> b)"
   and hpsafe_Assign_simps[simp]: "hpsafe (Assign x e)"
   and hpsafe_DiffAssign_simps[simp]: "hpsafe (DiffAssign x e)"
   and hpsafe_Test_simps[simp]: "hpsafe (? p)"
   
   and fsafe_Geq_simps[simp]: "fsafe (Geq t1 t2)"
   and fsafe_Prop_simps[simp]: "fsafe (Prop p args)"
   and fsafe_Not_simps[simp]: "fsafe (Not p)"
   and fsafe_And_simps[simp]: "fsafe (And p q)"
   and fsafe_Exists_simps[simp]: "fsafe (Exists x p)"
   and fsafe_Diamond_simps[simp]: "fsafe (Diamond a p)"
   and fsafe_Context_simps[simp]: "fsafe (InContext C p)"
 
 definition Ssafe::"('sf,'sc,'sz) sequent \<Rightarrow> bool"
 where "Ssafe S \<longleftrightarrow>((\<forall>i. i \<ge> 0 \<longrightarrow> i < length (fst S) \<longrightarrow> fsafe (nth (fst S) i))
                  \<and>(\<forall>i. i \<ge> 0 \<longrightarrow> i < length (snd S) \<longrightarrow> fsafe (nth (snd S) i)))"
 
 definition Rsafe::"('sf,'sc,'sz) rule \<Rightarrow> bool"
 where "Rsafe R \<longleftrightarrow> ((\<forall>i. i \<ge> 0 \<longrightarrow> i < length (fst R) \<longrightarrow> Ssafe (nth (fst R) i)) 
                     \<and> Ssafe (snd R))"
   
 \<comment> \<open>Basic reasoning principles about syntactic constructs, including inductive principles\<close>
 lemma dfree_is_dsafe: "dfree \<theta> \<Longrightarrow> dsafe \<theta>"
   by (induction rule: dfree.induct) (auto intro: dsafe.intros)
   
 lemma hp_induct [case_names Var Assign DiffAssign Test Evolve Choice Compose Star]:
    "(\<And>x. P ($\<alpha> x)) \<Longrightarrow>
     (\<And>x1 x2. P (x1 := x2)) \<Longrightarrow>
     (\<And>x1 x2. P (DiffAssign x1 x2)) \<Longrightarrow>
     (\<And>x. P (? x)) \<Longrightarrow>
     (\<And>x1 x2. P (EvolveODE x1 x2)) \<Longrightarrow>
     (\<And>x1 x2. P x1 \<Longrightarrow> P x2 \<Longrightarrow> P (x1 \<union>\<union> x2)) \<Longrightarrow>
     (\<And>x1 x2. P x1 \<Longrightarrow> P x2 \<Longrightarrow> P (x1 ;; x2)) \<Longrightarrow>
     (\<And>x. P x \<Longrightarrow> P x**) \<Longrightarrow>
      P hp"
   by(induction rule: hp.induct) (auto)
 
 lemma fml_induct:
   "(\<And>t1 t2. P (Geq t1 t2))
   \<Longrightarrow> (\<And>p args. P (Prop p args))
   \<Longrightarrow> (\<And>p. P p \<Longrightarrow> P (Not p))
   \<Longrightarrow> (\<And>p q. P p \<Longrightarrow> P q \<Longrightarrow> P (And p q))
   \<Longrightarrow> (\<And>x p. P p \<Longrightarrow> P (Exists x p))
   \<Longrightarrow> (\<And>a p. P p \<Longrightarrow> P (Diamond a p))
   \<Longrightarrow> (\<And>C p. P p \<Longrightarrow> P (InContext C p))
   \<Longrightarrow> P \<phi>"
   by (induction rule: formula.induct) (auto)
 
 context ids begin
 lemma proj_sing1:"(singleton \<theta> vid1) = \<theta>"
   by (auto)
 
 lemma proj_sing2:"vid1 \<noteq> y  \<Longrightarrow> (singleton \<theta> y) = (Const 0)"
   by (auto)
 end
 
 end
diff --git a/thys/Hoare_Time/QuantK_Hoare.thy b/thys/Hoare_Time/QuantK_Hoare.thy
--- a/thys/Hoare_Time/QuantK_Hoare.thy
+++ b/thys/Hoare_Time/QuantK_Hoare.thy
@@ -1,794 +1,794 @@
 section \<open>Quantitative Hoare Logic (big-O style)\<close>
 
 theory QuantK_Hoare
 imports Big_StepT Complex_Main "HOL-Library.Extended_Nat"
 begin
 
 
 abbreviation "eq a b == (And (Not (Less a b)) (Not (Less b a)))"
    
 type_synonym lvname = string
 type_synonym assn = "state \<Rightarrow> bool" (* time bound *)
 type_synonym qassn = "state \<Rightarrow> enat" (* time bound *)
 
 text \<open>The support of an assn2\<close>
  
 abbreviation state_subst :: "state \<Rightarrow> aexp \<Rightarrow> vname \<Rightarrow> state"
   ("_[_'/_]" [1000,0,0] 999)
 where "s[a/x] == s(x := aval a s)"
 
 fun emb :: "bool \<Rightarrow> enat" ("\<up>") where
    "emb False = \<infinity>"
  | "emb True = 0"
   
 subsection "Definition of Validity"
   
 (* this definition refines the normal Hoare Triple Validity *)
 definition hoare2o_valid :: "qassn \<Rightarrow> com \<Rightarrow> qassn \<Rightarrow> bool"
-  ("\<Turnstile>\<^sub>2\<^sub>' {(1_)}/ (_)/ {(1_)}" 50) where
+  ("\<Turnstile>\<^sub>2\<^sub>'' {(1_)}/ (_)/ {(1_)}" 50) where
 "\<Turnstile>\<^sub>2\<^sub>' {P} c {Q}  \<longleftrightarrow>  (\<exists>k>0. (\<forall>s.  P s < \<infinity> \<longrightarrow> (\<exists>t p. ((c,s) \<Rightarrow> p \<Down> t) \<and> enat k * P s \<ge> p + enat k * Q t)))"
 
 
 subsection "Hoare Rules"
 
 inductive
-  hoareQ :: "qassn \<Rightarrow> com \<Rightarrow> qassn \<Rightarrow> bool" ("\<turnstile>\<^sub>2\<^sub>' ({(1_)}/ (_)/ {(1_)})" 50)
+  hoareQ :: "qassn \<Rightarrow> com \<Rightarrow> qassn \<Rightarrow> bool" ("\<turnstile>\<^sub>2\<^sub>'' ({(1_)}/ (_)/ {(1_)})" 50)
 where
 
 Skip:  "\<turnstile>\<^sub>2\<^sub>' {%s. eSuc (P s)} SKIP {P}"  |
 
 Assign:  "\<turnstile>\<^sub>2\<^sub>' {\<lambda>s. eSuc (P (s[a/x]))} x::=a { P }"  |
 
 If: "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {\<lambda>s. P s + \<up>( bval b s)} c\<^sub>1 { Q};
        \<turnstile>\<^sub>2\<^sub>' {\<lambda>s. P s + \<up>(\<not> bval b s)} c\<^sub>2 { Q} \<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {\<lambda>s. eSuc (P s)} IF b THEN c\<^sub>1 ELSE c\<^sub>2 { Q }"  |
 
 Seq: "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' { P\<^sub>1 } c\<^sub>1 { P\<^sub>2 }; \<turnstile>\<^sub>2\<^sub>' {P\<^sub>2} c\<^sub>2 { P\<^sub>3 }\<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P\<^sub>1} c\<^sub>1;;c\<^sub>2 {P\<^sub>3}"  |
  
 While:
   "\<lbrakk>   \<turnstile>\<^sub>2\<^sub>' { %s. I s + \<up>(bval b s) } c { %t. I t + 1 }   \<rbrakk>
    \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {\<lambda>s. I s + 1 } WHILE b DO c {\<lambda>s.  I s + \<up>(\<not> bval b s)  }" |
 
 conseq:  "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {P}c{Q} ; \<And>s. P s \<le> enat k *  P' s ; \<And>s. enat k * Q' s \<le> Q s; k>0 \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>2\<^sub>' {P'}c{ Q'}" 
   
 text \<open>Derived Rules\<close>
 
 lemma const: "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {\<lambda>s. enat k * P s}c{\<lambda>s. enat k * Q s};  k>0 \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>2\<^sub>' {P}c{ Q}" 
   apply(rule conseq) by auto
 
 inductive
   hoareQ' :: "qassn \<Rightarrow> com \<Rightarrow> qassn \<Rightarrow> bool" ("\<turnstile>\<^sub>Z ({(1_)}/ (_)/ {(1_)})" 50)
 where
 
 ZSkip:  "\<turnstile>\<^sub>Z {%s. eSuc (P s)} SKIP {P}"  |
 
 ZAssign:  "\<turnstile>\<^sub>Z {\<lambda>s. eSuc (P (s[a/x]))} x::=a { P }"  |
 
 ZIf: "\<lbrakk> \<turnstile>\<^sub>Z {\<lambda>s. P s + \<up>( bval b s)} c\<^sub>1 { Q};
        \<turnstile>\<^sub>Z {\<lambda>s. P s + \<up>(\<not> bval b s)} c\<^sub>2 { Q} \<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>Z {\<lambda>s. eSuc (P s)} IF b THEN c\<^sub>1 ELSE c\<^sub>2 { Q }"  |
 
 ZSeq: "\<lbrakk> \<turnstile>\<^sub>Z { P\<^sub>1 } c\<^sub>1 { P\<^sub>2 }; \<turnstile>\<^sub>Z {P\<^sub>2} c\<^sub>2 { P\<^sub>3 }\<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>Z {P\<^sub>1} c\<^sub>1;;c\<^sub>2 {P\<^sub>3}"  |
  
 ZWhile:
   "\<lbrakk>   \<turnstile>\<^sub>Z { %s. I s + \<up>(bval b s) } c { %t. I t + 1 }   \<rbrakk>
    \<Longrightarrow> \<turnstile>\<^sub>Z {\<lambda>s. I s + 1 } WHILE b DO c {\<lambda>s.  I s + \<up>(\<not> bval b s)  }" |
 
 Zconseq': "\<lbrakk> \<turnstile>\<^sub>Z {P}c{Q} ; \<And>s. P s \<le>  P' s ; \<And>s. Q' s \<le> Q s \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>Z {P'}c{ Q'}"   |
    
 Zconst:  "\<lbrakk> \<turnstile>\<^sub>Z {\<lambda>s. enat k * P s}c{\<lambda>s. enat k * Q s};  k>0 \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>Z {P}c{ Q}"  
     
 
 lemma Zconseq: "\<lbrakk> \<turnstile>\<^sub>Z {P}c{Q} ; \<And>s. P s \<le> enat k *  P' s ; \<And>s. enat k * Q' s \<le> Q s; k>0 \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>Z {P'}c{ Q'}"
   apply(rule Zconst[of k P' c Q'])
   apply(rule Zconseq'[where P=P and Q=Q]) by auto
     
     
 lemma ZQ: " \<turnstile>\<^sub>Z { P } c { Q } \<Longrightarrow>  \<turnstile>\<^sub>2\<^sub>' { P } c { Q }"
   apply(induct rule: hoareQ'.induct) 
     apply (auto simp: hoareQ.Skip  hoareQ.Assign hoareQ.If hoareQ.Seq hoareQ.While) 
     subgoal using conseq[where k=1] using one_enat_def by auto  
     subgoal for k P c Q  using const by auto  
     done
 lemma QZ: " \<turnstile>\<^sub>2\<^sub>' { P } c { Q } \<Longrightarrow>  \<turnstile>\<^sub>Z { P } c { Q }"
   apply(induct rule: hoareQ.induct) 
     apply (auto simp: ZSkip  ZAssign ZIf ZSeq ZWhile ) 
     using Zconseq by blast 
       
 lemma QZ_iff:  "\<turnstile>\<^sub>2\<^sub>' { P } c { Q } \<longleftrightarrow>  \<turnstile>\<^sub>Z { P } c { Q }"   
 using ZQ QZ by metis      
 
   
 subsection "Soundness"
 
 lemma enatSuc0[simp]: "enat (Suc 0) * x = x"
   using one_enat_def by auto 
  
     
 theorem hoareQ_sound: "\<turnstile>\<^sub>2\<^sub>' {P}c{ Q}  \<Longrightarrow>  \<Turnstile>\<^sub>2\<^sub>' {P}c{ Q}"
 apply(unfold hoare2o_valid_def)
 proof(  induction  rule: hoareQ.induct)
   case (Skip P)
   show ?case apply(rule exI[where x=1]) apply(auto)
     subgoal for s apply(rule exI[where x=s]) apply(rule exI[where x="Suc 0"])  
       apply safe 
       apply fast    
       by (metis add.left_neutral add.right_neutral eSuc_enat iadd_Suc le_iff_add zero_enat_def)
     done
 next
   case (Assign P a x)
   show ?case apply(rule exI[where x=1])   apply(auto)
     subgoal for s apply(rule exI[where x="s[a/x]"]) apply(rule exI[where x="Suc 0"]) 
       apply safe 
       apply fast
       by (metis add.left_neutral add.right_neutral  eSuc_enat iadd_Suc le_iff_add zero_enat_def)      
     done
 next
   case (Seq P1 C1 P2 C2 P3)
   from Seq(3) obtain k1 where Seq3: "\<forall>s. P1 s < \<infinity> \<longrightarrow> (\<exists>t p. (C1, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k1 * P2 t \<le> enat k1 * P1 s)" and 10: "k1>0" by blast
   from Seq(4) obtain k2 where Seq4: "\<forall>s. P2 s < \<infinity> \<longrightarrow> (\<exists>t p. (C2, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k2 * P3 t \<le> enat k2 * P2 s)" and 20: "k2>0" by blast
   let ?k = "lcm k1 k2" (* or k1*k2 *)
   show ?case apply(rule exI[where x="?k"])
   proof (safe)
     from 10 20 show "lcm k1 k2>0" by (auto simp: lcm_pos_nat)
     fix s
     assume ninfP1: "P1 s < \<infinity>"
     with Seq3 obtain t1 p1 where 1: "(C1, s) \<Rightarrow> p1 \<Down> t1" and q1: "enat p1 + k1 * P2 t1 \<le> k1 * P1 s" by blast
     with ninfP1 have ninfP2: "P2 t1 < \<infinity>"
       using not_le 10 by fastforce 
     with Seq4 obtain t2 p2 where 2: "(C2, t1) \<Rightarrow> p2 \<Down> t2" and q2: "enat p2 + k2 * P3 t2 \<le> k2 * P2 t1" by blast
     with ninfP2 have ninfP3: "P3 t2 < \<infinity>"
       using not_le 20  by fastforce 
     then obtain u2 where u2: "P3 t2 = enat u2" by auto
     from ninfP2 obtain u1 where u1: "P2 t1 = enat u1" by auto
     from ninfP1 obtain u0 where u0: "P1 s = enat u0" by auto
     
     from Big_StepT.Seq[OF 1 2] have 12: "(C1;; C2, s) \<Rightarrow> p1 + p2 \<Down> t2" by simp
     
     have i: "(C1;; C2, s) \<Rightarrow> p1+p2 \<Down> t2" using 1 and 2 by auto
     
     from 10 20 have p: "k1 div gcd k1 k2 > 0" "k2 div gcd k1 k2 > 0" by (simp_all add: Divides.div_positive)
         
     have za: "?k = (k1 div gcd k1 k2) * k2" 
       apply(simp only: lcm_nat_def)
       by (simp add: dvd_div_mult)
         
     have za2: "?k = (k2 div gcd k1 k2) * k1" 
       apply(simp only: lcm_nat_def)
       by (metis dvd_div_mult gcd_dvd2 mult.commute)
         
     from q1[unfolded u1 u2 u0] have z: "p1 + k1 * u1 \<le> k1 * u0" by auto
     from q2[unfolded u1 u2 u0] have y: "  p2 + k2 *   u2 \<le> k2 *   u1" by auto
     have "p1+p2 + ?k * u2 \<le> p1 + (k1 div gcd k1 k2)*p2  + ?k * u2  " using p by simp
     also have "\<dots> \<le> (k2 div gcd k1 k2)*p1 + (k1 div gcd k1 k2)*p2  + ?k * u2  " using p by simp                                      
     also have "\<dots> = (k2 div gcd k1 k2)*p1 + (k1 div gcd k1 k2)*(p2 + k2* u2)"
       apply(simp only: za) by algebra  
     also have "\<dots> \<le> (k2 div gcd k1 k2)*p1 + (k1 div gcd k1 k2)*(k2 *   u1)" using y
       by (metis add_left_mono distrib_left le_iff_add)   
     also have "\<dots> = (k2 div gcd k1 k2)*p1 + ?k * u1" by(simp only: za)
     also have "\<dots> = (k2 div gcd k1 k2)*p1 + (k2 div gcd k1 k2) *(k1* u1)" by(simp only: za2)
     also have "\<dots> \<le> (k2 div gcd k1 k2)*(p1 + k1*u1)"
       by (simp add: distrib_left)
     also have "\<dots> \<le> (k2 div gcd k1 k2)*(k1 * u0)" using z  
       by fastforce
     also have "\<dots> \<le> ?k * u0" by(simp only: za2)
     finally   
     have "p1+p2 + ?k * u2 \<le> ?k * u0" .
     then have ii: "enat (p1+p2) + ?k * P3 t2 \<le> ?k * P1 s" 
       unfolding u0 u2  by auto
         
     from i ii show "\<exists>t p. (C1;; C2, s) \<Rightarrow> p \<Down> t \<and> enat p + ?k * P3 t \<le> ?k * P1 s " by blast 
   qed  
 next
   case (If P b c1 Q c2)
   from If(3) obtain kT where If3: "\<forall>s. P s + \<up> (bval b s) < \<infinity> \<longrightarrow> (\<exists>t p. (c1, s) \<Rightarrow> p \<Down> t \<and> enat p + enat kT * Q t \<le> enat kT * (P s + \<up> (bval b s))) " and T: "kT > 0" by blast
   from If(4) obtain kF where If4: "\<forall>s. P s + \<up> (\<not> bval b s) < \<infinity> \<longrightarrow> (\<exists>t p. (c2, s) \<Rightarrow> p \<Down> t \<and> enat p + enat kF * Q t \<le> enat kF * (P s + \<up> (\<not> bval b s)))" and F: "kF > 0" by blast
   show ?case apply(rule exI[where x="kT*kF"])
   proof (safe)
     from T F show "0 < kT * kF" by auto
     fix s
     assume "eSuc (P s) < \<infinity>"
     then have i: "P s < \<infinity>"
       using enat_ord_simps(4) by fastforce  
     then obtain u0 where u0: "P s = enat u0" by auto
     show "\<exists>t p. (IF b THEN c1 ELSE c2, s) \<Rightarrow> p \<Down> t \<and> enat p + enat (kT * kF) * Q t \<le> enat (kT * kF) * eSuc (P s)"
     proof(cases "bval b s")
       case True
       with i have "P s + emb (bval b s) < \<infinity>" by simp
       with If3 obtain p t where 1: "(c1, s) \<Rightarrow> p \<Down> t" and q: "enat p + enat kT * Q t \<le> enat kT * (P s + emb (bval b s))"  by blast
       from Big_StepT.IfTrue[OF True 1] have 2: "(IF b THEN c1 ELSE c2, s) \<Rightarrow> p + 1 \<Down> t" by simp
            
       from q have "Q t < \<infinity>" using i T True
         using less_irrefl by fastforce
       then obtain u1 where u1: "Q t = enat u1" by auto 
       from q True have q': "p + kT * u1 \<le> kT * u0" unfolding u0 u1 by auto
       have "(p+1) +  (kT * kF) * u1 \<le> kF*(p+1) + (kT * kF) * u1" using F 
         by (simp add: mult_eq_if)
       also have "\<dots> \<le> kF*(p+1  + kT  * u1)"
         by (simp add: add_mult_distrib2)  
       also have "\<dots> \<le> kF*(1  + kT  * u0)"
         using q' by auto
       also have "\<dots> \<le> (kT * kF) * Suc u0" using T by simp
       finally 
       have " (p+1) +  (kT * kF) * u1 \<le>  (kT * kF) * Suc u0" .
       then have 1: "enat (p+1) + enat (kT * kF) * Q t \<le> enat (kT * kF) * eSuc (P s)"
         unfolding u1 u0 by (simp add: eSuc_enat) 
       from 1 2 show ?thesis by metis 
     next
       case False
       with i have "P s + emb (~bval b s) < \<infinity>" by simp
       with If4 obtain p t where 1: "(c2, s) \<Rightarrow> p \<Down> t" and q: "enat p + enat kF * Q t \<le> enat kF * (P s + emb (~bval b s))"  by blast
       from Big_StepT.IfFalse[OF False 1] have 2: "(IF b THEN c1 ELSE c2, s) \<Rightarrow> p + 1 \<Down> t" by simp
            
       from q have "Q t < \<infinity>" using i F False
         using less_irrefl by fastforce
       then obtain u1 where u1: "Q t = enat u1" by auto 
       from q False have q': "p + kF * u1 \<le> kF * u0" unfolding u0 u1 by auto
       have "(p+1) +  (kF * kT) * u1 \<le> kT*(p+1) + (kF * kT) * u1" using T 
         by (simp add: mult_eq_if)
       also have "\<dots> \<le> kT*(p+1  + kF  * u1)"
         by (simp add: add_mult_distrib2)  
       also have "\<dots> \<le> kT*(1  + kF  * u0)"
         using q' by auto
       also have "\<dots> \<le> (kF * kT) * Suc u0" using F by simp
       finally 
       have " (p+1) +  (kT * kF) * u1 \<le>  (kT * kF) * Suc u0"
         by (simp add: mult.commute) 
       then have 1: "enat (p+1) + enat (kT * kF) * Q t \<le> enat (kT * kF) * eSuc (P s)"
         unfolding u1 u0 by (simp add: eSuc_enat) 
       from 1 2 show ?thesis by metis 
     qed
   qed
 next
   case (conseq P c Q k1 P' Q') 
   from conseq(5) obtain k where c4: "\<forall>s. P s < \<infinity> \<longrightarrow> (\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * Q t \<le> enat k * P s)" and 0: "k>0" by blast
   show ?case apply(rule exI[where x="k*k1"])
   proof (safe)
     show "k*k1>0" using 0 conseq(4) by auto
     fix s
     assume "P' s < \<infinity>"
     with conseq(2,4)  have "P s < \<infinity>"
       using le_less_trans
       by (metis enat.distinct(2) enat_ord_simps(4) imult_is_infinity)  
     with c4 obtain p t where 1: "(c, s) \<Rightarrow> p \<Down> t" and 2: "enat p + enat k * Q t \<le> enat k * P s" by blast   
                
     have "enat p + enat (k*k1) * Q' t = enat p + enat (k) * ( (enat k1) * Q' t)"
       by (metis mult.assoc times_enat_simps(1))       
     also have "\<dots> \<le> enat p + enat (k) * Q t" using conseq(3)
       by (metis add_left_mono distrib_left le_iff_add)  
     also have "\<dots> \<le> enat k * P s" using 2 by auto
     also have "\<dots> \<le> enat (k*k1)  * P' s" using conseq(2)
       by (metis mult.assoc mult_left_mono not_less not_less_zero times_enat_simps(1))
     finally have 2: "enat p + enat (k*k1) * Q' t \<le> enat (k*k1) * P' s"
       by auto
     from 1 2 show "\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + (k*k1) * Q' t \<le> (k*k1) * P' s" by auto
   qed
 next
   case (While INV b c)  
   then obtain k where W2: "\<forall>s. INV s + \<up> (bval b s) < \<infinity> \<longrightarrow> (\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * (INV t + 1) \<le> enat k * (INV s + \<up> (bval b s)))" and g0: "k>0"
     by blast
   show ?case apply(rule exI[where x=k])
   proof (safe)
     show "0<k" by fact
     fix s
     assume ninfINV: "INV s + 1 < \<infinity>" 
     then have f: "INV s < \<infinity>"
       using enat_ord_simps(4) by fastforce 
     then obtain n where i: "INV s = enat n" using not_infinity_eq
       by auto      
     
     have "INV s = enat n \<Longrightarrow> \<exists>t p. (WHILE b DO c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * (INV t + emb (\<not> bval b t)) \<le> enat k * (INV s + 1)"
     proof (induct n arbitrary: s rule: less_induct)
       case (less n) 
       
       then show ?case 
       proof (cases "bval b s")
         case False
         show ?thesis
             apply(rule exI[where x="s"])
           apply(rule exI[where x="Suc 0"])
           apply safe
            apply (fact WhileFalse[OF False])
           using False 
           apply (simp add: one_enat_def) using g0
           by (metis One_nat_def Suc_ile_eq add.commute add_left_mono distrib_left enat_0_iff(2) mult.right_neutral not_gr_zero one_enat_def)    
       next
         case True
         with less(2) W2 have "(\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * (INV t + 1) \<le> enat k * INV s )"
           by force  
         then obtain t p where o: "(c, s) \<Rightarrow> p \<Down> t" and q: "enat p + enat k * (INV t + 1) \<le> enat k * INV s " by auto
         from o bigstep_progress have p: "p > 0" by blast
              
             
         from q  have pf: "enat k * (INV t + 1) \<le> enat k * INV s"
           using dual_order.trans by fastforce
         then have "INV t < \<infinity>" using less(2) 
           using g0 not_le by fastforce 
         then obtain invt where invt: "INV t = enat invt" by auto
         from pf g0 have g: "INV t  < INV s"
           unfolding less(2) invt
           by (metis (full_types) Suc_ile_eq add.commute eSuc_enat enat_ord_simps(1) nat_mult_le_cancel_disj plus_1_eSuc(1) times_enat_simps(1))
               
               
         then have ninfINVt: "INV t < \<infinity>" using less(2)
           using enat_ord_simps(4) by fastforce 
         then obtain n' where i: "INV t = enat n'" using not_infinity_eq
           by auto 
         with less(2) have ii: "n' < n"
           using g by auto
         from i ii less(1) obtain t2 p2 where o2: "(WHILE b DO c, t) \<Rightarrow> p2 \<Down> t2" and q2: "enat p2 + enat k * (INV t2 + emb (\<not> bval b t2)) \<le> enat k * ( INV t + 1)" by blast
         have ende: "~ bval b t2"
           apply(rule ccontr) apply(simp) using q2 g0 ninfINVt
           by (simp add: i one_enat_def) 
         from WhileTrue[OF True o o2] have "(WHILE b DO c, s) \<Rightarrow> 1 + p + p2 \<Down> t2" by simp
        
         from ende q2 have q2': "enat p2 + enat k * INV t2 \<le> enat k * (INV t + 1)" by simp
         
         show ?thesis 
           apply(rule exI[where x=t2])
           apply(rule exI[where x= "1 + p + p2"])
           apply(safe)
            apply(fact)
           using ende apply(simp)
         proof -
           have "enat (Suc (p + p2)) +  enat k * INV t2 = enat (Suc p) + enat p2 +  enat k * INV t2" by fastforce
           also have "\<dots> \<le> enat (Suc p) + enat k * (INV t + 1)" using q2'
             by (metis ab_semigroup_add_class.add_ac(1) add_left_mono) 
           also have "\<dots> \<le> 1 + enat k * (INV s)" using q
             by (metis (no_types, hide_lams) add.commute add_left_mono eSuc_enat iadd_Suc plus_1_eSuc(1))
           also have "\<dots> \<le> enat k + enat k * (INV s)" using g0
             by (simp add: Suc_leI one_enat_def) 
           also have "\<dots> \<le>  enat k * (INV s + 1)"
             by (simp add: add.commute distrib_left)
           finally show "enat (Suc (p + p2)) +  enat k * INV t2 \<le>  enat k * (INV s + 1)" .
           qed
         qed 
       qed
         
     from this[OF i] show "\<exists>t p. (WHILE b DO c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * (INV t + emb (\<not> bval b t)) \<le> enat k * (INV s + 1)" .
         
   qed
 qed 
 
   
 lemma conseq':
   "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {P} c {Q} ;  \<forall>s. P s \<le> P' s; \<forall>s. Q' s \<le> Q s  \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P'} c {Q'}"
   apply(rule conseq[where k=1]) by auto
 
 lemma strengthen_pre:
   "\<lbrakk> \<forall>s. P s \<le> P' s;  \<turnstile>\<^sub>2\<^sub>' {P} c {Q} \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P'} c {Q}"
   apply(rule conseq[where k=1 and Q'=Q and Q=Q]) by auto
 
 lemma weaken_post:
   "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {P} c {Q};  \<forall>s. Q s \<ge> Q' s \<rbrakk> \<Longrightarrow>  \<turnstile>\<^sub>2\<^sub>' {P} c {Q'}"
   apply(rule conseq[where k=1]) by auto 
 
 lemma Assign': "\<forall>s. P s \<ge> eSuc ( Q(s[a/x])) \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P} x ::= a {Q}" 
 by (simp add: strengthen_pre[OF _ Assign])
 
   
 subsection "Completeness"
     
 lemma bigstep_det: "(c1, s) \<Rightarrow> p1 \<Down> t1 \<Longrightarrow> (c1, s) \<Rightarrow> p \<Down> t \<Longrightarrow> p1=p \<and> t1=t"
   using big_step_t_determ2 by simp
 
 lemma bigstepT_the_cost: "(c, s) \<Rightarrow> P \<Down> T \<Longrightarrow> (THE n. \<exists>a. (c, s) \<Rightarrow> n \<Down> a) = P"
   using bigstep_det by blast 
 
 lemma bigstepT_the_state: "(c, s) \<Rightarrow> P \<Down> T \<Longrightarrow> (THE a. \<exists>n. (c, s) \<Rightarrow> n \<Down> a) = T"
   using bigstep_det by blast 
 
 
 lemma SKIPnot: "(\<not> (SKIP, s) \<Rightarrow> p \<Down> t) = (s\<noteq>t \<or> p\<noteq>Suc 0)" by blast
 
  
 lemma SKIPp: "(THE p. \<exists>t. (SKIP, s) \<Rightarrow> p \<Down> t) = Suc 0"
   apply(rule the_equality)
   apply fast
   apply auto done 
 
 lemma SKIPt: "(THE t. \<exists>p. (SKIP, s) \<Rightarrow> p \<Down> t) = s"
   apply(rule the_equality)
   apply fast
   apply auto done 
 
 
 lemma ASSp: "(THE p. Ex (big_step_t (x ::= e, s) p)) = Suc 0"
   apply(rule the_equality)
   apply fast
   apply auto done 
 
 lemma ASSt: "(THE t. \<exists>p. (x ::= e, s) \<Rightarrow> p \<Down> t) = s(x := aval e s)"
   apply(rule the_equality)
   apply fast
   apply auto done 
 
 lemma ASSnot: "( \<not> (x ::= e, s) \<Rightarrow> p \<Down> t ) = (p\<noteq>Suc 0 \<or> t\<noteq>s(x := aval e s))"
   apply auto done
 
 text\<open>
 The completeness proof proceeds along the same lines as the one for partial
 correctness. First we have to strengthen our notion of weakest precondition
 to take termination into account:\<close>
 
 definition wpQ :: "com \<Rightarrow> qassn \<Rightarrow> qassn" ("wp\<^sub>Q") where
 "wp\<^sub>Q c Q  =  (\<lambda>s. (if (\<exists>t p. (c,s) \<Rightarrow> p \<Down> t \<and> Q t < \<infinity>)  then enat (THE p. \<exists>t. (c,s) \<Rightarrow> p \<Down> t) + Q (THE t. \<exists>p. (c,s) \<Rightarrow> p \<Down> t) else \<infinity>))"
   
 lemma wpQ_skip[simp]: "wp\<^sub>Q SKIP Q = (%s. eSuc (Q s))"
   apply(auto intro!: ext simp: wpQ_def)
    prefer 2
    apply(simp only: SKIPnot)
    apply(simp)  
   apply(simp only: SKIPp SKIPt)
   using one_enat_def plus_1_eSuc(1) by auto    
 
 lemma wpQ_ass[simp]: "wp\<^sub>Q (x ::= e) Q = (\<lambda>s. eSuc (Q (s(x := aval e s))))"
 by (auto intro!: ext simp: wpQ_def ASSp ASSt ASSnot eSuc_enat) 
 
 lemma wpt_Seq[simp]: "wp\<^sub>Q (c\<^sub>1;;c\<^sub>2) Q = wp\<^sub>Q c\<^sub>1 (wp\<^sub>Q c\<^sub>2 Q)"
 unfolding wpQ_def
 proof (rule, case_tac "\<exists>t p. (c\<^sub>1;; c\<^sub>2, s) \<Rightarrow> p \<Down> t \<and> Q t < \<infinity>", goal_cases)
   case (1 s)
   then obtain u p where ter: "(c\<^sub>1;; c\<^sub>2, s) \<Rightarrow> p \<Down> u" and Q: "Q u < \<infinity>" by blast
   then obtain t p1 p2 where i: "(c\<^sub>1 , s) \<Rightarrow> p1 \<Down> t" and ii: "(c\<^sub>2 , t) \<Rightarrow> p2 \<Down> u" and p: "p1 + p2 = p" by blast
 
   from bigstepT_the_state[OF i] have t: "(THE t. \<exists>p. (c\<^sub>1, s) \<Rightarrow> p \<Down> t) = t"  
     by blast
   from bigstepT_the_state[OF ii] have t2: "(THE u. \<exists>p. (c\<^sub>2, t) \<Rightarrow> p \<Down> u) = u"  
     by blast
   from bigstepT_the_cost[OF i] have firstcost: "(THE p. \<exists>t. (c\<^sub>1, s) \<Rightarrow> p \<Down> t) = p1"  
     by blast
   from bigstepT_the_cost[OF ii] have secondcost: "(THE p. \<exists>u. (c\<^sub>2, t) \<Rightarrow> p \<Down> u) = p2"  
     by blast
   
   have totalcost: "(THE p. Ex (big_step_t (c\<^sub>1;; c\<^sub>2, s) p)) = p1 + p2"
     using bigstepT_the_cost[OF ter] p by auto
   have totalstate: "(THE t. \<exists>p. (c\<^sub>1;; c\<^sub>2, s) \<Rightarrow> p \<Down> t) = u"
     using bigstepT_the_state[OF ter] by auto
   
   have c2: "\<exists>ta p. (c\<^sub>2, t) \<Rightarrow> p \<Down> ta \<and> Q ta < \<infinity>"
     apply(rule exI[where x= u])
     apply(rule exI[where x= p2]) apply safe apply fact+ done
   
   
   have C: "\<exists>t p. (c\<^sub>1, s) \<Rightarrow> p \<Down> t \<and> (if \<exists>ta p. (c\<^sub>2, t) \<Rightarrow> p \<Down> ta \<and> Q ta < \<infinity> then enat (THE p. Ex (big_step_t (c\<^sub>2, t) p)) + Q (THE ta. \<exists>p. (c\<^sub>2, t) \<Rightarrow> p \<Down> ta) else \<infinity>) < \<infinity>"
     apply(rule exI[where x=t])
     apply(rule exI[where x=p1])
     apply safe
      apply fact
     apply(simp only: c2 if_True)
     using Q bigstepT_the_state ii by auto
    
   show ?case
     apply(simp only: 1 if_True t t2 c2 C totalcost totalstate firstcost secondcost) by fastforce
 next
   case (2 s)
   show ?case apply(simp only: 2 if_False)
     apply auto using 2  
     by force 
 qed
    
 
 lemma wpQ_If[simp]:
  "wp\<^sub>Q (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q = (\<lambda>s. eSuc (wp\<^sub>Q (if bval b s then c\<^sub>1 else c\<^sub>2) Q s))"
   apply (auto simp: wpQ_def fun_eq_iff)
   subgoal for x t p i ta ia xa apply(simp only: IfTrue[THEN bigstepT_the_state])
     apply(simp only: IfTrue[THEN bigstepT_the_cost])
     apply(simp only: bigstepT_the_cost bigstepT_the_state)
     by (simp add: eSuc_enat)            
     apply(simp only: bigstepT_the_state bigstepT_the_cost) apply force
    apply(simp only: bigstepT_the_state bigstepT_the_cost)
 proof(goal_cases)
   case (1 x t p i ta ia xa)
   note f= IfFalse[THEN bigstepT_the_state, of b x c\<^sub>2 xa ta "Suc xa" c\<^sub>1, simplified, OF 1(4) 1(5)]
   note f2= IfFalse[THEN bigstepT_the_cost, of b x c\<^sub>2 xa ta "Suc xa" c\<^sub>1, simplified, OF 1(4) 1(5)]
   note g= bigstep_det[OF 1(1) 1(5)]
   show ?case
     apply(simp only: f f2) using 1 g
     by (simp add: eSuc_enat)   
 next
   case 2
   then 
   show ?case
     apply(simp only: bigstepT_the_state bigstepT_the_cost)  apply force done
 qed
   
 lemma hoareQ_inf: "\<turnstile>\<^sub>2\<^sub>' {%s. \<infinity>} c { Q}"
   apply (induction c arbitrary: Q)
   apply(auto intro: hoareQ.Skip hoareQ.Assign hoareQ.Seq hoareQ.conseq)
   subgoal apply(rule hoareQ.conseq) apply(rule hoareQ.If[where P="%s. \<infinity>"]) by(auto intro: hoareQ.If hoareQ.conseq)
   subgoal apply(rule hoareQ.conseq) apply(rule hoareQ.While[where I="%s. \<infinity>"]) apply(rule hoareQ.conseq) by auto 
   done
 
 lemma assumes b: "bval b s"
   shows wpQ_WhileTrue: " wp\<^sub>Q c (wp\<^sub>Q (WHILE b DO c) Q) s  + 1 \<le> wp\<^sub>Q (WHILE b DO c) Q s"
 proof (cases "\<exists>t p. (WHILE b DO c, s) \<Rightarrow> p \<Down> t \<and> Q t < \<infinity>")
   case True
   then obtain t p where w: "(WHILE b DO c, s) \<Rightarrow> p \<Down> t" and q: "Q t < \<infinity>" by blast
   from b w obtain p1 p2 t1 where c: "(c, s) \<Rightarrow> p1 \<Down> t1" and w': "(WHILE b DO c, t1) \<Rightarrow> p2 \<Down> t" and sum: "1 + p1 + p2 = p"
     by auto 
   have g: "\<exists>ta p. (WHILE b DO c, t1) \<Rightarrow> p \<Down> ta \<and> Q ta < \<infinity>"
     apply(rule exI[where x="t"])
     apply(rule exI[where x="p2"])
       apply safe apply fact+ done
     
   have h: "\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> (if \<exists>ta p. (WHILE b DO c, t) \<Rightarrow> p \<Down> ta \<and> Q ta < \<infinity> then enat (THE p. Ex (big_step_t (WHILE b DO c, t) p)) + Q (THE ta. \<exists>p. (WHILE b DO c, t) \<Rightarrow> p \<Down> ta) else \<infinity>) < \<infinity>"
     apply(rule exI[where x="t1"])
     apply(rule exI[where x="p1"])
     apply safe apply fact
     apply(simp only: g if_True) using   bigstepT_the_state bigstepT_the_cost w' q by(auto)
   
   have "wp\<^sub>Q c (wp\<^sub>Q (WHILE b DO c) Q) s + 1 = enat p + Q t"
     unfolding wpQ_def apply(simp only: h if_True)
     apply(simp only: bigstepT_the_state[OF c] bigstepT_the_cost[OF c] g if_True bigstepT_the_state[OF w'] bigstepT_the_cost[OF w']) using sum
     by (metis One_nat_def ab_semigroup_add_class.add_ac(1) add.commute add.right_neutral eSuc_enat plus_1_eSuc(2) plus_enat_simps(1)) 
   also have "\<dots> = wp\<^sub>Q (WHILE b DO c) Q s"
     unfolding wpQ_def apply(simp only: True if_True)
     using bigstepT_the_state bigstepT_the_cost w apply(simp) done
   finally show ?thesis by simp
 next
   case False
   have "wp\<^sub>Q (WHILE b DO c) Q s = \<infinity>"
     unfolding wpQ_def 
     apply(simp only: False if_False) done
   then show ?thesis by auto
 qed
 
 lemma assumes b: "~ bval b s"
   shows wpQ_WhileFalse: " Q s  + 1 \<le> wp\<^sub>Q (WHILE b DO c) Q s"
 proof (cases "\<exists>t p. (WHILE b DO c, s) \<Rightarrow> p \<Down> t \<and> Q t < \<infinity>")
   case True
   with b obtain t p where w: "(WHILE b DO c, s) \<Rightarrow> p \<Down> t" and "Q t < \<infinity>" by blast
   with b have c: "s=t" "p=Suc 0" by auto
   have " wp\<^sub>Q (WHILE b DO c) Q s =  Q s  + 1"
     unfolding wpQ_def apply(simp only: True if_True)
     using w c bigstepT_the_cost bigstepT_the_state by(auto simp add: one_enat_def)  
   then show ?thesis by auto
 next
   case False
   have "wp\<^sub>Q (WHILE b DO c) Q s = \<infinity>"
     unfolding wpQ_def 
     apply(simp only: False if_False) done
   then show ?thesis by auto
 qed 
                             
 
 lemma wpQ_is_pre: "\<turnstile>\<^sub>2\<^sub>' {wp\<^sub>Q c Q} c { Q}"
 proof (induction c arbitrary: Q)
   case SKIP show ?case apply (auto intro: hoareQ.Skip) done
 next
   case Assign show ?case apply (auto intro:hoareQ.Assign) done
 next
   case Seq thus ?case by (auto intro:hoareQ.Seq)
 next 
   case (If x1 c1 c2 Q) thus ?case
     apply (auto intro!: hoareQ.If )  
      apply(rule hoareQ.conseq) 
        apply(auto)
      apply(rule hoareQ.conseq) 
       apply(auto)
     done
 next
   case (While b c)   
   show ?case
       apply(rule conseq[where k=1])   
       apply(rule hoareQ.While[where I="%s. (if bval b s then  wp\<^sub>Q c (wp\<^sub>Q (WHILE b DO c) Q) s else Q s)"])
       apply(rule conseq[where k=1])  
         apply(rule While[of "wp\<^sub>Q (WHILE b DO c) Q"])
        apply(case_tac "bval b s")  
         apply(simp) apply(simp)
       subgoal for s
         apply(cases "bval b s")
         using wpQ_WhileTrue apply simp
         using wpQ_WhileFalse apply simp done
         apply simp
       subgoal for s
         apply(cases "bval b s")
         using wpQ_WhileTrue apply simp
         using wpQ_WhileFalse apply simp done 
        apply(case_tac "bval b s")  
         apply(simp) apply(simp)
         apply simp done  
 qed
   
   
 lemma wpQ_is_pre': "\<turnstile>\<^sub>2\<^sub>' {wp\<^sub>Q c (%s. enat k * Q s )} c {(%s. enat k * Q s )}"  
   using wpQ_is_pre by blast 
     
 lemma wpQ_is_weakestprePotential1: "\<Turnstile>\<^sub>2\<^sub>' {P}c{Q} \<Longrightarrow> (\<exists>k>0. \<forall>s. wp\<^sub>Q c (%s. enat k* Q s) s \<le> enat k * P s)" 
 apply(auto simp: hoare2o_valid_def wpQ_def)
 proof (goal_cases)
   case (1 k) 
   show ?case 
   proof (rule exI[where x=k], safe)
     show "0<k" by fact
   next
     fix s t p i
     assume "(c, s) \<Rightarrow> p \<Down> t" "enat k * Q t = enat i"
     
     show "enat (\<down>\<^sub>t (c, s)) + enat k * Q (\<down>\<^sub>s (c, s)) \<le> enat k * P s"
     proof (cases "P s < \<infinity>") 
       case True
       with 1 obtain t p' where i: "(c, s) \<Rightarrow> p' \<Down> t" and ii: "enat p' + enat k *  Q t \<le> enat k * P s"
         by auto    
       show ?thesis by(simp add: bigstepT_the_state[OF i] bigstepT_the_cost[OF i] ii)
     next
       case False
       then show ?thesis
         using 1 by auto 
     qed  
   next
     fix s
     assume "\<forall>t. (\<forall>p. \<not> (c, s) \<Rightarrow> p \<Down> t) \<or> enat k * Q t = \<infinity>"
     then show "enat k * P s = \<infinity>" using 1 by force
   qed
 qed   
 
 theorem hoareQ_complete: "\<Turnstile>\<^sub>2\<^sub>' {P}c{Q} \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P}c{ Q}" 
 proof -
   assume "\<Turnstile>\<^sub>2\<^sub>' {P}c{Q}"
   with wpQ_is_weakestprePotential1 obtain k where "k>0" 
     and 1: "\<And>s. wp\<^sub>Q c (\<lambda>s. enat k * Q s) s \<le> enat k * P s" by blast
   show "\<turnstile>\<^sub>2\<^sub>' {P}c{Q}"
     apply(rule conseq[OF wpQ_is_pre'])
     apply(fact 1)
      apply simp by fact
 qed
     
 theorem hoareQ_complete': "\<Turnstile>\<^sub>2\<^sub>' {P}c{Q} \<Longrightarrow> \<turnstile>\<^sub>2\<^sub>' {P}c{ Q}"  
   unfolding hoare2o_valid_def
 proof -
   assume "\<exists>k>0. \<forall>s. P s < \<infinity> \<longrightarrow> (\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * Q t \<le> enat k * P s)"
   then obtain k where f: "\<forall>s. P s < \<infinity> \<longrightarrow> (\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat p + enat k * Q t \<le> enat k * P s)" and k: "k>0" by auto
   
   show "\<turnstile>\<^sub>2\<^sub>' {P}c{ Q}"
     apply(rule conseq[OF wpQ_is_pre', where Q'=Q, simplified, where k1=k and k=k and Q1=Q])
     unfolding  wpQ_def
     subgoal for s
       proof(cases "P s < \<infinity>") 
         case True
         with f obtain t p' where i: "(c, s) \<Rightarrow> p' \<Down> t" and ii: "enat p' + enat k * Q t \<le> enat k * P s"
           by auto    
         from ii k True have iii: "enat k * Q t < \<infinity>"
           using imult_is_infinity by fastforce 
         have kla: "\<exists>t p. (c, s) \<Rightarrow> p \<Down> t \<and> enat k * Q t < \<infinity>"
           using iii i by auto
         show ?thesis unfolding bigstepT_the_state[OF i]
             unfolding bigstepT_the_cost[OF i] 
             apply(simp only: kla) using ii by simp
       next
         case False
         then show ?thesis using k by auto
       qed   
     subgoal by auto 
     using k by auto  
 qed 
 
 corollary hoareQ_sound_complete: " \<turnstile>\<^sub>2\<^sub>' {P}c{Q} \<longleftrightarrow> \<Turnstile>\<^sub>2\<^sub>' {P}c{ Q}"
   by (metis hoareQ_sound hoareQ_complete)
   
 subsection "Example"
  
 lemma fixes X::int assumes "0 < X" shows  
  Z: "eSuc (enat (nat (2 * X) * nat (2 * X))) \<le> enat (5 * (nat (X * X)))"
 proof -
   from assms have nn: "0 \<le> X" by auto
   from assms have "0 < nat X" by auto 
   then have "0 < enat (nat X)" by (simp add: zero_enat_def)  
   then have A: "eSuc 0 \<le> enat (nat X)" using ileI1
     by blast
       
   have " (nat X) \<le>  (nat (X*X))"  using nn nat_mult_distrib  by auto
   then have D: "enat (nat X) \<le> enat (nat (X*X))"    by auto
       
   have C: "(enat (nat (2 * X) * nat (2 * X))) = 4* enat (nat (X * X))"   
     using nn nat_mult_distrib
     by (simp add: numeral_eq_enat)    
   have "eSuc (enat (nat (2 * X) * nat (2 * X)))
     = eSuc 0 +  (enat (nat (2 * X) * nat (2 * X)))"
     using one_eSuc plus_1_eSuc(1) by auto
   also have "\<dots> \<le> enat (nat X) +  (enat (nat (2 * X) * nat (2 * X)))"
     using A  add_right_mono by blast  
   also have "\<dots> \<le> enat (nat X) + 4* enat (nat (X * X))" using C by auto
   also have "\<dots> \<le> enat (nat (X * X)) + 4* enat (nat (X * X))" using D by auto
   also have "\<dots> = 5* enat (nat (X * X))"
     by (metis eSuc_numeral mult_eSuc semiring_norm(5)) 
   also have "\<dots> =  enat ( 5* nat (X * X))"
     by (simp add: numeral_eq_enat) 
   finally 
   show ?thesis .
 qed
           
      
  
 lemma weakenpre: "\<lbrakk> \<turnstile>\<^sub>2\<^sub>' {P}c{Q} ;   (\<forall>s. P s \<le>  P' s)  \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>2\<^sub>' {P'}c{ Q}"  using conseq[where Q'=Q and k=1]  
   by auto  
 
 lemma whileDecr: "\<turnstile>\<^sub>2\<^sub>' { %s. enat (nat (s ''x'')) + 1} WHILE (Less (N 0) (V ''x'')) DO (SKIP;; SKIP;; ''x'' ::= Plus (V ''x'') (N (-1))) { %s. enat 0}" 
   apply(rule conseq[where k=4])
      apply(rule While[where I="%s. enat 4 * (enat (nat (s ''x'')))"])
      prefer 2
   subgoal for s apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1)) by presburger
       apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (''x'' ::= Plus (V ''x'') (N (-1))) (\<lambda>t. enat 4 * enat (nat (t ''x'')) + 1)"])
       apply(simp)
      apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (SKIP) (\<lambda>s. eSuc (enat (4 * nat (s ''x'' - 1)) + 1))"])
       apply simp
   subgoal apply(rule weakenpre) apply(rule Skip) apply auto
     subgoal for s apply(cases "s ''x'' > 0") apply auto
       apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1) eSuc_enat) done
     done
   subgoal apply simp   apply(rule Skip) done
   subgoal apply simp apply(rule weakenpre) apply(rule Assign) by simp
      apply simp 
   subgoal for s apply(cases "s ''x'' > 0") by auto
   by simp
     
     
 lemma whileDecrIf: "\<turnstile>\<^sub>2\<^sub>' { %s. enat (nat (s ''x'')) + 1} WHILE (Less (N 0) (V ''x'')) DO ( (IF Less (N 0) (V ''z'') THEN SKIP;; SKIP ELSE SKIP );; ''x'' ::= Plus (V ''x'') (N (-1))) { %s. enat 0}"
   apply(rule conseq[OF While, where k=6 and I1="%s. enat 6 * (enat (nat (s ''x'')))"])  
      prefer 2
   subgoal for s apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1)) by presburger
       apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (''x'' ::= Plus (V ''x'') (N (-1))) (\<lambda>t. enat 6 * enat (nat (t ''x'')) + 1)"])
      apply(simp)
       apply(rule weakenpre)
       apply(rule If[where P="wp\<^sub>Q (IF Less (N 0) (V ''z'') THEN SKIP;; SKIP ELSE SKIP ) (\<lambda>s. eSuc (enat (6 * nat (s ''x'' - 1)) + 1))"])
       subgoal  
         apply simp 
         apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (SKIP) (\<lambda>s. eSuc (enat (6 * nat (s ''x'' - 1)) + 1))"])
         subgoal apply(rule weakenpre)  apply(rule Skip) by auto  
         subgoal apply(rule weakenpre) apply(rule Skip) by auto
         done
       subgoal
         apply simp 
         subgoal apply(rule weakenpre)  apply(rule Skip) by auto  
         done
      subgoal
               apply auto
     subgoal for s apply(cases "s ''x'' > 0") apply auto
       apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1) eSuc_enat) done
     subgoal for s apply(cases "s ''x'' > 0") apply auto
       apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1) eSuc_enat) done
     done
   subgoal apply simp apply(rule weakenpre) apply(rule Assign) by simp
      apply simp 
   subgoal for s apply(cases "s ''x'' > 0") by auto
   by simp
    
     
 lemma whileDecrIf2: "\<turnstile>\<^sub>2\<^sub>' { %s. enat (nat (s ''x'')) + 1} WHILE (Less (N 0) (V ''x'')) DO ( (IF Less (N 0) (V ''z'') THEN SKIP;; SKIP ELSE SKIP );; ''x'' ::= Plus (V ''x'') (N (-1))) { %s. enat 0}"
   apply(rule conseq[OF While, where k=6 and I1="%s. enat 6 * (enat (nat (s ''x'')))"])
       apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (''x'' ::= Plus (V ''x'') (N (-1))) (\<lambda>t. enat 6 * enat (nat (t ''x'')) + 1)"])
      apply(simp)
       apply(rule weakenpre)
       apply(rule If[where P="wp\<^sub>Q (IF Less (N 0) (V ''z'') THEN SKIP;; SKIP ELSE SKIP ) (\<lambda>s. eSuc (enat (6 * nat (s ''x'' - 1)) + 1))"])
       subgoal  
         apply simp 
         apply(rule Seq[where P\<^sub>2="wp\<^sub>Q (SKIP) (\<lambda>s. eSuc (enat (6 * nat (s ''x'' - 1)) + 1))"])
         subgoal apply(rule weakenpre)  apply(rule Skip) by auto  
         subgoal apply(rule weakenpre) apply(rule Skip) by auto
         done
       subgoal
         apply simp 
         subgoal apply(rule weakenpre)  apply(rule Skip) by auto  
         done
      prefer 2
     subgoal apply simp apply(rule weakenpre) apply(rule Assign) by simp        
      subgoal
               apply auto
     subgoal for s apply(cases "s ''x'' > 0") apply auto
       apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1) eSuc_enat) done
     subgoal for s apply(cases "s ''x'' > 0") apply auto
       apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1) eSuc_enat) done
     done 
   subgoal for s apply(simp only: one_enat_def plus_enat_simps times_enat_simps enat_ord_code(1)) by presburger
   subgoal for s apply(cases "s ''x'' > 0") by auto
   by simp
     
 
 end
\ No newline at end of file
diff --git a/thys/Hoare_Time/SepLogK_Hoare.thy b/thys/Hoare_Time/SepLogK_Hoare.thy
--- a/thys/Hoare_Time/SepLogK_Hoare.thy
+++ b/thys/Hoare_Time/SepLogK_Hoare.thy
@@ -1,1186 +1,1186 @@
 section "Hoare Logic based on Separation Logic and Time Credits (big-O style)" 
 theory SepLogK_Hoare
   imports Big_StepT  Partial_Evaluation  Big_StepT_Partial
 begin
 
 
    
 subsection \<open>Definition of Validity\<close>
           
 definition hoare3o_valid :: "assn2 \<Rightarrow> com \<Rightarrow> assn2 \<Rightarrow> bool"
-  ("\<Turnstile>\<^sub>3\<^sub>' {(1_)}/ (_)/ { (1_)}" 50) where
+  ("\<Turnstile>\<^sub>3\<^sub>'' {(1_)}/ (_)/ { (1_)}" 50) where
 "\<Turnstile>\<^sub>3\<^sub>' { P } c { Q }  \<longleftrightarrow>
     (\<exists> k>0. (\<forall>ps n. P (ps,n)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and> k * n = k * e + e' + m
      \<and> Q (ps',e))))"
  
  
 
 
 subsection "Hoare Rules"
      
 inductive
   hoare3a :: "assn2 \<Rightarrow> com \<Rightarrow> assn2 \<Rightarrow> bool" ("\<turnstile>\<^sub>3\<^sub>a ({(1_)}/ (_)/ { (1_)})" 50)
 where
 
 Skip:  "\<turnstile>\<^sub>3\<^sub>a {$1} SKIP { $0}"  |
 
 Assign4:  "\<turnstile>\<^sub>3\<^sub>a { (\<lambda>(ps,t). x\<in>dom ps \<and> vars a \<subseteq> dom ps \<and> Q (ps(x\<mapsto>(paval a ps)),t) ) ** $1} x::=a { Q }" |
 
 If: "\<lbrakk> \<turnstile>\<^sub>3\<^sub>a { \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b True s } c\<^sub>1 { Q };
        \<turnstile>\<^sub>3\<^sub>a {  \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b False s } c\<^sub>2 { Q } \<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). P (s,n) \<and> vars b \<subseteq> dom s) ** $1} IF b THEN c\<^sub>1 ELSE c\<^sub>2 { Q}"   |
 
 Frame:  "\<lbrakk>    \<turnstile>\<^sub>3\<^sub>a { P } C { Q  } \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>a { P ** F } C { Q ** F } "  |
 
 Seq:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>a { P } C\<^sub>1 { Q } ;  \<turnstile>\<^sub>3\<^sub>a { Q } C\<^sub>2 { R  } \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>a { P } C\<^sub>1 ;; C\<^sub>2 { R } "  |
 
 While:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b True s) } C { (\<lambda>(s,n). P (s,n) \<and>  vars b \<subseteq> dom s)  ** $1 }  \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). P (s,n) \<and>  vars b \<subseteq> dom s) ** $1 } WHILE b DO C {  \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b False s } "  |
    
 conseqS: "\<lbrakk> \<turnstile>\<^sub>3\<^sub>a {P}c{Q} ; \<And>s n. P' (s,n) \<Longrightarrow> P (s,n) ; \<And>s n. Q (s,n) \<Longrightarrow> Q' (s,n) \<rbrakk> \<Longrightarrow> 
            \<turnstile>\<^sub>3\<^sub>a {P'}c{ Q'}"   
   
 inductive
   hoare3b :: "assn2 \<Rightarrow> com \<Rightarrow> assn2 \<Rightarrow> bool" ("\<turnstile>\<^sub>3\<^sub>b ({(1_)}/ (_)/ { (1_)})" 50)
 where
 
 import:  "\<turnstile>\<^sub>3\<^sub>a {P} c { Q} \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>b {P} c { Q}"  |
 
 
 conseq: "\<lbrakk> \<turnstile>\<^sub>3\<^sub>b {P}c{Q} ; \<And>s n. P' (s,n) \<Longrightarrow> P (s,k*n) ; \<And>s n. Q (s,n) \<Longrightarrow> Q' (s,n div k); k>0 \<rbrakk> \<Longrightarrow> 
            \<turnstile>\<^sub>3\<^sub>b {P'}c{ Q'}"   
 
   
   
 inductive
-  hoare3' :: "assn2 \<Rightarrow> com \<Rightarrow> assn2 \<Rightarrow> bool" ("\<turnstile>\<^sub>3\<^sub>' ({(1_)}/ (_)/ { (1_)})" 50)
+  hoare3' :: "assn2 \<Rightarrow> com \<Rightarrow> assn2 \<Rightarrow> bool" ("\<turnstile>\<^sub>3\<^sub>'' ({(1_)}/ (_)/ { (1_)})" 50)
 where
 
 Skip:  "\<turnstile>\<^sub>3\<^sub>' {$1} SKIP { $0}"  |
 
 
 Assign:  "\<turnstile>\<^sub>3\<^sub>' {lmaps_to_expr_x x a v ** $1} x::=a { (%(s,c). dom s = vars a - {x} \<and> c = 0) ** x \<hookrightarrow> v }"  |
 
 Assign':  "\<turnstile>\<^sub>3\<^sub>' {pointsto x v' ** ( pointsto x v \<longrightarrow>* Q)  ** $1} x::= N v { Q }"  |
 
 
 Assign2:  "\<turnstile>\<^sub>3\<^sub>' {\<exists>v . ( ((\<exists>v'. pointsto x v') ** ( pointsto x v \<longrightarrow>* Q)  ** $1)
                  and sep_true ** (%(ps,n). vars a \<subseteq> dom ps \<and> paval a ps = v  ) )} x::= a { Q }"  |
 
 
 
 If: "\<lbrakk> \<turnstile>\<^sub>3\<^sub>' { \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b True s } c\<^sub>1 { Q };
        \<turnstile>\<^sub>3\<^sub>' {  \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b False s } c\<^sub>2 { Q } \<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { (\<lambda>(s,n). P (s,n) \<and> vars b \<subseteq> dom s) ** $1} IF b THEN c\<^sub>1 ELSE c\<^sub>2 { Q}"   |
 
 Frame:  "\<lbrakk>    \<turnstile>\<^sub>3\<^sub>' { P } C { Q  } \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P ** F } C { Q ** F } "  |
 
 Seq:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>' { P } C\<^sub>1 { Q } ;  \<turnstile>\<^sub>3\<^sub>' { Q } C\<^sub>2 { R  } \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P } C\<^sub>1 ;; C\<^sub>2 { R } "  |
 
 While:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>' { (\<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b True s) } C { (\<lambda>(s,n). P (s,n) \<and>  vars b \<subseteq> dom s)  ** $1 }  \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { (\<lambda>(s,n). P (s,n) \<and>  vars b \<subseteq> dom s) ** $1 } WHILE b DO C {  \<lambda>(s,n). P (s,n) \<and> lmaps_to_axpr b False s } "  |
    
 conseq: "\<lbrakk> \<turnstile>\<^sub>3\<^sub>' {P}c{Q} ; \<And>s n. P' (s,n) \<Longrightarrow> P (s,k*n) ; \<And>s n. Q (s,n) \<Longrightarrow> Q' (s,n div k); k>0 \<rbrakk> \<Longrightarrow> 
            \<turnstile>\<^sub>3\<^sub>' {P'}c{ Q'}"   |
 
 normalize:  "\<lbrakk>    \<turnstile>\<^sub>3\<^sub>' { P ** $m } C { Q  ** $n }; n\<le>m \<rbrakk>
              \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P ** $(m-n) } C { Q } "   | 
 
 Assign''': "\<turnstile>\<^sub>3\<^sub>' {  $1 ** (x \<hookrightarrow> ds) } x ::= (N v) {  (x \<hookrightarrow> v) }" |
 
 Assign'''': "\<lbrakk>  symeval P a v; \<turnstile>\<^sub>3\<^sub>' {P} x ::= (N v) {Q'}  \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' {P} x ::= a {Q'}" |
 
 Assign4:  "\<turnstile>\<^sub>3\<^sub>' { (\<lambda>(ps,t). x\<in>dom ps \<and> vars a \<subseteq> dom ps \<and> Q (ps(x\<mapsto>(paval a ps)),t) ) ** $1} x::=a { Q }" |
 
 False: "\<turnstile>\<^sub>3\<^sub>' {  \<lambda>(ps,n). False } c {  Q }" |
 
 pureI: "( P \<Longrightarrow>  \<turnstile>\<^sub>3\<^sub>' { Q} c { R}) \<Longrightarrow>  \<turnstile>\<^sub>3\<^sub>' {\<up>P ** Q} c { R}"
    
 
 (* which is more general Assign4 or Assign2 ? *)
 
 definition A4 :: "vname \<Rightarrow> aexp \<Rightarrow> assn2 \<Rightarrow> assn2" 
   where "A4 x a Q = ((\<lambda>(ps,t). x\<in>dom ps \<and> vars a \<subseteq> dom ps \<and> Q (ps(x\<mapsto>(paval a ps)),t) ) ** $1)"
 definition A2 :: "vname \<Rightarrow> aexp \<Rightarrow> assn2 \<Rightarrow> assn2" 
   where "A2 x a Q = (\<exists>v . ( ((\<exists>v'. pointsto x v') ** ( pointsto x v \<longrightarrow>* Q)  ** $1)
                  and sep_true ** (%(ps,n). vars a \<subseteq> dom ps \<and> paval a ps = v  ) ))"
 
     
 lemma "A4 x a Q (ps,n) \<Longrightarrow> A2 x a Q (ps,n)"
 unfolding A4_def A2_def sep_conj_def dollar_def sep_impl_def pointsto_def apply auto
   apply(rule exI[where x="paval a ps"])
   apply safe
   subgoal for n v
     apply(rule exI[where x="[x \<mapsto> v]::partstate"])
     apply(rule exI[where x=0])
     apply auto apply(rule exI[where x="ps(x:=None)"])
     apply auto
     unfolding sep_disj_fun_def domain_conv apply auto  
     unfolding plus_fun_conv apply auto 
       by (simp add: map_add_upd_left map_upd_triv) 
   subgoal for n v
     apply(rule exI[where x=0])
     apply(rule exI[where x=n])
     apply(rule exI[where x=ps])
     by auto 
   done
           
 lemma "A2 x a Q (ps,n) \<Longrightarrow> A4 x a Q (ps,n)"
   unfolding A4_def A2_def sep_conj_def dollar_def sep_impl_def pointsto_def
   apply (auto simp: sep_disj_commute) 
   subgoal for aa ba ab ac bc xa bd apply(rule exI[where x=bd])
     by (auto simp: sep_add_ac  domain_conv sep_disj_fun_def)
   subgoal  for aa ba ab ac bc xa bd apply(rule exI[where x=bd])
     apply (auto simp: sep_add_ac)      
     subgoal apply (auto simp:   domain_conv sep_disj_fun_def)
       by (metis fun_upd_same none_def plus_fun_def)
     subgoal 
       by (metis domD map_add_dom_app_simps(1) plus_fun_conv subsetCE)      
     subgoal 
     proof -
       assume a: "ab + [x \<mapsto> xa] = aa + ac"
       assume b: "ps = aa + ac" and o: "aa ## ac"
       then have b': "ps = ac + aa" by(simp add: sep_add_ac)
       assume vars: "vars a \<subseteq> dom ac"
       have pa: "paval a ps = paval a ac" unfolding b' 
         apply(rule paval_extend) using o vars by (simp_all add: sep_add_ac)
         
       have f: "\<And>f. (ab + [x \<mapsto> xa])(x \<mapsto> f) = ab + [x \<mapsto> f]"
         by (simp add: plus_fun_conv) 
           
       assume "Q (ab + [x \<mapsto> paval a ac], bd)"
       thus "Q ((aa + ac)(x \<mapsto> paval a (aa + ac)), bd)"
         unfolding b[symmetric] pa
         unfolding b a[symmetric] pa f by auto
     qed
     done
   done
     
 lemma E_extendsR: "\<turnstile>\<^sub>3\<^sub>a { P } c { F } \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P } c { F }"      
   apply (induct  rule: hoare3a.induct)
     apply(intro hoare3'.Skip)
     apply(intro hoare3'.Assign4)
     subgoal using hoare3'.If by auto
     subgoal using hoare3'.Frame by auto
     subgoal using hoare3'.Seq by auto
     subgoal using hoare3'.While by auto
     subgoal using hoare3'.conseq[where k=1] by simp
     done
   
 lemma E_extendsS: "\<turnstile>\<^sub>3\<^sub>b { P } c { F } \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P } c { F }"      
   apply (induct  rule: hoare3b.induct)
     apply(erule E_extendsR) 
     using hoare3'.conseq  by blast
  
       
 
 
 lemma Skip':  "P = (F ** $1) \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' { P } SKIP { F }" 
   apply(rule conseq[where k=1])
     apply(rule Frame[where F=F])
      apply(rule Skip)
     by (auto simp: sep_conj_ac)
  
   
 subsubsection "experiments with explicit and implicit GarbageCollection"
  
 lemma "( (\<forall>ps n. P (ps,n)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and>  n =  e + e' + m
      \<and> Q (ps',e))))
   \<longleftrightarrow>   (\<forall>ps n. P (ps,n) \<longrightarrow> (\<exists>ps' m e . ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps')   \<and>  n = e  + m \<and> (Q ** (\<lambda>_. True)) (ps',e)))"
 
 proof (safe)
   fix ps n
   assume "\<forall>ps n. P (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> n = e + e' + m \<and> Q (ps', e))"
     "P (ps, n)"
   then obtain ps' ps'' m e e' where C: "(c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> n = e + e' + m \<and> Q (ps', e)" by blast
   show "\<exists>ps' m e. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' \<and> n = e + m \<and> (Q ** (\<lambda>_. True)) (ps',e)"   unfolding   sep_conj_def
     apply(rule exI[where x="ps' + ps''"])
     apply(rule exI[where x="m"])
     apply(rule exI[where x="e+e'"]) using C   by auto
 next
   fix ps n
   assume "\<forall>ps n. P (ps,n) \<longrightarrow> (\<exists>ps' m e . ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps')   \<and>  n = e  + m \<and> (Q ** (\<lambda>_. True)) (ps',e))"
     "P (ps, n)"
   then obtain ps' m e where C: "((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps')   \<and>  n = e  + m" and Q: "(Q ** (\<lambda>_. True)) (ps',e)" by blast
   from Q obtain ps1 ps2 e1 e2 where Q': "Q (ps1,e1)" "ps'=ps1+ps2" "ps1##ps2" "e=e1+e2" unfolding sep_conj_def by auto
   show "\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> n = e + e' + m \<and> Q (ps', e)"
     apply(rule exI[where x="ps1"])
     apply(rule exI[where x="ps2"])
     apply(rule exI[where x="m"])
     apply(rule exI[where x="e1"])
     apply(rule exI[where x="e2"]) using C Q' by auto
 qed
        
 subsection \<open>Soundness\<close>
 
 theorem hoareT_sound2_part: assumes "\<turnstile>\<^sub>3\<^sub>' { P }c{ Q  }"
   shows "\<Turnstile>\<^sub>3\<^sub>' { P } c { Q }" using assms        
 proof(induction  rule: hoare3'.induct) 
    case (conseq P c Q P' k1 Q')
   then obtain k where p: "\<forall>ps n. P (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'')  \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> Q (ps',e))" and gt0: "k>0"
     unfolding hoare3o_valid_def by blast
       
       
   show ?case    unfolding hoare3o_valid_def
     apply(rule exI[where x="k*k1"])
     apply safe
     using gt0 conseq(4) apply simp
   proof -
     fix ps n
     assume "P' (ps,n)"
     with conseq(2) have "P (ps, k1*n)" by simp
     with p obtain ps' ps'' m e e' where pB: "(c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''" and orth: "ps' ## ps''"
           and m: "k * (k1 * n) = k*e + e' + m" and Q:  "Q (ps', e)"  by blast
                  
     from Q conseq(3) have Q': "Q' (ps', e div k1)" by auto
       
     have "k * k1 * n = k*e + e' + m" using m by auto
     also have "\<dots> = k*(k1 * (e div k1) + e mod k1) + e' + m" using mod_mult_div_eq by simp
     also have "\<dots> = k*k1*(e div k1) + (k*(e mod k1) + e') + m"
       by (metis add.assoc distrib_left mult.assoc) 
     finally have "k * k1 * n = k * k1 * (e div k1) + (k * (e mod k1) + e') + m" .
       
         
     show "\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * k1 * n = k * k1 * e + e' + m \<and> Q' (ps', e)"
       apply(rule exI[where x="ps'"])
       apply(rule exI[where x="ps''"])
       apply(rule exI[where x=m])
       apply(rule exI[where x="e div k1"])
       apply(rule exI[where x="k * (e mod k1) + e'"])
       apply safe apply fact apply fact apply fact apply fact done
   qed  
 next     
   case (Frame P c Q F)
   from Frame(2)[unfolded hoare3o_valid_def]  obtain k
     where hyp: "\<forall>ps n. P (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'')  \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> Q (ps',e))"
         and k: "k>0"
     unfolding hoare3o_valid_def by blast
       
   show ?case unfolding hoare3o_valid_def apply(rule exI[where x=k]) using k apply simp
   proof(safe)
     fix ps n
     assume "(P \<and>* F) (ps, n)"
     then obtain ps1 ps2 where orth: "ps1 ## ps2" and add: "(ps, n) = ps1 + ps2"
                   and P: "P ps1" and F: "F ps2" unfolding sep_conj_def by blast
     from hyp P have "(\<exists>ps' ps'' m e e'. ((c,fst ps1) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'')  \<and> ps' ## ps'' \<and> k * snd ps1 = k * e + e' + m \<and> Q (ps',e))"
       by simp
     then obtain ps' ps'' m e e' where a: "(c, fst ps1) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''" and orth2[simp]: "ps' ## ps''"
               and m: "k * snd ps1 = k * e + e' + m"  and Q: "Q (ps', e)" by blast                                                      
    
     from big_step_t3_post_dom_conv[OF a] have dom: "dom (ps' + ps'') = dom (fst ps1)" by auto         
         
         
     from add have g: "ps = fst ps1 + fst ps2" and h: "n = snd ps1 + snd ps2" by (auto simp add: plus_prod_def)  
       
     from orth have [simp]: "fst ps2 ## ps'" "fst ps2 ## ps''"
        apply (metis dom map_convs(1) orth2 sep_disj_addD1 sep_disj_commuteI sep_disj_fun_def sep_disj_prod_def) 
       by (metis dom map_convs(1) orth orth2 sep_add_commute sep_disj_addD1 sep_disj_commuteI sep_disj_fun_def sep_disj_prod_def)
         
     then have e: "ps' ## fst ps2" unfolding sep_disj_fun_def using dom   unfolding domain_conv  by blast
         
     have 3: "(Q \<and>* F) (ps'+fst ps2, e+snd ps2)" unfolding sep_conj_def
         apply(rule exI[where x="(ps',e)"])
       apply(rule exI[where x="ps2"])
       apply safe
       subgoal  using orth  unfolding sep_disj_prod_def apply (auto simp: sep_disj_nat_def) 
         apply(rule e) done             
       subgoal unfolding plus_prod_def apply auto done
         apply fact apply fact done
         
     show "\<exists>ps' ps'' m. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> (\<exists>e. (\<exists>e'. k * n = k * e + e' + m) \<and> (Q \<and>* F) (ps', e))" 
       apply(rule exI[where x="ps'+fst ps2"])
       apply(rule exI[where x="ps''"])
       apply(rule exI[where x=m])
     proof safe
       show "(c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + fst ps2 + ps''"
         apply(rule Framer2[OF _ _ g]) apply (fact a)
          using orth apply (auto simp: sep_disj_prod_def)
          by (metis \<open>fst ps2 ## ps''\<close> \<open>fst ps2 ## ps'\<close> orth2 sep_add_assoc sep_add_commute sep_disj_commuteI)   
      next
        show "ps' + fst ps2 ## ps''"
          by (metis dom map_convs(1) orth orth2 sep_add_disjI1 sep_disj_fun_def sep_disj_prod_def)
      next
        show "\<exists>e. (\<exists>e'. k * n = k * e + e' + m) \<and> (Q \<and>* F) (ps' + fst ps2, e)"
          apply(rule exI[where x="e+snd ps2"])
          apply safe
          subgoal proof(rule exI[where x=e'])
            have "k * n = k * snd ps1 + k * snd ps2" unfolding h by (simp add: distrib_left)  
            also have "\<dots> =  k * e + e' + m + k* snd ps2" unfolding m by auto
            finally show "k * n = k * (e + snd ps2) + e' + m"
              by algebra
          qed  apply fact done
      qed 
    qed
 next 
   case (False c Q)    
   then show ?case by (auto simp: hoare3o_valid_def) 
 next
   case (Assign2 x Q a)
   show ?case 
     unfolding hoare3o_valid_def
     apply (rule exI[where x=1], safe) apply auto
     proof -
       fix ps n v
       assume A: "((\<lambda>s. \<exists>xa. (x \<hookrightarrow> xa) s) \<and>* (x \<hookrightarrow> v \<longrightarrow>* Q) \<and>* $ (Suc 0)) (ps, n)"
       assume B: "((\<lambda>s. True) \<and>* (\<lambda>(ps, n). vars a \<subseteq> dom ps \<and> paval a ps = v)) (ps, n)"
         
         
       from A obtain ps1 ps2 n1 n2 v' where  "ps1 ## ps2" and add1: "ps = ps1 + ps2" and n: "n = n1 + n2" and
          1: "(\<exists>xaa. (x \<hookrightarrow> xaa) (ps1,n1))"
          and 2:  "((x \<hookrightarrow> v \<longrightarrow>* Q) \<and>* $ (Suc 0)) (ps2,n2)"  unfolding sep_conj_def
         by fastforce
           
       from 2 obtain ps2a ps2b n2a n2b where "ps2a ## ps2b" and add2: "ps2 = ps2a + ps2b" and n2: "n2 = n2a + n2b"
         and Q: "(x \<hookrightarrow> v \<longrightarrow>* Q) (ps2a,n2a)" and ps2b: "ps2b=0" and n2b: "n2b=1" unfolding dollar_def sep_conj_def
         by fastforce
           
         
       from 1 obtain v' where n1: "n1=0" and p: "ps1 = ([x \<mapsto> v']::partstate)" 
           and x: "x : dom ps1" by (auto simp: pointsto_def)
       from x add1 have x: "x : dom ps"
         by (simp add: plus_fun_conv subset_iff) 
            
       have f: "([x \<mapsto> v'] + ps2a)(x \<mapsto> v) = ps2a + [x \<mapsto> v]"
         by (smt \<open>\<And>thesis. (\<And>v'. \<lbrakk>n1 = 0; ps1 = [x \<mapsto> v']; x \<in> dom ps1\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> \<open>ps1 ## ps2\<close> add2 disjoint_iff_not_equal dom_fun_upd domain_conv fun_upd_upd map_add_upd_left option.distinct(1) plus_fun_conv ps2b sep_add_commute sep_add_zero sep_disj_fun_def) 
         
           
       let ?n' = "n2a + n1"
       from n n2 n2b have n': "n=1+?n'" by simp
       have Q': "Q (ps(x \<mapsto> v), ?n')" using Q n1 unfolding sep_impl_def apply auto
         unfolding pointsto_def apply auto
         subgoal 
           by (metis \<open>ps1 ## ps2\<close> \<open>ps2 = ps2a + ps2b\<close> \<open>ps2b = 0\<close> dom_fun_upd domain_conv option.distinct(1) p sep_add_zero sep_disj_commute sep_disj_fun_def)
         subgoal unfolding add1 p add2 ps2b
           by (auto simp: f)  
         done
             
       from B obtain ps1 ps2 n1 n2 where orth: "ps1 ## ps2" and add: "ps = ps2 + ps1" and n: "n=n1+n2"
           and vars: "vars a \<subseteq> dom ps2" and v: "paval a ps2 = v"
         unfolding sep_conj_def by (auto simp: sep_add_ac)
           
       from vars add have a: "vars a \<subseteq> dom ps"
         by (simp add: plus_fun_conv subset_iff)          
           
       from a x have "vars a \<union> {x} \<subseteq> dom ps" by auto
           
       have "paval a ps = v" unfolding add apply(subst paval_extend)
         using orth vars v by(auto simp: sep_disj_commute)
           
         
       show "\<exists>ps' ps'' m. (x ::= a, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> (\<exists>e. (\<exists>e'. n = e + e' + m) \<and> Q (ps', e))"
         apply(rule exI[where x="ps(x\<mapsto>v)"])
         apply(rule exI[where x=0])
         apply(rule exI[where x="Suc 0"])
         apply auto
         apply(rule big_step_t_part.Assign)
            apply fact+ apply simp 
         apply(rule exI[where x="?n'"])
           apply safe 
           apply(rule exI[where x=0]) using n' apply simp
           using Q' by auto
           
     qed
 next
   case Skip
   then show ?case by (auto simp: hoare3o_valid_def dollar_def)   
 next
   case (Assign4 x a Q)
   then show ?case
     apply (auto simp: dollar_def sep_conj_def  hoare3o_valid_def ) 
       apply(rule exI[where x=1]) apply auto
       subgoal for ps b y
         apply(rule exI[where x="ps(x \<mapsto> paval a ps)"])
         apply(rule exI[where x="0"])
         apply(rule exI[where x="Suc 0"]) apply auto
           apply(rule exI[where x=b]) by auto
       done
 next
   case (Assign' x v' v Q )
   have "\<And>aa. aa ## [x \<mapsto> v'] \<Longrightarrow>
        \<not> aa ## [x \<mapsto> v] \<Longrightarrow> False"   unfolding sep_disj_fun_def domain_def
     apply auto by (smt Collect_conj_eq Collect_empty_eq) 
   have f: "\<And>v'. domain [x \<mapsto> v'] = {x}" unfolding domain_conv by auto 
      
   { fix ps
     assume u: "ps ## [x \<mapsto> v']"
     have 2: "[x \<mapsto> v'] + ps = ps + [x \<mapsto> v']"
           "[x \<mapsto> v] + ps = ps + [x \<mapsto> v]"
          subgoal apply (subst sep_add_commute) using u by (auto simp: sep_add_ac) 
          subgoal apply (subst sep_add_commute) using u apply (auto simp: sep_add_ac)
              unfolding sep_disj_fun_def f by auto  done
     have "(x ::= N v, [x \<mapsto> v'] + ps) \<Rightarrow>\<^sub>A Suc 0 \<Down> [x \<mapsto> v] + ps"
       apply(rule Framer[OF big_step_t_part.Assign])
          apply simp_all using u  by (auto simp: sep_add_ac) 
     then have "(x ::= N v, ps + [x \<mapsto> v']) \<Rightarrow>\<^sub>A Suc 0 \<Down> ps + [x \<mapsto> v]" 
       by (simp only: 2)  
   } note f2 = this
       
   from Assign' show ?case 
     apply (auto simp: dollar_def sep_conj_def pointsto_def sep_impl_def hoare3o_valid_def ) 
     apply(rule exI[where x=1]) apply (auto simp: sep_add_ac) 
     subgoal unfolding sep_disj_fun_def f by auto 
     subgoal for ps n
       apply(rule exI[where x="ps+[x \<mapsto> v]"])
       apply(rule exI[where x="0"])
       apply(rule exI[where x="Suc 0"])
       apply safe 
       subgoal using f2 by auto
       subgoal  by auto 
       subgoal by force
       done
     done
 next
   case (Assign x a v)   
   then show ?case unfolding hoare3o_valid_def
     apply(rule exI[where x=1]) 
     apply auto apply (auto simp: dollar_def )
       subgoal for ps n
          apply (subst (asm) separate_othogonal) apply auto
       apply(rule exI[where x="ps(x:=Some v)"])
       apply(rule exI[where x="0"])
       apply(rule exI[where x="1"])
       apply auto 
       apply (auto simp: pointsto_def)  unfolding  sep_conj_def
     subgoal  apply(rule exI[where x="((%y. if y=x then None else ps y) , 0)"])
       apply(rule exI[where x="((%y. if y = x then Some (paval a ps) else None),0)"])
         apply (auto simp: sep_disj_prod_def sep_disj_fun_def plus_fun_def)
       apply (smt domIff domain_conv)
       apply (metis domI insertE option.simps(3))
       using domIff by fastforce
     done  
   done
 next
   case (If P b c\<^sub>1 Q c\<^sub>2)
   from If(3)[unfolded hoare3o_valid_def]
     obtain k1 where T: "\<And>ps n. P (ps, n) \<Longrightarrow> vars b \<subseteq> dom ps \<Longrightarrow> pbval b ps
      \<Longrightarrow> (\<exists>ps' ps'' m e e'. (c\<^sub>1, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k1 * n = k1 * e + e' + m \<and> Q (ps', e))"
         and k1: "k1 > 0" by force
   from If(4)[unfolded hoare3o_valid_def]
     obtain k2 where F: "\<And>ps n. P (ps, n) \<Longrightarrow> vars b \<subseteq> dom ps \<Longrightarrow> \<not> pbval b ps
      \<Longrightarrow> (\<exists>ps' ps'' m e e'. (c\<^sub>2, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k2 * n = k2 * e + e' + m \<and> Q (ps', e))"
         and k2: "k2 > 0" by force
         
     show ?case unfolding hoare3o_valid_def apply auto apply (auto simp: dollar_def)   
         apply(rule exI[where x="k1 * k2"]) using k1 k2 apply auto
   proof (goal_cases)
     case (1 ps n)   
     then obtain n' where P: "P (ps, n')" and dom: "vars b \<subseteq> dom ps" and Suc: "n = Suc n'" unfolding sep_conj_def
       by force
     show ?case 
     proof(cases "pbval b ps")
       case True
       with T[OF P dom] obtain ps' ps'' m e e' where d: "(c\<^sub>1, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''"
             and orth: "ps' ## ps''" and m1:  "k1 * n' = k1 * e + e' + m" and Q:  "Q (ps', e)"
           by blast
         from big_step_t3_post_dom_conv[OF d] have klong: "dom (ps' + ps'') = dom ps" . 
       from k1 obtain k1' where k1': "k1 = Suc k1'"
         using gr0_implies_Suc by blast 
       from k2 obtain k2' where k2': "k2 = Suc k2'"
         using gr0_implies_Suc by blast 
       let ?e1 = "(k2' * (e' + m + k1) + e' + k1')"
       show ?thesis
         apply(rule exI[where x=ps']) 
         apply(rule exI[where x=ps'']) apply(rule exI[where x="m+1"])   
           apply safe
             apply(rule big_step_t_part.IfTrue)
               apply (rule dom)
               apply fact
                apply (rule True)
            apply (rule d)
           apply simp 
          apply fact
         subgoal apply(rule exI[where x="e"])
           apply safe
           subgoal proof (rule exI[where x="?e1"]) 
             have "k1 * k2 * n = k2 * (k1*n)" by auto
             also have "\<dots> = k2 * (k1*n' + k1)" unfolding Suc  by auto
             also have "\<dots> = k2 * (k1 * e + e' + m + k1)" unfolding m1 by auto
             also have "\<dots> = k1 * k2 * e + k2* (e' + m + k1)"  by algebra
             also have "\<dots> = k1 * k2 * e + k2' * (e' + m + k1) + (e' + m + k1)" unfolding k2'
               by simp 
             also have "\<dots> = k1 * k2 * e + k2' * (e' + m + k1) + (e' + k1' + m + 1)" unfolding k1' by simp
             also have "\<dots> = k1 *k2*e + (k2' * (e' + m + k1) + e' + k1') + (m+1)" by algebra  
             finally show "k1 * k2 * n = k1 * k2 * e + ?e1 + (m + 1)" .
           qed  using Q by force   
         done          
     next
       case False
       with F[OF P dom] obtain ps' ps'' m e e' where d: "(c\<^sub>2, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''"
             and orth: "ps' ## ps''" and m2:  "k2 * n' = k2 * e + e' + m" and Q:  "Q (ps', e)"
           by blast
         from big_step_t3_post_dom_conv[OF d] have klong: "dom (ps' + ps'') = dom ps" . 
       from k1 obtain k1' where k1': "k1 = Suc k1'"
         using gr0_implies_Suc by blast 
       from k2 obtain k2' where k2': "k2 = Suc k2'"
         using gr0_implies_Suc by blast 
       let ?e2 = "(k1' * (e' + m + k2) + e' + k2')"
       show ?thesis
         apply(rule exI[where x=ps']) 
         apply(rule exI[where x=ps'']) apply(rule exI[where x="m+1"])   
           apply safe
             apply(rule big_step_t_part.IfFalse)
               apply (rule dom)
               apply fact
                apply (rule False)
            apply (rule d)
           apply simp 
          apply fact
         subgoal apply(rule exI[where x="e"])
           apply safe
           subgoal proof (rule exI[where x="?e2"]) 
             have "k1 * k2 * n = k1 * (k2*n)" by auto
             also have "\<dots> = k1 * (k2*n' + k2)" unfolding Suc  by auto
             also have "\<dots> = k1 * (k2 * e + e' + m + k2)" unfolding m2 by auto
             also have "\<dots> = k1 * k2 * e + k1* (e' + m + k2)"  by algebra
             also have "\<dots> = k1 * k2 * e + k1' * (e' + m + k2) + (e' + m + k2)" unfolding k1'
               by simp 
             also have "\<dots> = k1 * k2 * e + k1' * (e' + m + k2) + (e' + k2' + m + 1)" unfolding k2' by simp
             also have "\<dots> = k1 *k2*e + (k1' * (e' + m + k2) + e' + k2') + (m+1)" by algebra  
             finally show "k1 * k2 * n = k1 * k2 * e + ?e2 + (m + 1)" .
           qed  using Q by force   
         done
     qed 
   qed
 next
   case (Seq P C\<^sub>1 Q C\<^sub>2 R) 
     
   from Seq(3)[unfolded hoare3o_valid_def] obtain k1 where
     1: "(\<forall>ps n. P (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. (C\<^sub>1, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k1 * n = k1 * e + e' + m \<and> Q (ps', e)))"
       and k10: "k1 > 0" by blast
   from Seq(4)[unfolded hoare3o_valid_def]  obtain k2 where 
     2: " (\<forall>ps n. Q (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. (C\<^sub>2, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k2 * n = k2 * e + e' + m \<and> R (ps', e)))"
       and k20: "k2 > 0" by blast
       
   from k10 obtain k1' where k1': "k1 = Suc k1'"
     using gr0_implies_Suc by blast 
   from k20 obtain k2' where k2': "k2 = Suc k2'"
     using gr0_implies_Suc by blast 
         
   show ?case unfolding hoare3o_valid_def
   apply(rule exI[where x="k2*k1"])
   proof safe        
     fix ps n      
     assume "P (ps, n)"
       
     with 1 obtain ps1' ps1'' m1 e1 e1' where C1: "(C\<^sub>1, ps) \<Rightarrow>\<^sub>A m1 \<Down> ps1' + ps1''" and orth: "ps1' ## ps1''"
           and m1: "k1 * n = k1 * e1 + e1' + m1"and Q: "Q (ps1', e1)" by blast
       
     from Q and 2 obtain ps2' ps2'' m2 e2 e2' where C2: "(C\<^sub>2, ps1') \<Rightarrow>\<^sub>A m2 \<Down> ps2' + ps2''" and orth2: "ps2' ## ps2''"
         and m2: "k2 * e1 = k2 * e2 + e2' + m2" and R: "R (ps2', e2)" by blast
     
     let ?ee = "(k1 *e2'  + k2*e1' +k2'*m1+ k1'*m2)"
       
     show "\<exists>ps' ps'' m e e'. (C\<^sub>1;; C\<^sub>2, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k2 * k1 * n = k2 * k1 * e + e' + m \<and> R (ps', e)"
       apply(rule exI[where x=ps2'])
         apply(rule exI[where x="ps2'' + ps1''"])
         apply(rule exI[where x="m1+m2"])
         apply(rule exI[where x="e2"])
       apply(rule exI[where x="?ee"])
     proof safe
       have C2': "(C\<^sub>2, ps1' + ps1'') \<Rightarrow>\<^sub>A m2 \<Down> ps2' + (ps2'' + ps1'')" 
         apply(rule Framer2[OF C2, of ps1'']) apply fact apply simp
           using sep_add_assoc
           by (metis C2 big_step_t3_post_dom_conv map_convs(1) orth orth2 sep_add_commute sep_disj_addD1 sep_disj_commuteI sep_disj_fun_def)
       show "(C\<^sub>1;; C\<^sub>2, ps) \<Rightarrow>\<^sub>A m1 + m2 \<Down> ps2' + (ps2'' + ps1'')"
         using C1 C2' by auto
     next
       show "ps2' ## ps2'' + ps1''"
         by (metis C2 big_step_t3_post_dom_conv map_convs(1) orth orth2 sep_disj_addI3 sep_disj_fun_def)
     next
       have "k2 * k1 * n = k2 * (k1 * n)" by auto
       also have "\<dots> = k2 * (k1 * e1 + e1' + m1)" using m1 by auto
       also have "\<dots> = k1 * k2 * e1 + k2 * (e1' + m1)" by algebra
       also have "\<dots> = k1 * (k2 * e2 + e2' + m2) + k2 * (e1' + m1)" using m2 by auto
       also have "\<dots> = k2 * k1 * e2 + (k1 *e2'  + k2*e1' +k2*m1+ k1*m2)" by algebra
       also have "\<dots> = k2 * k1 * e2 + (k1 *e2'  + k2*e1' +k2'*m1+m1+ k1'*m2+m2)" unfolding k1' k2' by auto
       also have "\<dots> = k2 * k1 * e2 + (k1 *e2'  + k2*e1' +k2'*m1+ k1'*m2)+(m1+m2)"  by auto
       finally show "k2 * k1 * n = k2 * k1 * e2 + ?ee + (m1 + m2)" .
     qed fact 
   qed (simp add: k10 k20)     
 next
   case (While P b C) 
      
    {
      assume "\<exists>k>0. \<forall>ps n. (case (ps, n) of (s, n) \<Rightarrow> P (s, n) \<and> lmaps_to_axpr b True s) \<longrightarrow>
                  (\<exists>ps' ps'' m e e'. (C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> ((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* $ 1) (ps', e))"
      then obtain k where  While2: "\<forall>ps n. (case (ps, n) of (s, n) \<Rightarrow> P (s, n) \<and> lmaps_to_axpr b True s) \<longrightarrow> (\<exists>ps' ps'' m e e'. (C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> ((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* $ 1) (ps', e))" and k: "k>0" by blast
          
   from k obtain k' where k': "k = Suc k'"
     using gr0_implies_Suc by blast
       
     have "\<exists>k>0. \<forall>ps n. ((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* $ 1) (ps, n) \<longrightarrow>
                  (\<exists>ps' ps'' m e e'.
                      (WHILE b DO C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and>
                      ps' ## ps'' \<and> k * n = k * e + e' + m \<and> (case (ps', e) of (s, n) \<Rightarrow> P (s, n) \<and> lmaps_to_axpr b False s))" (* 
     have "\<exists>k>0. \<forall>ps n. ((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* $ 1) (ps, n) \<longrightarrow> (\<exists>ps' m. (WHILE b DO C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' \<and> m \<le> k * n \<and> (case (ps', n - m) of (s, n) \<Rightarrow> P (s, n) \<and> lmaps_to_axpr b False s))"
    *)   proof (rule exI[where x=k], safe, goal_cases)
     case (2 ps n)  
     from 2 show ?case  
       proof(induct n arbitrary: ps rule: less_induct)
         case (less x ps3) 
           
       show ?case 
       proof(cases "pbval b ps3")
         case True
         from less(2) obtain x' where P: "P (ps3, x')" and dom: "vars b \<subseteq> dom ps3"  and Suc: "x = Suc x'" unfolding sep_conj_def dollar_def by auto 
         from P dom True have 
            g: "((\<lambda>(s, n). P (s, n) \<and> lmaps_to_axpr b True s)) (ps3, x')" 
             unfolding dollar_def by auto  
           from While2 g obtain ps3' ps3'' m e e' where C: "(C, ps3) \<Rightarrow>\<^sub>A m \<Down> ps3' + ps3''" and orth: "ps3' ## ps3''"
                 and x: "k * x' = k * e + e' + m" and P': "((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* $ 1) (ps3', e)" by blast
           then obtain x''' where P'': "P (ps3', x''')" and domb: "vars b \<subseteq> dom ps3'" and Suc'': "e = Suc x'''"
               unfolding sep_conj_def dollar_def by auto  
               
           from C big_step_t3_post_dom_conv have "dom ps3 = dom (ps3' + ps3'')" by simp
           with dom have dom': "vars b \<subseteq> dom (ps3' + ps3'')" by auto
               
           from C big_step_t3_gt0 have gt0: "m > 0" by auto
             
           have "e < x" using  x Suc gt0
             by (metis k le_add1 le_less_trans less_SucI less_add_same_cancel1 nat_mult_less_cancel1)   
  
           (*have "\<exists>ps' m. (WHILE b DO C, ps3') \<Rightarrow>\<^sub>A m \<Down> ps' \<and> m \<le> k * (x - (1 + m)) \<and> P (ps', (x - (1 + m)) - m) \<and> vars b \<subseteq> dom ps' \<and> \<not> pbval b ps'"
            *)
           have "\<exists>ps' ps'' m e2 e2'. (WHILE b DO C, ps3') \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * e = k * e2 + e2' + m \<and> P (ps', e2) \<and> lmaps_to_axpr b False ps'" 
                  apply(rule less(1))
              apply fact by fact 
               
           then obtain ps4' ps4'' mt et et' where w: "((WHILE b DO C, ps3') \<Rightarrow>\<^sub>A mt \<Down> ps4' + ps4'')"
               and ortho: "ps4' ## ps4''" and m'': "k * e = k * et + et' + mt"
               and P'': "P (ps4', et)" and dom'': "vars b \<subseteq> dom ps4'" and b'': "\<not> pbval b ps4'" by auto
                  
           have "ps4'' ## ps3''" and "ps4' ## ps3''" by (metis big_step_t3_post_dom_conv domain_conv orth ortho sep_add_disjD sep_disj_fun_def w)+  
               
           show ?thesis
             apply(rule exI[where x="ps4'"])
             apply(rule exI[where x="(ps4'' +  ps3'')"])
             apply(rule exI[where x="1 + m + mt"])
             apply(rule exI[where x="et"])
             apply(rule exI[where x=" et'  + k' + e'"])
           proof (safe)
             have "(WHILE b DO C, ps3' + ps3'') \<Rightarrow>\<^sub>A mt \<Down> ps4' + (ps4'' +  ps3'')"
               apply(rule Framer2[OF w, of ps3'']) apply fact
                apply simp 
               apply(rule sep_add_assoc[symmetric])
                 by fact+
             show "(WHILE b DO C, ps3) \<Rightarrow>\<^sub>A 1 + m + mt \<Down> ps4' + (ps4'' +  ps3'')"
               apply(rule WhileTrue) apply fact apply fact apply (fact C) apply fact by auto
           next
             show "ps4' ## ps4'' + ps3''"
               by (metis big_step_t3_post_dom_conv domain_conv orth ortho sep_disj_addI3 sep_disj_fun_def w)   
           next 
             have "k * x = k * x' + k" unfolding Suc by auto
             also have "\<dots> = k * e + e' + m + k" unfolding x by simp
             also have "\<dots> = k * et + et' + mt + e' + m + k" using m'' by simp
             also have "\<dots> = k * et + et' + mt + e' + m + 1 + k'" using k' by simp
             also have "\<dots> = k * et + ( et'  + k' + e') + (1 + m + mt)" using k' by simp
             finally show "k * x = k * et + ( et'  + k' + e') + (1 + m + mt)" by simp
           next
             show "P (ps4', et)" by fact
           next
             show "lmaps_to_axpr b False ps4'" apply simp using dom'' b'' .. 
           qed                   
       next
         case False
         from less(2) obtain x' where P: "P (ps3, x')" and dom: "vars b \<subseteq> dom ps3" and Suc: "x = Suc x'" unfolding dollar_def sep_conj_def
           by force
         show ?thesis 
         apply(rule exI[where x=ps3])
         apply(rule exI[where x=0])
         apply(rule exI[where x="Suc 0"])
         apply(rule exI[where x="x'"])
           apply(rule exI[where x="k'"]) apply safe
             apply simp apply (rule big_step_t_part.WhileFalse)
         subgoal using dom by simp 
             apply fact apply simp
         using Suc k k' apply simp
         using P Suc apply simp
           using dom apply auto
           using False apply auto done    
       qed 
         
       qed
        
   qed (fact)
       
       
 } with While(2)
   show ?case  unfolding hoare3o_valid_def by simp
 next 
   case (Assign''' x ds v)
   then show ?case  
     unfolding hoare3o_valid_def apply auto 
     apply(rule exI[where x=1]) apply auto
     subgoal for ps n apply(rule exI[where x="ps(x\<mapsto>v)"]) apply(rule exI[where x="0"])
       apply(rule exI[where x="Suc 0"]) 
       apply safe 
         apply(rule big_step_t_part.Assign)
         apply (auto) 
          subgoal apply(subst (asm) separate_othogonal_commuted') by(auto simp: dollar_def pointsto_def)
          subgoal apply(subst (asm) separate_othogonal_commuted') by(auto simp: dollar_def pointsto_def)
          done
        done          
 next
   case (Assign'''' P a v x Q')
   from Assign''''(3)[unfolded hoare3o_valid_def] obtain k where k: "k>0" and 
    A: " \<forall>ps n. P (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. (x ::= N v, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> Q' (ps', e)) "
     by auto
   show ?case   
     unfolding hoare3o_valid_def apply auto 
     apply(rule exI[where x=k]) using k apply auto
     proof (goal_cases)
       case (1 ps n)
       with A obtain ps' ps'' m e e' 
         where " (x ::= N v, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''" and orth: "ps' ## ps''" and m: "k * n = k * e + e' + m" and Q: "Q' (ps', e)" by metis
       from 1(2) Assign''''(1)[unfolded symeval_def] have "paval' a ps = Some v" by auto
       show ?case apply(rule exI[where x=ps']) apply(rule exI[where x=ps'']) apply(rule exI[where x=m])
           apply safe
           apply(rule avalDirekt3_correct) apply fact+
           apply(rule exI[where x=e]) apply safe
           apply(rule exI[where x=e']) apply fact 
           apply fact done  
     qed 
 next
   case (pureI P Q c R)
   show ?case
   proof (cases "P")
     case True
     with pureI(2)[unfolded hoare3o_valid_def] obtain k where k: "k>0" and
      thing: " \<forall>ps n. Q (ps, n) \<longrightarrow> (\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> R (ps', e))" by auto
         
     show ?thesis unfolding hoare3o_valid_def apply(rule exI[where x=k])
       apply safe apply fact
       using thing by fastforce
   next
     case False
     show ?thesis unfolding hoare3o_valid_def apply(rule exI[where x=1])
         using False by auto
     qed 
       next
 case (normalize P m C Q n)
   then show ?case unfolding hoare3o_valid_def
   apply(safe) subgoal for k apply(rule exI[where x=k]) apply safe proof (goal_cases)
     case (1 ps N)
     have Q2: "P (ps, N - (m - n))" apply(rule stardiff) by fact
     have mn: "m - n \<le> N" apply(rule stardiff(2)) by fact 
     have P: "(P \<and>* $ m) (ps, N - (m - n) + m)"  unfolding sep_conj_def dollar_def
       apply(rule exI[where x="(ps,N - (m - n))"]) apply(rule exI[where x="(0,m)"])
       apply(auto simp: sep_disj_prod_def sep_disj_nat_def) by fact
     have N: " N - (m - n) + m =  N +n" using normalize(2)
       using mn by auto 
     from P N have P': "(P \<and>* $ m) (ps, N +n)"    by auto
         
     from P' 1(4) obtain ps' ps'' m' e e' where "(C, ps) \<Rightarrow>\<^sub>A m' \<Down> ps' + ps''" and orth: "ps' ## ps''"
         and m': "k * (N +n) = k * e + e' + m'" and Q: "(Q \<and>* $ n) (ps', e)" by blast 
         
     have Q2: "Q (ps', e - n)" apply(rule stardiff) by fact
     
     have en: "e\<ge>n" using Q
       using stardiff(2) by blast     
         
     show ?case
       apply(rule exI[where x="ps'"])
       apply(rule exI[where x="ps''"]) apply(rule exI[where x="m'"])
       apply(rule exI[where x="e - n"])
       apply(rule exI[where x="e'"])
       proof (safe)
         show "(C, ps) \<Rightarrow>\<^sub>A m' \<Down> ps' + ps''" by fact 
       next
         show "ps' ## ps''" by fact
       next
         have "k * N = k * ( (N + n)- n)" by auto
         also have "\<dots> = k*(N + n) - k*n"  using right_diff_distrib' by blast 
         also have "\<dots> = (k * e + e' + m') - k*n" using m' by auto
         also have "\<dots> = k * e - k*n + e' + m'" using en
           by (metis Nat.add_diff_assoc2 ab_semigroup_add_class.add_ac(1) distrib_left le_add1 le_add_diff_inverse)
         also have "\<dots> = k * (e-n) + e' + m'" by (simp add: diff_mult_distrib2)   
         finally show "k * N = k * (e - n) + e' + m'" .
       next
         show "Q (ps', e - n)" by fact
       qed     
     qed
   done
 qed
   
     
     
     
 thm hoareT_sound2_part E_extendsR
   
 lemma hoareT_sound2_partR: "\<turnstile>\<^sub>3\<^sub>a {P} c { Q} \<Longrightarrow> \<Turnstile>\<^sub>3\<^sub>' {P} c {Q}"
   using hoareT_sound2_part E_extendsR by blast
     
 
 subsubsection \<open>nice example\<close>
   
 lemma Frame_R:  assumes "\<turnstile>\<^sub>3\<^sub>' { P } C { Q  }" "Frame P' P F"
              shows "\<turnstile>\<^sub>3\<^sub>' { P' } C { Q ** F } "  
   apply(rule conseq[where k=1]) apply(rule Frame) apply(rule assms(1))
       using assms(2) unfolding Frame_def by auto
   
 lemma strengthen_post: assumes "\<turnstile>\<^sub>3\<^sub>' {P}c{Q}" "\<And>s. Q s \<Longrightarrow> Q' s"
   shows "\<turnstile>\<^sub>3\<^sub>' {P}c{ Q'}"
   apply(rule conseq[where k=1])
     apply (rule assms(1))
     apply simp apply simp apply fact apply simp done
            
 lemmas strongAssign = Assign''''[OF _ strengthen_post, OF _ Frame_R, OF _ Assign''']   
   
         
 lemma weakenpre:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>' {P}c{Q} ; \<And>s. P' s \<Longrightarrow> P s  \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>3\<^sub>' {P'}c{ Q}"
   using conseq[where k=1] by auto
     
 lemma weakenpreR:  "\<lbrakk> \<turnstile>\<^sub>3\<^sub>a {P}c{Q} ; \<And>s. P' s \<Longrightarrow> P s  \<rbrakk> \<Longrightarrow>
            \<turnstile>\<^sub>3\<^sub>a {P'}c{ Q}"
   using hoare3a.conseqS by auto
    
     
 subsection "Completeness"
     
     
-definition wp3' :: "com \<Rightarrow> assn2 \<Rightarrow> assn2" ("wp\<^sub>3\<^sub>'") where 
+definition wp3' :: "com \<Rightarrow> assn2 \<Rightarrow> assn2" ("wp\<^sub>3\<^sub>''") where 
 "wp\<^sub>3\<^sub>' c Q  =  (\<lambda>(s,n). \<exists>t m. n\<ge>m \<and> (c,s) \<Rightarrow>\<^sub>A m \<Down> t \<and> Q (t,n-m))" 
     
 lemma wp3Skip[simp]: "wp\<^sub>3\<^sub>' SKIP Q = (Q ** $1)"
   apply (auto intro!: ext simp: wp3'_def) 
     unfolding sep_conj_def dollar_def sep_disj_prod_def sep_disj_nat_def apply auto apply force
     subgoal for t n apply(rule exI[where x=t])  apply(rule exI[where x="Suc 0"])
       using big_step_t_part.Skip by auto
     done
  
 lemma wp3Assign[simp]: "wp\<^sub>3\<^sub>' (x ::= e) Q = ((\<lambda>(ps,t). vars e \<union> {x} \<subseteq> dom ps \<and> Q (ps(x \<mapsto> paval e ps),t)) ** $1)"
   apply (auto intro!: ext simp: wp3'_def )  
   unfolding sep_conj_def apply (auto simp: sep_disj_prod_def sep_disj_nat_def dollar_def) apply force
     by fastforce  
 
 lemma wpt_Seq[simp]: "wp\<^sub>3\<^sub>' (c\<^sub>1;;c\<^sub>2) Q = wp\<^sub>3\<^sub>' c\<^sub>1 (wp\<^sub>3\<^sub>' c\<^sub>2 Q)"
   apply (auto simp: wp3'_def fun_eq_iff ) 
   subgoal for a b t m1 s2 m2  
       apply(rule exI[where x="s2"])
       apply(rule exI[where x="m1"])
         apply simp
       apply(rule exI[where x="t"])
       apply(rule exI[where x="m2"])
       apply simp done
   subgoal for s m t' m1 t m2
       apply(rule exI[where x="t"])
       apply(rule exI[where x="m1+m2"])
     apply (auto simp: big_step_t_part.Seq) done
       done
 
 lemma wp3If[simp]:
  "wp\<^sub>3\<^sub>' (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q = ((\<lambda>(ps,t). vars b \<subseteq> dom ps \<and> wp\<^sub>3\<^sub>' (if pbval b ps then c\<^sub>1 else c\<^sub>2) Q (ps,t)) ** $1)"
   apply (auto simp: wp3'_def fun_eq_iff)
   unfolding sep_conj_def apply (auto simp: sep_disj_prod_def sep_disj_nat_def dollar_def)    
   subgoal for a ba t x apply(rule exI[where x="ba - 1"]) apply auto  
     apply(rule exI[where x=t]) apply(rule exI[where x=x]) apply auto done
   subgoal for a ba t x apply(rule exI[where x="ba - 1"]) apply auto 
     apply(rule exI[where x=t]) apply(rule exI[where x=x]) apply auto done
   subgoal for a ba t m
     apply(rule exI[where x=t]) apply(rule exI[where x="Suc m"]) apply auto
     apply(cases "pbval b a")
     subgoal apply simp apply(subst big_step_t_part.IfTrue) using big_step_t3_post_dom_conv by auto 
     subgoal apply simp apply(subst big_step_t_part.IfFalse) using big_step_t3_post_dom_conv by auto  
   done
   done 
              
     
 lemma sFTrue: assumes "pbval b ps" "vars b \<subseteq> dom ps"
   shows "wp\<^sub>3\<^sub>' (WHILE b DO c) Q (ps, n) = ((\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n))) \<and>* $ 1) (ps, n)"
     (is "?wp = (?I \<and>* $ 1) _")
 proof 
   assume "wp\<^sub>3\<^sub>' (WHILE b DO c) Q (ps, n)"
   from this[unfolded wp3'_def] obtain ps'' tt where tn: "tt \<le> n" and w1: "(WHILE b DO c, ps) \<Rightarrow>\<^sub>A tt \<Down> ps''" and Q: "Q (ps'', n - tt) " by blast      
   with assms obtain t t' ps' where w2: "(WHILE b DO c, ps') \<Rightarrow>\<^sub>A t' \<Down> ps''" and c: "(c, ps) \<Rightarrow>\<^sub>A t \<Down> ps'" and tt: "tt=1+t+t'" by auto
   
   from tn obtain k where n: "n=tt+k"
     using le_Suc_ex by blast  
       
   from assms show "(?I \<and>* $ 1) (ps,n)"
     unfolding sep_conj_def dollar_def  wp3'_def  apply auto
     apply(rule exI[where x="t+t'+k"])
       apply safe subgoal using n tt by auto
       apply(rule exI[where x="ps'"])
     apply(rule exI[where x="t"])
     using c apply auto
       apply(rule exI[where x="ps''"])
     apply(rule exI[where x="t'"])
     using w2 Q n by auto
 next
   assume "(?I \<and>* $ 1) (ps,n)"
   with assms have Q: "wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n-1)" and n: "n\<ge>1" unfolding dollar_def sep_conj_def by auto
   then obtain t ps' t' ps'' where t: "t \<le> n - 1"  
         and c: "(c, ps) \<Rightarrow>\<^sub>A t \<Down> ps'" and  t': "t' \<le> (n-1) - t" and w: "(WHILE b DO c, ps') \<Rightarrow>\<^sub>A t' \<Down> ps''" 
         and Q: "Q (ps'', ((n-1) - t) - t')"
     unfolding wp3'_def by auto
   show "?wp" unfolding wp3'_def
     apply simp apply(rule exI[where x="ps''"]) apply(rule exI[where x="1+t+t'"])
     apply safe
     subgoal using t t' n by simp
     subgoal using c w assms by auto
     subgoal using Q t t' n by simp
     done      
 qed
 
 lemma sFFalse: assumes "~ pbval b ps" "vars b \<subseteq> dom ps"
   shows "wp\<^sub>3\<^sub>' (WHILE b DO c) Q (ps, n) = ((\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n))) \<and>* $ 1) (ps, n)"
     (is "?wp = (?I \<and>* $ 1) _")
 proof 
   assume "wp\<^sub>3\<^sub>' (WHILE b DO c) Q (ps, n)"
   from this[unfolded wp3'_def] obtain ps' t where tn: "t \<le> n" and w1: "(WHILE b DO c, ps) \<Rightarrow>\<^sub>A t \<Down> ps'" and Q: "Q (ps', n - t) " by blast      
   from assms have w2: "(WHILE b DO c, ps) \<Rightarrow>\<^sub>A 1 \<Down> ps" by auto
   from w1 w2 big_step_t_determ2 have t1: "t=1" and pps: "ps=ps'" by auto
   from assms show "(?I \<and>* $ 1) (ps,n)"
     unfolding sep_conj_def dollar_def using t1 tn Q pps apply auto  apply(rule exI[where x="n-1"]) by auto
 next
   assume "(?I \<and>* $ 1) (ps,n)"
   with assms have Q: "Q(ps,n-1)" "n\<ge>1" unfolding dollar_def sep_conj_def by auto
   from assms have w2: "(WHILE b DO c, ps) \<Rightarrow>\<^sub>A 1 \<Down> ps" by auto   
   show "?wp" unfolding wp3'_def
     apply auto   apply(rule exI[where x=ps]) apply(rule exI[where x=1])
       using Q w2 by auto  
 qed
 
 lemma sF': "wp\<^sub>3\<^sub>' (WHILE b DO c) Q (ps,n) = ((\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n))) \<and>* $ 1) (ps,n)"   
   apply(cases "vars b \<subseteq> dom ps")
   subgoal apply(cases "pbval b ps") using sFTrue sFFalse by auto
   subgoal   by (auto simp add: dollar_def wp3'_def sep_conj_def) 
       done
     
 lemma sF: "wp\<^sub>3\<^sub>' (WHILE b DO c) Q s = ((\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n))) \<and>* $ 1) s"   
  using sF'
   by (metis (mono_tags, lifting) prod.case_eq_if prod.collapse sep_conj_impl1) 
     
     
     
 lemma strengthen_postR: assumes "\<turnstile>\<^sub>3\<^sub>a {P}c{Q}" "\<And>s. Q s \<Longrightarrow> Q' s"
   shows "\<turnstile>\<^sub>3\<^sub>a {P}c{ Q'}"
   apply(rule hoare3a.conseqS)
     apply (rule assms(1))
     apply simp by (fact assms(2))  
     
 lemma assumes "\<And>Q. \<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' c Q} c {Q}"
   shows WhileWpisPre: "\<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' (WHILE b DO c) Q} WHILE b DO c { Q}"
 proof - 
   define I where  "I \<equiv> (\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n)))"
   define I' where  "I' \<equiv> (\<lambda>(ps, n). (if pbval b ps then wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q) (ps, n) else Q (ps, n)))"
   have I': "I = (\<lambda>(ps, n). vars b \<subseteq> dom ps \<and> I' (ps, n))" unfolding I_def I'_def by auto
    
   from assms[where Q="(wp\<^sub>3\<^sub>' (WHILE b DO c) Q)"] have 
     c: "\<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' c (wp\<^sub>3\<^sub>' (WHILE b DO c) Q)} c {(wp\<^sub>3\<^sub>' (WHILE b DO c) Q)}" .
   have c': "\<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). I (s,n) \<and> lmaps_to_axpr b True s) } c { I  ** $1 }"
     apply(rule hoare3a.conseqS)             
       apply(rule c)              
     subgoal apply auto unfolding I_def by auto            
     subgoal  unfolding I_def   using sF by auto 
     done
       
   have c'': "\<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). I (s,n) \<and> lmaps_to_axpr b True s) } c { (\<lambda>(s, n). I (s, n) \<and> vars b \<subseteq> dom s)  ** $1 }"
     apply(rule strengthen_postR[OF c'])
       unfolding I'
       by (smt R case_prod_beta prod.sel(1) prod.sel(2))  
    
     have ka: "(\<lambda>(s, n). I (s, n) \<and> vars b \<subseteq> dom s) = I"
       apply rule unfolding I' by auto
         
   from hoare3a.While[where P="I"] c'' have
     w: "\<turnstile>\<^sub>3\<^sub>a { (\<lambda>(s,n). I (s,n) \<and>  vars b \<subseteq> dom s) ** $1 } WHILE b DO c {  \<lambda>(s,n). I (s,n) \<and> lmaps_to_axpr b False s }" .
         
   show "\<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' (WHILE b DO c) Q} WHILE b DO c { Q}"       
       apply(rule hoare3a.conseqS)      
       apply(rule w)           
     subgoal unfolding ka using sF I_def by simp  
     subgoal unfolding I_def by auto 
     done
 qed
      
 
 lemma wpT_is_pre: "\<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' c Q} c { Q}"
 proof (induction c arbitrary: Q)
   case SKIP
   then show ?case apply auto 
     using hoare3a.Frame[where F=Q and Q="$0" and P="$1", OF hoare3a.Skip]
       by (auto simp: sep.add_ac) 
 next
   case (Assign x1 x2) 
   then show ?case using hoare3a.Assign4 by simp 
 next               
   case (Seq c1 c2)
   then show ?case apply auto
     apply(subst hoare3a.Seq[rotated]) by auto
 next
   case (If x1 c1 c2)
   then show ?case apply auto 
     apply(rule weakenpreR[OF hoare3a.If, where P1="%(ps,n). wp\<^sub>3\<^sub>' (if pbval x1 ps then c1 else c2) Q (ps,n)"])
       apply auto
     subgoal apply(rule hoare3a.conseqS[where P="wp\<^sub>3\<^sub>' c1 Q" and Q=Q]) by auto 
     subgoal apply(rule hoare3a.conseqS[where P="wp\<^sub>3\<^sub>' c2 Q" and Q=Q]) by auto 
   proof -
     fix a b
     assume "((\<lambda>(ps, t). vars x1 \<subseteq> dom ps \<and> wp\<^sub>3\<^sub>' (if pbval x1 ps then c1 else c2) Q (ps, t)) \<and>* $ (Suc 0)) (a, b)"
     then show "((\<lambda>(ps, t). wp\<^sub>3\<^sub>' (if pbval x1 ps then c1 else c2) Q (ps, t) \<and> vars x1 \<subseteq> dom ps) \<and>* $ (Suc 0)) (a, b)"
        unfolding sep_conj_def apply auto apply(case_tac "pbval x1 aa") apply auto done (* strange! *)
   qed 
 next
   case (While b c)
   with WhileWpisPre show ?case .
 qed  
    
 lemma hoare3o_valid_alt: "\<Turnstile>\<^sub>3\<^sub>' { P } c { Q }  \<Longrightarrow>
     (\<exists> k>0. (\<forall>ps n. P (ps,n div k)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and> n = e + e' + m
      \<and> Q (ps',e div k))))"  
 proof -
   assume "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q}"
   from this[unfolded hoare3o_valid_def] obtain k where k0: "k>0" and 
      P: "\<And>ps n. P (ps, n) \<Longrightarrow> (\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> Q (ps', e)) "
     by blast
   show ?thesis apply(rule exI[where x=k])
       apply safe apply fact
   proof -
     fix ps n
     assume "P (ps, n div k)"
     with P obtain ps' ps'' m e e' where 1: "(c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''" "ps' ## ps''" and e: "k * (n div k) = k * e + e' + m" and Q: "Q (ps', e)"
       by blast
     have "k * (n div k) \<le> n" using k0
       by simp  
     then obtain e'' where "n = k * (n div k) + e''" using le_Suc_ex by blast
     also have "\<dots> = k * e + e' + e'' + m" using e   by auto 
     finally have "n = k * e + (e'+e'') + m"  and "Q (ps', (k*e) div k)" using Q k0 by auto
     with 1     
      show " \<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> n = e + e' + m \<and> Q (ps', e div k)" by blast
   qed
 qed         
               
   
 lemma valid_alternative_with_GC: assumes "(\<forall>ps n. P (ps,n)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and> n = e + e' + m
      \<and> Q (ps',e))) " shows "(\<forall>ps n. P (ps,n)    
  \<longrightarrow> (\<exists>ps'  m e . ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps'  ) 
       \<and> n = e + m \<and> (Q ** sep_true) (ps',e)))" 
 proof safe
   fix ps n
   assume P: "P (ps,n)"
   with assms obtain ps' ps'' m e e' where c: "(c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''" and
      ps: "ps' ## ps''" and n: "n = e + e' + m" and Q: "Q (ps',e)" by blast
   show "\<exists>ps' m e. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' \<and> n = e + m \<and> (Q \<and>* (\<lambda>s. True)) (ps', e)"
     apply(rule exI[where x="ps' + ps''"])
     apply(rule exI[where x=m])
     apply(rule exI[where x="e+e'"])
     apply safe apply fact apply fact
       unfolding sep_conj_def apply simp apply(rule exI[where x=ps']) apply(rule exI[where x=e])
       apply(rule exI[where x=ps'']) apply safe apply fact apply(rule exI[where x=e']) apply simp
       apply fact done
   qed
      
     
 lemma hoare3o_valid_GC: "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q } \<Longrightarrow> \<Turnstile>\<^sub>3\<^sub>' {P} c { Q ** sep_true}"
 proof -
   assume "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q }" 
   then obtain k where "k>0" and P: "\<And>ps n. P (ps, n) \<Longrightarrow> (\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> Q (ps', e))"
     unfolding hoare3o_valid_def by blast
   show "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q ** sep_true}" unfolding hoare3o_valid_def
     apply(rule exI[where x=k])
     apply safe apply fact
   proof -
     fix ps n
     assume "P (ps, n)"
     with P obtain ps' ps'' m e e' where "(c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps''"" ps' ## ps'' "" k * n = k * e + e' + m " and Q: " Q (ps', e)"
       by blast
 
     show "\<exists>ps' ps'' m e e'. (c, ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'' \<and> ps' ## ps'' \<and> k * n = k * e + e' + m \<and> (Q \<and>* (\<lambda>s. True)) (ps', e)"    
       apply(rule exI[where x=ps'])
       apply(rule exI[where x=ps''])
       apply(rule exI[where x=m])
       apply(rule exI[where x=e])
       apply(rule exI[where x=e'])
       apply safe apply fact+ unfolding sep_conj_def apply(rule exI[where x="(ps', e)"])  apply(rule exI[where x="0"]) using Q by simp
   qed
 qed
   
 lemma hoare3a_sound_GC: "\<turnstile>\<^sub>3\<^sub>a {P} c { Q} \<Longrightarrow> \<Turnstile>\<^sub>3\<^sub>' {P} c { Q ** sep_true}" using hoare3o_valid_GC hoareT_sound2_partR by auto  
   
 lemma valid_wp: "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q} \<Longrightarrow> (\<exists>k>0. \<forall>s n. P (s, n) \<longrightarrow> wp\<^sub>3\<^sub>' c (\<lambda>(ps, n). (Q ** sep_true) (ps, n div k)) (s, k * n))"
 proof -
   let ?P = "\<lambda>k (ps,n). P (ps,n div k)"
   let ?Q = "\<lambda>k (ps,n). Q (ps,n div k)"
   let ?QG = "\<lambda>k (ps,n). (Q ** sep_true) (ps,n div k)"
   assume "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q}" 
   then obtain k where k[simp]: "k>0" and "(\<forall>ps n. P (ps,n div k)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and> n = e + e' + m
      \<and> Q (ps',e div k)))" using hoare3o_valid_alt by blast  
   then have "(\<forall>ps n. ?P k (ps,n)
  \<longrightarrow> (\<exists>ps' ps'' m e e'. ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps' + ps'') 
      \<and> ps' ## ps'' \<and> n = e + e' + m
      \<and> ?Q k (ps',e)))" by auto
   then have f: "(\<forall>ps n. ?P k (ps,n) \<longrightarrow> (\<exists>ps'  m e . ((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps'  ) 
       \<and> n = e + m \<and> (?Q k ** sep_true) (ps',e)))"
     apply(rule valid_alternative_with_GC) done
   
       
   have "\<And>s n. P (s, n) \<Longrightarrow> wp\<^sub>3\<^sub>' c (\<lambda>(ps, n). (Q ** sep_true) (ps, n div k)) (s, k * n)" 
     unfolding wp3'_def apply auto
   proof -
     fix ps n
     assume "P (ps,n)"
     then have "P (ps,(k*n) div k)" apply simp done
     with f obtain ps' m e where "((c,ps) \<Rightarrow>\<^sub>A m \<Down> ps'  )" and z: "k * n = e + m"
         and Q: "(?Q k ** sep_true) (ps',e)" by blast
     from z have e: "e = k * n -m " by auto
     from Q[unfolded e sep_conj_def] obtain ps1 ps2 e1 e2 where
       "ps1 ## ps2" "(ps' = ps1 +ps2)" and eq: "k * n - m = e1 +  e2" and Q: "Q (ps1, e1 div k)" by force
 
     let ?f = "(e1 + e2) div k - (e1 div k + (e2 div k))"
     have kl: "(e1 + e2) div k \<ge> (e1 div k + (e2 div k))" using k
       using div_add1_eq le_iff_add by blast                        
     show "\<exists>t m. m \<le> k * n \<and> (c, ps) \<Rightarrow>\<^sub>A m \<Down> t \<and> (Q \<and>* (\<lambda>s. True)) (t, (k * n - m) div k)"   
       apply(rule exI[where x=ps'])  
       apply(rule exI[where x=m]) apply safe using z apply simp
        apply fact unfolding e unfolding sep_conj_def 
         apply(rule exI[where x="(ps1,e1 div k)"])
       apply(rule exI[where x="(ps2,e2 div k+?f)"]) apply auto apply fact+
       unfolding eq using kl 
       apply force using Q by auto
   qed 
   then show "(\<exists>k>0. \<forall>s n. P (s, n) \<longrightarrow> wp\<^sub>3\<^sub>' c (\<lambda>(ps, n). (Q ** sep_true) (ps, n div k)) (s, k * n))"
     using k by metis
 qed
     
     
 theorem completeness: "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q} \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>b {P} c { Q ** sep_true}"
 proof -
   let ?P = "\<lambda>k (ps,n). P (ps,n div k)"
   let ?Q = "\<lambda>k (ps,n). Q (ps,n div k)"
   let ?QG = "\<lambda>k (ps,n). (Q ** sep_true) (ps,n div k)"
   assume "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q}" 
   then obtain k where k[simp]: "k>0" and P: "\<And>s n. P (s, n) \<Longrightarrow> wp\<^sub>3\<^sub>' c (\<lambda>(ps, n). (Q ** sep_true) (ps, n div k)) (s, k * n)" 
     using valid_wp by blast 
       
   from wpT_is_pre  have R: "\<turnstile>\<^sub>3\<^sub>a {wp\<^sub>3\<^sub>' c (?QG k)} c {?QG k}" by auto
   
   show "\<turnstile>\<^sub>3\<^sub>b {P} c { Q ** sep_true}" 
     apply(rule hoare3b.conseq[OF hoare3b.import[OF R], where k=k])
     subgoal for s n  by (fact P) 
         apply simp by (fact k)
 qed
   
   
 thm E_extendsR completeness
   
 lemma completenessR: "\<Turnstile>\<^sub>3\<^sub>' {P} c { Q} \<Longrightarrow> \<turnstile>\<^sub>3\<^sub>' {P} c { Q ** sep_true}"  
   using E_extendsS completeness by metis
 
 
 end
diff --git a/thys/Hybrid_Logic/Hybrid_Logic.thy b/thys/Hybrid_Logic/Hybrid_Logic.thy
--- a/thys/Hybrid_Logic/Hybrid_Logic.thy
+++ b/thys/Hybrid_Logic/Hybrid_Logic.thy
@@ -1,4820 +1,4820 @@
 theory Hybrid_Logic imports "HOL-Library.Countable" begin
 
 section \<open>Syntax\<close>
 
 datatype ('a, 'b) fm
   = Pro 'a
   | Nom 'b
   | Neg \<open>('a, 'b) fm\<close> (\<open>\<^bold>\<not> _\<close> [40] 40)
   | Dis \<open>('a, 'b) fm\<close> \<open>('a, 'b) fm\<close> (infixr \<open>\<^bold>\<or>\<close> 30)
   | Dia \<open>('a, 'b) fm\<close> (\<open>\<^bold>\<diamond> _\<close> 10)
   | Sat 'b \<open>('a, 'b) fm\<close> (\<open>\<^bold>@ _ _\<close> 10)
 
 text \<open>We can give other connectives as abbreviations.\<close>
 
 abbreviation Top (\<open>\<^bold>\<top>\<close>) where
   \<open>\<^bold>\<top> \<equiv> (undefined \<^bold>\<or> \<^bold>\<not> undefined)\<close>
 
 abbreviation Con (infixr \<open>\<^bold>\<and>\<close> 35) where
   \<open>p \<^bold>\<and> q \<equiv> \<^bold>\<not> (\<^bold>\<not> p \<^bold>\<or> \<^bold>\<not> q)\<close>
 
 abbreviation Imp (infixr \<open>\<^bold>\<longrightarrow>\<close> 25) where
   \<open>p \<^bold>\<longrightarrow> q \<equiv> \<^bold>\<not> (p \<^bold>\<and> \<^bold>\<not> q)\<close>
 
 abbreviation Box (\<open>\<^bold>\<box> _\<close> 10) where
   \<open>\<^bold>\<box> p \<equiv> \<^bold>\<not> (\<^bold>\<diamond> \<^bold>\<not> p)\<close>
 
 primrec nominals :: \<open>('a, 'b) fm \<Rightarrow> 'b set\<close> where
   \<open>nominals (Pro x) = {}\<close>
 | \<open>nominals (Nom i) = {i}\<close>
 | \<open>nominals (\<^bold>\<not> p) = nominals p\<close>
 | \<open>nominals (p \<^bold>\<or> q) = nominals p \<union> nominals q\<close>
 | \<open>nominals (\<^bold>\<diamond> p) = nominals p\<close>
 | \<open>nominals (\<^bold>@ i p) = {i} \<union> nominals p\<close>
 
 primrec sub :: \<open>('b \<Rightarrow> 'c) \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'c) fm\<close> where
   \<open>sub _ (Pro x) = Pro x\<close>
 | \<open>sub f (Nom i) = Nom (f i)\<close>
 | \<open>sub f (\<^bold>\<not> p) = (\<^bold>\<not> sub f p)\<close>
 | \<open>sub f (p \<^bold>\<or> q) = (sub f p \<^bold>\<or> sub f q)\<close>
 | \<open>sub f (\<^bold>\<diamond> p) = (\<^bold>\<diamond> sub f p)\<close>
 | \<open>sub f (\<^bold>@ i p) = (\<^bold>@ (f i) (sub f p))\<close>
 
 lemma sub_nominals: \<open>nominals (sub f p) = f ` nominals p\<close>
   by (induct p) auto
 
 lemma sub_id: \<open>sub id p = p\<close>
   by (induct p) simp_all
 
 lemma sub_upd_fresh: \<open>i \<notin> nominals p \<Longrightarrow> sub (f(i := j)) p = sub f p\<close>
   by (induct p) auto
 
 section \<open>Semantics\<close>
 
 text \<open>
   Type variable \<open>'w\<close> stands for the set of worlds and \<open>'a\<close> for the set of propositional symbols.
   The accessibility relation is given by \<open>R\<close> and the valuation by \<open>V\<close>.
   The mapping from nominals to worlds is an extra argument \<open>g\<close> to the semantics.\<close>
 
 datatype ('w, 'a) model =
   Model (R: \<open>'w \<Rightarrow> 'w set\<close>) (V: \<open>'w \<Rightarrow> 'a \<Rightarrow> bool\<close>)
 
 primrec semantics
   :: \<open>('w, 'a) model \<Rightarrow> ('b \<Rightarrow> 'w) \<Rightarrow> 'w \<Rightarrow> ('a, 'b) fm \<Rightarrow> bool\<close>
   (\<open>_, _, _ \<Turnstile> _\<close> [50, 50, 50] 50) where
   \<open>(M, _, w \<Turnstile> Pro x) = V M w x\<close>
 | \<open>(_, g, w \<Turnstile> Nom i) = (w = g i)\<close>
 | \<open>(M, g, w \<Turnstile> \<^bold>\<not> p) = (\<not> M, g, w \<Turnstile> p)\<close>
 | \<open>(M, g, w \<Turnstile> (p \<^bold>\<or> q)) = ((M, g, w \<Turnstile> p) \<or> (M, g, w \<Turnstile> q))\<close>
 | \<open>(M, g, w \<Turnstile> \<^bold>\<diamond> p) = (\<exists>v \<in> R M w. M, g, v \<Turnstile> p)\<close>
 | \<open>(M, g, _ \<Turnstile> \<^bold>@ i p) = (M, g, g i \<Turnstile> p)\<close>
 
 lemma \<open>M, g, w \<Turnstile> \<^bold>\<top>\<close>
   by simp
 
 lemma semantics_fresh:
   \<open>i \<notin> nominals p \<Longrightarrow> (M, g, w \<Turnstile> p) = (M, g(i := v), w \<Turnstile> p)\<close>
   by (induct p arbitrary: w) auto
 
 subsection \<open>Examples\<close>
 
 abbreviation is_named :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>is_named M \<equiv> \<forall>w. \<exists>a. V M a = w\<close>
 
 abbreviation reflexive :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>reflexive M \<equiv> \<forall>w. w \<in> R M w\<close>
 
 abbreviation irreflexive :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>irreflexive M \<equiv> \<forall>w. w \<notin> R M w\<close>
 
 abbreviation symmetric :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>symmetric M \<equiv> \<forall>v w. w \<in> R M v \<longleftrightarrow> v \<in> R M w\<close>
 
 abbreviation asymmetric :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>asymmetric M \<equiv> \<forall>v w. \<not> (w \<in> R M v \<and> v \<in> R M w)\<close>
 
 abbreviation transitive :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>transitive M \<equiv> \<forall>v w x. w \<in> R M v \<and> x \<in> R M w \<longrightarrow> x \<in> R M v\<close>
 
 abbreviation universal :: \<open>('w, 'b) model \<Rightarrow> bool\<close> where
   \<open>universal M \<equiv> \<forall>v w. v \<in> R M w\<close>
 
 lemma \<open>irreflexive M \<Longrightarrow> M, g, w \<Turnstile> \<^bold>@ i \<^bold>\<not> (\<^bold>\<diamond> Nom i)\<close>
 proof -
   assume \<open>irreflexive M\<close>
   then have \<open>g i \<notin> R M (g i)\<close>
     by simp
   then have \<open>\<not> (\<exists>v \<in> R M (g i). g i = v)\<close>
     by simp
   then have \<open>\<not> M, g, g i \<Turnstile> \<^bold>\<diamond> Nom i\<close>
     by simp
   then have \<open>M, g, g i \<Turnstile> \<^bold>\<not> (\<^bold>\<diamond> Nom i)\<close>
     by simp
   then show \<open>M, g, w \<Turnstile> \<^bold>@ i \<^bold>\<not> (\<^bold>\<diamond> Nom i)\<close>
     by simp
 qed
 
 text \<open>We can automatically show some characterizations of frames by pure axioms.\<close>
 
 lemma \<open>irreflexive M = (\<forall>g w. M, g, w \<Turnstile> \<^bold>@ i \<^bold>\<not> (\<^bold>\<diamond> Nom i))\<close>
   by auto
 
 lemma \<open>asymmetric M = (\<forall>g w. M, g, w \<Turnstile> \<^bold>@ i (\<^bold>\<box> \<^bold>\<not> (\<^bold>\<diamond> Nom i)))\<close>
   by auto
 
 lemma \<open>universal M = (\<forall>g w. M, g, w \<Turnstile> \<^bold>\<diamond> Nom i)\<close>
   by auto
 
 section \<open>Tableau\<close>
 
 text \<open>
   A block is defined as a list of formulas and an opening nominal.
   The opening nominal is not necessarily in the list.
   A branch is a list of blocks.
   All blocks have an opening nominal; there is no possibility of an unnamed initial block.
 \<close>
 
 type_synonym ('a, 'b) block = \<open>('a, 'b) fm list \<times> 'b\<close>
 type_synonym ('a, 'b) branch = \<open>('a, 'b) block list\<close>
 
 abbreviation member_list :: \<open>'a \<Rightarrow> 'a list \<Rightarrow> bool\<close> (\<open>_ \<in>. _\<close> [51, 51] 50) where
   \<open>x \<in>. xs \<equiv> x \<in> set xs\<close>
 
 text \<open>The predicate \<open>on\<close> accounts for the opening nominal when checking if a formula is on a block.\<close>
 
 primrec on :: \<open>('a, 'b) fm \<Rightarrow> ('a, 'b) block \<Rightarrow> bool\<close> (\<open>_ on _\<close> [51, 51] 50) where
   \<open>p on (ps, i) = (p \<in>. ps \<or> p = Nom i)\<close>
 
 syntax
   "_Ballon" :: \<open>pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3\<forall>(_/on_)./ _)\<close> [0, 0, 10] 10)
   "_Bexon" :: \<open>pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3\<exists>(_/on_)./ _)\<close> [0, 0, 10] 10)
 
 translations
   "\<forall>p on A. P" \<rightharpoonup> "\<forall>p. p on A \<longrightarrow> P"
   "\<exists>p on A. P" \<rightharpoonup> "\<exists>p. p on A \<and> P"
 
 abbreviation list_nominals :: \<open>('a, 'b) fm list \<Rightarrow> 'b set\<close> where
   \<open>list_nominals ps \<equiv> (\<Union>p \<in> set ps. nominals p)\<close>
 
 primrec block_nominals :: \<open>('a, 'b) block \<Rightarrow> 'b set\<close> where
   \<open>block_nominals (ps, i) = {i} \<union> list_nominals ps\<close>
 
 definition branch_nominals :: \<open>('a, 'b) branch \<Rightarrow> 'b set\<close> where
   \<open>branch_nominals branch \<equiv> (\<Union>block \<in> set branch. block_nominals block)\<close>
 
 abbreviation at_in :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> bool\<close>
   (\<open>_ at _ in _\<close> [51, 51, 51] 50) where
   \<open>p at a in branch \<equiv> \<exists>ps. (ps, a) \<in>. branch \<and> p on (ps, a)\<close>
 
 definition new :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> bool\<close> where
   \<open>new p a branch \<equiv> \<not> p at a in branch\<close>
 
 definition witnessed :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> bool\<close> where
   \<open>witnessed p a branch \<equiv> \<exists>i. (\<^bold>@ i p) at a in branch \<and> (\<^bold>\<diamond> Nom i) at a in branch\<close>
 
 text \<open>
   A branch has a closing tableau iff it is contained in the following inductively defined set.
   In that case I call the branch closeable.
   The number in front of the turnstile is the number of available coins to spend on GoTo.
 \<close>
 
 inductive ST :: \<open>nat \<Rightarrow> ('a, 'b) branch \<Rightarrow> bool\<close> (\<open>_ \<turnstile> _\<close> [50, 50] 50) where
   Close:
   \<open>p at i in branch \<Longrightarrow> (\<^bold>\<not> p) at i in branch \<Longrightarrow>
    n \<turnstile> branch\<close>
 | Neg:
   \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (ps, a) # branch \<Longrightarrow>
    new p a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> (p # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | DisP:
   \<open>(p \<^bold>\<or> q) at a in (ps, a) # branch \<Longrightarrow>
    new p a ((ps, a) # branch) \<Longrightarrow> new q a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> (p # ps, a) # branch \<Longrightarrow> Suc n \<turnstile> (q # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | DisN:
   \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (ps, a) # branch \<Longrightarrow>
    new (\<^bold>\<not> p) a ((ps, a) # branch) \<or> new (\<^bold>\<not> q) a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | DiaP:
   \<open>(\<^bold>\<diamond> p) at a in (ps, a) # branch \<Longrightarrow>
    i \<notin> branch_nominals ((ps, a) # branch) \<Longrightarrow>
    \<nexists>a. p = Nom a \<Longrightarrow> \<not> witnessed p a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | DiaN:
   \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (ps, a) # branch \<Longrightarrow>
    (\<^bold>\<diamond> Nom i) at a in (ps, a) # branch \<Longrightarrow>
    new (\<^bold>\<not> (\<^bold>@ i p)) a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | SatP:
   \<open>(\<^bold>@ a p) at b in (ps, a) # branch \<Longrightarrow>
    new p a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> (p # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | SatN:
   \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in (ps, a) # branch \<Longrightarrow>
    new (\<^bold>\<not> p) a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> ((\<^bold>\<not> p) # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 | GoTo:
   \<open>i \<in> branch_nominals branch \<Longrightarrow>
    n \<turnstile> ([], i) # branch \<Longrightarrow>
    Suc n \<turnstile> branch\<close>
 | Nom:
   \<open>p at b in (ps, a) # branch \<Longrightarrow> Nom i at b in (ps, a) # branch \<Longrightarrow>
    Nom i at a in (ps, a) # branch \<Longrightarrow>
    new p a ((ps, a) # branch) \<Longrightarrow>
    Suc n \<turnstile> (p # ps, a) # branch \<Longrightarrow>
    n \<turnstile> (ps, a) # branch\<close>
 
 abbreviation ST_ex :: \<open>('a, 'b) branch \<Rightarrow> bool\<close> (\<open>\<turnstile> _\<close> [50] 50) where
   \<open>\<turnstile> branch \<equiv> \<exists>n. n \<turnstile> branch\<close>
 
 lemma ST_Suc: \<open>n \<turnstile> branch \<Longrightarrow> Suc n \<turnstile> branch\<close>
   by (induct n branch rule: ST.induct) (simp_all add: ST.intros)
 
 text \<open>A verified derivation in the calculus.\<close>
 
 lemma
   fixes i
   defines \<open>p \<equiv> \<^bold>\<not> (\<^bold>@ i (Nom i))\<close>
   shows \<open>Suc n \<turnstile> [([p], a)]\<close>
 proof -
   have \<open>i \<in> branch_nominals [([p], a)]\<close>
     unfolding p_def branch_nominals_def by simp
   then have ?thesis if \<open>n \<turnstile> [([], i), ([p], a)]\<close>
     using that GoTo by fast
   moreover have \<open>new (\<^bold>\<not> Nom i) i [([], i), ([p], a)]\<close>
     unfolding p_def new_def by auto
   moreover have \<open>(\<^bold>\<not> (\<^bold>@ i (Nom i))) at a in [([], i), ([p], a)]\<close>
     unfolding p_def by fastforce
   ultimately have ?thesis if \<open>Suc n \<turnstile> [([\<^bold>\<not> Nom i], i), ([p], a)]\<close>
     using that SatN by fast
   then show ?thesis
     by (meson Close list.set_intros(1) on.simps)
 qed
 
 section \<open>Soundness\<close>
 
 text \<open>
   An \<open>i\<close>-block is satisfied by a model \<open>M\<close> and assignment \<open>g\<close> if all formulas on the block
     are true under \<open>M\<close> at the world \<open>g i\<close>
   A branch is satisfied by a model and assignment if all blocks on it are.
 \<close>
 
 primrec block_sat :: \<open>('w, 'a) model \<Rightarrow> ('b \<Rightarrow> 'w) \<Rightarrow> ('a, 'b) block \<Rightarrow> bool\<close>
   (\<open>_, _ \<Turnstile>\<^sub>B _\<close> [50, 50] 50) where
   \<open>(M, g \<Turnstile>\<^sub>B (ps, i)) = (\<forall>p on (ps, i). M, g, g i \<Turnstile> p)\<close>
 
 abbreviation branch_sat ::
   \<open>('w, 'a) model \<Rightarrow> ('b \<Rightarrow> 'w) \<Rightarrow> ('a, 'b) branch \<Rightarrow> bool\<close>
   (\<open>_, _ \<Turnstile>\<^sub>\<Theta> _\<close> [50, 50] 50) where
   \<open>M, g \<Turnstile>\<^sub>\<Theta> branch \<equiv> \<forall>(ps, i) \<in> set branch. M, g \<Turnstile>\<^sub>B (ps, i)\<close>
 
 lemma block_nominals:
   \<open>p on block \<Longrightarrow> i \<in> nominals p \<Longrightarrow> i \<in> block_nominals block\<close>
   by (induct block) auto
 
 lemma block_sat_fresh:
   assumes \<open>M, g \<Turnstile>\<^sub>B block\<close> \<open>i \<notin> block_nominals block\<close>
   shows \<open>M, g(i := v) \<Turnstile>\<^sub>B block\<close>
   using assms
 proof (induct block)
   case (Pair ps a)
   then have \<open>\<forall>p on (ps, a). i \<notin> nominals p\<close>
     using block_nominals by fast
   moreover have \<open>i \<noteq> a\<close>
     using calculation by simp
   ultimately have \<open>\<forall>p on (ps, a). M, g(i := v), (g(i := v)) a \<Turnstile> p\<close>
     using Pair semantics_fresh by fastforce
   then show ?case
     by (meson block_sat.simps)
 qed
 
 lemma branch_sat_fresh:
   assumes \<open>M, g \<Turnstile>\<^sub>\<Theta> branch\<close> \<open>i \<notin> branch_nominals branch\<close>
   shows \<open>M, g(i := v) \<Turnstile>\<^sub>\<Theta> branch\<close>
   using assms using block_sat_fresh unfolding branch_nominals_def by fast
 
 text \<open>If a branch has a derivation then it cannot be satisfied.\<close>
 
 lemma soundness': \<open>n \<turnstile> branch \<Longrightarrow> M, g \<Turnstile>\<^sub>\<Theta> branch \<Longrightarrow> False\<close>
 proof (induct branch arbitrary: g rule: ST.induct)
   case (Close p i branch)
   then have \<open>M, g, g i \<Turnstile> p\<close> \<open>M, g, g i \<Turnstile> \<^bold>\<not> p\<close>
     by fastforce+
   then show ?case
     by simp
 next
   case (Neg p a ps branch)
   have \<open>M, g, g a \<Turnstile> p\<close>
     using Neg(1, 5) by fastforce
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> (p # ps, a) # branch\<close>
     using Neg(5) by simp
   then show ?case
     using Neg(4) by blast
 next
   case (DisP p q a ps branch)
   consider \<open>M, g, g a \<Turnstile> p\<close> | \<open>M, g, g a \<Turnstile> q\<close>
     using DisP(1, 8) by fastforce
   then consider
     \<open>M, g \<Turnstile>\<^sub>\<Theta> (p # ps, a) # branch\<close> |
     \<open>M, g \<Turnstile>\<^sub>\<Theta> (q # ps, a) # branch\<close>
     using DisP(8) by auto
   then show ?case
     using DisP(5, 7) by metis
 next
   case (DisN p q a ps branch)
   have \<open>M, g, g a \<Turnstile> \<^bold>\<not> p\<close> \<open>M, g, g a \<Turnstile> \<^bold>\<not> q\<close>
     using DisN(1, 5) by fastforce+
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch\<close>
     using DisN(5) by simp
   then show ?case
     using DisN(4) by blast
 next
   case (DiaP p a ps branch i)
   then have *: \<open>M, g \<Turnstile>\<^sub>B (ps, a)\<close>
     by simp
 
   have \<open>i \<notin> nominals p\<close>
     using DiaP(1-2) unfolding branch_nominals_def by fastforce
 
   have \<open>M, g, g a \<Turnstile> \<^bold>\<diamond> p\<close>
     using DiaP(1, 7) by fastforce
   then obtain v where \<open>v \<in> R M (g a)\<close> \<open>M, g, v \<Turnstile> p\<close>
     by auto
   then have \<open>M, g(i := v), v \<Turnstile> p\<close>
     using \<open>i \<notin> nominals p\<close> semantics_fresh by metis
   then have \<open>M, g(i := v), g a \<Turnstile> \<^bold>@ i p\<close>
     by simp
   moreover have \<open>M, g(i := v), g a \<Turnstile> \<^bold>\<diamond> Nom i\<close>
     using \<open>v \<in> R M (g a)\<close> by simp
   moreover have \<open>M, g(i := v) \<Turnstile>\<^sub>\<Theta> (ps, a) # branch\<close>
     using DiaP(2, 7) branch_sat_fresh by fast
   moreover have \<open>i \<notin> block_nominals (ps, a)\<close>
     using DiaP(2) unfolding branch_nominals_def by simp
   then have \<open>\<forall>p on (ps, a). M, g(i := v), g a \<Turnstile> p\<close>
     using * semantics_fresh by fastforce
   ultimately have
     \<open>M, g(i := v) \<Turnstile>\<^sub>\<Theta> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch\<close>
     by auto
   then show ?case
     using DiaP by blast
 next
   case (DiaN p a ps branch i)
   have \<open>M, g, g a \<Turnstile> \<^bold>\<not> (\<^bold>\<diamond> p)\<close> \<open>M, g, g a \<Turnstile> \<^bold>\<diamond> Nom i\<close>
     using DiaN(1-2, 6) by fastforce+
   then have \<open>M, g, g a \<Turnstile> \<^bold>\<not> (\<^bold>@ i p)\<close>
     by simp
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch\<close>
     using DiaN(6) by simp
   then show ?thesis
     using DiaN(5) by blast
 next
   case (SatP a p b ps branch)
   have \<open>M, g, g a \<Turnstile> p\<close>
     using SatP(1, 5) by fastforce
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> (p # ps, a) # branch\<close>
     using SatP(5) by simp
   then show ?case
     using SatP(4) by blast
 next
   case (SatN a p b ps branch)
   have \<open>M, g, g a \<Turnstile> \<^bold>\<not> p\<close>
     using SatN(1, 5) by fastforce
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> ((\<^bold>\<not> p) # ps, a) # branch\<close>
     using SatN(5) by simp
   then show ?case
     using SatN(4) by blast
 next
   case (GoTo i branch)
   then show ?case
     by auto
 next
   case (Nom p b ps a branch i g)
   have \<open>M, g, g b \<Turnstile> p\<close> \<open>M, g, g b \<Turnstile> Nom i\<close>
     using Nom(1-2, 7) by fastforce+
   then have \<open>M, g, g i \<Turnstile> p\<close>
     by simp
   moreover have \<open>M, g, g a \<Turnstile> Nom i\<close>
     using Nom(3, 7) by fastforce
   moreover have \<open>M, g \<Turnstile>\<^sub>B (ps, a)\<close>
     using Nom(7) by simp
   ultimately have \<open>M, g \<Turnstile>\<^sub>B (p # ps, a)\<close>
     by simp
   then have \<open>M, g \<Turnstile>\<^sub>\<Theta> (p # ps, a) # branch\<close>
     using Nom(7) by simp
   then show ?case
     using Nom(6) by blast
 qed
 
 lemma block_sat: \<open>\<forall>p on block. M, g, w \<Turnstile> p \<Longrightarrow> M, g \<Turnstile>\<^sub>B block\<close>
   by (induct block) auto
 
 lemma branch_sat:
   assumes \<open>\<forall>(ps, i) \<in> set branch. \<forall>p on (ps, i). M, g, w \<Turnstile> p\<close>
   shows \<open>M, g \<Turnstile>\<^sub>\<Theta> branch\<close>
   using assms block_sat by fast
 
 lemma soundness:
   assumes \<open>n \<turnstile> branch\<close>
   shows \<open>\<exists>block \<in> set branch. \<exists>p on block. \<not> M, g, w \<Turnstile> p\<close>
   using assms soundness' branch_sat by fast
 
 corollary \<open>\<not> n \<turnstile> []\<close>
   using soundness by fastforce
 
 theorem soundness_fresh:
   assumes \<open>n \<turnstile> [([\<^bold>\<not> p], i)]\<close> \<open>i \<notin> nominals p\<close>
   shows \<open>M, g, w \<Turnstile> p\<close>
 proof -
   from assms(1) have \<open>M, g, g i \<Turnstile> p\<close> for g
     using soundness by fastforce
   then have \<open>M, g(i := w), (g(i := w)) i \<Turnstile> p\<close>
     by blast
   then have \<open>M, g(i := w), w \<Turnstile> p\<close>
     by simp
   then have \<open>M, g(i := g i), w \<Turnstile> p\<close>
     using assms(2) semantics_fresh by metis
   then show ?thesis
     by simp
 qed
 
 section \<open>No Detours\<close>
 
 text \<open>
   We only need to spend initial coins when we apply GoTo twice in a row.
   Otherwise another rule will have been applied in-between that justifies the GoTo.
   Therefore by avoiding detours we can close any closeable branch starting from 1 coin.
 \<close>
 
 primrec nonempty :: \<open>('a, 'b) block \<Rightarrow> bool\<close> where
   \<open>nonempty (ps, i) = (ps \<noteq> [])\<close>
 
 lemma nonempty_Suc:
   assumes
     \<open>n \<turnstile> (ps, a) # filter nonempty left @ right\<close>
     \<open>q at a in (ps, a) # filter nonempty left @ right\<close> \<open>q \<noteq> Nom a\<close>
   shows \<open>Suc n \<turnstile> filter nonempty ((ps, a) # left) @ right\<close>
 proof (cases ps)
   case Nil
   then have \<open>a \<in> branch_nominals (filter nonempty left @ right)\<close>
     unfolding branch_nominals_def using assms(2-3) by fastforce
   then show ?thesis
     using assms(1) Nil GoTo by auto
 next
   case Cons
   then show ?thesis
     using assms(1) ST_Suc by auto
 qed
 
 lemma ST_nonempty:
   \<open>n \<turnstile> left @ right \<Longrightarrow> Suc m \<turnstile> filter nonempty left @ right\<close>
 proof (induct n \<open>left @ right\<close> arbitrary: left right rule: ST.induct)
   case (Close p i n)
   have \<open>(\<^bold>\<not> p) at i in filter nonempty left @ right\<close>
     using Close(2) by fastforce
   moreover from this have \<open>p at i in filter nonempty left @ right\<close>
     using Close(1) by fastforce
   ultimately show ?case
     using ST.Close by fast
 next
   case (Neg p a ps branch n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> (p # ps, a) # branch\<close>
       using Neg(4) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using Neg(1-2) ST.Neg by fast
     then show ?thesis
       using Nil Neg(5) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> (p # ps, a) # filter nonempty left' @ right\<close>
       using Neg(4)[where left=\<open>_ # left'\<close>] Neg(5) by fastforce
     moreover have *: \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons Neg(1, 5) by fastforce
     moreover have \<open>new p a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons Neg(2, 5) unfolding new_def by auto
     ultimately have \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.Neg by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
       using * nonempty_Suc by fast
     then show ?thesis
       using Cons Neg(5) by auto
   qed
 next
   case (DisP p q a ps branch n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> (p # ps, a) # branch\<close> \<open>Suc m \<turnstile> (q # ps, a) # branch\<close>
       using DisP(5, 7) by fastforce+
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using DisP(1-3) ST.DisP by fast
     then show ?thesis
       using Nil DisP(8) ST_Suc by auto
   next
     case (Cons _ left')
     then have
       \<open>Suc m \<turnstile> (p # ps, a) # filter nonempty left' @ right\<close>
       \<open>Suc m \<turnstile> (q # ps, a) # filter nonempty left' @ right\<close>
       using DisP(5, 7)[where left=\<open>_ # left'\<close>] DisP(8) by fastforce+
     moreover have *: \<open>(p \<^bold>\<or> q) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons DisP(1, 8) by fastforce
     moreover have
       \<open>new p a ((ps, a) # filter nonempty left' @ right)\<close>
       \<open>new q a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons DisP(2-3, 8) unfolding new_def by auto
     ultimately have \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.DisP by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
       using * nonempty_Suc by fast
     then show ?thesis
       using Cons DisP(8) by auto
   qed
 next
   case (DisN p q a ps branch n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch\<close>
       using DisN(4) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using DisN(1-2) ST.DisN by fast
     then show ?thesis
       using Nil DisN(5) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # filter nonempty left' @ right\<close>
       using DisN(4)[where left=\<open>_ # left'\<close>] DisN(5) by fastforce
     moreover have *: \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons DisN(1, 5) by fastforce
     moreover consider
       \<open>new (\<^bold>\<not> p) a ((ps, a) # filter nonempty left' @ right)\<close> |
       \<open>new (\<^bold>\<not> q) a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons DisN(2, 5) unfolding new_def by auto
     ultimately have \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.DisN by metis
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
       using * nonempty_Suc by fast
     then show ?thesis
       using Cons DisN(5) by auto
   qed
 next
   case (DiaP p a ps branch i n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch\<close>
       using DiaP(6) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using DiaP(1-4) ST.DiaP by fast
     then show ?thesis
       using Nil DiaP(7) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # filter nonempty left' @ right\<close>
       using DiaP(6)[where left=\<open>_ # left'\<close>] DiaP(7) by fastforce
     moreover have *: \<open>(\<^bold>\<diamond> p) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons DiaP(1, 7) by fastforce
     moreover have \<open>i \<notin> branch_nominals ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons DiaP(2, 7) unfolding branch_nominals_def by auto
     moreover have \<open>\<not> witnessed p a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons DiaP(4, 7) unfolding witnessed_def by auto
     ultimately have \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using DiaP(3) ST.DiaP by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
       using * nonempty_Suc by fast
     then show ?thesis
       using Cons DiaP(7) by auto
   qed
 next
   case (DiaN p a ps branch i n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch\<close>
       using DiaN(5) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using DiaN(1-3) ST.DiaN by fast
     then show ?thesis
       using Nil DiaN(6) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # filter nonempty left' @ right\<close>
       using DiaN(5)[where left=\<open>_ # left'\<close>] DiaN(6) by fastforce
     moreover have *: \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons DiaN(1, 6) by fastforce
     moreover have *: \<open>(\<^bold>\<diamond> Nom i) at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons DiaN(2, 6) by fastforce
     moreover have \<open>new (\<^bold>\<not> (\<^bold>@ i p)) a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons DiaN(3, 6) unfolding new_def by auto
     ultimately have \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.DiaN by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
       using * nonempty_Suc by fast
     then show ?thesis
       using Cons DiaN(6) by auto
   qed
 next
   case (SatP a p b ps branch n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> (p # ps, a) # branch\<close>
       using SatP(4) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using SatP(1-2) ST.SatP by fast
     then show ?thesis
       using Nil SatP(5) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> (p # ps, a) # filter nonempty left' @ right\<close>
       using SatP(4)[where left=\<open>_ # left'\<close>] SatP(5) by fastforce
     moreover have \<open>(\<^bold>@ a p) at b in (ps, a) # filter nonempty left' @ right\<close>
       using Cons SatP(1, 5) by fastforce
     moreover have \<open>new p a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons SatP(2, 5) unfolding new_def by auto
     ultimately have *: \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.SatP by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
     proof (cases ps)
       case Nil
       then have \<open>a \<in> branch_nominals (filter nonempty left' @ right)\<close>
         unfolding branch_nominals_def using SatP(1, 5) Cons by fastforce
       then show ?thesis
         using * Nil GoTo by fastforce
     next
       case Cons
       then show ?thesis
         using * ST_Suc by auto
     qed
     then show ?thesis
       using Cons SatP(5) by auto
   qed
 next
   case (SatN a p b ps branch n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> p) # ps, a) # branch\<close>
       using SatN(4) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using SatN(1-2) ST.SatN by fast
     then show ?thesis
       using Nil SatN(5) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> ((\<^bold>\<not> p) # ps, a) # filter nonempty left' @ right\<close>
       using SatN(4)[where left=\<open>_ # left'\<close>] SatN(5) by fastforce
     moreover have \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in (ps, a) # filter nonempty left' @ right\<close>
       using Cons SatN(1, 5) by fastforce
     moreover have \<open>new (\<^bold>\<not> p) a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons SatN(2, 5) unfolding new_def by auto
     ultimately have *: \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.SatN by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
     proof (cases ps)
       case Nil
       then have \<open>a \<in> branch_nominals (filter nonempty left' @ right)\<close>
         unfolding branch_nominals_def using SatN(1, 5) Cons by fastforce
       then show ?thesis
         using * Nil GoTo by fastforce
     next
       case Cons
       then show ?thesis
         using * ST_Suc by auto
     qed
     then show ?thesis
       using Cons SatN(5) by auto
   qed
 next
   case (GoTo i n)
   show ?case
     using GoTo(3)[where left=\<open>([], i) # left\<close>] by simp
 next
   case (Nom p b ps a branch i n)
   then show ?case
   proof (cases left)
     case Nil
     then have \<open>Suc m \<turnstile> (p # ps, a) # branch\<close>
       using Nom(6) by fastforce
     then have \<open>m \<turnstile> (ps, a) # branch\<close>
       using Nom(1-4) ST.Nom by fast
     then show ?thesis
       using Nil Nom(7) ST_Suc by auto
   next
     case (Cons _ left')
     then have \<open>Suc m \<turnstile> (p # ps, a) # filter nonempty left' @ right\<close>
       using Nom(6)[where left=\<open>_ # left'\<close>] Nom(7) by fastforce
     moreover have
       \<open>p at b in (ps, a) # filter nonempty left' @ right\<close>
       \<open>Nom i at b in (ps, a) # filter nonempty left' @ right\<close>
       \<open>Nom i at a in (ps, a) # filter nonempty left' @ right\<close>
       using Cons Nom(1-4, 7) unfolding new_def by simp_all (metis empty_iff empty_set)+
     moreover have \<open>new p a ((ps, a) # filter nonempty left' @ right)\<close>
       using Cons Nom(4, 7) unfolding new_def by auto
     ultimately have *: \<open>m \<turnstile> (ps, a) # filter nonempty left' @ right\<close>
       using ST.Nom by fast
     then have \<open>Suc m \<turnstile> filter nonempty ((ps, a) # left') @ right\<close>
     proof (cases ps)
       case Nil
       moreover have \<open>a \<noteq> b\<close>
         using Nom(1, 4) unfolding new_def by blast
       ultimately have \<open>a \<in> branch_nominals (filter nonempty left' @ right)\<close>
       proof (cases \<open>i = a\<close>)
         case True
         then have \<open>Nom a at b in left' @ right\<close>
           using \<open>a \<noteq> b\<close> Nom(2, 7) Cons by auto
         then show ?thesis
           unfolding branch_nominals_def using \<open>a \<noteq> b\<close> by fastforce
       next
         case False
         then have \<open>Nom i at a in left' @ right\<close>
           using Nom(3, 7) Nil Cons by auto
         then show ?thesis
           unfolding branch_nominals_def using False by fastforce
       qed
       then show ?thesis
         using * Nil GoTo by auto
     next
       case Cons
       then show ?thesis
         using * ST_Suc by auto
     qed
     then show ?thesis
       using Cons Nom(7) by auto
   qed
 qed
 
 theorem ST_coins: \<open>n \<turnstile> branch \<Longrightarrow> Suc m \<turnstile> branch\<close>
   using ST_nonempty[where left=\<open>[]\<close>] by auto
 
 corollary ST_one: \<open>n \<turnstile> branch \<Longrightarrow> 1 \<turnstile> branch\<close>
   using ST_coins by auto
 
 subsection \<open>Free GoTo\<close>
 
 text \<open>The above result allows us to derive a version of GoTo that works "for free."\<close>
 
 lemma GoTo':
   assumes \<open>Suc n \<turnstile> ([], i) # branch\<close> \<open>i \<in> branch_nominals branch\<close>
   shows \<open>Suc n \<turnstile> branch\<close>
   using assms GoTo ST_coins by fast
 
 section \<open>Indexed Mapping\<close>
 
 text \<open>This section contains some machinery for deriving rules.\<close>
 
 subsection \<open>Indexing\<close>
 
 text \<open>
   We use pairs of natural numbers to index into the branch.
   The first component specifies the block and the second specifies the formula in that block.
   We index from the back to ensure that indices are stable
     under the addition of new formulas and blocks.
 \<close>
 
 primrec rev_nth :: \<open>'a list \<Rightarrow> nat \<Rightarrow> 'a option\<close> (infixl \<open>!.\<close> 100) where
   \<open>[] !. v = None\<close>
 | \<open>(x # xs) !. v = (if length xs = v then Some x else xs !. v)\<close>
 
 lemma rev_nth_last: \<open>xs !. 0 = Some x \<Longrightarrow> last xs = x\<close>
   by (induct xs) auto
 
 lemma rev_nth_zero: \<open>(xs @ [x]) !. 0 = Some x\<close>
   by (induct xs) auto
 
 lemma rev_nth_snoc: \<open>(xs @ [x]) !. Suc v = Some y \<Longrightarrow> xs !. v = Some y\<close>
   by (induct xs) auto
 
 lemma rev_nth_Suc: \<open>(xs @ [x]) !. Suc v = xs !. v\<close>
   by (induct xs) auto
 
 lemma rev_nth_bounded: \<open>v < length xs \<Longrightarrow> \<exists>x. xs !. v = Some x\<close>
   by (induct xs) simp_all
 
 lemma rev_nth_Cons: \<open>xs !. v = Some y \<Longrightarrow> (x # xs) !. v = Some y\<close>
 proof (induct xs arbitrary: v rule: rev_induct)
   case (snoc a xs)
   then show ?case
   proof (induct v)
     case (Suc v)
     then have \<open>xs !. v = Some y\<close>
       using rev_nth_snoc by fast
     then have \<open>(x # xs) !. v = Some y\<close>
       using Suc(2) by blast
     then show ?case
       using Suc(3) by auto
   qed simp
 qed simp
 
 lemma rev_nth_append: \<open>xs !. v = Some y \<Longrightarrow> (ys @ xs) !. v = Some y\<close>
   using rev_nth_Cons[where xs=\<open>_ @ xs\<close>] by (induct ys) simp_all
 
 lemma rev_nth_mem: \<open>block \<in>. branch \<longleftrightarrow> (\<exists>v. branch !. v = Some block)\<close>
 proof
   assume \<open>block \<in>. branch\<close>
   then show \<open>\<exists>v. branch !. v = Some block\<close>
   proof (induct branch)
     case (Cons block' branch)
     then show ?case
     proof (cases \<open>block = block'\<close>)
       case False
       then have \<open>\<exists>v. branch !. v = Some block\<close>
         using Cons by simp
       then show ?thesis
         using rev_nth_Cons by fast
     qed auto
   qed simp
 next
   assume \<open>\<exists>v. branch !. v = Some block\<close>
   then show \<open>block \<in>. branch\<close>
   proof (induct branch)
     case (Cons block' branch)
     then show ?case
       by simp (metis option.sel)
   qed simp
 qed
 
 lemma rev_nth_on: \<open>p on (ps, i) \<longleftrightarrow> (\<exists>v. ps !. v = Some p) \<or> p = Nom i\<close>
   by (simp add: rev_nth_mem)
 
 lemma rev_nth_Some: \<open>xs !. v = Some y \<Longrightarrow> v < length xs\<close>
 proof (induct xs arbitrary: v rule: rev_induct)
   case (snoc x xs)
   then show ?case
     by (induct v) (simp_all, metis rev_nth_snoc)
 qed simp
 
 lemma index_Cons:
   assumes \<open>((ps, a) # branch) !. v = Some (qs, b)\<close> \<open>qs !. v' = Some q\<close>
   shows \<open>\<exists>qs'. ((p # ps, a) # branch) !. v = Some (qs', b) \<and> qs' !. v' = Some q\<close>
 proof -
   have
     \<open>((p # ps, a) # branch) !. v = Some (qs, b) \<or>
      ((p # ps, a) # branch) !. v = Some (p # qs, b)\<close>
     using assms(1) by auto
   moreover have \<open>qs !. v' = Some q\<close> \<open>(p # qs) !. v' = Some q\<close>
     using assms(2) rev_nth_Cons by fast+
   ultimately show ?thesis
     by fastforce
 qed
 
 subsection \<open>Mapping\<close>
 
 primrec mapi :: \<open>(nat \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list\<close> where
   \<open>mapi f [] = []\<close>
 | \<open>mapi f (x # xs) = f (length xs) x # mapi f xs\<close>
 
 primrec mapi_block ::
   \<open>(nat \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'b) fm) \<Rightarrow> (('a, 'b) block \<Rightarrow> ('a, 'b) block)\<close> where
   \<open>mapi_block f (ps, i) = (mapi f ps, i)\<close>
 
 definition mapi_branch ::
   \<open>(nat \<Rightarrow> nat \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'b) fm) \<Rightarrow> (('a, 'b) branch \<Rightarrow> ('a, 'b) branch)\<close> where
   \<open>mapi_branch f branch \<equiv> mapi (\<lambda>v. mapi_block (f v)) branch\<close>
 
 abbreviation mapper ::
   \<open>(('a, 'b) fm \<Rightarrow> ('a, 'b) fm) \<Rightarrow>
    (nat \<times> nat) set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'b) fm\<close> where
   \<open>mapper f xs v v' p \<equiv> (if (v, v') \<in> xs then f p else p)\<close>
 
 lemma mapi_block_add_oob:
   assumes \<open>length ps \<le> v'\<close>
   shows
     \<open>mapi_block (mapper f ({(v, v')} \<union> xs) v) (ps, i) =
      mapi_block (mapper f xs v) (ps, i)\<close>
   using assms by (induct ps) simp_all
 
 lemma mapi_branch_add_oob:
   assumes \<open>length branch \<le> v\<close>
   shows
     \<open>mapi_branch (mapper f ({(v, v')} \<union> xs)) branch =
      mapi_branch (mapper f xs) branch\<close>
   unfolding mapi_branch_def using assms by (induct branch) simp_all
 
 lemma mapi_branch_head_add_oob:
   \<open>mapi_branch (mapper f ({(length branch, length ps)} \<union> xs)) ((ps, a) # branch) =
    mapi_branch (mapper f xs) ((ps, a) # branch)\<close>
   using mapi_branch_add_oob[where branch=branch] unfolding mapi_branch_def
   using mapi_block_add_oob[where ps=ps] by simp
 
 lemma mapi_branch_mem:
   assumes \<open>(ps, i) \<in>. branch\<close>
   shows \<open>\<exists>v. (mapi (f v) ps, i) \<in>. mapi_branch f branch\<close>
   unfolding mapi_branch_def using assms by (induct branch) auto
 
 lemma rev_nth_mapi_branch:
   assumes \<open>branch !. v = Some (ps, a)\<close>
   shows \<open>(mapi (f v) ps, a) \<in>. mapi_branch f branch\<close>
   unfolding mapi_branch_def using assms
   by (induct branch) (simp_all, metis mapi_block.simps option.inject)
 
 lemma rev_nth_mapi_block:
   assumes \<open>ps !. v' = Some p\<close>
   shows \<open>f v' p on (mapi f ps, a)\<close>
   using assms by (induct ps) (simp_all, metis option.sel)
 
 lemma mapi_append:
   \<open>mapi f (xs @ ys) = mapi (\<lambda>v. f (v + length ys)) xs @ mapi f ys\<close>
   by (induct xs) simp_all
 
 lemma mapi_block_id: \<open>mapi_block (mapper f {} v) (ps, i) = (ps, i)\<close>
   by (induct ps) auto
 
 lemma mapi_branch_id: \<open>mapi_branch (mapper f {}) branch = branch\<close>
   unfolding mapi_branch_def using mapi_block_id by (induct branch) auto
 
 lemma length_mapi: \<open>length (mapi f xs) = length xs\<close>
   by (induct xs) auto
 
 lemma mapi_rev_nth:
   assumes \<open>xs !. v = Some x\<close>
   shows \<open>mapi f xs !. v = Some (f v x)\<close>
   using assms
 proof (induct xs arbitrary: v)
   case (Cons y xs)
   have *: \<open>mapi f (y # xs) = f (length xs) y # mapi f xs\<close>
     by simp
   show ?case
   proof (cases \<open>v = length xs\<close>)
     case True
     then have \<open>mapi f (y # xs) !. v = Some (f (length xs) y)\<close>
       using length_mapi * by (metis rev_nth.simps(2))
     then show ?thesis
       using Cons.prems True by auto
   next
     case False
     then show ?thesis
       using * Cons length_mapi by (metis rev_nth.simps(2))
   qed
 qed simp
 
 section \<open>Duplicate Formulas\<close>
 
 subsection \<open>Removable indices\<close>
 
 abbreviation \<open>proj \<equiv> Equiv_Relations.proj\<close>
 
 definition all_is :: \<open>('a, 'b) fm \<Rightarrow> ('a, 'b) fm list \<Rightarrow> nat set \<Rightarrow> bool\<close> where
   \<open>all_is p ps xs \<equiv> \<forall>v \<in> xs. ps !. v = Some p\<close>
 
 definition is_at :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>is_at p i branch v v' \<equiv> \<exists>ps. branch !. v = Some (ps, i) \<and> ps !. v' = Some p\<close>
 
 text \<open>This definition is slightly complicated by the inability to index the opening nominal.\<close>
 
 definition is_elsewhere :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> (nat \<times> nat) set \<Rightarrow> bool\<close> where
   \<open>is_elsewhere p i branch xs \<equiv> \<exists>w w' ps. (w, w') \<notin> xs \<and>
     branch !. w = Some (ps, i) \<and> (p = Nom i \<or> ps !. w' = Some p)\<close>
 
 definition Dup :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> (nat \<times> nat) set \<Rightarrow> bool\<close> where
   \<open>Dup p i branch xs \<equiv> \<forall>(v, v') \<in> xs.
     is_at p i branch v v' \<and> is_elsewhere p i branch xs\<close>
 
 lemma Dup_all_is:
   assumes \<open>Dup p i branch xs\<close> \<open>branch !. v = Some (ps, a)\<close>
   shows \<open>all_is p ps (proj xs v)\<close>
   using assms unfolding Dup_def is_at_def all_is_def proj_def by auto
 
 lemma Dup_branch:
   \<open>Dup p i branch xs \<Longrightarrow> Dup p i (extra @ branch) xs\<close>
   unfolding Dup_def is_at_def is_elsewhere_def using rev_nth_append by fast
 
 lemma Dup_block:
   assumes \<open>Dup p i ((ps, a) # branch) xs\<close>
   shows \<open>Dup p i ((ps' @ ps, a) # branch) xs\<close>
   unfolding Dup_def
 proof safe
   fix v v'
   assume \<open>(v, v') \<in> xs\<close>
   then show \<open>is_at p i ((ps' @ ps, a) # branch) v v'\<close>
     using assms rev_nth_append unfolding Dup_def is_at_def by fastforce
 next
   fix v v'
   assume \<open>(v, v') \<in> xs\<close>
   then obtain w w' qs where
     \<open>(w, w') \<notin> xs\<close> \<open>((ps, a) # branch) !. w = Some (qs, i)\<close>
     \<open>p = Nom i \<or> qs !. w' = Some p\<close>
     using assms unfolding Dup_def is_elsewhere_def by blast
   then have
     \<open>\<exists>qs. ((ps' @ ps, a) # branch) !. w = Some (qs, i) \<and>
      (p = Nom i \<or> qs !. w' = Some p)\<close>
     using rev_nth_append by fastforce
   then show \<open>is_elsewhere p i ((ps' @ ps, a) # branch) xs\<close>
     unfolding is_elsewhere_def using \<open>(w, w') \<notin> xs\<close> by blast
 qed
 
 lemma Dup_opening:
   assumes \<open>Dup p i branch xs\<close> \<open>(v, v') \<in> xs\<close> \<open>branch !. v = Some (ps, a)\<close>
   shows \<open>i = a\<close>
   using assms unfolding Dup_def is_at_def by auto
 
 lemma Dup_head:
   \<open>Dup p i ((ps, a) # branch) xs \<Longrightarrow> Dup p i ((q # ps, a) # branch) xs\<close>
   using Dup_block[where ps'=\<open>[_]\<close>] by simp
 
 lemma Dup_head_oob':
   assumes \<open>Dup p i ((ps, a) # branch) xs\<close>
   shows \<open>(length branch, k + length ps) \<notin> xs\<close>
   using assms rev_nth_Some unfolding Dup_def is_at_def by fastforce
 
 lemma Dup_head_oob:
   assumes \<open>Dup p i ((ps, a) # branch) xs\<close>
   shows \<open>(length branch, length ps) \<notin> xs\<close>
   using assms Dup_head_oob'[where k=0] by fastforce
 
 subsection \<open>Omitting formulas\<close>
 
 primrec omit :: \<open>nat set \<Rightarrow> ('a, 'b) fm list \<Rightarrow> ('a, 'b) fm list\<close> where
   \<open>omit xs [] = []\<close>
 | \<open>omit xs (p # ps) = (if length ps \<in> xs then omit xs ps else p # omit xs ps)\<close>
 
 primrec omit_block :: \<open>nat set \<Rightarrow> ('a, 'b) block \<Rightarrow> ('a, 'b) block\<close> where
   \<open>omit_block xs (ps, a) = (omit xs ps, a)\<close>
 
 definition omit_branch :: \<open>(nat \<times> nat) set \<Rightarrow> ('a, 'b) branch \<Rightarrow> ('a, 'b) branch\<close> where
   \<open>omit_branch xs branch \<equiv> mapi (\<lambda>v. omit_block (proj xs v)) branch\<close>
 
 lemma omit_mem: \<open>ps !. v = Some p \<Longrightarrow> v \<notin> xs \<Longrightarrow> p \<in>. omit xs ps\<close>
 proof (induct ps)
   case (Cons q ps)
   then show ?case
     by (cases \<open>v = length ps\<close>) simp_all
 qed simp
 
 lemma omit_id: \<open>omit {} ps = ps\<close>
   by (induct ps) auto
 
 lemma omit_block_id: \<open>omit_block {} block = block\<close>
   using omit_id by (cases block) simp
 
 lemma omit_branch_id: \<open>omit_branch {} branch = branch\<close>
   unfolding omit_branch_def proj_def using omit_block_id
   by (induct branch) fastforce+
 
 lemma omit_branch_mem_diff_opening:
   assumes \<open>Dup p i branch xs\<close> \<open>(ps, a) \<in>. branch\<close> \<open>i \<noteq> a\<close>
   shows \<open>(ps, a) \<in>. omit_branch xs branch\<close>
 proof -
   obtain v where v: \<open>branch !. v = Some (ps, a)\<close>
     using assms(2) rev_nth_mem by fast
   then have \<open>omit_branch xs branch !. v = Some (omit (proj xs v) ps, a)\<close>
     unfolding omit_branch_def by (simp add: mapi_rev_nth)
   then have *: \<open>(omit (proj xs v) ps, a) \<in>. omit_branch xs branch\<close>
     using rev_nth_mem by fast
   moreover have \<open>proj xs v = {}\<close>
     unfolding proj_def using assms(1, 3) v Dup_opening by fast
   then have \<open>omit (proj xs v) ps = ps\<close>
     using omit_id by auto
   ultimately show ?thesis
     by simp
 qed
 
 lemma omit_branch_mem_same_opening:
   assumes \<open>Dup p i branch xs\<close> \<open>p at i in branch\<close>
   shows \<open>p at i in omit_branch xs branch\<close>
 proof -
   obtain ps where ps: \<open>(ps, i) \<in>. branch\<close> \<open>p on (ps, i)\<close>
     using assms(2) by blast
   then obtain v where v: \<open>branch !. v = Some (ps, i)\<close>
     using rev_nth_mem by fast
   then have \<open>omit_branch xs branch !. v = Some (omit (proj xs v) ps, i)\<close>
     unfolding omit_branch_def by (simp add: mapi_rev_nth)
   then have *: \<open>(omit (proj xs v) ps, i) \<in>. omit_branch xs branch\<close>
     using rev_nth_mem by fast
 
   consider
     v' where \<open>ps !. v' = Some p\<close> \<open>(v, v') \<in> xs\<close> |
     v' where \<open>ps !. v' = Some p\<close> \<open>(v, v') \<notin> xs\<close> |
     \<open>p = Nom i\<close>
     using ps v rev_nth_mem by fastforce
   then show ?thesis
   proof cases
     case (1 v')
     then obtain qs w w' where qs:
       \<open>(w, w') \<notin> xs\<close> \<open>branch !. w = Some (qs, i)\<close> \<open>p = Nom i \<or> qs !. w' = Some p\<close>
       using assms(1) unfolding Dup_def is_elsewhere_def by blast
     then have \<open>omit_branch xs branch !. w = Some (omit (proj xs w) qs, i)\<close>
       unfolding omit_branch_def by (simp add: mapi_rev_nth)
     then have \<open>(omit (proj xs w) qs, i) \<in>. omit_branch xs branch\<close>
       using rev_nth_mem by fast
     moreover have \<open>p on (omit (proj xs w) qs, i)\<close>
       unfolding proj_def using qs(1, 3) omit_mem by fastforce
     ultimately show ?thesis
       by blast
   next
     case (2 v')
     then show ?thesis
       using * omit_mem unfolding proj_def
       by (metis Image_singleton_iff on.simps)
   next
     case 3
     then show ?thesis
       using * by auto
   qed
 qed
 
 lemma omit_del:
   assumes \<open>p \<in>. ps\<close> \<open>p \<notin> set (omit xs ps)\<close>
   shows \<open>\<exists>v. ps !. v = Some p \<and> v \<in> xs\<close>
   using assms omit_mem rev_nth_mem by metis
 
 lemma omit_all_is:
   assumes \<open>all_is p ps xs\<close> \<open>q \<in>. ps\<close> \<open>q \<notin> set (omit xs ps)\<close>
   shows \<open>q = p\<close>
   using assms omit_del unfolding all_is_def by fastforce
 
 lemma omit_branch_mem_diff_formula:
   assumes \<open>Dup p i branch xs\<close> \<open>q at i in branch\<close> \<open>p \<noteq> q\<close>
   shows \<open>q at i in omit_branch xs branch\<close>
 proof -
   obtain ps where ps: \<open>(ps, i) \<in>. branch\<close> \<open>q on (ps, i)\<close>
     using assms(2) by blast
   then obtain v where v: \<open>branch !. v = Some (ps, i)\<close>
     using rev_nth_mem by fast
   then have \<open>omit_branch xs branch !. v = Some (omit (proj xs v) ps, i)\<close>
     unfolding omit_branch_def by (simp add: mapi_rev_nth)
   then have *: \<open>(omit (proj xs v) ps, i) \<in>. omit_branch xs branch\<close>
     using rev_nth_mem by fast
   moreover have \<open>all_is p ps (proj xs v)\<close>
     using assms(1) Dup_all_is v by fast
   then have \<open>q on (omit (proj xs v) ps, i)\<close>
     using ps assms(3) omit_all_is by auto
   ultimately show ?thesis
     by blast
 qed
 
 lemma omit_branch_mem:
   assumes \<open>Dup p i branch xs\<close> \<open>q at a in branch\<close>
   shows \<open>q at a in omit_branch xs branch\<close>
   using assms omit_branch_mem_diff_opening omit_branch_mem_same_opening
     omit_branch_mem_diff_formula by fast
 
 lemma omit_set: \<open>set (omit xs ps) \<subseteq> set ps\<close>
   by (induct ps) auto
 
 lemma on_omit: \<open>p on (omit xs ps, i) \<Longrightarrow> p on (ps, i)\<close>
   using omit_set by auto
 
 lemma Dup_set:
   assumes \<open>all_is p ps xs\<close>
   shows \<open>{p} \<union> set (omit xs ps) = {p} \<union> set ps\<close>
   using assms omit_all_is omit_set unfolding all_is_def by fast
 
 lemma Dup_list_nominals:
   assumes \<open>all_is p ps xs\<close>
   shows \<open>nominals p \<union> list_nominals (omit xs ps) = nominals p \<union> list_nominals ps\<close>
   using assms Dup_set by fastforce
 
 lemma Dup_block_nominals:
   assumes \<open>all_is p ps xs\<close>
   shows
     \<open>nominals p \<union> block_nominals (omit xs ps, i) =
      nominals p \<union> block_nominals (ps, i)\<close>
   using assms by (simp add: Dup_list_nominals)
 
 lemma Dup_branch_nominals':
   assumes \<open>Dup p i branch xs\<close>
   shows
     \<open>nominals p \<union> branch_nominals (omit_branch xs branch) =
      nominals p \<union> branch_nominals branch\<close>
 proof -
   have \<open>\<forall>(v, v') \<in> xs. v < length branch \<longrightarrow> is_at p i branch v v'\<close>
     using assms unfolding Dup_def by auto
   then show ?thesis
   proof (induct branch)
     case Nil
     then show ?case
       unfolding omit_branch_def by simp
   next
     case (Cons block branch)
     then show ?case
     proof (cases block)
       case (Pair ps a)
       have \<open>\<forall>(v, v') \<in> xs. v < length branch \<longrightarrow> is_at p i branch v v'\<close>
         using Cons(2) rev_nth_Cons unfolding is_at_def by auto
       then have
         \<open>nominals p \<union> branch_nominals (omit_branch xs branch) =
          nominals p \<union> branch_nominals branch\<close>
         using Cons(1) by blast
       then have
         \<open>nominals p \<union> branch_nominals (omit_branch xs ((ps, a) # branch)) =
          nominals p \<union> block_nominals (omit (proj xs (length branch)) ps, a) \<union>
           branch_nominals branch\<close>
         unfolding branch_nominals_def omit_branch_def by auto
       moreover have \<open>all_is p ps (proj xs (length branch))\<close>
         using Cons(2) Pair unfolding proj_def all_is_def is_at_def by auto
       then have
         \<open>nominals p \<union> block_nominals (omit (proj xs (length branch)) ps, a) =
          nominals p \<union> block_nominals (ps, a)\<close>
         using Dup_block_nominals by fast
       then have
         \<open>nominals p \<union> block_nominals (omit_block (proj xs (length branch)) (ps, a)) =
          nominals p \<union> block_nominals (ps, a)\<close>
         by simp
       ultimately have
         \<open>nominals p \<union> branch_nominals (omit_branch xs ((ps, a) # branch)) =
           nominals p \<union> block_nominals (ps, a) \<union> branch_nominals branch\<close>
         by auto
       then show ?thesis
         unfolding branch_nominals_def using Pair by auto
     qed
   qed
 qed
 
 lemma Dup_branch_nominals:
   assumes \<open>Dup p i branch xs\<close>
   shows \<open>branch_nominals (omit_branch xs branch) = branch_nominals branch\<close>
 proof (cases \<open>xs = {}\<close>)
   case True
   then show ?thesis
     using omit_branch_id by metis
 next
   case False
   with assms obtain ps w w' where
     \<open>(w, w') \<notin> xs\<close> \<open>branch !. w = Some (ps, i)\<close> \<open>p = Nom i \<or> ps !. w' = Some p\<close>
     unfolding Dup_def is_elsewhere_def by fast
   then have *: \<open>(ps, i) \<in>. branch\<close> \<open>p on (ps, i)\<close>
     using rev_nth_mem rev_nth_on by fast+
   then have \<open>nominals p \<subseteq> branch_nominals branch\<close>
     unfolding branch_nominals_def using block_nominals by fast
   moreover obtain ps' where
     \<open>(ps', i) \<in>. omit_branch xs branch\<close> \<open>p on (ps', i)\<close>
     using assms * omit_branch_mem by fast
   then have \<open>nominals p \<subseteq> branch_nominals (omit_branch xs branch)\<close>
     unfolding branch_nominals_def using block_nominals by fast
   moreover have
     \<open>nominals p \<union> branch_nominals (omit_branch xs branch) =
      nominals p \<union> branch_nominals branch\<close>
     using assms Dup_branch_nominals' by fast
   ultimately show ?thesis
     by blast
 qed
 
 lemma omit_branch_mem_dual:
   assumes \<open>p at i in omit_branch xs branch\<close>
   shows \<open>p at i in branch\<close>
 proof -
   obtain ps where ps: \<open>(ps, i) \<in>. omit_branch xs branch\<close> \<open>p on (ps, i)\<close>
     using assms(1) by blast
   then obtain v where v: \<open>omit_branch xs branch !. v = Some (ps, i)\<close>
     using rev_nth_mem unfolding omit_branch_def by fast
   then have \<open>v < length (omit_branch xs branch)\<close>
     using rev_nth_Some by fast
   then have \<open>v < length branch\<close>
     unfolding omit_branch_def using length_mapi by metis
   then obtain ps' i' where ps': \<open>branch !. v = Some (ps', i')\<close>
     using rev_nth_bounded by (metis surj_pair)
   then have \<open>omit_branch xs branch !. v = Some (omit (proj xs v) ps', i')\<close>
     unfolding omit_branch_def by (simp add: mapi_rev_nth)
   then have \<open>ps = omit (proj xs v) ps'\<close> \<open>i = i'\<close>
     using v by simp_all
   then have \<open>p on (ps', i)\<close>
     using ps omit_set by auto
   moreover have \<open>(ps', i) \<in>. branch\<close>
     using ps' \<open>i = i'\<close> rev_nth_mem by fast
   ultimately show ?thesis
     using \<open>ps = omit (proj xs v) ps'\<close> by blast
 qed
 
 lemma witnessed_omit_branch:
   assumes \<open>witnessed p a (omit_branch xs branch)\<close>
   shows \<open>witnessed p a branch\<close>
 proof -
   obtain ps qs i where
     ps: \<open>(ps, a) \<in>. omit_branch xs branch\<close> \<open>(\<^bold>@ i p) on (ps, a)\<close> and
     qs: \<open>(qs, a) \<in>. omit_branch xs branch\<close> \<open>(\<^bold>\<diamond> Nom i) on (qs, a)\<close>
     using assms unfolding witnessed_def by blast
   from ps obtain ps' where
     \<open>(ps', a) \<in>. branch\<close> \<open>(\<^bold>@ i p) on (ps', a)\<close>
     using omit_branch_mem_dual by fast
   moreover from qs obtain qs' where
     \<open>(qs', a) \<in>. branch\<close> \<open>(\<^bold>\<diamond> Nom i) on (qs', a)\<close>
     using omit_branch_mem_dual by fast
   ultimately show ?thesis
     unfolding witnessed_def by blast
 qed
 
 lemma new_omit_branch:
   assumes \<open>new p a branch\<close>
   shows \<open>new p a (omit_branch xs branch)\<close>
   using assms omit_branch_mem_dual unfolding new_def by fast
 
 lemma omit_oob:
   assumes \<open>length ps \<le> v\<close>
   shows \<open>omit ({v} \<union> xs) ps = omit xs ps\<close>
   using assms by (induct ps) simp_all
 
 lemma omit_branch_oob:
   assumes \<open>length branch \<le> v\<close>
   shows \<open>omit_branch ({(v, v')} \<union> xs) branch = omit_branch xs branch\<close>
   using assms
 proof (induct branch)
   case Nil
   then show ?case
     unfolding omit_branch_def by simp
 next
   case (Cons block branch)
   let ?xs = \<open>({(v, v')} \<union> xs)\<close>
   show ?case
   proof (cases block)
     case (Pair ps a)
     then have
       \<open>omit_branch ?xs ((ps, a) # branch) =
         (omit (proj ?xs (length branch)) ps, a) # omit_branch xs branch\<close>
       using Cons unfolding omit_branch_def by simp
     moreover have \<open>proj ?xs (length branch) = proj xs (length branch)\<close>
       using Cons(2) unfolding proj_def by auto
     ultimately show ?thesis
       unfolding omit_branch_def by simp
   qed
 qed
 
 subsection \<open>Induction\<close>
 
 lemma ST_Dup:
   assumes \<open>n \<turnstile> branch\<close> \<open>Dup q i branch xs\<close>
   shows \<open>n \<turnstile> omit_branch xs branch\<close>
   using assms
 proof (induct n branch)
   case (Close p i' branch n)
   have \<open>p at i' in omit_branch xs branch\<close>
     using Close(1, 3) omit_branch_mem by fast
   moreover have \<open>(\<^bold>\<not> p) at i' in omit_branch xs branch\<close>
     using Close(2, 3) omit_branch_mem by fast
   ultimately show ?case
     using ST.Close by fast
 next
   case (Neg p a ps branch n)
   have \<open>Suc n \<turnstile> omit_branch xs ((p # ps, a) # branch)\<close>
     using Neg(4-) Dup_head by fast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using Neg(5) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> (p # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in omit_branch xs ((ps, a) # branch)\<close>
     using Neg(1, 5) omit_branch_mem by fast
   moreover have \<open>new p a (omit_branch xs ((ps, a) # branch))\<close>
     using Neg(2) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.Neg)
 next
   case (DisP p q a ps branch n)
   have
     \<open>Suc n \<turnstile> omit_branch xs ((p # ps, a) # branch)\<close>
     \<open>Suc n \<turnstile> omit_branch xs ((q # ps, a) # branch)\<close>
     using DisP(4-) Dup_head by fast+
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DisP(8) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> (p # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     \<open>Suc n \<turnstile> (q # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp_all
   moreover have \<open>(p \<^bold>\<or> q) at a in omit_branch xs ((ps, a) # branch)\<close>
     using DisP(1, 8) omit_branch_mem by fast
   moreover have \<open>new p a (omit_branch xs ((ps, a) # branch))\<close>
     using DisP(2) new_omit_branch by fast
   moreover have \<open>new q a (omit_branch xs ((ps, a) # branch))\<close>
     using DisP(3) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.DisP)
 next
   case (DisN p q a ps branch n)
   have \<open>Suc n \<turnstile> omit_branch xs (((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch)\<close>
     using DisN(4-) Dup_block[where ps'=\<open>[_, _]\<close>] by fastforce
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DisN(5) Dup_head_oob by fast
   moreover have \<open>(length branch, 1 + length ps) \<notin> xs\<close>
     using DisN(5) Dup_head_oob' by fast
   ultimately have
     \<open>Suc n \<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # omit (proj xs (length branch)) ps, a) #
       omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in omit_branch xs ((ps, a) # branch)\<close>
     using DisN(1, 5) omit_branch_mem by fast
   moreover have
     \<open>new (\<^bold>\<not> p) a (omit_branch xs ((ps, a) # branch)) \<or>
      new (\<^bold>\<not> q) a (omit_branch xs ((ps, a) # branch))\<close>
     using DisN(2) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.DisN)
 next
   case (DiaP p a ps branch i n)
   have \<open>Suc n \<turnstile> omit_branch xs (((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch)\<close>
     using DiaP(4-) Dup_block[where ps'=\<open>[_, _]\<close>] by fastforce
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DiaP(7) Dup_head_oob by fast
   moreover have \<open>(length branch, 1+ length ps) \<notin> xs\<close>
     using DiaP(7) Dup_head_oob' by fast
   ultimately have
     \<open>Suc n \<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # omit (proj xs (length branch)) ps, a) #
       omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>\<diamond> p) at a in omit_branch xs ((ps, a) # branch)\<close>
     using DiaP(1, 7) omit_branch_mem by fast
   moreover have \<open>i \<notin> branch_nominals (omit_branch xs ((ps, a) # branch))\<close>
     using DiaP(2, 7) Dup_branch_nominals by fast
   moreover have \<open>\<not> witnessed p a (omit_branch xs ((ps, a) # branch))\<close>
     using DiaP(4) witnessed_omit_branch by fast
   ultimately show ?case
     using DiaP(3) by (simp add: omit_branch_def ST.DiaP)
 next
   case (DiaN p a ps branch i n)
   have \<open>Suc n \<turnstile> omit_branch xs (((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch)\<close>
     using DiaN(4-) Dup_head by fast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DiaN(6) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # omit (proj xs (length branch)) ps, a) #
       omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in omit_branch xs ((ps, a) # branch)\<close>
     using DiaN(1, 6) omit_branch_mem by fast
   moreover have \<open>(\<^bold>\<diamond> Nom i) at a in omit_branch xs ((ps, a) # branch)\<close>
     using DiaN(2, 6) omit_branch_mem by fast
   moreover have \<open>new (\<^bold>\<not> (\<^bold>@ i p)) a (omit_branch xs ((ps, a) # branch))\<close>
     using DiaN(3) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.DiaN)
 next
   case (SatP a p b ps branch n)
   have \<open>Suc n \<turnstile> omit_branch xs ((p # ps, a) # branch)\<close>
     using SatP(4-) Dup_head by fast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using SatP(5) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> (p # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>@ a p) at b in omit_branch xs ((ps, a) # branch)\<close>
     using SatP(1, 5) omit_branch_mem by fast
   moreover have \<open>new p a (omit_branch xs ((ps, a) # branch))\<close>
     using SatP(2) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.SatP)
 next
   case (SatN a p b ps branch n)
   have \<open>Suc n \<turnstile> omit_branch xs (((\<^bold>\<not> p) # ps, a) # branch)\<close>
     using SatN(4-) Dup_head by fast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using SatN(5) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> ((\<^bold>\<not> p) # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in omit_branch xs ((ps, a) # branch)\<close>
     using SatN(1, 5) omit_branch_mem by fast
   moreover have \<open>new (\<^bold>\<not> p) a (omit_branch xs ((ps, a) # branch))\<close>
     using SatN(2) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.SatN)
 next
   case (GoTo i branch n)
   then have \<open>n \<turnstile> omit_branch xs (([], i) # branch)\<close>
     using Dup_branch[where extra=\<open>[([], i)]\<close>] by fastforce
   then have \<open>n \<turnstile> ([], i) # omit_branch xs branch\<close>
     unfolding omit_branch_def by simp
   moreover have \<open>i \<in> branch_nominals (omit_branch xs branch)\<close>
     using GoTo(1, 4) Dup_branch_nominals by fast
   ultimately show ?case
     unfolding omit_branch_def by (simp add: ST.GoTo)
 next
   case (Nom p b ps a branch i' n)
   have \<open>Suc n \<turnstile> omit_branch xs ((p # ps, a) # branch)\<close>
     using Nom(4-) Dup_head by fast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using Nom(7) Dup_head_oob by fast
   ultimately have
     \<open>Suc n \<turnstile> (p # omit (proj xs (length branch)) ps, a) # omit_branch xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>p at b in omit_branch xs ((ps, a) # branch)\<close>
     using Nom(1, 7) omit_branch_mem by fast
   moreover have \<open>Nom i' at b in omit_branch xs ((ps, a) # branch)\<close>
     using Nom(2, 7) omit_branch_mem by fast
   moreover have \<open>Nom i' at a in omit_branch xs ((ps, a) # branch)\<close>
     using Nom(3, 7) omit_branch_mem by fast
   moreover have \<open>new p a (omit_branch xs ((ps, a) # branch))\<close>
     using Nom(4) new_omit_branch by fast
   ultimately show ?case
     by (simp add: omit_branch_def ST.Nom)
 qed
 
 theorem Dup:
   assumes \<open>n \<turnstile> (p # ps, a) # branch\<close> \<open>\<not> new p a ((ps, a) # branch)\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
 proof -
   obtain qs where qs:
     \<open>(qs, a) \<in>. (ps, a) # branch\<close> \<open>p on (qs, a)\<close>
     using assms(2) unfolding new_def by blast
 
   let ?xs = \<open>{(length branch, length ps)}\<close>
 
   have *: \<open>is_at p a ((p # ps, a) # branch) (length branch) (length ps)\<close>
     unfolding is_at_def by simp
 
   have \<open>Dup p a ((p # ps, a) # branch) ?xs\<close>
   proof (cases \<open>p = Nom a\<close>)
     case True
     moreover have \<open>((p # ps, a) # branch) !. length branch = Some (p # ps, a)\<close>
       by simp
     moreover have \<open>p on (p # ps, a)\<close>
       by simp
     ultimately have \<open>is_elsewhere p a ((p # ps, a) # branch) ?xs\<close>
       unfolding is_elsewhere_def using assms(2) rev_nth_Some
       by (metis (mono_tags, lifting) Pair_inject less_le singletonD)
     then show ?thesis
       unfolding Dup_def using * by blast
   next
     case false: False
     then show ?thesis
     proof (cases \<open>ps = qs\<close>)
       case True
       then obtain w' where w': \<open>qs !. w' = Some p\<close>
         using qs(2) false rev_nth_mem by fastforce
       then have \<open>(p # ps) !. w' = Some p\<close>
         using True rev_nth_Cons by fast
       moreover have \<open>((p # ps, a) # branch) !. length branch = Some (p # ps, a)\<close>
         by simp
       moreover have \<open>(length branch, w') \<notin> ?xs\<close>
         using True w' rev_nth_Some by fast
       ultimately have \<open>is_elsewhere p a ((p # ps, a) # branch) ?xs\<close>
         unfolding is_elsewhere_def by fast
       then show ?thesis
         unfolding Dup_def using * by fast
     next
       case False
       then obtain w where w: \<open>branch !. w = Some (qs, a)\<close>
         using qs(1) rev_nth_mem by fastforce
       moreover obtain w' where w': \<open>qs !. w' = Some p\<close>
         using qs(2) false rev_nth_mem by fastforce
       moreover have \<open>(w, w') \<notin> ?xs\<close>
         using rev_nth_Some w by fast
       ultimately have \<open>is_elsewhere p a ((p # ps, a) # branch) ?xs\<close>
         unfolding is_elsewhere_def using rev_nth_Cons by fast
       then show ?thesis
         unfolding Dup_def using * by fast
     qed
   qed
 
   then have \<open>n \<turnstile> omit_branch ?xs ((p # ps, a) # branch)\<close>
     using assms(1) ST_Dup by fast
   then have \<open>n \<turnstile> (omit (proj ?xs (length branch)) ps, a) # omit_branch ?xs branch\<close>
     unfolding omit_branch_def proj_def by simp
   moreover have \<open>omit_branch ?xs branch = omit_branch {} branch\<close>
     using omit_branch_oob by auto
   then have \<open>omit_branch ?xs branch = branch\<close>
     using omit_branch_id by simp
   moreover have \<open>proj ?xs (length branch) = {length ps}\<close>
     unfolding proj_def by blast
   then have \<open>omit (proj ?xs (length branch)) ps = omit {} ps\<close>
     using omit_oob by auto
   then have \<open>omit (proj ?xs (length branch)) ps = ps\<close>
     using omit_id by simp
   ultimately show ?thesis
     by simp
 qed
 
 subsection \<open>Unrestricted rules\<close>
 
 lemma ST_add: \<open>n \<turnstile> branch \<Longrightarrow> m + n \<turnstile> branch\<close>
   using ST_Suc by (induct m) auto
 
 lemma ST_le: \<open>n \<turnstile> branch \<Longrightarrow> n \<le> m \<Longrightarrow> m \<turnstile> branch\<close>
   using ST_add by (metis le_add_diff_inverse2)
 
 lemma Neg':
   assumes
     \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> (p # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
   using assms Neg Dup ST_Suc by metis
 
 lemma DisP':
   assumes
     \<open>(p \<^bold>\<or> q) at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> (p # ps, a) # branch\<close> \<open>n \<turnstile> (q # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
 proof (cases \<open>new p a ((ps, a) # branch) \<and> new q a ((ps, a) # branch)\<close>)
   case True
   then show ?thesis
     using assms DisP ST_Suc by fast
 next
   case False
   then show ?thesis
     using assms Dup by fast
 qed
 
 lemma DisP'':
   assumes
     \<open>(p \<^bold>\<or> q) at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> (p # ps, a) # branch\<close> \<open>m \<turnstile> (q # ps, a) # branch\<close>
   shows \<open>max n m \<turnstile> (ps, a) # branch\<close>
 proof (cases \<open>n \<le> m\<close>)
   case True
   then have \<open>m \<turnstile> (p # ps, a) # branch\<close>
     using assms(2) ST_le by blast
   then show ?thesis
     using assms True by (simp add: DisP' max.absorb2)
 next
   case False
   then have \<open>n \<turnstile> (q # ps, a) # branch\<close>
     using assms(3) ST_le by fastforce
   then show ?thesis
     using assms False by (simp add: DisP' max.absorb1)
 qed
 
 lemma DisN':
   assumes
     \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
 proof (cases \<open>new (\<^bold>\<not> q) a ((ps, a) # branch) \<or> new (\<^bold>\<not> p) a ((ps, a) # branch)\<close>)
   case True
   then show ?thesis
     using assms DisN ST_Suc by fast
 next
   case False
   then show ?thesis
     using assms Dup
     by (metis (no_types, lifting) list.set_intros(1-2) new_def on.simps set_ConsD)
 qed
 
 lemma DiaN':
   assumes
     \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (ps, a) # branch\<close>
     \<open>(\<^bold>\<diamond> Nom i) at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
   using assms DiaN Dup ST_Suc by fast
 
 lemma SatP':
   assumes
     \<open>(\<^bold>@ a p) at b in (ps, a) # branch\<close>
     \<open>n \<turnstile> (p # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
   using assms SatP Dup ST_Suc by fast
 
 lemma SatN':
   assumes
     \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in (ps, a) # branch\<close>
     \<open>n \<turnstile> ((\<^bold>\<not> p) # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
   using assms SatN Dup ST_Suc by fast
 
 lemma Nom':
   assumes
     \<open>p at b in (ps, a) # branch\<close>
     \<open>Nom i at b in (ps, a) # branch\<close>
     \<open>Nom i at a in (ps, a) # branch\<close>
     \<open>n \<turnstile> (p # ps, a) # branch\<close>
   shows \<open>n \<turnstile> (ps, a) # branch\<close>
   using assms Nom Dup ST_Suc by fast
 
 section \<open>Substitution\<close>
 
 lemma finite_nominals: \<open>finite (nominals p)\<close>
   by (induct p) simp_all
 
 lemma finite_block_nominals: \<open>finite (block_nominals block)\<close>
   using finite_nominals by (induct block) auto
 
 lemma finite_branch_nominals: \<open>finite (branch_nominals branch)\<close>
   unfolding branch_nominals_def by (induct branch) (auto simp: finite_block_nominals)
 
 abbreviation sub_list :: \<open>('b \<Rightarrow> 'c) \<Rightarrow> ('a, 'b) fm list \<Rightarrow> ('a, 'c) fm list\<close> where
   \<open>sub_list f ps \<equiv> map (sub f) ps\<close>
 
 primrec sub_block :: \<open>('b \<Rightarrow> 'c) \<Rightarrow> ('a, 'b) block \<Rightarrow> ('a, 'c) block\<close> where
   \<open>sub_block f (ps, i) = (sub_list f ps, f i)\<close>
 
 definition sub_branch :: \<open>('b \<Rightarrow> 'c) \<Rightarrow> ('a, 'b) branch \<Rightarrow> ('a, 'c) branch\<close> where
   \<open>sub_branch f blocks \<equiv> map (sub_block f) blocks\<close>
 
 lemma sub_block_mem: \<open>p on block \<Longrightarrow> sub f p on sub_block f block\<close>
   by (induct block) auto
 
 lemma sub_branch_mem:
   assumes \<open>(ps, i) \<in>. branch\<close>
   shows \<open>(sub_list f ps, f i) \<in>. sub_branch f branch\<close>
   unfolding sub_branch_def using assms image_iff by fastforce
 
 lemma sub_block_nominals: \<open>block_nominals (sub_block f block) = f ` block_nominals block\<close>
   by (induct block) (auto simp: sub_nominals)
 
 lemma sub_branch_nominals:
   \<open>branch_nominals (sub_branch f branch) = f ` branch_nominals branch\<close>
   unfolding branch_nominals_def sub_branch_def
   by (induct branch) (auto simp: sub_block_nominals)
 
 lemma sub_list_id: \<open>sub_list id ps = ps\<close>
   using sub_id by (induct ps) auto
 
 lemma sub_block_id: \<open>sub_block id block = block\<close>
   using sub_list_id by (induct block) auto
 
 lemma sub_branch_id: \<open>sub_branch id branch = branch\<close>
   unfolding sub_branch_def using sub_block_id by (induct branch) auto
 
 lemma sub_block_upd_fresh:
   assumes \<open>i \<notin> block_nominals block\<close>
   shows \<open>sub_block (f(i := j)) block = sub_block f block\<close>
   using assms by (induct block) (auto simp add: sub_upd_fresh)
 
 lemma sub_branch_upd_fresh:
   assumes \<open>i \<notin> branch_nominals branch\<close>
   shows \<open>sub_branch (f(i := j)) branch = sub_branch f branch\<close>
   using assms unfolding branch_nominals_def sub_branch_def
   by (induct branch) (auto simp: sub_block_upd_fresh)
 
 lemma sub_comp: \<open>sub f (sub g p) = sub (f o g) p\<close>
   by (induct p) simp_all
 
 lemma sub_list_comp: \<open>sub_list f (sub_list g ps) = sub_list (f o g) ps\<close>
   using sub_comp by (induct ps) auto
 
 lemma sub_block_comp: \<open>sub_block f (sub_block g block) = sub_block (f o g) block\<close>
   using sub_list_comp by (induct block) simp_all
 
 lemma sub_branch_comp:
   \<open>sub_branch f (sub_branch g branch) = sub_branch (f o g) branch\<close>
   unfolding sub_branch_def using sub_block_comp by (induct branch) fastforce+
 
 lemma swap_id: \<open>(id(i := j, j := i)) o (id(i := j, j := i)) = id\<close>
   by auto
 
 lemma at_in_sub_branch:
   assumes \<open>p at i in (ps, a) # branch\<close>
   shows \<open>sub f p at f i in (sub_list f ps, f a) # sub_branch f branch\<close>
   using assms sub_branch_mem by fastforce
 
 text \<open>
   If a branch has a closing tableau then so does any branch obtained by renaming nominals.
   Since some formulas on the renamed branch may no longer be new, they do not contribute
     any fuel and so we existentially quantify over the fuel needed to close the new branch.
 \<close>
 
 lemma ST_sub':
   fixes f :: \<open>'b \<Rightarrow> 'c\<close>
   assumes \<open>\<And>(f :: 'b \<Rightarrow> 'c) i A. finite A \<Longrightarrow> i \<notin> A \<Longrightarrow> \<exists>j. j \<notin> f ` A\<close>
   shows \<open>n \<turnstile> branch \<Longrightarrow> \<turnstile> sub_branch f branch\<close>
 proof (induct branch arbitrary: f rule: ST.induct)
   case (Close p i branch)
   have \<open>sub f p at f i in sub_branch f branch\<close>
     using Close(1) sub_branch_mem by fastforce
   moreover have \<open>(\<^bold>\<not> sub f p) at f i in sub_branch f branch\<close>
     using Close(2) sub_branch_mem by force
   ultimately show ?case
     using ST.Close by fast
 next
   case (Neg p a ps branch n)
   then have \<open>\<turnstile> (sub f p # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>(\<^bold>\<not> \<^bold>\<not> sub f p) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using Neg(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(3))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using Neg' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (DisP p q a ps branch n)
   then have
     \<open>\<turnstile> (sub f p # sub_list f ps, f a) # sub_branch f branch\<close>
     \<open>\<turnstile> (sub f q # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp_all
   moreover have \<open>(sub f p \<^bold>\<or> sub f q) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using DisP(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(4))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using DisP'' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (DisN p q a ps branch n)
   then have \<open>\<turnstile> ((\<^bold>\<not> sub f q) # (\<^bold>\<not> sub f p) # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>(\<^bold>\<not> (sub f p \<^bold>\<or> sub f q)) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using DisN(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(3-4))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using DisN' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (DiaP p a ps branch i n)
   show ?case
   proof (cases \<open>witnessed (sub f p) (f a) (sub_branch f ((ps, a) # branch))\<close>)
     case True
     then obtain i' where
       rs: \<open>(\<^bold>@ i' (sub f p)) at f a in (sub_list f ps, f a) # sub_branch f branch\<close> and
       ts: \<open>(\<^bold>\<diamond> Nom i') at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
       unfolding sub_branch_def witnessed_def by auto
     from rs have rs':
       \<open>(\<^bold>@ i' (sub f p)) at f a in ((\<^bold>\<diamond> Nom i') # sub_list f ps, f a) # sub_branch f branch\<close>
       by fastforce
 
     let ?f = \<open>f(i := i')\<close>
     let ?branch = \<open>sub_branch ?f branch\<close>
     have \<open>sub_branch ?f ((ps, a) # branch) = sub_branch f ((ps, a) # branch)\<close>
       using DiaP(2) sub_branch_upd_fresh by fast
     then have **: \<open>sub_list ?f ps = sub_list f ps\<close> \<open>?f a = f a\<close> \<open>?branch = sub_branch f branch\<close>
       unfolding sub_branch_def by simp_all
 
     have p: \<open>sub ?f p = sub f p\<close>
       using DiaP(1-2) sub_upd_fresh unfolding branch_nominals_def by fastforce
 
     have \<open>\<turnstile> ((\<^bold>@ (?f i) (sub ?f p)) # (\<^bold>\<diamond> Nom (?f i)) # sub_list ?f ps, ?f a) # ?branch\<close>
       using DiaP(6)[where f=\<open>?f\<close>] unfolding sub_branch_def by simp
     then have \<open>\<turnstile> ((\<^bold>@ i' (sub f p)) # (\<^bold>\<diamond> Nom i') # sub_list f ps, f a) # sub_branch f branch\<close>
       using p ** by simp
     then have \<open>\<turnstile> ((\<^bold>\<diamond> Nom i') # sub_list f ps, f a) # sub_branch f branch\<close>
       using rs' by (meson Nom' on.simps)
     then have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
       using ts by (meson Nom' on.simps)
     then show ?thesis
       unfolding sub_branch_def by auto
   next
     case False
     have \<open>finite (branch_nominals ((ps, a) # branch))\<close>
       by (simp add: finite_branch_nominals)
     then obtain j where *: \<open>j \<notin> f ` branch_nominals ((ps, a) # branch)\<close>
       using DiaP(2) assms by blast
 
     let ?f = \<open>f(i := j)\<close>
     let ?branch = \<open>sub_branch ?f branch\<close>
     have **: \<open>sub_branch ?f ((ps, a) # branch) = sub_branch f ((ps, a) # branch)\<close>
       using DiaP(2) sub_branch_upd_fresh by fast
     then have ***: \<open>sub_list ?f ps = sub_list f ps\<close> \<open>?f a = f a\<close> \<open>?branch = sub_branch f branch\<close>
       unfolding sub_branch_def by simp_all
     moreover have p: \<open>sub ?f p = sub f p\<close>
       using DiaP(1-2) sub_upd_fresh unfolding branch_nominals_def by fastforce
     ultimately have \<open>\<not> witnessed (sub ?f p) (?f a) (sub_branch ?f ((ps, a) # branch))\<close>
       using False ** by simp
     then have w: \<open>\<not> witnessed (sub ?f p) (?f a) ((sub_list ?f ps, ?f a) # ?branch)\<close>
       unfolding sub_branch_def by simp
 
     have \<open>\<turnstile> ((\<^bold>@ (?f i) (sub ?f p)) # (\<^bold>\<diamond> Nom (?f i)) # sub_list ?f ps, ?f a) # ?branch\<close>
       using DiaP(6)[where f=\<open>?f\<close>] ST_Suc unfolding sub_branch_def by simp
     moreover have \<open>sub ?f (\<^bold>\<diamond> p) at ?f a in (sub_list ?f ps, ?f a) # sub_branch ?f branch\<close>
       using DiaP(1) at_in_sub_branch by fast
     then have \<open>(\<^bold>\<diamond> sub ?f p) at ?f a in (sub_list ?f ps, ?f a) # sub_branch ?f branch\<close>
       by simp
     moreover have \<open>\<nexists>a. sub ?f p = Nom a\<close>
       using DiaP(3) by (cases p) simp_all
     moreover have \<open>?f i \<notin> branch_nominals ((sub_list ?f ps, ?f a) # ?branch)\<close>
       using * ** sub_branch_nominals unfolding sub_branch_def
       by (metis fun_upd_same list.simps(9) sub_block.simps)
     ultimately have \<open>\<turnstile> (sub_list ?f ps, ?f a) # ?branch\<close>
       using w ST.DiaP ST_Suc by fast
     then show ?thesis
       using *** unfolding sub_branch_def by simp
   qed
 next
   case (DiaN p a ps branch i n)
   then have \<open>\<turnstile> ((\<^bold>\<not> (\<^bold>@ (f i) (sub f p))) # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>(\<^bold>\<not> (\<^bold>\<diamond> sub f p)) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using DiaN(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(3, 5))
   moreover have \<open>(\<^bold>\<diamond> Nom (f i)) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using DiaN(2) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(2, 5))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using DiaN' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (SatP a p b ps branch n)
   then have \<open>\<turnstile> (sub f p # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>(\<^bold>@ (f a) (sub f p)) at f b in (sub_list f ps, f a) # sub_branch f branch\<close>
     using SatP(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(6))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using SatP' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (SatN a p b ps branch n)
   then have \<open>\<turnstile> ((\<^bold>\<not> sub f p) # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>(\<^bold>\<not> (\<^bold>@ (f a) (sub f p))) at f b in (sub_list f ps, f a) # sub_branch f branch\<close>
     using SatN(1) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(3, 6))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using SatN' by fast
   then show ?case
     unfolding sub_branch_def by simp
 next
   case (GoTo i branch n)
   then have \<open>\<turnstile> ([], f i) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>f i \<in> branch_nominals (sub_branch f branch)\<close>
     using GoTo(1) sub_branch_nominals by fast
   ultimately show ?case
     using ST.GoTo by fast
 next
   case (Nom p b ps a branch i n)
   then have \<open>\<turnstile> (sub f p # sub_list f ps, f a) # sub_branch f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>sub f p at f b in (sub_list f ps, f a) # sub_branch f branch\<close>
     using Nom(1) at_in_sub_branch by fast
   moreover have \<open>Nom (f i) at f b in (sub_list f ps, f a) # sub_branch f branch\<close>
     using Nom(2) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(2))
   moreover have \<open>Nom (f i) at f a in (sub_list f ps, f a) # sub_branch f branch\<close>
     using Nom(3) at_in_sub_branch by (metis (no_types, hide_lams) sub.simps(2))
   ultimately have \<open>\<turnstile> (sub_list f ps, f a) # sub_branch f branch\<close>
     using Nom' by fast
   then show ?case
     unfolding sub_branch_def by simp
 qed
 
 lemma ex_fresh_gt:
   fixes f :: \<open>'b \<Rightarrow> 'c\<close>
   assumes \<open>\<exists>g :: 'c \<Rightarrow> 'b. surj g\<close> \<open>finite A\<close> \<open>i \<notin> A\<close>
   shows \<open>\<exists>j. j \<notin> f ` A\<close>
 proof (rule ccontr)
   assume \<open>\<nexists>j. j \<notin> f ` A\<close>
   moreover obtain g :: \<open>'c \<Rightarrow> 'b\<close> where \<open>surj g\<close>
     using assms(1) by blast
   ultimately show False
     using assms(2-3)
     by (metis UNIV_I UNIV_eq_I card_image_le card_seteq finite_imageI image_comp subsetI)
 qed
 
 corollary ST_sub_gt:
   fixes f :: \<open>'b \<Rightarrow> 'c\<close>
   assumes \<open>\<exists>g :: 'c \<Rightarrow> 'b. surj g\<close> \<open>\<turnstile> branch\<close>
   shows \<open>\<turnstile> sub_branch f branch\<close>
   using assms ex_fresh_gt ST_sub' by metis
 
 corollary ST_sub_inf:
   fixes f :: \<open>'b \<Rightarrow> 'c\<close>
   assumes \<open>infinite (UNIV :: 'c set)\<close> \<open>n \<turnstile> branch\<close>
   shows \<open>\<turnstile> sub_branch f branch\<close>
 proof -
   have \<open>finite A \<Longrightarrow> \<exists>j. j \<notin> f ` A\<close> for A and f :: \<open>'b \<Rightarrow> 'c\<close>
     using assms(1) ex_new_if_finite by blast
   then show ?thesis
     using assms(2) ST_sub' by metis
 qed
 
 corollary ST_sub:
   fixes f :: \<open>'b \<Rightarrow> 'b\<close>
   assumes \<open>\<turnstile> branch\<close>
   shows \<open>\<turnstile> sub_branch f branch\<close>
 proof -
   have \<open>finite A \<Longrightarrow> i \<notin> A \<Longrightarrow> \<exists>j. j \<notin> f ` A\<close> for i A and f :: \<open>'b \<Rightarrow> 'b\<close>
     by (metis card_image_le card_seteq finite_imageI subsetI)
   then show ?thesis
     using assms ST_sub' by metis
 qed
 
 subsection \<open>Unrestricted \<open>(\<^bold>\<diamond>)\<close> rule\<close>
 
 lemma DiaP':
   assumes
     \<open>(\<^bold>\<diamond> p) at a in (ps, a) # branch\<close>
     \<open>\<nexists>a. p = Nom a\<close> \<open>i \<notin> branch_nominals ((ps, a) # branch)\<close>
     \<open>\<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch\<close>
   shows \<open>\<turnstile> (ps, a) # branch\<close>
 proof (cases \<open>witnessed p a ((ps, a) # branch)\<close>)
   case True
   then obtain i' where
     rs: \<open>(\<^bold>@ i' p) at a in (ps, a) # branch\<close> and
     ts: \<open>(\<^bold>\<diamond> Nom i') at a in (ps, a) # branch\<close>
     unfolding witnessed_def by blast
   then have rs':
     \<open>(\<^bold>@ i' p) at a in ((\<^bold>\<diamond> Nom i') # ps, a) # branch\<close>
     by fastforce
 
   let ?f = \<open>id(i := i')\<close>
   have \<open>\<turnstile> sub_branch ?f (((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # branch)\<close>
     using assms(4) ST_sub by blast
   then have \<open>\<turnstile> ((\<^bold>@ i' (sub ?f p)) # (\<^bold>\<diamond> Nom i') # sub_list ?f ps, ?f a) # sub_branch ?f branch\<close>
     unfolding sub_branch_def by simp
   moreover have \<open>i \<notin> nominals p\<close> \<open>i \<notin> list_nominals ps\<close> \<open>i \<noteq> a\<close> \<open>i \<notin> branch_nominals branch\<close>
     using assms(1-3) unfolding branch_nominals_def by fastforce+
   then have \<open>sub ?f p = p\<close>
     by (simp add: sub_id sub_upd_fresh)
   moreover have \<open>sub_list ?f ps = ps\<close>
     using \<open>i \<notin> list_nominals ps\<close> by (simp add: map_idI sub_id sub_upd_fresh)
   moreover have \<open>?f a = a\<close>
     using \<open>i \<noteq> a\<close> by simp
   moreover have \<open>sub_branch ?f branch = branch\<close>
     using \<open>i \<notin> branch_nominals branch\<close> by (simp add: sub_branch_id sub_branch_upd_fresh)
   ultimately have \<open>\<turnstile> ((\<^bold>@ i' p) # (\<^bold>\<diamond> Nom i') # ps, a) # branch\<close>
     by simp
   then have \<open>\<turnstile> ((\<^bold>\<diamond> Nom i') # ps, a) # branch\<close>
     using rs' by (meson Nom' on.simps)
   then show ?thesis
     using ts by (meson Nom' on.simps)
 next
   case False
   then show ?thesis
     using assms DiaP ST_Suc by fast
 qed
 
 section \<open>Structural Properties\<close>
 
 lemma block_nominals_branch:
   assumes \<open>block \<in>. branch\<close>
   shows \<open>block_nominals block \<subseteq> branch_nominals branch\<close>
   unfolding branch_nominals_def using assms by blast
 
 lemma sub_block_fresh:
   assumes \<open>i \<notin> branch_nominals branch\<close> \<open>block \<in>. branch\<close>
   shows \<open>sub_block (f(i := j)) block = sub_block f block\<close>
   using assms block_nominals_branch sub_block_upd_fresh by fast
 
 lemma list_down_induct [consumes 1, case_names Start Cons]:
   assumes \<open>\<forall>y \<in> set ys. Q y\<close> \<open>P (ys @ xs)\<close>
     \<open>\<And>y xs. Q y \<Longrightarrow> P (y # xs) \<Longrightarrow> P xs\<close>
   shows \<open>P xs\<close>
   using assms by (induct ys) auto
 
 text \<open>
   If the last block on a branch has opening nominal \<open>a\<close> and the last formulas on that block
    occur on another block alongside nominal \<open>a\<close>, then we can drop those formulas.
 \<close>
 
 lemma ST_drop_prefix:
   assumes \<open>set ps \<subseteq> set qs\<close> \<open>(qs, a) \<in>. branch\<close> \<open>n \<turnstile> (ps @ ps', a) # branch\<close>
   shows \<open>n \<turnstile> (ps', a) # branch\<close>
 proof -
   have \<open>\<forall>p \<in> set ps. p on (qs, a)\<close>
     using assms(1) by auto
   then show ?thesis
   proof (induct ps' rule: list_down_induct)
     case Start
     then show ?case
       using assms(3) .
   next
     case (Cons p ps)
     then show ?case
       using assms(2) by (meson Nom' list.set_intros(2) on.simps)
   qed
 qed
 
 text \<open>We can drop a block if it is subsumed by another block.\<close>
 
 lemma ST_drop_block:
   assumes
     \<open>set ps \<subseteq> set ps'\<close> \<open>(ps', a) \<in>. branch\<close>
     \<open>n \<turnstile> (ps, a) # branch\<close>
   shows \<open>Suc n \<turnstile> branch\<close>
   using assms
 proof (induct branch)
   case Nil
   then show ?case
     by simp
 next
   case (Cons block branch)
   then show ?case
   proof (cases block)
     case (Pair qs b)
     then have \<open>n \<turnstile> ([], a) # (qs, b) # branch\<close>
       using Cons(2-4) ST_drop_prefix[where branch=\<open>(qs, b) # branch\<close>] by simp
     moreover have \<open>a \<in> branch_nominals ((qs, b) # branch)\<close>
       unfolding branch_nominals_def using Cons(3) Pair by fastforce
     ultimately have \<open>Suc n \<turnstile> (qs, b) # branch\<close>
       by (simp add: GoTo)
     then show ?thesis
       using Pair Dup by fast
   qed
 qed
 
 lemma ST_drop_block':
   assumes \<open>n \<turnstile> (ps, a) # branch\<close> \<open>(ps, a) \<in>. branch\<close>
   shows \<open>Suc n \<turnstile> branch\<close>
   using assms ST_drop_block by fastforce
 
 lemma sub_branch_image: \<open>set (sub_branch f branch) = sub_block f ` set branch\<close>
   unfolding sub_branch_def by simp
 
 lemma sub_block_repl:
   assumes \<open>j \<notin> block_nominals block\<close>
   shows \<open>i \<notin> block_nominals (sub_block (id(i := j, j := i)) block)\<close>
   using assms by (simp add: image_iff sub_block_nominals)
 
 lemma sub_branch_repl:
   assumes \<open>j \<notin> branch_nominals branch\<close>
   shows \<open>i \<notin> branch_nominals (sub_branch (id(i := j, j := i)) branch)\<close>
   using assms by (simp add: image_iff sub_branch_nominals)
 
 text \<open>If a finite set of blocks has a closing tableau then so does any finite superset.\<close>
 
 lemma ST_struct:
   fixes branch :: \<open>('a, 'b) branch\<close>
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>n \<turnstile> branch\<close> \<open>set branch \<subseteq> set branch'\<close>
   shows \<open>\<turnstile> branch'\<close>
   using assms(2-3)
 proof (induct n branch arbitrary: branch' rule: ST.induct)
   case (Close p i branch)
   then show ?case
     using ST.Close by fast
 next
   case (Neg p a ps branch n)
   have \<open>\<turnstile> (p # ps, a) # branch'\<close>
     using Neg(4-5) by (simp add: subset_code(1))
   moreover have \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (ps, a) # branch'\<close>
     using Neg(1, 5) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using Neg' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using Neg(5) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (DisP p q a ps branch)
   have \<open>\<turnstile> (p # ps, a) # branch'\<close> \<open>\<turnstile> (q # ps, a) # branch'\<close>
     using DisP(5, 7-8) by (simp_all add: subset_code(1))
   moreover have \<open>(p \<^bold>\<or> q) at a in (ps, a) # branch'\<close>
     using DisP(1, 8) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using DisP'' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using DisP(8) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (DisN p q a ps branch n)
   have \<open>\<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a)# branch'\<close>
     using DisN(4-5) by (simp add: subset_code(1))
   moreover have \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (ps, a) # branch'\<close>
     using DisN(1, 5) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using DisN' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using DisN(5) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (DiaP p a ps branch i n)
   have \<open>finite (branch_nominals branch')\<close>
     by (simp add: finite_branch_nominals)
   then obtain j where j: \<open>j \<notin> branch_nominals branch'\<close>
     using assms ex_new_if_finite by blast
   then have j': \<open>j \<notin> branch_nominals ((ps, a) # branch)\<close>
     using DiaP(7) unfolding branch_nominals_def by blast
 
   let ?f = \<open>id(i := j, j := i)\<close>
   let ?branch' = \<open>sub_branch ?f branch'\<close>
   have branch': \<open>sub_branch ?f ?branch' = branch'\<close>
     using sub_branch_comp sub_branch_id swap_id by metis
 
   have branch: \<open>sub_branch ?f ((ps, a) # branch) = (ps, a) # branch\<close>
     using DiaP(2) j' sub_branch_id sub_branch_upd_fresh by metis
   moreover have
     \<open>set (sub_branch ?f ((ps, a) # branch)) \<subseteq> set ?branch'\<close>
     using DiaP(7) sub_branch_image by blast
   ultimately have *: \<open>set ((ps, a) # branch) \<subseteq> set ?branch'\<close>
     unfolding sub_branch_def by auto
 
   have \<open>i \<notin> block_nominals (ps, a)\<close>
     using DiaP unfolding branch_nominals_def by simp
   moreover have \<open>i \<notin> branch_nominals ?branch'\<close>
     using j sub_branch_repl by metis
   ultimately have i: \<open>i \<notin> branch_nominals ((ps, a) # ?branch')\<close>
     unfolding branch_nominals_def by simp
 
   have \<open>\<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ps, a) # ?branch'\<close>
     using DiaP(6) *
     by (metis (no_types, lifting) subset_code(1) insert_mono list.set(2) set_subset_Cons)
   moreover have \<open>(\<^bold>\<diamond> p) at a in (ps, a) # ?branch'\<close>
     using DiaP(1, 7) * by (meson set_subset_Cons subset_code(1))
   ultimately have \<open>\<turnstile> (ps, a) # ?branch'\<close>
     using inf DiaP(3) i DiaP' by metis
   then have \<open>\<turnstile> sub_branch ?f ((ps, a) # ?branch')\<close>
     using ST_sub by blast
   then have \<open>\<turnstile> (ps, a) # branch'\<close>
     using branch' branch unfolding sub_branch_def by simp
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using \<open>set ((ps, a) # branch) \<subseteq> set branch'\<close> by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (DiaN p a ps branch i n)
   have \<open>\<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps, a) # branch'\<close>
     using DiaN(5-6) by (simp add: subset_code(1))
   moreover have
     \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (ps, a) # branch'\<close>
     \<open>(\<^bold>\<diamond> Nom i) at a in (ps, a) # branch'\<close>
     using DiaN(1-2, 6) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using DiaN' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using DiaN(6) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (SatP a p b ps branch n)
   have \<open>\<turnstile> (p # ps, a) # branch'\<close>
     using SatP(4-5) by (simp add: subset_code(1))
   moreover have \<open>(\<^bold>@ a p) at b in (ps, a) # branch'\<close>
     using SatP(1, 5) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using SatP' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using SatP(5) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (SatN a p b ps branch n)
   have\<open>\<turnstile> ((\<^bold>\<not> p) # ps, a) # branch'\<close>
     using SatN(4-5) by (simp add: subset_code(1))
   moreover have \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in (ps, a) # branch'\<close>
     using SatN(1, 5) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using SatN' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using SatN(5) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 next
   case (GoTo i branch n)
   then have \<open>\<turnstile> ([], i) # branch'\<close>
     by (simp add: subset_code(1))
   moreover have \<open>i \<in> branch_nominals branch'\<close>
     using GoTo(1, 4) unfolding branch_nominals_def by auto
   ultimately show ?case
     using GoTo(2) ST.GoTo by fast
 next
   case (Nom p b ps a branch i n)
   have \<open>\<turnstile> (p # ps, a) # branch'\<close>
     using Nom(6-7) by (simp add: subset_code(1))
   moreover have \<open>p at b in (ps, a) # branch'\<close>
     using Nom(1, 7) by auto
   moreover have \<open>Nom i at b in (ps, a) # branch'\<close>
     using Nom(2, 7) by auto
   moreover have \<open>Nom i at a in (ps, a) # branch'\<close>
     using Nom(3, 7) by auto
   ultimately have \<open>\<turnstile> (ps, a) # branch'\<close>
     using Nom' by fast
   moreover have \<open>(ps, a) \<in>. branch'\<close>
     using Nom(7) by simp
   ultimately show ?case
     using ST_drop_block' by fast
 qed
 
 text \<open>
   If a branch has a closing tableau then we can replace the formulas of the last block
   on that branch with any finite superset and still obtain a closing tableau.
 \<close>
 
 lemma ST_struct_block:
   fixes branch :: \<open>('a, 'b) branch\<close>
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>n \<turnstile> (ps, a) # branch\<close> \<open>set ps \<subseteq> set ps'\<close>
   shows \<open>\<turnstile> (ps', a) # branch\<close>
   using assms(2-3)
 proof (induct \<open>(ps, a) # branch\<close> arbitrary: ps ps' rule: ST.induct)
   case (Close p i n ts ts')
   then have \<open>p at i in (ts', a) # branch\<close> \<open>(\<^bold>\<not> p) at i in (ts', a) # branch\<close>
     by auto
   then show ?case
     using ST.Close by fast
 next
   case (Neg p ps n)
   then have \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> (p # ps', a) # branch\<close>
     using Neg(4-5) by (simp add: subset_code(1))
   ultimately show ?case
     using Neg' by fast
 next
   case (DisP p q ps n)
   then have \<open>(p \<^bold>\<or> q) at a in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> (p # ps', a) # branch\<close> \<open>\<turnstile> (q # ps', a) # branch\<close>
     using DisP(5, 7-8) by (simp_all add: subset_code(1))
   ultimately show ?case
     using DisP'' by fast
 next
   case (DisN p q ps n)
   then have \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps', a) # branch\<close>
     using DisN(4-5) by (simp add: subset_code(1))
   ultimately show ?case
     using DisN' by fast
 next
   case (DiaP p ps i n)
   have \<open>finite (branch_nominals ((ps', a) # branch))\<close>
     using finite_branch_nominals by blast
   then obtain j where j: \<open>j \<notin> branch_nominals ((ps', a) # branch)\<close>
     using assms ex_new_if_finite by blast
   then have j': \<open>j \<notin> block_nominals (ps, a)\<close>
     using DiaP.prems unfolding branch_nominals_def by auto
 
   let ?f = \<open>id(i := j, j := i)\<close>
   let ?ps' = \<open>sub_list ?f ps'\<close>
   have ps': \<open>sub_list ?f ?ps' = ps'\<close>
     using sub_list_comp sub_list_id swap_id by metis
 
   have \<open>i \<notin> block_nominals (ps, a)\<close>
     using DiaP(1-2) unfolding branch_nominals_def by simp
   then have ps: \<open>sub_block ?f (ps, a) = (ps, a)\<close>
     using j' sub_block_id sub_block_upd_fresh by metis
   moreover have \<open>set (sub_list ?f ps) \<subseteq> set (sub_list ?f ps')\<close>
     using \<open>set ps \<subseteq> set ps'\<close> by auto
   ultimately have *: \<open>set ps \<subseteq> set ?ps'\<close>
     by simp
 
   have \<open>i \<notin> branch_nominals branch\<close>
     using DiaP unfolding branch_nominals_def by simp
   moreover have \<open>j \<notin> branch_nominals branch\<close>
     using j unfolding branch_nominals_def by simp
   ultimately have branch: \<open>sub_branch ?f branch = branch\<close>
     using sub_branch_id sub_branch_upd_fresh by metis
 
   have \<open>i \<noteq> a\<close> \<open>j \<noteq> a\<close>
     using DiaP j unfolding branch_nominals_def by simp_all
   then have \<open>?f a = a\<close>
     by simp
   moreover have \<open>j \<notin> block_nominals (ps', a)\<close>
     using j unfolding branch_nominals_def by simp
   ultimately have \<open>i \<notin> block_nominals (?ps', a)\<close>
     using sub_block_repl[where block=\<open>(ps', a)\<close> and i=i and j=j] by simp
 
   have \<open>(\<^bold>\<diamond> p) at a in (?ps', a) # branch\<close>
     using DiaP(1) * by fastforce
   moreover have \<open>\<turnstile> ((\<^bold>@ i p) # (\<^bold>\<diamond> Nom i) # ?ps', a) # branch\<close>
     using * DiaP(6) by (simp add: subset_code(1))
   moreover have \<open>i \<notin> branch_nominals ((?ps', a) # branch)\<close>
     using DiaP(2) \<open>i \<notin> block_nominals (?ps', a)\<close> unfolding branch_nominals_def by simp
   ultimately have \<open>\<turnstile> (?ps', a) # branch\<close>
     using DiaP(3) DiaP' by fast
   then have \<open>\<turnstile> sub_branch ?f ((?ps', a) # branch)\<close>
     using ST_sub by blast
   then have \<open>\<turnstile> (sub_list ?f ?ps', ?f a) # sub_branch ?f branch\<close>
     unfolding sub_branch_def by simp
   then show ?case
     using \<open>?f a = a\<close> ps' branch by simp
 next
   case (DiaN p ps i n)
   then have
     \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (ps', a) # branch\<close>
     \<open>(\<^bold>\<diamond> Nom i) at a in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> ((\<^bold>\<not> (\<^bold>@ i p)) # ps', a) # branch\<close>
     using DiaN(5-6) by (simp add: subset_code(1))
   ultimately show ?case
     using DiaN' by fast
 next
   case (SatP p b ps n)
   then have \<open>(\<^bold>@ a p) at b in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> (p # ps', a) # branch\<close>
     using SatP(4-5) by (simp add: subset_code(1))
   ultimately show ?case
     using SatP' by fast
 next
   case (SatN p b ps n)
   then have \<open>(\<^bold>\<not> (\<^bold>@ a p)) at b in (ps', a) # branch\<close>
     by auto
   moreover have \<open>\<turnstile> ((\<^bold>\<not> p) # ps', a) # branch\<close>
     using SatN(4-5) by (simp add: subset_code(1))
   ultimately show ?case
     using SatN' by fast
 next
   case (GoTo i n ps)
   then have \<open>Suc n \<turnstile> (ps, a) # branch\<close>
     using ST.GoTo by fast
   then obtain m where \<open>m \<turnstile> (ps, a) # (ps', a) # branch\<close>
     using inf ST_struct[where branch'=\<open>(ps, a) # _ # _\<close>] by fastforce
   then have \<open>Suc m \<turnstile> (ps', a) # branch\<close>
     using GoTo(4) by (simp add: ST_drop_block[where a=a])
   then show ?case
     by blast
 next
   case (Nom p b ps i)
   have \<open>p at b in (ps', a) # branch\<close>
     using Nom(1, 7) by auto
   moreover have \<open>Nom i at b in (ps', a) # branch\<close>
     using Nom(2, 7) by auto
   moreover have \<open>Nom i at a in (ps', a) # branch\<close>
     using Nom(3, 7) by auto
   moreover have \<open>\<turnstile> (p # ps', a) # branch\<close>
     using Nom(6-7) by (simp add: subset_code(1))
   ultimately show ?case
     using Nom' by fast
 qed
 
 section \<open>Unrestricted \<open>(\<^bold>@)\<close> and \<open>(\<^bold>\<not> \<^bold>@)\<close> rules\<close>
 
 text \<open>We can derive more general versions of the \<open>(\<^bold>@)\<close> and \<open>(\<^bold>\<not> \<^bold>@)\<close> rules using weakening and \<open>Nom\<close>.\<close>
 
 lemma SatP'':
   fixes i :: 'b
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>(\<^bold>@ i p) at b in (ps, a) # branch\<close>
     \<open>Nom i at a in (ps, a) # branch\<close>
     \<open>\<turnstile> (p # ps, a) # branch\<close>
   shows \<open>\<turnstile> (ps, a) # branch\<close>
 proof -
   have \<open>i \<in> branch_nominals ((ps, a) # branch)\<close>
     using assms(2) unfolding branch_nominals_def by fastforce
   then have ?thesis if \<open>\<turnstile> ([], i) # (ps, a) # branch\<close>
     using that GoTo by fast
   then have ?thesis if \<open>\<turnstile> ([Nom a], i) # (ps, a) # branch\<close>
     using that assms(3) by (meson Nom' list.set_intros(1) on.simps set_subset_Cons subsetD)
   then have ?thesis if \<open>\<turnstile> ([p, Nom a], i) # (ps, a) # branch\<close>
     using that assms(2) by (meson SatP' set_subset_Cons subsetD)
   then have ?thesis if \<open>\<turnstile> (ps, a) # ([p, Nom a], i) # branch\<close>
     using that inf ST_struct[where branch'=\<open>([p, Nom a], i) # (ps, a) # branch\<close>] by fastforce
   then have ?thesis if \<open>\<turnstile> (p # ps, a) # ([p, Nom a], i) # branch\<close>
     using that by (meson Nom' list.set_intros(1) on.simps set_subset_Cons subsetD)
   then show ?thesis
     using inf assms(4) ST_struct[where branch'=\<open>(p # ps, a) # ([p, Nom a], i) # branch\<close>]
     by fastforce
 qed
 
 lemma SatN'':
   fixes i :: 'b
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>(\<^bold>\<not> (\<^bold>@ i p)) at b in (ps, a) # branch\<close>
     \<open>Nom i at a in (ps, a) # branch\<close>
     \<open>\<turnstile> ((\<^bold>\<not> p) # ps, a) # branch\<close>
   shows \<open>\<turnstile> (ps, a) # branch\<close>
 proof -
   have \<open>i \<in> branch_nominals ((ps, a) # branch)\<close>
     using assms(2) unfolding branch_nominals_def by fastforce
   then have ?thesis if \<open>\<turnstile> ([], i) # (ps, a) # branch\<close>
     using that GoTo by fast
   then have ?thesis if \<open>\<turnstile> ([Nom a], i) # (ps, a) # branch\<close>
     using that assms(3) by (meson Nom' list.set_intros(1) on.simps set_subset_Cons subsetD)
   then have ?thesis if \<open>\<turnstile> ([\<^bold>\<not> p, Nom a], i) # (ps, a) # branch\<close>
     using that assms(2) by (meson SatN' set_subset_Cons subsetD)
   then have ?thesis if \<open>\<turnstile> (ps, a) # ([\<^bold>\<not> p, Nom a], i) # branch\<close>
     using that inf ST_struct[where branch'=\<open>([\<^bold>\<not> p, Nom a], i) # (ps, a) # branch\<close>] by fastforce
   then have ?thesis if \<open>\<turnstile> ((\<^bold>\<not> p) # ps, a) # ([\<^bold>\<not> p, Nom a], i) # branch\<close>
     using that by (meson Nom' list.set_intros(1) on.simps set_subset_Cons subsetD)
   then show ?thesis
     using inf assms(4) ST_struct[where branch'=\<open>((\<^bold>\<not> p) # ps, a) # ([\<^bold>\<not> p, Nom a], i) # branch\<close>]
     by fastforce
 qed
 
 section \<open>Bridge\<close>
 
 text \<open>
   We are going to define a \<open>descendants k i branch\<close> relation on sets of indices.
   The sets are built on the index of a \<open>\<^bold>\<diamond> Nom k\<close> on an \<open>i\<close>-block in \<open>branch\<close> and can be extended
     by indices of formula occurrences that can be thought of as descending from
     that \<open>\<^bold>\<diamond> Nom k\<close> by application of either the \<open>(\<^bold>\<not> \<^bold>\<diamond>)\<close> or \<open>Nom\<close> rule.
 
   We will show that if we have nominals \<open>j\<close> and \<open>k\<close> on the same block in a closeable branch,
   then the branch obtained by the following transformation is also closeable:
   For every index \<open>v\<close>, if the formula at \<open>v\<close> is \<open>\<^bold>\<diamond> Nom k\<close>, replace it by \<open>\<^bold>\<diamond> Nom j\<close> and
     if it is \<open>\<^bold>\<not> (\<^bold>@ k p)\<close> replace it by \<open>\<^bold>\<not> (\<^bold>@ j p)\<close>.
   There are no other cases.
 
   From this transformation we can derive the Bridge rule.
 \<close>
 
 subsection \<open>Replacing\<close>
 
 abbreviation bridge' :: \<open>'b \<Rightarrow> 'b \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'b) fm\<close> where
   \<open>bridge' k j p \<equiv> case p of
     (\<^bold>\<diamond> Nom k') \<Rightarrow> (if k = k' then (\<^bold>\<diamond> Nom j) else (\<^bold>\<diamond> Nom k'))
   | (\<^bold>\<not> (\<^bold>@ k' q)) \<Rightarrow> (if k = k' then (\<^bold>\<not> (\<^bold>@ j q)) else (\<^bold>\<not> (\<^bold>@ k' q)))
   | p \<Rightarrow> p\<close>
 
 abbreviation bridge ::
   \<open>'b \<Rightarrow> 'b \<Rightarrow> (nat \<times> nat) set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('a, 'b) fm \<Rightarrow> ('a, 'b) fm\<close> where
   \<open>bridge k j \<equiv> mapper (bridge' k j)\<close>
 
 lemma bridge_on_Nom:
   \<open>Nom i on (ps, a) \<Longrightarrow> Nom i on (mapi (bridge k j xs v) ps, a)\<close>
   by (induct ps) auto
 
 lemma bridge'_nominals:
   \<open>nominals (bridge' k j p) \<union> {k, j} = nominals p \<union> {k, j}\<close>
 proof (induct p)
   case (Neg p)
   then show ?case by (cases p) auto
 next
   case (Dia p)
   then show ?case by (cases p) auto
 qed auto
 
 lemma bridge_nominals:
   \<open>nominals (bridge k j xs v v' p) \<union> {k, j} = nominals p \<union> {k, j}\<close>
 proof (cases \<open>(v, v') \<in> xs\<close>)
   case True
   then have \<open>nominals (bridge k j xs v v' p) = nominals (bridge' k j p)\<close>
     by simp
   then show ?thesis
     using bridge'_nominals by metis
 qed simp
 
 lemma bridge_block_nominals:
   \<open>block_nominals (mapi_block (bridge k j xs v) (ps, a)) \<union> {k, j} =
    block_nominals (ps, a) \<union> {k, j}\<close>
 proof (induct ps)
   case Nil
   then show ?case
     by simp
 next
   case (Cons p ps)
   have \<open>?case \<longleftrightarrow>
     (nominals (bridge k j xs v (length ps) p)) \<union>
     (block_nominals (mapi_block (bridge k j xs v) (ps, a)) \<union> {k, j}) =
     (nominals p) \<union> (block_nominals (ps, a) \<union> {k, j})\<close>
     by simp
   also have \<open>\<dots> \<longleftrightarrow>
     (nominals (bridge k j xs v (length ps) p) \<union> {k, j}) \<union>
     (block_nominals (mapi_block (bridge k j xs v) (ps, a)) \<union> {k, j}) =
     (nominals p \<union> {k, j}) \<union> (block_nominals (ps, a) \<union> {k, j})\<close>
     by blast
   moreover have
     \<open>nominals (bridge k j xs v (length ps) p) \<union> {k, j} = nominals p \<union> {k, j}\<close>
     using bridge_nominals by metis
   moreover note Cons
   ultimately show ?case
     by argo
 qed
 
 lemma bridge_branch_nominals:
   \<open>branch_nominals (mapi_branch (bridge k j xs) branch) \<union> {k, j} =
    branch_nominals branch \<union> {k, j}\<close>
 proof (induct branch)
   case Nil
   then show ?case
     unfolding branch_nominals_def mapi_branch_def
     by simp
 next
   case (Cons block branch)
   have \<open>?case \<longleftrightarrow>
     (block_nominals (mapi_block (bridge k j xs (length branch)) block)) \<union>
     (branch_nominals (mapi_branch (bridge k j xs) branch) \<union> {k, j}) =
     (block_nominals block) \<union> (branch_nominals branch \<union> {k, j})\<close>
     unfolding branch_nominals_def mapi_branch_def by simp
   also have \<open>\<dots> \<longleftrightarrow>
     (block_nominals (mapi_block (bridge k j xs (length branch)) block) \<union> {k, j}) \<union>
     (branch_nominals (mapi_branch (bridge k j xs) branch) \<union> {k, j}) =
     (block_nominals block \<union> {k, j}) \<union> (branch_nominals branch \<union> {k, j})\<close>
     by blast
   moreover have
     \<open>block_nominals (mapi_block (bridge k j xs (length branch)) block) \<union> {k, j} =
      block_nominals block \<union> {k, j}\<close>
     using bridge_block_nominals[where ps=\<open>fst block\<close> and a=\<open>snd block\<close>] by simp
   ultimately show ?case
     using Cons by argo
 qed
 
 lemma at_in_mapi_branch:
   assumes \<open>p at a in branch\<close> \<open>p \<noteq> Nom a\<close>
   shows \<open>\<exists>v v'. f v v' p at a in mapi_branch f branch\<close>
   using assms by (meson mapi_branch_mem rev_nth_mapi_block rev_nth_on)
 
 lemma nom_at_in_bridge:
   fixes k j xs
   defines \<open>f \<equiv> bridge k j xs\<close>
   assumes \<open>Nom i at a in branch\<close>
   shows \<open>Nom i at a in mapi_branch f branch\<close>
 proof -
   obtain qs where qs: \<open>(qs, a) \<in>. branch\<close> \<open>Nom i on (qs, a)\<close>
     using assms(2) by blast
   then obtain l where \<open>(mapi (f l) qs, a) \<in>. mapi_branch f branch\<close>
     using mapi_branch_mem by fast
   moreover have \<open>Nom i on (mapi (f l) qs, a)\<close>
     unfolding f_def using qs(2) by (induct qs) auto
   ultimately show ?thesis
     by blast
 qed
 
 lemma nominals_mapi_branch_bridge:
   assumes \<open>Nom j at a in branch\<close> \<open>Nom k at a in branch\<close>
   shows \<open>branch_nominals (mapi_branch (bridge k j xs) branch) = branch_nominals branch\<close>
 proof -
   let ?f = \<open>bridge k j xs\<close>
   have \<open>Nom j at a in mapi_branch ?f branch\<close>
     using assms(1) nom_at_in_bridge by fast
   then have \<open>j \<in> branch_nominals (mapi_branch ?f branch)\<close>
     unfolding branch_nominals_def by fastforce
   moreover have \<open>Nom k at a in mapi_branch ?f branch\<close>
     using assms(2) nom_at_in_bridge by fast
   then have \<open>k \<in> branch_nominals (mapi_branch ?f branch)\<close>
     unfolding branch_nominals_def by fastforce
   moreover have \<open>j \<in> branch_nominals branch\<close> \<open>k \<in> branch_nominals branch\<close>
     using assms(1-2) unfolding branch_nominals_def by fastforce+
   moreover have
     \<open>branch_nominals (mapi_branch ?f branch) \<union> {k, j} = branch_nominals branch \<union> {k, j}\<close>
     using bridge_branch_nominals by metis
   ultimately show ?thesis
     by blast
 qed
 
 lemma bridge_proper_dia:
   assumes \<open>\<nexists>a. p = Nom a\<close>
   shows \<open>bridge k j xs v v' (\<^bold>\<diamond> p) = (\<^bold>\<diamond> p)\<close>
   using assms by (induct p) simp_all
 
 lemma bridge_compl_cases:
   fixes k j xs v v' w w' p
   defines \<open>q \<equiv> bridge k j xs v v' p\<close> and \<open>q' \<equiv> bridge k j xs w w' (\<^bold>\<not> p)\<close>
   shows
     \<open>(q = (\<^bold>\<diamond> Nom j) \<and> q' = (\<^bold>\<not> (\<^bold>\<diamond> Nom k))) \<or>
  (\<exists>r. q = (\<^bold>\<not> (\<^bold>@ j r)) \<and> q' = (\<^bold>\<not> \<^bold>\<not> (\<^bold>@ k r))) \<or>
  (\<exists>r. q = (\<^bold>@ k r) \<and> q' = (\<^bold>\<not> (\<^bold>@ j r))) \<or>
      (q = p \<and> q' = (\<^bold>\<not> p))\<close>
 proof (cases p)
   case (Neg p)
   then show ?thesis
     by (cases p) (simp_all add: q_def q'_def)
 next
   case (Dia p)
   then show ?thesis
     by (cases p) (simp_all add: q_def q'_def)
 qed (simp_all add: q_def q'_def)
 
 subsection \<open>Descendants\<close>
 
 inductive descendants :: \<open>'b \<Rightarrow> 'b \<Rightarrow> ('a, 'b) branch \<Rightarrow> (nat \<times> nat) set \<Rightarrow> bool\<close> where
   Initial:
   \<open>branch !. v = Some (qs, i) \<Longrightarrow> qs !. v' = Some (\<^bold>\<diamond> Nom k) \<Longrightarrow>
     descendants k i branch {(v, v')}\<close>
 | Derived:
   \<open>branch !. v = Some (qs, a) \<Longrightarrow> qs !. v' = Some (\<^bold>\<not> (\<^bold>@ k p)) \<Longrightarrow>
     descendants k i branch xs \<Longrightarrow> (w, w') \<in> xs \<Longrightarrow>
     branch !. w = Some (rs, a) \<Longrightarrow> rs !. w' = Some (\<^bold>\<diamond> Nom k) \<Longrightarrow>
     descendants k i branch ({(v, v')} \<union> xs)\<close>
 | Copied:
   \<open>branch !. v = Some (qs, a) \<Longrightarrow> qs !. v' = Some p \<Longrightarrow>
     descendants k i branch xs \<Longrightarrow> (w, w') \<in> xs \<Longrightarrow>
     branch !. w = Some (rs, b) \<Longrightarrow> rs !. w' = Some p \<Longrightarrow>
     Nom j at b in branch \<Longrightarrow> Nom j at a in branch \<Longrightarrow>
     descendants k i branch ({(v, v')} \<union> xs)\<close>
 
 lemma descendants_initial:
   assumes \<open>descendants k i branch xs\<close>
   shows \<open>\<exists>(v, v') \<in> xs. \<exists>ps.
     branch !. v = Some (ps, i) \<and> ps !. v' = Some (\<^bold>\<diamond> Nom k)\<close>
   using assms by (induct k i branch xs rule: descendants.induct) simp_all
 
 lemma descendants_bounds_fst:
   assumes \<open>descendants k i branch xs\<close> \<open>(v, v') \<in> xs\<close>
   shows \<open>v < length branch\<close>
   using assms rev_nth_Some
   by (induct k i branch xs rule: descendants.induct) fast+
 
 lemma descendants_bounds_snd:
   assumes \<open>descendants k i branch xs\<close> \<open>(v, v') \<in> xs\<close> \<open>branch !. v = Some (ps, a)\<close>
   shows \<open>v' < length ps\<close>
   using assms
   by (induct k i branch xs rule: descendants.induct) (auto simp: rev_nth_Some)
 
 lemma descendants_branch:
   \<open>descendants k i branch xs \<Longrightarrow> descendants k i (extra @ branch) xs\<close>
 proof (induct k i branch xs rule: descendants.induct)
   case (Initial branch v qs i v' k)
   then show ?case
     using rev_nth_append descendants.Initial by fast
 next
   case (Derived branch v qs a v' k p i xs w w' rs)
   then have
     \<open>(extra @ branch) !. v = Some (qs, a)\<close>
     \<open>(extra @ branch) !. w = Some (rs, a)\<close>
     using rev_nth_append by fast+
   then show ?case
     using Derived(2, 4-5, 7) descendants.Derived by fast
 next
   case (Copied branch v qs a v' p k i xs w w' rs b j)
   then have
     \<open>(extra @ branch) !. v = Some (qs, a)\<close>
     \<open>(extra @ branch) !. w = Some (rs, b)\<close>
     using rev_nth_append by fast+
   moreover have \<open>Nom j at b in (extra @ branch)\<close> \<open>Nom j at a in (extra @ branch)\<close>
     using Copied(8-9) by auto
   ultimately show ?case
     using Copied(2-4, 5-7, 9) descendants.Copied by fast
 qed
 
 lemma descendants_block:
   assumes \<open>descendants k i ((ps, a) # branch) xs\<close>
   shows \<open>descendants k i ((ps' @ ps, a) # branch) xs\<close>
   using assms
 proof (induct k i \<open>(ps, a) # branch\<close> xs arbitrary: ps a branch rule: descendants.induct)
   case (Initial v qs i v' k)
   have
     \<open>((ps' @ ps, a) # branch) !. v = Some (qs, i) \<or>
      ((ps' @ ps, a) # branch) !. v = Some (ps' @ qs, i)\<close>
     using Initial(1) by auto
   moreover have
     \<open>qs !. v' = Some (\<^bold>\<diamond> Nom k)\<close> \<open>(ps' @ qs) !. v' = Some (\<^bold>\<diamond> Nom k)\<close>
     using Initial(2) rev_nth_append by simp_all
   ultimately show ?case
     using descendants.Initial by fast
 next
   case (Derived v qs a' v' k p i xs w w' rs)
   have
     \<open>((ps' @ ps, a) # branch) !. v = Some (qs, a') \<or>
      ((ps' @ ps, a) # branch) !. v = Some (ps' @ qs, a')\<close>
     using Derived(1) by auto
   moreover have
     \<open>qs !. v' = Some (\<^bold>\<not> (\<^bold>@ k p))\<close> \<open>(ps' @ qs) !. v' = Some (\<^bold>\<not> (\<^bold>@ k p))\<close>
     using Derived(2) rev_nth_append by simp_all
   moreover have
     \<open>((ps' @ ps, a) # branch) !. w = Some (rs, a') \<or>
      ((ps' @ ps, a) # branch) !. w = Some (ps' @ rs, a')\<close>
     using \<open>((ps, a) # branch) !. w = Some (rs, a')\<close> by auto
   moreover have
     \<open>rs !. w' = Some (\<^bold>\<diamond> Nom k)\<close> \<open>(ps' @ rs) !. w' = Some (\<^bold>\<diamond> Nom k)\<close>
     using Derived(7) rev_nth_append by simp_all
   ultimately show ?case
     using Derived(4-5) descendants.Derived by fast
 next
   case (Copied v qs a' v' p k i xs w w' rs b j)
   have
     \<open>((ps' @ ps, a) # branch) !. v = Some (qs, a') \<or>
      ((ps' @ ps, a) # branch) !. v = Some (ps' @ qs, a')\<close>
     using Copied(1) by auto
   moreover have \<open>qs !. v' = Some p\<close> \<open>(ps' @ qs) !. v' = Some p\<close>
     using Copied(2) rev_nth_append by simp_all
   moreover have
     \<open>((ps' @ ps, a) # branch) !. w = Some (rs, b) \<or>
      ((ps' @ ps, a) # branch) !. w = Some (ps' @ rs, b)\<close>
     using Copied(6) by auto
   moreover have \<open>rs !. w' = Some p\<close> \<open>(ps' @ rs) !. w' = Some p\<close>
     using Copied(7) rev_nth_append by simp_all
   moreover have
     \<open>((ps' @ ps, a) # branch) !. w = Some (rs, b) \<or>
      ((ps' @ ps, a) # branch) !. w = Some (ps' @ rs, b)\<close>
     using Copied(6) by auto
   moreover have \<open>rs !. w' = Some p\<close> \<open>(ps' @ rs) !. w' = Some p\<close>
     using Copied(7) rev_nth_append by simp_all
   moreover have \<open>Nom j at b in (ps' @ ps, a) # branch\<close>
     using Copied(8) by fastforce
   moreover have \<open>Nom j at a' in (ps' @ ps, a) # branch\<close>
     using Copied(9) by fastforce
   ultimately show ?case
     using Copied(4-5) descendants.Copied[where branch=\<open>(ps' @ ps, a) # branch\<close>]
     by blast
 qed
 
 lemma descendants_no_head:
   assumes \<open>descendants k i ((ps, a) # branch) xs\<close>
   shows \<open>descendants k i ((p # ps, a) # branch) xs\<close>
   using assms descendants_block[where ps'=\<open>[_]\<close>] by simp
 
 lemma descendants_types:
   assumes
     \<open>descendants k i branch xs\<close> \<open>(v, v') \<in> xs\<close>
     \<open>branch !. v = Some (ps, a)\<close> \<open>ps !. v' = Some p\<close>
   shows \<open>p = (\<^bold>\<diamond> Nom k) \<or> (\<exists>q. p = (\<^bold>\<not> (\<^bold>@ k q)))\<close>
   using assms by (induct k i branch xs arbitrary: v v' ps a) fastforce+
 
 lemma descendants_oob_head':
   assumes \<open>descendants k i ((ps, a) # branch) xs\<close>
   shows \<open>(length branch, m + length ps) \<notin> xs\<close>
   using assms descendants_bounds_snd by fastforce
 
 lemma descendants_oob_head:
   assumes \<open>descendants k i ((ps, a) # branch) xs\<close>
   shows \<open>(length branch, length ps) \<notin> xs\<close>
   using assms descendants_oob_head'[where m=0] by fastforce
 
 subsection \<open>Induction\<close>
 
 text \<open>
   We induct over an arbitrary set of indices.
   That way, we can determine in each case whether the extension gets replaced or not
     by manipulating the set before applying the induction hypothesis.
 \<close>
 
 lemma ST_bridge':
   fixes a :: 'b
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>n \<turnstile> (ps, a) # branch\<close>
     \<open>descendants k i ((ps, a) # branch) xs\<close>
     \<open>Nom j at c in branch\<close> \<open>Nom k at c in branch\<close>
   shows \<open>\<turnstile> mapi_branch (bridge k j xs) ((ps, a) # branch)\<close>
   using assms(2-)
 proof (induct n \<open>(ps, a) # branch\<close> arbitrary: ps a branch xs rule: ST.induct)
   case (Close p i')
   let ?f = \<open>bridge k j xs\<close>
   let ?branch = \<open>mapi_branch ?f ((ps, a) # branch)\<close>
 
   obtain qs where qs: \<open>(qs, i') \<in>. (ps, a) # branch\<close> \<open>p on (qs, i')\<close>
     using Close(1) by blast
   obtain rs where rs: \<open>(rs, i') \<in>. (ps, a) # branch\<close> \<open>(\<^bold>\<not> p) on (rs, i')\<close>
     using Close(2) by blast
 
   obtain v where v: \<open>(mapi (?f v) qs, i') \<in>. ?branch\<close>
     using qs mapi_branch_mem by fast
   obtain w where w: \<open>(mapi (?f w) rs, i') \<in>. ?branch\<close>
     using rs mapi_branch_mem by fast
 
   have j: \<open>Nom j at c in ?branch\<close>
     using Close(4) nom_at_in_bridge unfolding mapi_branch_def by fastforce
   have k: \<open>Nom k at c in ?branch\<close>
     using Close(5) nom_at_in_bridge unfolding mapi_branch_def by fastforce
 
   show ?case
   proof (cases \<open>\<exists>a. p = Nom a\<close>)
     case True
     then have \<open>p on (mapi (?f v) qs, i')\<close>
       using qs bridge_on_Nom by fast
     moreover have \<open>(\<^bold>\<not> p) on (mapi (?f w) rs, i')\<close>
       using rs(2) True by (induct rs) auto
     ultimately show ?thesis
       using v w ST.Close by fast
   next
     case False
     then obtain v' where \<open>qs !. v' = Some p\<close>
       using qs rev_nth_on by fast
     then have qs': \<open>(?f v v' p) on (mapi (?f v) qs, i')\<close>
       using rev_nth_mapi_block by fast
 
     then obtain w' where \<open>rs !. w' = Some (\<^bold>\<not> p)\<close>
       using rs rev_nth_on by fast
     then have rs': \<open>(?f w w' (\<^bold>\<not> p)) on (mapi (?f w) rs, i')\<close>
       using rev_nth_mapi_block by fast
 
     obtain q q' where q: \<open>?f v v' p = q\<close> and q': \<open>?f w w' (\<^bold>\<not> p) = q'\<close>
       by simp_all
     then consider
       (dia) \<open>q = (\<^bold>\<diamond> Nom j)\<close> \<open>q' = (\<^bold>\<not> (\<^bold>\<diamond> Nom k))\<close> |
       (satn)\<open>\<exists>r. q = (\<^bold>\<not> (\<^bold>@ j r)) \<and> q' = (\<^bold>\<not> \<^bold>\<not> (\<^bold>@ k r))\<close> |
       (sat) \<open>\<exists>r. q = (\<^bold>@ k r) \<and> q' = (\<^bold>\<not> (\<^bold>@ j r))\<close> |
       (old) \<open>q = p\<close> \<open>q' = (\<^bold>\<not> p)\<close>
       using bridge_compl_cases by fast
     then show ?thesis
     proof cases
       case dia
       then have *:
         \<open>(\<^bold>\<diamond> Nom j) on (mapi (?f v) qs, i')\<close>
         \<open>(\<^bold>\<not> (\<^bold>\<diamond> Nom k)) on (mapi (?f w) rs, i')\<close>
         using q qs' q' rs' by simp_all
 
       have \<open>i' \<in> branch_nominals ?branch\<close>
         unfolding branch_nominals_def using v by fastforce
       then have ?thesis if \<open>\<turnstile> ([], i') # ?branch\<close>
         using that GoTo by fast
       moreover have \<open>(mapi (?f v) qs, i') \<in>. ([], i') # ?branch\<close>
         using v by simp
       moreover have \<open>(mapi (?f w) rs, i') \<in>. ([], i') # ?branch\<close>
         using w by simp
       ultimately have ?thesis if \<open>\<turnstile> ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using that * by (meson DiaN')
       moreover have \<open>j \<in> branch_nominals (([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch)\<close>
         unfolding branch_nominals_def by simp
       ultimately have ?thesis if \<open>\<turnstile> ([], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using that GoTo by fast
       moreover have \<open>Nom j at c in ([], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using j by auto
       moreover have \<open>Nom k at c in ([], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using k by auto
       ultimately have ?thesis if \<open>\<turnstile> ([Nom k], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using that by (meson Nom' list.set_intros(1) on.simps)
       moreover have \<open>(\<^bold>\<not> (\<^bold>@ j (Nom k))) at i' in ([Nom k], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         by fastforce
       ultimately have ?thesis if \<open>\<turnstile> ([\<^bold>\<not> Nom k, Nom k], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         using that SatN' by fast
       moreover have \<open>Nom k at j in ([\<^bold>\<not> Nom k, Nom k], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         by fastforce
       moreover have \<open>(\<^bold>\<not> Nom k) at j in ([\<^bold>\<not> Nom k, Nom k], j) # ([\<^bold>\<not> (\<^bold>@ j (Nom k))], i') # ?branch\<close>
         by fastforce
       ultimately show ?thesis
         using ST.Close by fast
     next
       case satn
       then obtain r where *:
         \<open>(\<^bold>\<not> (\<^bold>@ j r)) on (mapi (?f v) qs, i')\<close>
         \<open>(\<^bold>\<not> \<^bold>\<not> (\<^bold>@ k r)) on (mapi (?f w) rs, i')\<close>
         using q qs' q' rs' by auto
 
       have \<open>i' \<in> branch_nominals ?branch\<close>
         unfolding branch_nominals_def using v by fastforce
       then have ?thesis if \<open>\<turnstile> ([], i') # ?branch\<close>
         using that GoTo by fast
       moreover have \<open>(mapi (?f w) rs, i') \<in>. ([], i') # ?branch\<close>
         using w by simp
       ultimately have ?thesis if \<open>\<turnstile> ([\<^bold>@ k r], i') # ?branch\<close>
         using that *(2) by (meson Neg')
       moreover have \<open>j \<in> branch_nominals (([\<^bold>@ k r], i') # ?branch)\<close>
         unfolding branch_nominals_def using j by fastforce
       ultimately have ?thesis if \<open>\<turnstile> ([], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using that j GoTo by fast
       moreover have
         \<open>Nom j at c in ([], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         \<open>Nom k at c in ([], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using j k by auto
       ultimately have ?thesis if \<open>\<turnstile> ([Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using that by (meson Nom' list.set_intros(1) on.simps)
       then have ?thesis if \<open>\<turnstile> ([r, Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using that inf by (meson SatP'' list.set_intros(1) list.set_intros(2) on.simps)
       moreover have \<open>(mapi (?f v) qs, i') \<in>. ([r, Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using v by simp
       ultimately have ?thesis if \<open>\<turnstile> ([\<^bold>\<not> r, r, Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         using that *(1) by (meson SatN')
       moreover have \<open>r at j in ([\<^bold>\<not> r, r, Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         by fastforce
       moreover have \<open>(\<^bold>\<not> r) at j in ([\<^bold>\<not> r, r, Nom k], j) # ([\<^bold>@ k r], i') # ?branch\<close>
         by fastforce
       ultimately show ?thesis
         using ST.Close by fast
     next
       case sat
       then obtain r where *:
         \<open>(\<^bold>@ k r) on (mapi (?f v) qs, i')\<close>
         \<open>(\<^bold>\<not> (\<^bold>@ j r)) on (mapi (?f w) rs, i')\<close>
         using q qs' q' rs' by auto
 
       have \<open>j \<in> branch_nominals ?branch\<close>
         unfolding branch_nominals_def using j by fastforce
       then have ?thesis if \<open>\<turnstile> ([], j) # ?branch\<close>
         using that GoTo by fast
       moreover have \<open>Nom j at c in ([], j) # ?branch\<close> \<open>Nom k at c in ([], j) # ?branch\<close>
         using j k by auto
       ultimately have ?thesis if \<open>\<turnstile> ([Nom k], j) # ?branch\<close>
         using that by (meson Nom' list.set_intros(1) on.simps)
       moreover have \<open>(mapi (?f v) qs, i') \<in>. ([Nom k], j) # ?branch\<close>
         using v by simp
       ultimately have ?thesis if \<open>\<turnstile> ([r, Nom k], j) # ?branch\<close>
         using that *(1) inf by (meson SatP'' list.set_intros(1) on.simps)
       moreover have \<open>(mapi (?f w) rs, i') \<in>. ([r, Nom k], j) # ?branch\<close>
         using w by simp
       ultimately have ?thesis if \<open>\<turnstile> ([\<^bold>\<not> r, r, Nom k], j) # ?branch\<close>
         using that *(2) by (meson SatN')
       moreover have \<open>r at j in ([\<^bold>\<not> r, r, Nom k], j) # ?branch\<close>
         by fastforce
       moreover have \<open>(\<^bold>\<not> r) at j in ([\<^bold>\<not> r, r, Nom k], j) # ?branch\<close>
         by fastforce
       ultimately show ?thesis
         using ST.Close by fast
     next
       case old
       then have \<open>p on (mapi (?f v) qs, i')\<close> \<open>(\<^bold>\<not> p) on (mapi (?f w) rs, i')\<close>
         using q qs' q' rs' by simp_all
       then show ?thesis
         using v w ST.Close[where p=p and i=i'] by fast
     qed
   qed
 next
   case (Neg p a ps branch)
   let ?f = \<open>bridge k j xs\<close>
   have p: \<open>?f l l' (\<^bold>\<not> \<^bold>\<not> p) = (\<^bold>\<not> \<^bold>\<not> p)\<close> for l l'
     by simp
 
   have \<open>descendants k i ((p # ps, a) # branch) xs\<close>
     using Neg(5) descendants_no_head by fast
   then have \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
     using Neg(4-) by blast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using Neg(5) descendants_oob_head by fast
   ultimately have \<open>\<turnstile> (p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def by simp
   moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>\<not> \<^bold>\<not> p) at a in mapi_branch ?f ((ps, a) # branch)\<close>
     using Neg(1) at_in_mapi_branch by fast
   then have \<open>(\<^bold>\<not> \<^bold>\<not> p) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using p by simp
   ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     using Neg' by fast
   then show ?case
     unfolding mapi_branch_def by auto
 next
   case (DisP p q a ps branch)
   let ?f = \<open>bridge k j xs\<close>
   have p: \<open>?f l l' (p \<^bold>\<or> q) = (p \<^bold>\<or> q)\<close> for l l'
     by simp
 
   have
     \<open>descendants k i ((p # ps, a) # branch) xs\<close>
     \<open>descendants k i ((q # ps, a) # branch) xs\<close>
     using DisP(8) descendants_no_head by fast+
   then have
     \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
     \<open>\<turnstile> mapi_branch ?f ((q # ps, a) # branch)\<close>
     using DisP(5-) by blast+
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DisP(8) descendants_oob_head by fast
   ultimately have
     \<open>\<turnstile> (p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     \<open>\<turnstile> (q # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def by simp_all
   moreover have \<open>\<exists>l l'. ?f l l' (p \<^bold>\<or> q) at a in mapi_branch ?f ((ps, a) # branch)\<close>
     using DisP(1) at_in_mapi_branch by fast
   then have \<open>(p \<^bold>\<or> q) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using p by simp
   ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     using DisP'' by fast
   then show ?case
     unfolding mapi_branch_def by auto
 next
   case (DisN p q a ps branch)
   let ?f = \<open>bridge k j xs\<close>
   have p: \<open>?f l l' (\<^bold>\<not> (p \<^bold>\<or> q)) = (\<^bold>\<not> (p \<^bold>\<or> q))\<close> for l l'
     by simp
 
   have \<open>descendants k i (((\<^bold>\<not> p) # ps, a) # branch) xs\<close>
     using DisN(5) descendants_no_head by fast
   then have \<open>descendants k i (((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch) xs\<close>
     using descendants_no_head by fast
   then have \<open>\<turnstile> mapi_branch ?f (((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, a) # branch)\<close>
     using DisN(4-) by blast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using DisN(5) descendants_oob_head by fast
   moreover have \<open>(length branch, 1 + length ps) \<notin> xs\<close>
     using DisN(5) descendants_oob_head' by fast
   ultimately have \<open>\<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def by simp
   moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>\<not> (p \<^bold>\<or> q)) at a in mapi_branch ?f ((ps, a) # branch)\<close>
     using DisN(1) at_in_mapi_branch by fast
   then have \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using p by simp
   ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     using DisN' by fast
   then show ?case
     unfolding mapi_branch_def by auto
 next
   case (DiaP p a ps branch i')
   let ?f = \<open>bridge k j xs\<close>
   have p: \<open>?f l l' (\<^bold>\<diamond> p) = (\<^bold>\<diamond> p)\<close> for l l'
     using DiaP(3) bridge_proper_dia by fast
 
   have \<open>branch_nominals (mapi_branch ?f ((ps, a) # branch)) = branch_nominals ((ps, a) # branch)\<close>
     using DiaP(8-) nominals_mapi_branch_bridge[where j=j and k=k and branch=\<open>(ps, a) # branch\<close>]
     by auto
   then have i': \<open>i' \<notin> branch_nominals ((mapi (?f (length branch)) ps, a) # mapi_branch ?f branch)\<close>
     unfolding mapi_branch_def using DiaP(2) by simp
 
   have 1: \<open>?f (length branch) (1 + length ps) (\<^bold>@ i' p) = (\<^bold>@ i' p)\<close>
     by simp
   have \<open>i' \<noteq> k\<close>
     using DiaP(2, 8-) unfolding branch_nominals_def by fastforce
   then have 2: \<open>?f (length branch) (length ps) (\<^bold>\<diamond> Nom i') = (\<^bold>\<diamond> Nom i')\<close>
     by simp
 
   have \<open>descendants k i (((\<^bold>@ i' p) # (\<^bold>\<diamond> Nom i') # ps, a) # branch) xs\<close>
     using DiaP(7) descendants_block[where ps'=\<open>[_, _]\<close>] by fastforce
   then have \<open>\<turnstile> mapi_branch ?f (((\<^bold>@ i' p) # (\<^bold>\<diamond> Nom i') # ps, a) # branch)\<close>
     using DiaP(4-) by blast
   then have \<open>\<turnstile> ((\<^bold>@ i' p) # (\<^bold>\<diamond> Nom i') # mapi (?f (length branch)) ps, a) #
       mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using 1 by (simp add: 2)
   moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>\<diamond> p) at a in mapi_branch ?f ((ps, a) # branch)\<close>
     using DiaP(1) at_in_mapi_branch by fast
   then have \<open>(\<^bold>\<diamond> p) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using p by simp
   ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     using i' DiaP(3) DiaP' by fast
   then show ?case
     unfolding mapi_branch_def by simp
 next
   case (DiaN p a ps branch i')
   have p: \<open>bridge k j xs l l' (\<^bold>\<not> (\<^bold>\<diamond> p)) = (\<^bold>\<not> (\<^bold>\<diamond> p))\<close> for xs l l'
     by simp
 
   obtain rs where rs: \<open>(rs, a) \<in>. (ps, a) # branch\<close> \<open>(\<^bold>\<diamond> Nom i') on (rs, a)\<close>
     using DiaN(2) by fast
   obtain v where v: \<open>((ps, a) # branch) !. v = Some (rs, a)\<close>
     using rs(1) rev_nth_mem by fast
   obtain v' where v': \<open>rs !. v' = Some (\<^bold>\<diamond> Nom i')\<close>
     using rs(2) rev_nth_on by fast
 
   show ?case
   proof (cases \<open>(v, v') \<in> xs\<close>)
     case True
     then have \<open>i' = k\<close>
       using DiaN(6) v v' descendants_types by fast
 
     let ?xs = \<open>{(length branch, length ps)} \<union> xs\<close>
     let ?f = \<open>bridge k j ?xs\<close>
     let ?branch = \<open>((\<^bold>\<not> (\<^bold>@ i' p)) # ps, a) # branch\<close>
 
     obtain rs' where
       \<open>(((\<^bold>\<not> (\<^bold>@ k p)) # ps, a) # branch) !. v = Some (rs', a)\<close>
       \<open>rs' !. v' = Some (\<^bold>\<diamond> Nom i')\<close>
       using v v' index_Cons by fast
     moreover have \<open>descendants k i (((\<^bold>\<not> (\<^bold>@ k p)) # ps, a) # branch) xs\<close>
       using DiaN(6) descendants_block[where ps'=\<open>[_]\<close>] by fastforce
     moreover have \<open>?branch !. length branch = Some ((\<^bold>\<not> (\<^bold>@ k p)) # ps, a)\<close>
       using \<open>i' = k\<close> by simp
     moreover have \<open>((\<^bold>\<not> (\<^bold>@ k p)) # ps) !. length ps = Some (\<^bold>\<not> (\<^bold>@ k p))\<close>
       by simp
     ultimately have \<open>descendants k i (((\<^bold>\<not> (\<^bold>@ k p)) # ps, a) # branch) ?xs\<close>
       using True \<open>i' = k\<close> Derived[where branch=\<open>_ # branch\<close>] by simp
 
     then have \<open>\<turnstile> mapi_branch ?f (((\<^bold>\<not> (\<^bold>@ k p)) # ps, a) # branch)\<close>
       using \<open>i' = k\<close> DiaN(5-) by blast
     then have \<open>\<turnstile> ((\<^bold>\<not> (\<^bold>@ j p)) # mapi (?f (length branch)) ps, a) #
         mapi_branch (bridge k j ?xs) branch\<close>
       unfolding mapi_branch_def using \<open>i' = k\<close> by simp
     moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>\<not> (\<^bold>\<diamond> p)) at a in mapi_branch ?f ((ps, a) # branch)\<close>
       using DiaN(1) at_in_mapi_branch by fast
     then have \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def using p[where xs=\<open>?xs\<close>] by simp
     moreover have \<open>(mapi (?f v) rs, a) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
       using v rev_nth_mapi_branch by fast
     then have \<open>(mapi (?f v) rs, a) \<in>
         set ((mapi (?f (length branch)) ps, a) # mapi_branch ?f branch)\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>?f v v' (\<^bold>\<diamond> Nom i') on (mapi (?f v) rs, a)\<close>
       using v' rev_nth_mapi_block by fast
     then have \<open>(\<^bold>\<diamond> Nom j) on (mapi (?f v) rs, a)\<close>
       using True \<open>i' = k\<close> by simp
     ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       by (meson DiaN')
     then have \<open>\<turnstile> (mapi (bridge k j xs (length branch)) ps, a) #
         mapi_branch (bridge k j xs) branch\<close>
       using mapi_branch_head_add_oob[where branch=branch and ps=ps] unfolding mapi_branch_def
       by simp
     then show ?thesis
       unfolding mapi_branch_def by simp
   next
     case False
     let ?f = \<open>bridge k j xs\<close>
 
     have \<open>descendants k i (((\<^bold>\<not> (\<^bold>@ i' p)) # ps, a) # branch) xs\<close>
       using DiaN(6) descendants_no_head by fast
     then have \<open>\<turnstile> mapi_branch ?f (((\<^bold>\<not> (\<^bold>@ i' p)) # ps, a) # branch)\<close>
       using DiaN(5-) by blast
     moreover have \<open>(length branch, length ps) \<notin> xs\<close>
       using DiaN(6) descendants_oob_head by fast
     ultimately have \<open>\<turnstile> ((\<^bold>\<not> (\<^bold>@ i' p)) # mapi (?f (length branch)) ps, a) #
         mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>\<not> (\<^bold>\<diamond> p)) at a in mapi_branch ?f ((ps, a) # branch)\<close>
       using DiaN(1) at_in_mapi_branch by fast
     then have \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def using p[where xs=\<open>xs\<close>] by simp
     moreover have \<open>(mapi (?f v) rs, a) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
       using v rev_nth_mapi_branch by fast
     then have \<open>(mapi (?f v) rs, a) \<in>
         set ((mapi (?f (length branch)) ps, a) # mapi_branch ?f branch)\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>?f v v' (\<^bold>\<diamond> Nom i') on (mapi (?f v) rs, a)\<close>
       using v' rev_nth_mapi_block by fast
     then have \<open>(\<^bold>\<diamond> Nom i') on (mapi (?f v) rs, a)\<close>
       using False by simp
     ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       by (meson DiaN')
     then show ?thesis
       unfolding mapi_branch_def by simp
   qed
 next
   case (SatP a p b ps branch)
   let ?f = \<open>bridge k j xs\<close>
   have p: \<open>?f l l' (\<^bold>@ a p) = (\<^bold>@ a p)\<close> for l l'
     by simp
 
   have \<open>descendants k i ((p # ps, a) # branch) xs\<close>
     using SatP(5) descendants_no_head by fast
   then have \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
     using SatP(4-) by blast
   moreover have \<open>(length branch, length ps) \<notin> xs\<close>
     using SatP(5) descendants_oob_head by fast
   ultimately have \<open>\<turnstile> (p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def by simp
   moreover have \<open>\<exists>l l'. ?f l l' (\<^bold>@ a p) at b in mapi_branch ?f ((ps, a) # branch)\<close>
     using SatP(1) at_in_mapi_branch by fast
   then have \<open>(\<^bold>@ a p) at b in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     unfolding mapi_branch_def using p by simp
   ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
     using SatP' by fast
   then show ?case
     unfolding mapi_branch_def by simp
 next
   case (SatN a p b ps branch)
   obtain qs where qs: \<open>(qs, b) \<in>. (ps, a) # branch\<close> \<open>(\<^bold>\<not> (\<^bold>@ a p)) on (qs, b)\<close>
     using SatN(1) by fast
   obtain v where v: \<open>((ps, a) # branch) !. v = Some (qs, b)\<close>
     using qs(1) rev_nth_mem by fast
   obtain v' where v': \<open>qs !. v' = Some (\<^bold>\<not> (\<^bold>@ a p))\<close>
     using qs(2) rev_nth_on by fast
 
   show ?case
   proof (cases \<open>(v, v') \<in> xs\<close>)
     case True
     then have \<open>a = k\<close>
       using SatN(5) v v' descendants_types by fast
 
     let ?f = \<open>bridge k j xs\<close>
     let ?branch = \<open>((\<^bold>\<not> p) # ps, a) # branch\<close>
     have p: \<open>?f v v' (\<^bold>\<not> (\<^bold>@ k p)) = (\<^bold>\<not> (\<^bold>@ j p))\<close>
       using True by simp
 
     obtain rs' where
       \<open>?branch !. v = Some (rs', b)\<close>
       \<open>rs' !. v' = Some (\<^bold>\<not> (\<^bold>@ k p))\<close>
       using v v' \<open>a = k\<close> index_Cons by fast
     have \<open>descendants k i ?branch xs\<close>
       using SatN(5) descendants_no_head by fast
     then have \<open>\<turnstile> mapi_branch ?f ?branch\<close>
       using \<open>a = k\<close> SatN(4-) by blast
     moreover have \<open>(length branch, length ps) \<notin> xs\<close>
       using SatN(5) descendants_oob_head by fast
     ultimately have \<open>\<turnstile> ((\<^bold>\<not> p) # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def using \<open>a = k\<close> by simp
     then have *: \<open>\<turnstile> ((\<^bold>\<not> p) # Nom j # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using inf ST_struct_block[where ps'=\<open>(\<^bold>\<not> p) # Nom j # _\<close>] by fastforce
 
     have \<open>(mapi (?f v) qs, b) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
       using v rev_nth_mapi_branch by fast
     then have \<open>(mapi (?f v) qs, b) \<in>
         set ((mapi (?f (length branch)) ps, a) # mapi_branch ?f branch)\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>?f v v' (\<^bold>\<not> (\<^bold>@ k p)) on (mapi (?f v) qs, b)\<close>
       using v' \<open>a = k\<close> rev_nth_mapi_block by fast
     then have \<open>(\<^bold>\<not> (\<^bold>@ j p)) on (mapi (?f v) qs, b)\<close>
       using p by simp
     ultimately obtain qs' where
       \<open>(qs', b) \<in>. (Nom j # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       \<open>(\<^bold>\<not> (\<^bold>@ j p)) on (qs', b)\<close>
       by fastforce
     then have \<open>\<turnstile> (Nom j # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using * inf by (meson SatN'' list.set_intros(1) on.simps)
 
     moreover have \<open>Nom j at c in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using SatN(6) nom_at_in_bridge unfolding mapi_branch_def by fastforce
     moreover have \<open>Nom k at c in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using SatN(7) nom_at_in_bridge unfolding mapi_branch_def by fastforce
     ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using \<open>a = k\<close> by (meson Nom' list.set_intros(1) on.simps)
     then show ?thesis
       unfolding mapi_branch_def by simp
   next
     case False
     let ?f = \<open>bridge k j xs\<close>
 
     have \<open>descendants k i (((\<^bold>\<not> p) # ps, a) # branch) xs\<close>
       using SatN(5) descendants_no_head by fast
     then have \<open>\<turnstile> mapi_branch (bridge k j xs) (((\<^bold>\<not> p) # ps, a) # branch)\<close>
       using SatN(4-) by blast
     moreover have \<open>(length branch, length ps) \<notin> xs\<close>
       using SatN(5) descendants_oob_head by fast
     ultimately have \<open>\<turnstile> ((\<^bold>\<not> p) # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>(mapi (?f v) qs, b) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
       using v rev_nth_mapi_branch by fast
     then have \<open>(mapi (?f v) qs, b) \<in>
         set ((mapi (?f (length branch)) ps, a) # mapi_branch ?f branch)\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>?f v v' (\<^bold>\<not> (\<^bold>@ a p)) on (mapi (?f v) qs, b)\<close>
       using v' rev_nth_mapi_block by fast
     then have \<open>(\<^bold>\<not> (\<^bold>@ a p)) on (mapi (?f v) qs, b)\<close>
       using False by simp
     ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       by (meson SatN')
     then show ?thesis
       unfolding mapi_branch_def by simp
   qed
 next
   case (GoTo i' n ps a branch)
   let ?f = \<open>bridge k j xs\<close>
 
   have \<open>descendants k i (([], i') # (ps, a) # branch) xs\<close>
     using GoTo(4) descendants_branch[where extra=\<open>[_]\<close>] by simp
   then have \<open>\<turnstile> mapi_branch ?f (([], i') # (ps, a) # branch)\<close>
     using GoTo(3, 5-) by auto
   then have \<open>\<turnstile> ([], i') # mapi_branch ?f ((ps, a) # branch)\<close>
     unfolding mapi_branch_def by simp
   moreover have
     \<open>branch_nominals (mapi_branch ?f ((ps, a) # branch)) = branch_nominals ((ps, a) # branch)\<close>
     using GoTo(5-) nominals_mapi_branch_bridge[where j=j and k=k and branch=\<open>(ps, a) # branch\<close>]
     by auto
   then have \<open>i' \<in> branch_nominals (mapi_branch (bridge k j xs) ((ps, a) # branch))\<close>
     using GoTo(1) by blast
   ultimately show ?case
     using ST.GoTo by fast
 next
   case (Nom p b ps a branch i')
   show ?case
   proof (cases \<open>\<exists>j. p = Nom j\<close>)
     case True
     let ?f = \<open>bridge k j xs\<close>
 
     have \<open>descendants k i ((p # ps, a) # branch) xs\<close>
       using Nom(7) descendants_block[where ps'=\<open>[p]\<close>] by simp
     then have \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
       using Nom(6-) by blast
     moreover have \<open>?f (length branch) (length ps) p = p\<close>
       using True by auto
     ultimately have \<open>\<turnstile> (p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>p at b in mapi_branch ?f ((ps, a) # branch)\<close>
       using Nom(1) True nom_at_in_bridge by fast
     then have \<open>p at b in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>Nom i' at b in mapi_branch ?f ((ps, a) # branch)\<close>
       using Nom(2) True nom_at_in_bridge by fast
     then have \<open>Nom i' at b in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     moreover have \<open>Nom i' at a in mapi_branch ?f ((ps, a) # branch)\<close>
       using Nom(3) True nom_at_in_bridge by fast
     then have \<open>Nom i' at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       unfolding mapi_branch_def by simp
     ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
       using Nom' by fast
     then show ?thesis
       unfolding mapi_branch_def by simp
   next
     case False
     obtain qs where qs: \<open>(qs, b) \<in>. (ps, a) # branch\<close> \<open>p on (qs, b)\<close>
       using Nom(1) by blast
     obtain v where v: \<open>((ps, a) # branch) !. v = Some (qs, b)\<close>
       using qs(1) rev_nth_mem by fast
     obtain v' where v': \<open>qs !. v' = Some p\<close>
       using qs(2) False rev_nth_on by fast
 
     show ?thesis
     proof (cases \<open>(v, v') \<in> xs\<close>)
       case True
       let ?xs = \<open>{(length branch, length ps)} \<union> xs\<close>
       let ?f = \<open>bridge k j ?xs\<close>
 
       let ?p = \<open>bridge' k j p\<close>
       have p: \<open>?f v v' p = ?p\<close>
         using True by simp
 
       obtain qs' where
         \<open>((p # ps, a) # branch) !. v = Some (qs', b)\<close>
         \<open>qs' !. v' = Some p\<close>
         using v v' index_Cons by fast
       moreover have \<open>Nom i' at b in (p # ps, a) # branch\<close>
         using Nom(2) by fastforce
       moreover have \<open>descendants k i ((p # ps, a) # branch) xs\<close>
         using Nom(7) descendants_block[where ps'=\<open>[p]\<close>] by simp
       moreover have
         \<open>((p # ps, a) # branch) !. length branch = Some (p # ps, a)\<close>
         \<open>(p # ps) !. length ps = Some p\<close>
         by simp_all
       moreover have \<open>Nom i' at a in (p # ps, a) # branch\<close>
         using Nom(3) by fastforce
       ultimately have \<open>descendants k i ((p # ps, a) # branch) ?xs\<close>
         using True Copied by fast
       then have \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
         using Nom(6-) by blast
       then have \<open>\<turnstile> (?p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
 
       moreover have \<open>(mapi (?f v) qs, b) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
         using v rev_nth_mapi_branch by fast
       then have \<open>(mapi (?f v) qs, b) \<in>. (mapi (?f (length branch)) ps, a) #
           mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       moreover have \<open>?f v v' p on (mapi (?f v) qs, b)\<close>
         using v v' rev_nth_mapi_block by fast
       then have \<open>?p on (mapi (?f v) qs, b)\<close>
         using p by simp
 
       moreover have \<open>Nom i' at b in mapi_branch ?f ((ps, a) # branch)\<close>
         using Nom(2) nom_at_in_bridge by fast
       then have \<open>Nom i' at b in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       moreover have \<open>Nom i' at a in mapi_branch ?f ((ps, a) # branch)\<close>
         using Nom(3) nom_at_in_bridge by fast
       then have \<open>Nom i' at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         using Nom' by fast
       then have \<open>\<turnstile> (mapi (bridge k j xs (length branch)) ps, a) #
           mapi_branch (bridge k j xs) branch\<close>
         using mapi_branch_head_add_oob[where branch=branch and ps=ps]
         unfolding mapi_branch_def by simp
       then show ?thesis
         unfolding mapi_branch_def by simp
     next
       case False
       let ?f = \<open>bridge k j xs\<close>
 
       have \<open>descendants k i ((p # ps, a) # branch) xs\<close>
         using Nom(7) descendants_no_head by fast
       then have \<open>\<turnstile> mapi_branch ?f ((p # ps, a) # branch)\<close>
         using Nom(6-) by blast
       moreover have \<open>(length branch, length ps) \<notin> xs\<close>
         using Nom(7) descendants_oob_head by fast
       ultimately have \<open>\<turnstile> (p # mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
 
       moreover have \<open>(mapi (?f v) qs, b) \<in>. mapi_branch ?f ((ps, a) # branch)\<close>
         using v rev_nth_mapi_branch by fast
       then have \<open>(mapi (?f v) qs, b) \<in>. (mapi (?f (length branch)) ps, a) #
           mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       moreover have \<open>?f v v' p on (mapi (?f v) qs, b)\<close>
         using v v' rev_nth_mapi_block by fast
       then have \<open>p on (mapi (?f v) qs, b)\<close>
         using False by simp
       moreover have \<open>Nom i' at b in mapi_branch ?f ((ps, a) # branch)\<close>
         using Nom(2) nom_at_in_bridge by fast
       then have \<open>Nom i' at b in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       moreover have \<open>Nom i' at a in mapi_branch ?f ((ps, a) # branch)\<close>
         using Nom(3) nom_at_in_bridge by fast
       then have \<open>Nom i' at a in (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         unfolding mapi_branch_def by simp
       ultimately have \<open>\<turnstile> (mapi (?f (length branch)) ps, a) # mapi_branch ?f branch\<close>
         using Nom' by fast
       then show ?thesis
         unfolding mapi_branch_def by simp
     qed
   qed
 qed
 
 lemma ST_bridge:
   fixes i :: 'b
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>\<turnstile> branch\<close> \<open>descendants k i branch xs\<close>
     \<open>Nom j at c in branch\<close> \<open>Nom k at c in branch\<close>
   shows \<open>\<turnstile> mapi_branch (bridge k j xs) branch\<close>
 proof -
   have \<open>\<turnstile> ([], j) # branch\<close>
     using inf assms(2) ST_struct[where branch'=\<open>([], j) # branch\<close>] by auto
   moreover have \<open>descendants k i (([], j) # branch) xs\<close>
     using assms(3) descendants_branch[where extra=\<open>[_]\<close>] by fastforce
   ultimately have \<open>\<turnstile> mapi_branch (bridge k j xs) (([], j) # branch)\<close>
     using ST_bridge' inf assms(3-) by fast
   then have *: \<open>\<turnstile> ([], j) # mapi_branch (bridge k j xs) branch\<close>
     unfolding mapi_branch_def by simp
   have \<open>branch_nominals (mapi_branch (bridge k j xs) branch) = branch_nominals branch\<close>
     using nominals_mapi_branch_bridge assms(4-) by fast
   moreover have \<open>j \<in> branch_nominals branch\<close>
     using assms(4) unfolding branch_nominals_def by fastforce
   ultimately have \<open>j \<in> branch_nominals (mapi_branch (bridge k j xs) branch)\<close>
     by simp
   then show ?thesis
     using * GoTo by fast
 qed
 
 subsection \<open>Derivation\<close>
 
 theorem Bridge:
   fixes i :: 'b
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>Nom i at b in branch\<close> \<open>(\<^bold>\<diamond> Nom j) at b in branch\<close> \<open>Nom i at a in branch\<close>
     \<open>Nom j at c in branch\<close> \<open>Nom k at c in branch\<close>
     \<open>\<turnstile> ((\<^bold>\<diamond> Nom k) # ps, a) # branch\<close>
   shows \<open>\<turnstile> (ps, a) # branch\<close>
 proof -
   let ?xs = \<open>{(length branch, length ps)}\<close>
 
   have \<open>descendants k a (((\<^bold>\<diamond> Nom k) # ps, a) # branch) ?xs\<close>
     using Initial by force
   moreover have
     \<open>Nom j at c in ((\<^bold>\<diamond> Nom k) # ps, a) # branch\<close>
     \<open>Nom k at c in ((\<^bold>\<diamond> Nom k) # ps, a) # branch\<close>
     using assms(5-6) by auto
   ultimately have
     \<open>\<turnstile> mapi_branch (bridge k j ?xs) (((\<^bold>\<diamond> Nom k) # ps, a) # branch)\<close>
     using ST_bridge inf assms(7) by fast
   then have \<open>\<turnstile> ((\<^bold>\<diamond> Nom j) # mapi (bridge k j ?xs (length branch)) ps, a) #
       mapi_branch (bridge k j ?xs) branch\<close>
     unfolding mapi_branch_def by simp
   moreover have \<open>mapi_branch (bridge k j {(length branch, length ps)}) branch =
       mapi_branch (bridge k j {}) branch\<close>
     using mapi_branch_add_oob[where xs=\<open>{}\<close>] by fastforce
   moreover have \<open>mapi (bridge k j ?xs (length branch)) ps =
     mapi (bridge k j {} (length branch)) ps\<close>
     using mapi_block_add_oob[where xs=\<open>{}\<close> and ps=ps] by simp
   ultimately have \<open>\<turnstile> ((\<^bold>\<diamond> Nom j) # ps, a) # branch\<close>
     using mapi_block_id[where ps=ps] mapi_branch_id[where branch=branch] by simp
   then show ?thesis
     using assms(2-5) by (meson Nom' set_subset_Cons subsetD)
 qed
 
 section \<open>Completeness\<close>
 
 subsection \<open>Hintikka\<close>
 
 abbreviation at_in' :: \<open>('a, 'b) fm \<Rightarrow> 'b \<Rightarrow> ('a, 'b) block set \<Rightarrow> bool\<close>
-  (\<open>_ at _ in' _\<close> [51, 51, 51] 50) where
+  (\<open>_ at _ in'' _\<close> [51, 51, 51] 50) where
   \<open>p at a in' branch \<equiv> \<exists>ps. (ps, a) \<in> branch \<and> p on (ps, a)\<close>
 
 text \<open>
   A set of blocks is Hintikka if it satisfies the following requirements.
   Intuitively, if it corresponds to an exhausted open branch.
 \<close>
 
 definition hintikka :: \<open>('a, 'b) block set \<Rightarrow> bool\<close> where
   \<open>hintikka H \<equiv>
     (\<forall>x i j. Nom j at i in' H \<longrightarrow> Pro x at j in' H \<longrightarrow>
       \<not> (\<^bold>\<not> Pro x) at i in' H) \<and>
     (\<forall>a i. Nom a at i in' H \<longrightarrow>
       \<not> (\<^bold>\<not> Nom a) at i in' H) \<and>
     (\<forall>i j. (\<^bold>\<diamond> Nom j) at i in' H \<longrightarrow>
       \<not> (\<^bold>\<not> (\<^bold>\<diamond> Nom j)) at i in' H) \<and>
     (\<forall>p i. i \<in> nominals p \<longrightarrow> (\<exists>block \<in> H. p on block) \<longrightarrow>
       (\<exists>ps. (ps, i) \<in> H)) \<and>
     (\<forall>i j. Nom j at i in' H \<longrightarrow>
       Nom i at j in' H) \<and>
     (\<forall>i j k. Nom j at i in' H \<longrightarrow> Nom k at j in' H \<longrightarrow>
       Nom k at i in' H) \<and>
     (\<forall>i j k. (\<^bold>\<diamond> Nom j) at i in' H \<longrightarrow> Nom k at j in' H \<longrightarrow>
       (\<^bold>\<diamond> Nom k) at i in' H) \<and>
     (\<forall>i j k. (\<^bold>\<diamond> Nom j) at i in' H \<longrightarrow> Nom k at i in' H \<longrightarrow>
       (\<^bold>\<diamond> Nom j) at k in' H) \<and>
     (\<forall>p q i. (p \<^bold>\<or> q) at i in' H \<longrightarrow>
       p at i in' H \<or> q at i in' H) \<and>
     (\<forall>p q i. (\<^bold>\<not> (p \<^bold>\<or> q)) at i in' H \<longrightarrow>
       (\<^bold>\<not> p) at i in' H \<and> (\<^bold>\<not> q) at i in' H) \<and>
     (\<forall>p i. (\<^bold>\<not> \<^bold>\<not> p) at i in' H \<longrightarrow>
       p at i in' H) \<and>
     (\<forall>p i a. (\<^bold>@ i p) at a in' H \<longrightarrow>
       p at i in' H) \<and>
     (\<forall>p i a. (\<^bold>\<not> (\<^bold>@ i p)) at a in' H \<longrightarrow>
       (\<^bold>\<not> p) at i in' H) \<and>
     (\<forall>p i. (\<nexists>a. p = Nom a) \<longrightarrow> (\<^bold>\<diamond> p) at i in' H \<longrightarrow>
       (\<exists>j. (\<^bold>\<diamond> Nom j) at i in' H \<and> (\<^bold>@ j p) at i in' H)) \<and>
     (\<forall>p i j. (\<^bold>\<not> (\<^bold>\<diamond> p)) at i in' H \<longrightarrow> (\<^bold>\<diamond> Nom j) at i in' H \<longrightarrow>
       (\<^bold>\<not> (\<^bold>@ j p)) at i in' H)\<close>
 
 text \<open>
   Two nominals \<open>i\<close> and \<open>j\<close> are equivalent in respect to a Hintikka set \<open>H\<close> if
     \<open>H\<close> contains an \<open>i\<close>-block with \<open>j\<close> on it.
   This is shown to be an equivalence relation.
 \<close>
 
 definition hequiv :: \<open>('a, 'b) block set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool\<close> where
   \<open>hequiv H i j \<equiv> Nom j at i in' H\<close>
 
 abbreviation hequiv_rel :: \<open>('a, 'b) block set \<Rightarrow> ('b \<times> 'b) set\<close> where
   \<open>hequiv_rel H \<equiv> {(i, j) |i j. hequiv H i j}\<close>
 
 definition names :: \<open>('a, 'b) block set \<Rightarrow> 'b set\<close> where
   \<open>names H \<equiv> {i |ps i. (ps, i) \<in> H}\<close>
 
 lemma hequiv_refl: \<open>hintikka H \<Longrightarrow> i \<in> names H \<Longrightarrow> hequiv H i i\<close>
   unfolding hintikka_def hequiv_def names_def by auto
 
 lemma hequiv_refl': \<open>hintikka H \<Longrightarrow> (ps, i) \<in> H \<Longrightarrow> hequiv H i i\<close>
   using hequiv_refl unfolding names_def by fast
 
 lemma hequiv_sym: \<open>hintikka H \<Longrightarrow> hequiv H i j = hequiv H j i\<close>
   unfolding hintikka_def hequiv_def by meson
 
 lemma hequiv_trans:
   \<open>hintikka H \<Longrightarrow> hequiv H i j \<Longrightarrow> hequiv H j k \<Longrightarrow> hequiv H i k\<close>
   unfolding hintikka_def hequiv_def by meson
 
 lemma hequiv_names: \<open>hequiv H i j \<Longrightarrow> i \<in> names H\<close>
   unfolding hequiv_def names_def by blast
 
 lemma hequiv_names_rel: \<open>hintikka H \<Longrightarrow> hequiv_rel H \<subseteq> names H \<times> names H\<close>
   using hequiv_sym hequiv_names by fast
 
 lemma hequiv_refl_rel: \<open>hintikka H \<Longrightarrow> refl_on (names H) (hequiv_rel H)\<close>
   unfolding refl_on_def using hequiv_refl hequiv_names_rel by fast
 
 lemma hequiv_sym_rel: \<open>hintikka H \<Longrightarrow> sym (hequiv_rel H)\<close>
   unfolding sym_def using hequiv_sym by fast
 
 lemma hequiv_trans_rel: \<open>hintikka H \<Longrightarrow> trans (hequiv_rel H)\<close>
   unfolding trans_def using hequiv_trans by fast
 
 lemma hequiv_rel: \<open>hintikka H \<Longrightarrow> equiv (names H) (hequiv_rel H)\<close>
   using hequiv_refl_rel hequiv_sym_rel hequiv_trans_rel by (rule equivI)
 
 subsubsection \<open>Named model\<close>
 
 text \<open>
   Given a Hintikka set \<open>H\<close> and a formula \<open>p\<close> on a block in \<open>H\<close>
     we will construct a model that satisfies \<open>p\<close>.
 
   The worlds of our model are sets of equivalent nominals and
     nominals are assigned to their equivalence class.
 
   From a world \<open>is\<close>, we can reach a world \<open>js\<close> iff there is an \<open>i \<in> is\<close> and a \<open>j \<in> js\<close> s.t.
     there is an \<open>i\<close>-block in \<open>H\<close> with \<open>\<^bold>\<diamond> Nom j\<close> on it.
 
   A propositional symbol \<open>p\<close> is true in a world \<open>is\<close> if there exists an \<open>i \<in> is\<close> s.t.
     \<open>p\<close> occurs on an \<open>i\<close>-block in \<open>H\<close>.
  \<close>
 
 definition assign :: \<open>('a, 'b) block set \<Rightarrow> 'b \<Rightarrow> 'b set\<close> where
   \<open>assign H i \<equiv> proj (hequiv_rel H) i\<close>
 
 definition reach :: \<open>('a, 'b) block set \<Rightarrow> 'b set \<Rightarrow> 'b set set\<close> where
   \<open>reach H is \<equiv> {assign H j |i j. i \<in> is \<and> (\<^bold>\<diamond> Nom j) at i in' H}\<close>
 
 definition val :: \<open>('a, 'b) block set \<Rightarrow> 'b set \<Rightarrow> 'a \<Rightarrow> bool\<close> where
   \<open>val H is x \<equiv> \<exists>i \<in> is. Pro x at i in' H\<close>
 
 lemma hequiv_assign: \<open>hintikka H \<Longrightarrow> hequiv H i j \<Longrightarrow> assign H i = assign H j\<close>
   unfolding proj_def assign_def using equiv_class_eq hequiv_rel by fast
 
 lemma hequiv_model:
   assumes \<open>hintikka H\<close> \<open>hequiv H i j\<close>
   shows
     \<open>(Model (reach H) (val H), assign H, assign H i \<Turnstile> p) =
      (Model (reach H) (val H), assign H, assign H j \<Turnstile> p)\<close>
   using assms hequiv_assign by fastforce
 
 lemma assign_refl: \<open>hintikka H \<Longrightarrow> i \<in> names H \<Longrightarrow> i \<in> assign H i\<close>
   unfolding proj_def assign_def using hequiv_refl by fastforce
 
 lemma assign_refl': \<open>hintikka H \<Longrightarrow> (ps, i) \<in> H \<Longrightarrow> i \<in> assign H i\<close>
   using assign_refl unfolding names_def by fast
 
 lemma assign_named:
   \<open>hintikka H \<Longrightarrow> i \<in> names H \<Longrightarrow> \<forall>j \<in> assign H i. \<exists>ps. (ps, j) \<in> H\<close>
   using hequiv_sym unfolding proj_def assign_def hequiv_def by fast
 
 lemma nominal_in_names:
   assumes \<open>hintikka H\<close> \<open>\<exists>block \<in> H. i \<in> block_nominals block\<close>
   shows \<open>i \<in> names H\<close>
 proof -
   have \<open>(\<forall>p. i \<in> nominals p \<and> (\<exists>block \<in> H. p on block) \<longrightarrow> (\<exists>br. (br, i) \<in> H))\<close>
     using \<open>hintikka H\<close> unfolding hintikka_def by meson
   then show ?thesis
     unfolding names_def using assms(2) by fastforce
 qed
 
 lemma assign_sym: \<open>hintikka H \<Longrightarrow> j \<in> assign H i \<longleftrightarrow> i \<in> assign H j\<close>
   unfolding proj_def assign_def using hequiv_sym by fast
 
 lemma hintikka_model:
   assumes \<open>hintikka H\<close>
   shows
     \<open>p at i in' H \<Longrightarrow> Model (reach H) (val H), assign H, assign H i \<Turnstile> p\<close>
     \<open>(\<^bold>\<not> p) at i in' H \<Longrightarrow> \<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> p\<close>
 proof (induct p arbitrary: i)
   fix i
   case (Pro x)
   assume \<open>Pro x at i in' H\<close>
   then show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> Pro x\<close>
     using assms(1) assign_refl' unfolding val_def by fastforce
 next
   fix i
   case (Pro x)
   assume \<open>(\<^bold>\<not> Pro x) at i in' H\<close>
   then have \<open>\<not> Pro x at j in' H\<close> if \<open>Nom j at i in' H\<close> for j
     using that assms(1) unfolding hintikka_def by meson
   then have \<open>\<not> Pro x at j in' H\<close> if \<open>hequiv H i j\<close> for j
     using that unfolding hequiv_def by simp
   then have \<open>\<not> val H (assign H i) x\<close>
     unfolding proj_def val_def assign_def by blast
   then show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> Pro x\<close>
     by simp
 next
   fix i
   case (Nom a)
   assume \<open>Nom a at i in' H\<close>
   then have \<open>assign H a = assign H i\<close>
     using assms(1) hequiv_assign hequiv_sym unfolding hequiv_def by fast
   then show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> Nom a\<close>
     by simp
 next
   fix i
   case (Nom a)
   assume \<open>(\<^bold>\<not> Nom a) at i in' H\<close>
   then have \<open>\<not> Nom a at i in' H\<close>
     using assms(1) unfolding hintikka_def by meson
   then have \<open>\<not> hequiv H i a\<close>
     unfolding hequiv_def by blast
   then have \<open>\<not> hequiv H a i\<close>
     using assms(1) hequiv_sym by fast
   moreover have \<open>hequiv H i i\<close>
     using assms(1) \<open>(\<^bold>\<not> Nom a) at i in' H\<close> hequiv_refl' by fast
   ultimately have \<open>assign H a \<noteq> assign H i\<close>
     unfolding proj_def assign_def by blast
   then show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> Nom a\<close>
     by simp
 next
   fix i
   case (Neg p)
   moreover assume \<open>(\<^bold>\<not> p) at i in' H\<close>
   ultimately show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>\<not> p\<close>
     using assms(1) by simp
 next
   fix i
   case (Neg p)
   moreover assume \<open>(\<^bold>\<not> \<^bold>\<not> p) at i in' H\<close>
   then have \<open>p at i in' H\<close>
     using assms(1) unfolding hintikka_def by meson
   ultimately show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>\<not> p\<close>
     using assms(1) by auto
 next
   fix i
   case (Dis p q)
   moreover assume \<open>(p \<^bold>\<or> q) at i in' H\<close>
   then have \<open>p at i in' H \<or> q at i in' H\<close>
     using assms(1) unfolding hintikka_def by meson
   ultimately show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> (p \<^bold>\<or> q)\<close>
     by (meson semantics.simps(4))
 next
   fix i
   case (Dis p q)
   moreover assume \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) at i in' H\<close>
   then have \<open>(\<^bold>\<not> p) at i in' H\<close> \<open>(\<^bold>\<not> q) at i in' H\<close>
     using assms(1) unfolding hintikka_def by meson+
   ultimately show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> (p \<^bold>\<or> q)\<close>
     by auto
 next
   fix i
   case (Dia p)
   moreover assume \<open>(\<^bold>\<diamond> p) at i in' H\<close>
   ultimately show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>\<diamond> p\<close>
   proof (cases \<open>\<exists>j. p = Nom j\<close>)
     case True
     then obtain j where \<open>p = Nom j\<close>
       by blast
     have \<open>i \<in> assign H i\<close>
       using assms(1) \<open>(\<^bold>\<diamond> p) at i in' H\<close> assign_refl' by fast
     moreover have \<open>j \<in> nominals (\<^bold>\<diamond> p)\<close>
       using \<open>p = Nom j\<close> by simp
     then have \<open>(\<exists>block \<in> H. (\<^bold>\<diamond> p) on block) \<longrightarrow> (\<exists>qs. (qs, j) \<in> H)\<close>
       using assms(1) unfolding hintikka_def by meson
     then have \<open>\<exists>bl. (bl, j) \<in> H\<close>
       using \<open>(\<^bold>\<diamond> p) at i in' H\<close> by blast
     then have \<open>j \<in> assign H j\<close>
       using assms(1) \<open>(\<^bold>\<diamond> p) at i in' H\<close> assign_refl' by fast
     moreover have \<open>(\<^bold>\<diamond> Nom j) at i in' H\<close>
       using \<open>p = Nom j\<close> \<open>(\<^bold>\<diamond> p) at i in' H\<close> by blast
     ultimately have \<open>assign H j \<in> reach H (assign H i)\<close>
       using \<open>(\<^bold>\<diamond> p) at i in' H\<close> unfolding reach_def by auto
     then show ?thesis
       using \<open>p = Nom j\<close> by simp
   next
     case False
     then have \<open>\<exists>j. (\<^bold>\<diamond> Nom j) at i in' H \<and> (\<^bold>@ j p) at i in' H\<close>
       using assms \<open>(\<^bold>\<diamond> p) at i in' H\<close> unfolding hintikka_def by blast
     then obtain j where *: \<open>(\<^bold>\<diamond> Nom j) at i in' H\<close> \<open>(\<^bold>@ j p) at i in' H\<close>
       by blast
 
     from *(2) have \<open>p at j in' H\<close>
       using assms(1) unfolding hintikka_def by blast
     then have \<open>Model (reach H) (val H), assign H, assign H j \<Turnstile> p\<close>
       using Dia by blast
 
     have \<open>i \<in> assign H i\<close>
       using assms(1) assign_refl' \<open>(\<^bold>\<diamond> p) at i in' H\<close> by fast
     moreover have \<open>j \<in> assign H j\<close>
       using assms(1) assign_refl' \<open>p at j in' H\<close> by fast
     ultimately have \<open>assign H j \<in> reach H (assign H i)\<close>
       using *(1) unfolding reach_def by auto
     then show ?thesis
       using \<open>Model (reach H) (val H), assign H, assign H j \<Turnstile> p\<close> by auto
   qed
 next
   fix i
   case (Dia p)
   assume \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at i in' H\<close>
   show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>\<diamond> p\<close>
   proof
     assume \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>\<diamond> p\<close>
     then obtain i' j where
       \<open>Model (reach H) (val H), assign H, assign H j \<Turnstile> p\<close>
       \<open>i' \<in> assign H i\<close> \<open>(\<^bold>\<diamond> Nom j) at i' in' H\<close>
       unfolding reach_def by auto
 
     have \<open>Nom i' at i in' H\<close>
       using \<open>i' \<in> assign H i\<close> \<open>(\<^bold>\<diamond> Nom j) at i' in' H\<close>
       unfolding hequiv_def proj_def assign_def by auto
     then have \<open>Nom i at i' in' H\<close>
       using assms(1) unfolding hintikka_def by meson
     then have \<open>(\<^bold>\<diamond> Nom j) at i in' H\<close>
       using assms(1) \<open>(\<^bold>\<diamond> Nom j) at i' in' H\<close>
       unfolding hintikka_def by meson
     then have \<open>(\<^bold>\<not> (\<^bold>@ j p)) at i in' H\<close>
       using assms(1) \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) at i in' H\<close>
       unfolding hintikka_def by meson
     moreover have \<open>(\<^bold>\<not> p) at j in' H\<close> if \<open>\<exists>a. (\<^bold>\<not> (\<^bold>@ j p)) at a in' H\<close>
       using that assms(1) unfolding hintikka_def by blast
     ultimately have \<open>(\<^bold>\<not> p) at j in' H\<close>
       by blast
     then have \<open>\<not> Model (reach H) (val H), assign H, assign H j \<Turnstile> p\<close>
       using Dia by blast
     then show False
       using \<open>Model (reach H) (val H), assign H, assign H j \<Turnstile> p\<close> by blast
   qed
 next
   fix i
   case (Sat j p)
   assume \<open>(\<^bold>@ j p) at i in' H\<close>
   moreover have \<open>p at j in' H\<close> if \<open>\<exists>a. (\<^bold>@ j p) at a in' H\<close>
     using that assms(1) unfolding hintikka_def by meson
   ultimately have \<open>p at j in' H\<close>
     by blast
   then show \<open>Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>@ j p\<close>
     using Sat by simp
 next
   fix i
   case (Sat j p)
   assume \<open>(\<^bold>\<not> (\<^bold>@ j p)) at i in' H\<close>
   moreover have \<open>(\<^bold>\<not> p) at j in' H\<close> if \<open>\<exists>a. (\<^bold>\<not> (\<^bold>@ j p)) at a in' H\<close>
     using that assms(1) unfolding hintikka_def by meson
   ultimately have \<open>(\<^bold>\<not> p) at j in' H\<close>
     by blast
   then show \<open>\<not> Model (reach H) (val H), assign H, assign H i \<Turnstile> \<^bold>@ j p\<close>
     using Sat by simp
 qed
 
 subsection \<open>Lindenbaum-Henkin\<close>
 
 text \<open>
   A set of blocks is consistent if no finite subset can be derived.
   Given a consistent set of blocks we are going to extend it to be
     saturated and maximally consistent and show that is then Hintikka.
 \<close>
 
 definition consistent :: \<open>('a, 'b) block set \<Rightarrow> bool\<close> where
   \<open>consistent S \<equiv> \<nexists>S'. set S' \<subseteq> S \<and> \<turnstile> S'\<close>
 
 instance fm :: (countable, countable) countable
   by countable_datatype
 
 definition proper_dia :: \<open>('a, 'b) fm \<Rightarrow> ('a, 'b) fm option\<close> where
   \<open>proper_dia p \<equiv>
     case p of (\<^bold>\<diamond> p) \<Rightarrow> (if \<nexists>a. p = Nom a then Some p else None) | _ \<Rightarrow> None\<close>
 
 lemma proper_dia: \<open>proper_dia p = Some q \<Longrightarrow> p = (\<^bold>\<diamond> q) \<and> (\<nexists>a. q = Nom a)\<close>
   unfolding proper_dia_def by (cases p) (simp_all, metis option.discI option.inject)
 
 text \<open>The following function witnesses each \<open>\<^bold>\<diamond> p\<close> in a fresh world.\<close>
 
 primrec witness_list :: \<open>('a, 'b) fm list \<Rightarrow> 'b set \<Rightarrow> ('a, 'b) fm list\<close> where
   \<open>witness_list [] _ = []\<close>
 | \<open>witness_list (p # ps) used =
     (case proper_dia p of
       None \<Rightarrow> witness_list ps used
     | Some q \<Rightarrow>
         let i = SOME i. i \<notin> used
         in (\<^bold>@ i q) # (\<^bold>\<diamond> Nom i) # witness_list ps ({i} \<union> used))\<close>
 
 primrec witness :: \<open>('a, 'b) block \<Rightarrow> 'b set \<Rightarrow> ('a, 'b) block\<close> where
   \<open>witness (ps, a) used = (witness_list ps used, a)\<close>
 
 lemma witness_list:
   \<open>proper_dia p = Some q \<Longrightarrow> witness_list (p # ps) used =
     (let i = SOME i. i \<notin> used in
       (\<^bold>@ i q) # (\<^bold>\<diamond> Nom i) # witness_list ps ({i} \<union> used))\<close>
   by simp
 
 primrec extend ::
   \<open>('a, 'b) block set \<Rightarrow> (nat \<Rightarrow> ('a, 'b) block) \<Rightarrow> nat \<Rightarrow> ('a, 'b) block set\<close> where
   \<open>extend S f 0 = S\<close>
 | \<open>extend S f (Suc n) =
     (if \<not> consistent ({f n} \<union> extend S f n)
      then extend S f n
      else
       let used = (\<Union>block \<in> {f n} \<union> extend S f n. block_nominals block)
       in {f n, witness (f n) used} \<union> extend S f n)\<close>
 
 definition Extend ::
   \<open>('a, 'b) block set \<Rightarrow> (nat \<Rightarrow> ('a, 'b) block) \<Rightarrow> ('a, 'b) block set\<close> where
   \<open>Extend S f \<equiv> (\<Union>n. extend S f n)\<close>
 
 lemma extend_chain: \<open>extend S f n \<subseteq> extend S f (Suc n)\<close>
   by auto
 
 lemma extend_mem: \<open>S \<subseteq> extend S f n\<close>
   by (induct n) auto
 
 lemma Extend_mem: \<open>S \<subseteq> Extend S f\<close>
   unfolding Extend_def using extend_mem by blast
 
 subsubsection \<open>Consistency\<close>
 
 lemma split_list:
   \<open>set A \<subseteq> {x} \<union> X \<Longrightarrow> x \<in>. A \<Longrightarrow> \<exists>B. set (x # B) = set A \<and> x \<notin> set B\<close>
   by simp (metis Diff_insert_absorb mk_disjoint_insert set_removeAll)
 
 lemma consistent_drop_single:
   fixes a :: 'b
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     cons: \<open>consistent ({(p # ps, a)} \<union> S)\<close>
   shows \<open>consistent ({(ps, a)} \<union> S)\<close>
   unfolding consistent_def
 proof
   assume \<open>\<exists>S'. set S' \<subseteq> {(ps, a)} \<union> S \<and> (\<exists>n. n \<turnstile> S')\<close>
   then obtain S' n where \<open>set S' \<subseteq> {(ps, a)} \<union> S\<close> \<open>(ps, a) \<in>. S'\<close> \<open>n \<turnstile> S'\<close>
     using assms unfolding consistent_def by blast
   then obtain S'' where \<open>set ((ps, a) # S'') = set S'\<close> \<open>(ps, a) \<notin> set S''\<close>
     using split_list by metis
   then have \<open>\<turnstile> (ps, a) # S''\<close>
     using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
   then have \<open>\<turnstile> (p # ps, a) # S''\<close>
     using inf ST_struct_block[where ps'=\<open>p # ps\<close>] by fastforce
   moreover have \<open>set ((p # ps, a) # S'') \<subseteq> {(p # ps, a)} \<union> S\<close>
     using \<open>(ps, a) \<notin> set S''\<close> \<open>set ((ps, a) # S'') = set S'\<close> \<open>set S' \<subseteq> {(ps, a)} \<union> S\<close> by auto
   ultimately show False
     using cons unfolding consistent_def by blast
 qed
 
 lemma consistent_drop_block: \<open>consistent ({block} \<union> S) \<Longrightarrow> consistent S\<close>
   unfolding consistent_def by blast
 
 lemma inconsistent_weaken: \<open>\<not> consistent S \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> \<not> consistent S'\<close>
   unfolding consistent_def by blast
 
 lemma finite_nominals_set: \<open>finite S \<Longrightarrow> finite (\<Union>block \<in> S. block_nominals block)\<close>
   by (induct S rule: finite_induct) (simp_all add: finite_block_nominals)
 
 lemma witness_list_used:
   fixes i :: 'b
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and \<open>finite used\<close> \<open>i \<notin> list_nominals ps\<close>
   shows \<open>i \<notin> list_nominals (witness_list ps ({i} \<union> used))\<close>
   using assms(2-)
 proof (induct ps arbitrary: used)
   case (Cons p ps)
   then show ?case
   proof (cases \<open>proper_dia p\<close>)
     case (Some q)
     let ?j = \<open>SOME j. j \<notin> {i} \<union> used\<close>
     have \<open>finite ({i} \<union> used)\<close>
       using \<open>finite used\<close> by simp
     then have \<open>\<exists>j. j \<notin> {i} \<union> used\<close>
       using inf ex_new_if_finite by metis
     then have j: \<open>?j \<notin> {i} \<union> used\<close>
       using someI_ex by metis
 
     have \<open>witness_list (p # ps) ({i} \<union> used) =
         (\<^bold>@ ?j q) # (\<^bold>\<diamond> Nom ?j) # witness_list ps ({?j} \<union> ({i} \<union> used))\<close>
       using Some witness_list by metis
     then have *: \<open>list_nominals (witness_list (p # ps) ({i} \<union> used)) =
         {?j} \<union> nominals q \<union> list_nominals (witness_list ps ({?j} \<union> ({i} \<union> used)))\<close>
       by simp
 
     have \<open>finite ({?j} \<union> used)\<close>
       using \<open>finite used\<close> by simp
     moreover have \<open>i \<notin> list_nominals ps\<close>
       using \<open>i \<notin> list_nominals (p # ps)\<close> by simp
     ultimately have \<open>i \<notin> list_nominals (witness_list ps ({i} \<union> ({?j} \<union> used)))\<close>
       using Cons by metis
     moreover have \<open>{i} \<union> ({?j} \<union> used) = {?j} \<union> ({i} \<union> used)\<close>
       by blast
     moreover have \<open>i \<noteq> ?j\<close>
       using j by auto
     ultimately have \<open>i \<in> list_nominals (witness_list (p # ps) ({i} \<union> used)) \<longleftrightarrow> i \<in> nominals q\<close>
       using * by simp
     moreover have \<open>i \<notin> nominals q\<close>
       using Cons(3) Some proper_dia by fastforce
     ultimately show ?thesis
       by blast
   qed simp
 qed simp
 
 lemma witness_used:
   fixes i :: 'b
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>finite used\<close> \<open>i \<notin> block_nominals block\<close>
   shows \<open>i \<notin> block_nominals (witness block ({i} \<union> used))\<close>
   using assms witness_list_used by (induct block) fastforce
 
 lemma consistent_witness_list:
   fixes a :: 'b
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and \<open>consistent S\<close>
     \<open>(ps, a) \<in> S\<close> \<open>finite used\<close> \<open>(\<Union> (block_nominals ` S)) \<subseteq> used\<close>
   shows \<open>consistent ({(witness_list ps used, a)} \<union> S)\<close>
   using assms(2-)
 proof (induct ps arbitrary: used S)
   case Nil
   then have \<open>{(witness_list [] used, a)} \<union> S = S\<close>
     by auto
   then show ?case
     using \<open>consistent S\<close> by simp
 next
   case (Cons p ps)
   have \<open>{(p # ps, a)} \<union> S = S\<close>
     using \<open>(p # ps, a) \<in> S\<close> by blast
   then have \<open>consistent ({(p # ps, a)} \<union> S)\<close>
     using \<open>consistent S\<close> by simp
   then have \<open>consistent ({(ps, a)} \<union> S)\<close>
     using inf consistent_drop_single by fast
   moreover have \<open>(ps, a) \<in> {(ps, a)} \<union> S\<close>
     by simp
   moreover have \<open>\<Union> (block_nominals ` ({(ps, a)} \<union> S)) \<subseteq> extra \<union> used\<close> for extra
     using \<open>(p # ps, a) \<in> S\<close> \<open>\<Union> (block_nominals ` S) \<subseteq> used\<close> by fastforce
   moreover have \<open>finite (extra \<union> used)\<close> if \<open>finite extra\<close> for extra
     using that \<open>finite used\<close> by blast
   ultimately have cons:
     \<open>consistent ({(witness_list ps (extra \<union> used), a)} \<union> ({(ps, a)} \<union> S))\<close>
     if \<open>finite extra\<close> for extra
     using that Cons by metis
 
   show ?case
   proof (cases \<open>proper_dia p\<close>)
     case None
     then have \<open>witness_list (p # ps) used = witness_list ps used\<close>
       by auto
     moreover have \<open>consistent ({(witness_list ps used, a)} \<union> ({(ps, a)} \<union> S))\<close>
       using cons[where extra=\<open>{}\<close>] by simp
     then have \<open>consistent ({(witness_list ps used, a)} \<union> S)\<close>
       using consistent_drop_block[where block=\<open>(ps, a)\<close>] by simp
     ultimately show ?thesis
       by simp
   next
     case (Some q)
     let ?i = \<open>SOME i. i \<notin> used\<close>
     have \<open>\<exists>i. i \<notin> used\<close>
       using \<open>finite used\<close> inf ex_new_if_finite by metis
     then have \<open>?i \<notin> used\<close>
       using someI_ex by metis
     then have i: \<open>?i \<notin> \<Union> (block_nominals ` S)\<close>
       using Cons by blast
     then have \<open>?i \<notin> block_nominals (p # ps, a)\<close>
       using Cons by blast
 
     let ?tail = \<open>witness_list ps ({?i} \<union> used)\<close>
 
     have \<open>consistent ({(?tail, a)} \<union> ({(ps, a)} \<union> S))\<close>
       using cons[where extra=\<open>{?i}\<close>] by simp
     then have *: \<open>consistent ({(?tail, a)} \<union> S)\<close>
       using consistent_drop_block[where block=\<open>(ps, a)\<close>] by simp
 
     have \<open>witness_list (p # ps) used = (\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail\<close>
       using Some witness_list by metis
     moreover have \<open>consistent ({((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a)} \<union> S)\<close>
       unfolding consistent_def
     proof
       assume \<open>\<exists>S'. set S' \<subseteq> {((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a)} \<union> S \<and> (\<exists>n. n \<turnstile> S')\<close>
       then obtain S' n where
         \<open>n \<turnstile> S'\<close> and S':
         \<open>set S' \<subseteq> {((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a)} \<union> S\<close>
         \<open>((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) \<in>. S'\<close>
         using * unfolding consistent_def by blast
       then obtain S'' where S'':
         \<open>set (((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) # S'') = set S'\<close>
         \<open>((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) \<notin> set S''\<close>
         using split_list[where x=\<open>((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a)\<close>] by blast
       then have \<open>\<turnstile> ((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) # S''\<close>
         using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
       moreover have \<open>set (((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) # S'') \<subseteq>
         set (((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) # (p # ps, a) # S'')\<close>
         by auto
       ultimately have **:
         \<open>\<turnstile> ((\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # ?tail, a) # (p # ps, a) # S''\<close>
         using inf ST_struct by blast
 
       have \<open>?i \<notin> block_nominals (?tail, a)\<close>
         using inf \<open>finite used\<close> \<open>?i \<notin> block_nominals (p # ps, a)\<close> witness_used
         by fastforce
       moreover have \<open>?i \<notin> branch_nominals S''\<close>
         unfolding branch_nominals_def using i S' S'' by auto
       ultimately have \<open>?i \<notin> branch_nominals ((?tail, a) # (p # ps, a) # S'')\<close>
         using \<open>?i \<notin> block_nominals (p # ps, a)\<close> unfolding branch_nominals_def
         by simp
 
       moreover have \<open>\<nexists>a. q = Nom a\<close>
         using Some proper_dia by blast
       moreover have \<open>(p # ps, a) \<in>. (?tail, a) # (p # ps, a) # S''\<close>
         by simp
       moreover have \<open>p = (\<^bold>\<diamond> q)\<close>
         using Some proper_dia by blast
       then have \<open>(\<^bold>\<diamond> q) on (p # ps, a)\<close>
         by simp
       ultimately have \<open>\<turnstile> (?tail, a) # (p # ps, a) # S''\<close>
         using ** DiaP' by fast
       moreover have \<open>set ((p # ps, a) # S'') \<subseteq> S\<close>
         using Cons S' S'' by auto
       ultimately show False
         using * unfolding consistent_def by (simp add: subset_Un_eq)
     qed
     ultimately show ?thesis
       by simp
   qed
 qed
 
 lemma consistent_witness:
   fixes block :: \<open>('a, 'b) block\<close>
   assumes \<open>infinite (UNIV :: 'b set)\<close>
     \<open>consistent S\<close> \<open>finite (\<Union> (block_nominals ` S))\<close> \<open>block \<in> S\<close>
   shows \<open>consistent ({witness block (\<Union> (block_nominals ` S))} \<union> S)\<close>
   using assms consistent_witness_list by (cases block) fastforce
 
 lemma consistent_extend:
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>consistent (extend S f n)\<close> \<open>finite (\<Union> (block_nominals ` extend S f n))\<close>
   shows \<open>consistent (extend S f (Suc n))\<close>
 proof -
   consider
     (inconsistent) \<open>\<not> consistent ({f n} \<union> extend S f n)\<close> |
     (consistent) \<open>consistent ({f n} \<union> extend S f n)\<close>
     by blast
   then show ?thesis
   proof cases
     case inconsistent
     then show ?thesis
       using assms by simp
   next
     case consistent
     let ?used = \<open>\<Union>block \<in> {f n} \<union> extend S f n. block_nominals block\<close>
     have *: \<open>extend S f (n + 1) = {f n, witness (f n) ?used} \<union> extend S f n\<close>
       using consistent by simp
 
     have \<open>consistent ({f n} \<union> extend S f n)\<close>
       using consistent by simp
     moreover have \<open>finite ((\<Union> (block_nominals ` ({f n} \<union> extend S f n))))\<close>
       using \<open>finite (\<Union> (block_nominals ` extend S f n))\<close> finite_nominals_set by force
     moreover have \<open>f n \<in> {f n} \<union> extend S f n\<close>
       by simp
     ultimately have \<open>consistent ({witness (f n) ?used} \<union> ({f n} \<union> extend S f n))\<close>
       using inf consistent_witness by blast
     then show ?thesis
       using * by simp
   qed
 qed
 
 lemma finite_nominals_extend:
   assumes \<open>finite (\<Union> (block_nominals ` S))\<close>
   shows \<open>finite (\<Union> (block_nominals ` extend S f n))\<close>
   using assms by (induct n) (simp_all add: finite_block_nominals)
 
 lemma consistent_extend':
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and \<open>consistent S\<close> \<open>finite (\<Union> (block_nominals ` S))\<close>
   shows \<open>consistent (extend S f n)\<close>
   using assms by (induct n) (simp, metis consistent_extend finite_nominals_extend)
 
 lemma UN_finite_bound:
   assumes \<open>finite A\<close> \<open>A \<subseteq> (\<Union>n. f n)\<close>
   shows \<open>\<exists>m :: nat. A \<subseteq> (\<Union>n \<le> m. f n)\<close>
   using assms
 proof (induct A rule: finite_induct)
   case (insert x A)
   then obtain m where \<open>A \<subseteq> (\<Union>n \<le> m. f n)\<close>
     by fast
   then have \<open>A \<subseteq> (\<Union>n \<le> (m + k). f n)\<close> for k
     by fastforce
   moreover obtain m' where \<open>x \<in> f m'\<close>
     using insert(4) by blast
   ultimately have \<open>{x} \<union> A \<subseteq> (\<Union>n \<le> m + m'. f n)\<close>
     by auto
   then show ?case
     by blast
 qed simp
 
 lemma extend_bound: \<open>(\<Union>n \<le> m. extend S f n) = extend S f m\<close>
 proof (induct m)
   case (Suc m)
   have \<open>\<Union> (extend S f ` {..Suc m}) = \<Union> (extend S f ` {..m}) \<union> extend S f (Suc m)\<close>
     using atMost_Suc by auto
   also have \<open>\<dots> = extend S f m \<union> extend S f (Suc m)\<close>
     using Suc by blast
   also have \<open>\<dots> = extend S f (Suc m)\<close>
     using extend_chain by blast
   finally show ?case
     by simp
 qed simp
 
 lemma consistent_Extend:
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>consistent S\<close> \<open>finite (\<Union> (block_nominals ` S))\<close>
   shows \<open>consistent (Extend S f)\<close>
   unfolding Extend_def
 proof (rule ccontr)
   assume \<open>\<not> consistent (\<Union> (range (extend S f)))\<close>
   then obtain S' n where
     \<open>n \<turnstile> S'\<close>
     \<open>set S' \<subseteq> (\<Union>n. extend S f n)\<close>
     unfolding consistent_def by blast
   moreover have \<open>finite (set S')\<close>
     by simp
   ultimately obtain m where \<open>set S' \<subseteq> (\<Union>n \<le> m. extend S f n)\<close>
     using UN_finite_bound by metis
   then have \<open>set S' \<subseteq> extend S f m\<close>
     using extend_bound by blast
   moreover have \<open>consistent (extend S f m)\<close>
     using assms consistent_extend' by blast
   ultimately show False
     unfolding consistent_def using \<open>n \<turnstile> S'\<close> by blast
 qed
 
 subsubsection \<open>Maximality\<close>
 
 text \<open>A set of blocks is maximally consistent if any proper extension makes it inconsistent.\<close>
 
 definition maximal :: \<open>('a, 'b) block set \<Rightarrow> bool\<close> where
   \<open>maximal S \<equiv> consistent S \<and>
     (\<forall>block. block \<notin> S \<longrightarrow> \<not> consistent ({block} \<union> S))\<close>
 
 lemma extend_not_mem:
   \<open>f n \<notin> extend S f (Suc n) \<Longrightarrow> \<not> consistent ({f n} \<union> extend S f n)\<close>
   by (metis Un_insert_left extend.simps(2) insertI1)
 
 lemma maximal_Extend:
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>consistent S\<close> \<open>finite (\<Union> (block_nominals ` S))\<close> \<open>surj f\<close>
   shows \<open>maximal (Extend S f)\<close>
 proof (rule ccontr)
   assume \<open>\<not> maximal (Extend S f)\<close>
   then obtain block where
     \<open>block \<notin> Extend S f\<close> \<open>consistent ({block} \<union> Extend S f)\<close>
     unfolding maximal_def using assms consistent_Extend by blast
   obtain n where n: \<open>f n = block\<close>
     using \<open>surj f\<close> unfolding surj_def by metis
   then have \<open>block \<notin> extend S f (Suc n)\<close>
     using \<open>block \<notin> Extend S f\<close> extend_chain unfolding Extend_def by blast
   then have \<open>\<not> consistent ({block} \<union> extend S f n)\<close>
     using n extend_not_mem by blast
   moreover have \<open>block \<notin> extend S f n\<close>
     using \<open>block \<notin> extend S f (Suc n)\<close> extend_chain by auto
   then have \<open>{block} \<union> extend S f n \<subseteq> {block} \<union> Extend S f\<close>
     unfolding Extend_def by blast
   ultimately have \<open>\<not> consistent ({block} \<union> Extend S f)\<close>
     using inconsistent_weaken by blast
   then show False
     using \<open>consistent ({block} \<union> Extend S f)\<close> by blast
 qed
 
 subsubsection \<open>Saturation\<close>
 
 text \<open>A set of blocks is saturated if every \<open>\<^bold>\<diamond> p\<close> is witnessed.\<close>
 
 definition saturated :: \<open>('a, 'b) block set \<Rightarrow> bool\<close> where
   \<open>saturated S \<equiv> \<forall>p i. (\<^bold>\<diamond> p) at i in' S \<longrightarrow> (\<nexists>a. p = Nom a) \<longrightarrow>
     (\<exists>j. (\<^bold>@ j p) at i in' S \<and> (\<^bold>\<diamond> Nom j) at i in' S)\<close>
 
 lemma witness_list_append:
   \<open>\<exists>extra. witness_list (ps @ qs) used = witness_list ps used @ witness_list qs (extra \<union> used)\<close>
 proof (induct ps arbitrary: used)
   case Nil
   then show ?case
     by (metis Un_absorb append_self_conv2 witness_list.simps(1))
 next
   case (Cons p ps)
   show ?case
   proof (cases \<open>\<exists>q. proper_dia p = Some q\<close>)
     case True
     let ?i = \<open>SOME i. i \<notin> used\<close>
     from True obtain q where q: \<open>proper_dia p = Some q\<close>
       by blast
     moreover have \<open>(p # ps) @ qs = p # (ps @ qs)\<close>
       by simp
     ultimately have
       \<open>witness_list ((p # ps) @ qs) used = (\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) #
        witness_list (ps @ qs) ({?i} \<union> used)\<close>
       using witness_list by metis
     then have
       \<open>\<exists>extra. witness_list ((p # ps) @ qs) used = (\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) #
         witness_list ps ({?i} \<union> used) @ witness_list qs (extra \<union> ({?i} \<union> used))\<close>
       using Cons by metis
     moreover have \<open>(\<^bold>@ ?i q) # (\<^bold>\<diamond> Nom ?i) # witness_list ps ({?i} \<union> used) =
         witness_list (p # ps) used\<close>
       using q witness_list by metis
     ultimately have \<open>\<exists>extra. witness_list ((p # ps) @ qs) used =
         witness_list (p # ps) used @ witness_list qs (extra \<union> ({?i} \<union> used))\<close>
       by (metis append_Cons)
     then have \<open>\<exists>extra. witness_list ((p # ps) @ qs) used =
         witness_list (p # ps) used @ witness_list qs (({?i} \<union> extra) \<union> used)\<close>
       by simp
     then show ?thesis
       by blast
   qed (simp add: Cons)
 qed
 
 lemma ex_witness_list:
   assumes \<open>p \<in>. ps\<close> \<open>proper_dia p = Some q\<close>
   shows \<open>\<exists>i. {\<^bold>@ i q, \<^bold>\<diamond> Nom i} \<subseteq> set (witness_list ps used)\<close>
   using \<open>p \<in>. ps\<close>
 proof (induct ps arbitrary: used)
   case (Cons a ps)
   then show ?case
   proof (induct \<open>a = p\<close>)
     case True
     then have
       \<open>\<exists>i. witness_list (a # ps) used = (\<^bold>@ i q) # (\<^bold>\<diamond> Nom i) #
         witness_list ps ({i} \<union> used)\<close>
       using \<open>proper_dia p = Some q\<close> witness_list by metis
     then show ?case
       by auto
   next
     case False
     then have \<open>\<exists>i. {\<^bold>@ i q, \<^bold>\<diamond> Nom i} \<subseteq> set (witness_list ps (extra \<union> used))\<close> for extra
       by simp
     moreover have \<open>\<exists>extra. witness_list (a # ps) used =
         witness_list [a] used @ witness_list ps (extra \<union> used)\<close>
       using witness_list_append[where ps=\<open>[_]\<close>] by simp
     ultimately show ?case
       by fastforce
   qed
 qed simp
 
 lemma saturated_Extend:
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>consistent S\<close> \<open>finite (\<Union> (block_nominals ` S))\<close> \<open>surj f\<close>
   shows \<open>saturated (Extend S f)\<close>
   unfolding saturated_def
 proof safe
   fix ps i p
   assume \<open>(ps, i) \<in> Extend S f\<close> \<open>(\<^bold>\<diamond> p) on (ps, i)\<close> \<open>\<nexists>a. p = Nom a\<close>
   obtain n where n: \<open>f n = (ps, i)\<close>
     using \<open>surj f\<close> unfolding surj_def by metis
 
   let ?used = \<open>(\<Union>block \<in> {f n} \<union> extend S f n. block_nominals block)\<close>
 
   have \<open>extend S f n \<subseteq> Extend S f\<close>
     unfolding Extend_def by auto
   moreover have \<open>consistent (Extend S f)\<close>
     using assms consistent_Extend by blast
   ultimately have \<open>consistent ({(ps, i)} \<union> extend S f n)\<close>
     using \<open>(ps, i) \<in> Extend S f\<close> inconsistent_weaken by blast
   then have \<open>extend S f (Suc n) = {f n, witness (f n) ?used} \<union> extend S f n\<close>
     using n \<open>(\<^bold>\<diamond> p) on (ps, i)\<close> by auto
   then have \<open>witness (f n) ?used \<in> Extend S f\<close>
     unfolding Extend_def by blast
   then have *: \<open>(witness_list ps ?used, i) \<in> Extend S f\<close>
     using n by simp
 
   have \<open>(\<^bold>\<diamond> p) \<in>. ps\<close>
     using \<open>(\<^bold>\<diamond> p) on (ps, i)\<close> by simp
   moreover have \<open>proper_dia (\<^bold>\<diamond> p) = Some p\<close>
     unfolding proper_dia_def using \<open>\<nexists>a. p = Nom a\<close> by simp
   ultimately have \<open>\<exists>j.
       (\<^bold>@ j p) on (witness_list ps ?used, i) \<and>
       (\<^bold>\<diamond> Nom j) on (witness_list ps ?used, i)\<close>
     using ex_witness_list by fastforce
   then show \<open>\<exists>j.
       (\<exists>qs. (qs, i) \<in> Extend S f \<and> (\<^bold>@ j p) on (qs, i)) \<and>
       (\<exists>rs. (rs, i) \<in> Extend S f \<and> (\<^bold>\<diamond> Nom j) on (rs, i))\<close>
     using * by blast
 qed
 
 subsection \<open>Smullyan-Fitting\<close>
 
 lemma hintikka_Extend:
   fixes S :: \<open>('a, 'b) block set\<close>
   assumes inf: \<open>infinite (UNIV :: 'b set)\<close> and
     \<open>maximal S\<close> \<open>consistent S\<close> \<open>saturated S\<close>
   shows \<open>hintikka S\<close>
   unfolding hintikka_def
 proof safe
   fix x i j ps qs rs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>Nom j on (ps, i)\<close> and
     qs: \<open>(qs, j) \<in> S\<close> \<open>Pro x on (qs, j)\<close> and
     rs: \<open>(rs, i) \<in> S\<close> \<open>(\<^bold>\<not> Pro x) on (rs, i)\<close>
   then have \<open>\<not> n \<turnstile> [(ps, i), (qs, j), (rs, i)]\<close> for n
     using \<open>consistent S\<close> unfolding consistent_def by simp
   moreover have \<open>n \<turnstile> [(Pro x # ps, i), (qs, j), (rs, i)]\<close> for n
     using ps(2) rs(2) by (meson Close list.set_intros(1) on.simps set_subset_Cons subsetD)
   then have \<open>n \<turnstile> [(ps, i), (qs, j), (rs, i)]\<close> for n
     using ps qs rev_nth_on
     by (meson Nom' list.set_intros(1) rev_nth_on set_subset_Cons subsetD)
   ultimately show False
     by blast
 next
   fix a i ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>Nom a on (ps, i)\<close> and
     qs: \<open>(qs, i) \<in> S\<close> \<open>(\<^bold>\<not> Nom a) on (qs, i)\<close>
   then have \<open>\<not> n \<turnstile> [(ps, i), (qs, i)]\<close> for n
     using \<open>consistent S\<close> unfolding consistent_def by simp
   moreover have \<open>n \<turnstile> [(ps, i), (qs, i)]\<close> for n
     using ps(2) qs(2) by (meson Close list.set_intros(1) set_subset_Cons subset_code(1))
   ultimately show False
     by blast
 next
   fix i j ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<diamond> Nom j) on (ps, i)\<close> and
     qs: \<open>(qs, i) \<in> S\<close> \<open>(\<^bold>\<not> (\<^bold>\<diamond> Nom j)) on (qs, i)\<close>
   then have \<open>\<not> n \<turnstile> [(ps, i), (qs, i)]\<close> for n
     using \<open>consistent S\<close> unfolding consistent_def by simp
   moreover have \<open>n \<turnstile> [(ps, i), (qs, i)]\<close> for n
     using ps(2) qs(2) Close[where p=\<open>\<^bold>\<diamond> Nom j\<close> and i=i] by force
   ultimately show False
     by blast
 next
   fix p i ps a
   assume i: \<open>i \<in> nominals p\<close> and ps: \<open>(ps, a) \<in> S\<close> \<open>p on (ps, a)\<close>
   show \<open>\<exists>qs. (qs, i) \<in> S\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, i) \<in> S\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([], i)} \<union> S\<close> and \<open>([], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un subset_insert)
     then obtain S'' where S'':
       \<open>set (([], i) # S'') = set S'\<close> \<open>([], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([], i)\<close>] by blast
     then have \<open>\<turnstile> ([], i) # (ps, a) # S''\<close>
       using inf ST_struct[where branch'=\<open>([], i) # (ps, a) # S''\<close>] \<open>n \<turnstile> S'\<close> by fastforce
     moreover have \<open>i \<in> branch_nominals ((ps, a) # S'')\<close>
       using i ps unfolding branch_nominals_def by auto
     ultimately have \<open>\<turnstile> (ps, a) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, a) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix i j ps
   assume ps: \<open>(ps, i) \<in> S\<close> \<open>Nom j on (ps, i)\<close>
   show \<open>\<exists>qs. (qs, j) \<in> S \<and> Nom i on (qs, j)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, j) \<in> S \<and> Nom i on (qs, j)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([Nom i], j)} \<union> S\<close> and \<open>([Nom i], j) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([Nom i], j) # S'') = set S'\<close> \<open>([Nom i], j) \<notin> set S''\<close>
       using split_list[where x=\<open>([Nom i], j)\<close>] by blast
     then have \<open>\<turnstile> ([Nom i], j) # (ps, i) # S''\<close>
       using inf ST_struct[where branch'=\<open>([Nom i], j) # (ps, i) # S''\<close>] \<open>n \<turnstile> S'\<close> by fastforce
     then have \<open>\<turnstile> ([], j) # (ps, i) # S''\<close>
       using \<open>Nom j on (ps, i)\<close> by (meson Nom' list.set_intros(1) list.set_intros(2) on.simps)
     moreover have \<open>j \<in> branch_nominals ((ps, i) # S'')\<close>
       using \<open>Nom j on (ps, i)\<close> unfolding branch_nominals_def by fastforce
     ultimately have \<open>\<turnstile> (ps, i) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, i) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix i j k ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>Nom j on (ps, i)\<close> and
     qs: \<open>(qs, j) \<in> S\<close> \<open>Nom k on (qs, j)\<close>
   show \<open>\<exists>rs. (rs, i) \<in> S \<and> Nom k on (rs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>rs. (rs, i) \<in> S \<and> Nom k on (rs, i)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([Nom k], i)} \<union> S\<close> and \<open>([Nom k], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([Nom k], i) # S'') = set S'\<close> \<open>([Nom k], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([Nom k], i)\<close>] by blast
     then have \<open>\<turnstile> ([Nom k], i) # (Nom k # ps, i) # (qs, j) # S''\<close>
       using inf ST_struct[where branch'=\<open>([Nom k], i) # (Nom k # ps, i) # (qs, j) # S''\<close>] \<open>n \<turnstile> S'\<close>
       by fastforce
     then have \<open>\<turnstile> ([], i) # (Nom k # ps, i) # (qs, j) # S''\<close>
       by (meson Nom' list.set_intros(1-2) on.simps)
     moreover have \<open>i \<in> branch_nominals ((Nom k # ps, i) # (qs, j) # S'')\<close>
       unfolding branch_nominals_def by simp
     ultimately have \<open>\<turnstile> (Nom k # ps, i) # (qs, j) # S''\<close>
       using GoTo by fast
     then have \<open>\<turnstile> (ps, i) # (qs, j) # S''\<close>
       using ps qs by (meson Nom' list.set_intros(1-2) on.simps)
     moreover have \<open>set ((ps, i) # (qs, j) # S'') \<subseteq> S\<close>
       using S' S'' ps qs by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix i j k ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<diamond> Nom j) on (ps, i)\<close> and
     qs: \<open>(qs, j) \<in> S\<close> \<open>Nom k on (qs, j)\<close>
   show \<open>\<exists>rs. (rs, i) \<in> S \<and> (\<^bold>\<diamond> Nom k) on (rs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>rs. (rs, i) \<in> S \<and> (\<^bold>\<diamond> Nom k) on (rs, i)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([\<^bold>\<diamond> Nom k], i)} \<union> S\<close> and \<open>([\<^bold>\<diamond> Nom k], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([\<^bold>\<diamond> Nom k], i) # S'') = set S'\<close> \<open>([\<^bold>\<diamond> Nom k], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([\<^bold>\<diamond> Nom k], i)\<close>] by blast
     then have \<open>\<turnstile> ([\<^bold>\<diamond> Nom k], i) # (ps, i) # (qs, j) # S''\<close>
       using inf ST_struct[where branch'=\<open>([\<^bold>\<diamond> Nom k], i) # (ps, i) # (qs, j) # S''\<close>] \<open>n \<turnstile> S'\<close>
       by fastforce
     then have \<open>\<turnstile> ([], i) # (ps, i) # (qs, j) # S''\<close>
       using ps(2) qs(2) inf by (meson Bridge list.set_intros(1) on.simps set_subset_Cons subset_iff)
     moreover have \<open>i \<in> branch_nominals ((ps, i) # (qs, j) # S'')\<close>
       using ps unfolding branch_nominals_def by fastforce
     ultimately have \<open>\<turnstile> (ps, i) # (qs, j) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, i) # (qs, j) # S'') \<subseteq> S\<close>
       using S' S'' ps qs by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix i j k ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<diamond> Nom j) on (ps, i)\<close> and
     qs: \<open>(qs, i) \<in> S\<close> \<open>Nom k on (qs, i)\<close>
   show \<open>\<exists>rs. (rs, k) \<in> S \<and> (\<^bold>\<diamond> Nom j) on (rs, k)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>rs. (rs, k) \<in> S \<and> (\<^bold>\<diamond> Nom j) on (rs, k)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([\<^bold>\<diamond> Nom j], k)} \<union> S\<close> and \<open>([\<^bold>\<diamond> Nom j], k) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([\<^bold>\<diamond> Nom j], k) # S'') = set S'\<close> \<open>([\<^bold>\<diamond> Nom j], k) \<notin> set S''\<close>
       using split_list[where x=\<open>([\<^bold>\<diamond> Nom j], k)\<close>] by blast
     then have \<open>\<turnstile> ([\<^bold>\<diamond> Nom j], k) # (Nom k # ps, i) # (qs, i) # S''\<close>
       using inf ST_struct[where branch'=\<open>([\<^bold>\<diamond> Nom j], k) # (Nom k # ps, i) # (qs, i) # S''\<close>] \<open>n \<turnstile> S'\<close>
       by fastforce
     then have \<open>\<turnstile> ([], k) # (Nom k # ps, i) # (qs, i) # S''\<close>
       using ps(2) by (meson Nom' fm.simps(22) list.set_intros(1-2) on.simps)
     moreover have \<open>k \<in> branch_nominals ((Nom k # ps, i) # (qs, i) # S'')\<close>
       unfolding branch_nominals_def by simp
     ultimately have \<open>\<turnstile> (Nom k # ps, i) # (qs, i) # S''\<close>
       using GoTo by fast
     then have \<open>\<turnstile> (ps, i) # (qs, i) # S''\<close>
       using ps(2) qs(2) by (meson Nom' list.set_intros(1-2) on.simps)
     moreover have \<open>set ((ps, i) # (qs, i) # S'') \<subseteq> S\<close>
       using S' S'' ps qs by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p q i ps
   assume ps: \<open>(ps, i) \<in> S\<close> \<open>(p \<^bold>\<or> q) on (ps, i)\<close> and *: \<open>\<not> q at i in' S\<close>
   show \<open>p at i in' S\<close>
   proof (rule ccontr)
     assume \<open>\<not> p at i in' S\<close>
     then obtain Sp' np where
       \<open>np \<turnstile> Sp'\<close> and Sp': \<open>set Sp' \<subseteq> {(p # ps, i)} \<union> S\<close> and \<open>(p # ps, i) \<in>. Sp'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain Sp'' where Sp'':
       \<open>set ((p # ps, i) # Sp'') = set Sp'\<close> \<open>(p # ps, i) \<notin> set Sp''\<close>
       using split_list[where x=\<open>(p # ps, i)\<close>] by blast
     then have \<open>\<turnstile> (p # ps, i) # Sp''\<close>
       using \<open>np \<turnstile> Sp'\<close> inf ST_struct by blast
 
     obtain Sq' nq where
       \<open>nq \<turnstile> Sq'\<close> and Sq': \<open>set Sq' \<subseteq> {(q # ps, i)} \<union> S\<close> and \<open>(q # ps, i) \<in>. Sq'\<close>
       using * \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain Sq'' where Sq'':
       \<open>set ((q # ps, i) # Sq'') = set Sq'\<close> \<open>(q # ps, i) \<notin> set Sq''\<close>
       using split_list[where x=\<open>(q # ps, i)\<close>] by blast
     then have \<open>\<turnstile> (q # ps, i) # Sq''\<close>
       using \<open>nq \<turnstile> Sq'\<close> inf ST_struct by blast
 
     obtain S'' where S'': \<open>set S'' = set Sp'' \<union> set Sq''\<close>
       by (meson set_union)
     then have
       \<open>set ((p # ps, i) # Sp'') \<subseteq> set ((p # ps, i) # S'')\<close>
       \<open>set ((q # ps, i) # Sq'') \<subseteq> set ((q # ps, i) # S'')\<close>
       by auto
     then have \<open>\<turnstile> (p # ps, i) # S''\<close> \<open>\<turnstile> (q # ps, i) # S''\<close>
       using \<open>\<turnstile> (p # ps, i) # Sp''\<close> \<open>\<turnstile> (q # ps, i) # Sq''\<close> inf ST_struct by blast+
     then have \<open>\<turnstile> (ps, i) # S''\<close>
       using ps by (meson DisP'' list.set_intros(1))
     moreover have \<open>set ((ps, i) # S'') \<subseteq> S\<close>
       using ps Sp' Sp'' Sq' Sq'' S'' by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p q i ps
   assume ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) on (ps, i)\<close>
   show \<open>(\<^bold>\<not> p) at i in' S\<close>
   proof (rule ccontr)
     assume \<open>\<not> (\<^bold>\<not> p) at i in' S\<close>
     then obtain S' where
       \<open>\<turnstile> S'\<close> and
       S': \<open>set S' \<subseteq> {((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i)} \<union> S\<close> and
       \<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis (mono_tags, lifting) insert_is_Un insert_subset list.simps(15) on.simps
           set_subset_Cons subset_insert)
     then obtain S'' where S'':
       \<open>set (((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) # S'') = set S'\<close>
       \<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) \<notin> set S''\<close>
       using split_list[where x=\<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i)\<close>] by blast
     then have \<open>\<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) # S''\<close>
       using inf ST_struct \<open>\<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> (ps, i) # S''\<close>
       using ps by (meson DisN' list.set_intros(1))
     moreover have \<open>set ((ps, i) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p q i ps
   assume ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<not> (p \<^bold>\<or> q)) on (ps, i)\<close>
   show \<open>(\<^bold>\<not> q) at i in' S\<close>
   proof (rule ccontr)
     assume \<open>\<not> (\<^bold>\<not> q) at i in' S\<close>
     then obtain S' where
       \<open>\<turnstile> S'\<close> and
       S': \<open>set S' \<subseteq> {((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i)} \<union> S\<close> and
       \<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis (mono_tags, lifting) insert_is_Un insert_subset list.simps(15) on.simps
           set_subset_Cons subset_insert)
     then obtain S'' where S'':
       \<open>set (((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) # S'') = set S'\<close>
       \<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) \<notin> set S''\<close>
       using split_list[where x=\<open>((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i)\<close>] by blast
     then have \<open>\<turnstile> ((\<^bold>\<not> q) # (\<^bold>\<not> p) # ps, i) # S''\<close>
       using inf ST_struct \<open>\<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> (ps, i) # S''\<close>
       using ps by (meson DisN' list.set_intros(1))
     moreover have \<open>set ((ps, i) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p i ps
   assume ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<not> \<^bold>\<not> p) on (ps, i)\<close>
   show \<open>\<exists>qs. (qs, i) \<in> S \<and> p on (qs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, i) \<in> S \<and> p on (qs, i)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {(p # ps, i)} \<union> S\<close> and \<open>(p # ps, i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set ((p # ps, i) # S'') = set S'\<close> \<open>(p # ps, i) \<notin> set S''\<close>
       using split_list[where x=\<open>(p # ps, i)\<close>] by blast
     then have \<open>\<turnstile> (p # ps, i) # S''\<close>
       using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> (ps, i) # S''\<close>
       using ps by (meson Neg' list.set_intros(1))
     moreover have \<open>set ((ps, i) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p i ps a
   assume ps: \<open>(ps, a) \<in> S\<close> \<open>(\<^bold>@ i p) on (ps, a)\<close>
   show \<open>\<exists>qs. (qs, i) \<in> S \<and> p on (qs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, i) \<in> S \<and> p on (qs, i)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([p], i)} \<union> S\<close> and \<open>([p], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([p], i) # S'') = set S'\<close> \<open>([p], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([p], i)\<close>] by blast
     then have \<open>\<turnstile> ([p], i) # S''\<close>
       using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
     moreover have \<open>set (([p], i) # S'') \<subseteq> set (([p], i) # (ps, a) # S'')\<close>
       by auto
     ultimately have \<open>\<turnstile> ([p], i) # (ps, a) # S''\<close>
       using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> ([], i) # (ps, a) # S''\<close>
       using ps by (metis SatP' insert_iff list.simps(15))
     moreover have \<open>i \<in> branch_nominals ((ps, a) # S'')\<close>
       using ps unfolding branch_nominals_def by fastforce
     ultimately have \<open>\<turnstile> (ps, a) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, a) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p i ps a
   assume ps: \<open>(ps, a) \<in> S\<close> \<open>(\<^bold>\<not> (\<^bold>@ i p)) on (ps, a)\<close>
   show \<open>\<exists>qs. (qs, i) \<in> S \<and> (\<^bold>\<not> p) on (qs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, i) \<in> S \<and> (\<^bold>\<not> p) on (qs, i)\<close>
     then obtain S' n where
       \<open>n \<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([\<^bold>\<not> p], i)} \<union> S\<close> and \<open>([\<^bold>\<not> p], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([\<^bold>\<not> p], i) # S'') = set S'\<close> \<open>([\<^bold>\<not> p], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([\<^bold>\<not> p], i)\<close>] by blast
     then have \<open>\<turnstile> ([\<^bold>\<not> p], i) # S''\<close>
       using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> ([\<^bold>\<not> p], i) # (ps, a) # S''\<close>
       using inf ST_struct[where branch'=\<open>([\<^bold>\<not> p], i) # _ # S''\<close>] \<open>n \<turnstile> S'\<close>
       by fastforce
     then have \<open>\<turnstile> ([], i) # (ps, a) # S''\<close>
       using ps by (metis SatN' insert_iff list.simps(15))
     moreover have \<open>i \<in> branch_nominals ((ps, a) # S'')\<close>
       using ps unfolding branch_nominals_def by fastforce
     ultimately have \<open>\<turnstile> (ps, a) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, a) # S'') \<subseteq> S\<close>
       using S' S'' ps by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 next
   fix p i ps
   assume
     \<open>\<nexists>a. p = Nom a\<close> and
     ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<diamond> p) on (ps, i)\<close>
   then show \<open>\<exists>j.
       (\<exists>qs. (qs, i) \<in> S \<and> (\<^bold>\<diamond> Nom j) on (qs, i)) \<and>
       (\<exists>rs. (rs, i) \<in> S \<and> (\<^bold>@ j p) on (rs, i))\<close>
     using \<open>saturated S\<close> unfolding saturated_def by blast
 next
   fix p i j ps qs
   assume
     ps: \<open>(ps, i) \<in> S\<close> \<open>(\<^bold>\<not> (\<^bold>\<diamond> p)) on (ps, i)\<close> and
     qs: \<open>(qs, i) \<in> S\<close> \<open>(\<^bold>\<diamond> Nom j) on (qs, i)\<close>
   show \<open>\<exists>rs. (rs, i) \<in> S \<and> (\<^bold>\<not> (\<^bold>@ j p)) on (rs, i)\<close>
   proof (rule ccontr)
     assume \<open>\<nexists>qs. (qs, i) \<in> S \<and> (\<^bold>\<not> (\<^bold>@ j p)) on (qs, i)\<close>
     then obtain S' n where
       \<open>n\<turnstile> S'\<close> and S': \<open>set S' \<subseteq> {([\<^bold>\<not> (\<^bold>@ j p)], i)} \<union> S\<close> and \<open>([\<^bold>\<not> (\<^bold>@ j p)], i) \<in>. S'\<close>
       using \<open>maximal S\<close> unfolding maximal_def consistent_def
       by (metis insert_is_Un list.set_intros(1) on.simps subset_insert)
     then obtain S'' where S'':
       \<open>set (([\<^bold>\<not> (\<^bold>@ j p)], i) # S'') = set S'\<close> \<open>([\<^bold>\<not> (\<^bold>@ j p)], i) \<notin> set S''\<close>
       using split_list[where x=\<open>([\<^bold>\<not> (\<^bold>@ j p)], i)\<close>] by blast
     then have \<open>\<turnstile> ([\<^bold>\<not> (\<^bold>@ j p)], i) # S''\<close>
       using inf ST_struct \<open>n \<turnstile> S'\<close> by blast
     then have \<open>\<turnstile> ([\<^bold>\<not> (\<^bold>@ j p)], i) # (ps, i) # (qs, i) # S''\<close>
       using inf ST_struct[where branch'=\<open>([_], _) # (ps, i) # (qs, i) # S''\<close>] \<open>n \<turnstile> S'\<close>
       by fastforce
     then have \<open>\<turnstile> ([], i) # (ps, i) # (qs, i) # S''\<close>
       using ps(2) qs(2) by (meson DiaN' list.set_intros(1) set_subset_Cons subset_iff)
     moreover have \<open>i \<in> branch_nominals ((ps, i) # (qs, i) # S'')\<close>
       unfolding branch_nominals_def by simp
     ultimately have \<open>\<turnstile> (ps, i) # (qs, i) # S''\<close>
       using GoTo by fast
     moreover have \<open>set ((ps, i) # (qs, i) # S'') \<subseteq> S\<close>
       using S' S'' ps qs by auto
     ultimately show False
       using \<open>consistent S\<close> unfolding consistent_def by blast
   qed
 qed
 
 subsection \<open>Result\<close>
 
 theorem completeness:
   fixes p :: \<open>('a :: countable, 'b :: countable) fm\<close>
   assumes
     inf: \<open>infinite (UNIV :: 'b set)\<close> and
     valid: \<open>\<forall>(M :: ('b set, 'a) model) g w. M, g, w \<Turnstile> p\<close>
   shows \<open>1 \<turnstile> [([\<^bold>\<not> p], i)]\<close>
 proof -
   have \<open>\<turnstile> [([\<^bold>\<not> p], i)]\<close>
   proof (rule ccontr)
     assume \<open>\<not> \<turnstile> [([\<^bold>\<not> p], i)]\<close>
     then have *: \<open>consistent {([\<^bold>\<not> p], i)}\<close>
       unfolding consistent_def using ST_struct inf
       by (metis empty_set list.simps(15))
 
     let ?S = \<open>Extend {([\<^bold>\<not> p], i)} from_nat\<close>
     have \<open>finite {([\<^bold>\<not> p], i)}\<close>
       by simp
     then have fin: \<open>finite (\<Union> (block_nominals ` {([\<^bold>\<not> p], i)}))\<close>
       using finite_nominals_set by blast
 
     have \<open>consistent ?S\<close>
       using consistent_Extend inf * fin by blast
     moreover have \<open>maximal ?S\<close>
       using maximal_Extend inf * fin by fastforce
     moreover have \<open>saturated ?S\<close>
       using saturated_Extend inf * fin by fastforce
     ultimately have \<open>hintikka ?S\<close>
       using hintikka_Extend inf by blast
     moreover have \<open>([\<^bold>\<not> p], i) \<in> ?S\<close>
       using Extend_mem by blast
     moreover have \<open>(\<^bold>\<not> p) on ([\<^bold>\<not> p], i)\<close>
       by simp
     ultimately have \<open>\<not> Model (reach ?S) (val ?S), assign ?S, assign ?S i \<Turnstile> p\<close>
       using hintikka_model by fast
     then show False
       using valid by blast
   qed
   then show ?thesis
     using ST_one by blast
 qed
 
 text \<open>
   We arbitrarily fix nominal and propositional symbols to be natural numbers
   (any countably infinite type suffices) and
   define validity as truth in all models with sets of natural numbers as worlds.
   We show below that this implies validity for any type of worlds.
 \<close>
 
 abbreviation
   \<open>valid p \<equiv> \<forall>(M :: (nat set, nat) model) (g :: nat \<Rightarrow> _) w. M, g, w \<Turnstile> p\<close>
 
 text \<open>A formula is valid iff its negation has a closing tableau from a fresh world.\<close>
 
 theorem main:
   assumes \<open>i \<notin> nominals p\<close>
   shows \<open>valid p \<longleftrightarrow> 1 \<turnstile> [([\<^bold>\<not> p], i)]\<close>
 proof
   assume \<open>valid p\<close>
   then show \<open>1 \<turnstile> [([\<^bold>\<not> p], i)]\<close>
     using completeness by blast
 next
   assume \<open>1 \<turnstile> [([\<^bold>\<not> p], i)]\<close>
   then show \<open>valid p\<close>
     using assms soundness_fresh by fast
 qed
 
 text \<open>The restricted validity implies validity in general.\<close>
 
 theorem valid_semantics:
   \<open>valid p \<longrightarrow> M, g, w \<Turnstile> p\<close>
 proof
   assume \<open>valid p\<close>
   then have \<open>i \<notin> nominals p \<Longrightarrow> \<turnstile> [([\<^bold>\<not> p], i)]\<close> for i
     using main by blast
   moreover have \<open>\<exists>i. i \<notin> nominals p\<close>
     by (simp add: finite_nominals ex_new_if_finite)
   ultimately show \<open>M, g, w \<Turnstile> p\<close>
     using soundness_fresh by fast
 qed
 
 end
diff --git a/thys/Iptables_Semantics/Semantics.thy b/thys/Iptables_Semantics/Semantics.thy
--- a/thys/Iptables_Semantics/Semantics.thy
+++ b/thys/Iptables_Semantics/Semantics.thy
@@ -1,1226 +1,1226 @@
 theory Semantics
 imports Main Firewall_Common "Common/List_Misc" "HOL-Library.LaTeXsugar"
 begin
 
 section\<open>Big Step Semantics\<close>
 
 
 text\<open>
 The assumption we apply in general is that the firewall does not alter any packets.
 \<close>
 
 text\<open>A firewall ruleset is a map of chain names
   (e.g., INPUT, OUTPUT, FORWARD, arbitrary-user-defined-chain) to a list of rules.
   The list of rules is processed sequentially.\<close>
 type_synonym 'a ruleset = "string \<rightharpoonup> 'a rule list"
 
 text\<open>A matcher (parameterized by the type of primitive @{typ 'a} and packet @{typ 'p})
      is a function which just tells whether a given primitive and packet matches.\<close>
 type_synonym ('a, 'p) matcher = "'a \<Rightarrow> 'p \<Rightarrow> bool"
 
 text\<open>Example: Assume a network packet only has a destination street number
     (for simplicity, of type @{typ "nat"}) and we only support the following match expression:
     Is the packet's street number within a certain range?
     The type for the primitive could then be @{typ "nat \<times> nat"} and a possible implementation
     for @{typ "(nat \<times> nat, nat) matcher"} could be
     @{term "match_street_number (a,b) p \<longleftrightarrow> p \<in> {a .. b}"}.
     Usually, the primitives are a datatype which supports interfaces, IP addresses, protocols,
     ports, payload, ...\<close>
 
 
 text\<open>Given an @{typ "('a, 'p) matcher"} and a match expression, does a packet of type @{typ 'p}
      match the match expression?\<close>
 fun matches :: "('a, 'p) matcher \<Rightarrow> 'a match_expr \<Rightarrow> 'p \<Rightarrow> bool" where
 "matches \<gamma> (MatchAnd e1 e2) p \<longleftrightarrow> matches \<gamma> e1 p \<and> matches \<gamma> e2 p" |
 "matches \<gamma> (MatchNot me) p \<longleftrightarrow> \<not> matches \<gamma> me p" |
 "matches \<gamma> (Match e) p \<longleftrightarrow> \<gamma> e p" |
 "matches _ MatchAny _ \<longleftrightarrow> True"
 
 
 (*Note: "matches \<gamma> (MatchNot me) p \<longleftrightarrow> \<not> matches \<gamma> me p" does not work for ternary logic.
   Here, we have Boolean logic and everything is fine.*)
 
 
 inductive iptables_bigstep :: "'a ruleset \<Rightarrow> ('a, 'p) matcher \<Rightarrow> 'p \<Rightarrow> 'a rule list \<Rightarrow> state \<Rightarrow> state \<Rightarrow> bool"
   ("_,_,_\<turnstile> \<langle>_, _\<rangle> \<Rightarrow> _"  [60,60,60,20,98,98] 89)
   for \<Gamma> and \<gamma> and p where
 skip:    "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[], t\<rangle> \<Rightarrow> t" |
 accept:  "matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Accept], Undecided\<rangle> \<Rightarrow> Decision FinalAllow" |
 drop:    "matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Drop], Undecided\<rangle> \<Rightarrow> Decision FinalDeny" |
 reject:  "matches \<gamma> m p \<Longrightarrow>  \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Reject], Undecided\<rangle> \<Rightarrow> Decision FinalDeny" |
 log:     "matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Log], Undecided\<rangle> \<Rightarrow> Undecided" |
 (*empty does not do anything to the packet. It could update the internal firewall state, e.g. marking a packet for later-on rate limiting*)
 empty:   "matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Empty], Undecided\<rangle> \<Rightarrow> Undecided" |
 nomatch: "\<not> matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Undecided" |
 decision: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Decision X\<rangle> \<Rightarrow> Decision X" |
 seq:      "\<lbrakk>\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> t; \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, t\<rangle> \<Rightarrow> t'\<rbrakk> \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1@rs\<^sub>2, Undecided\<rangle> \<Rightarrow> t'" |
 call_return:  "\<lbrakk> matches \<gamma> m p; \<Gamma> chain = Some (rs\<^sub>1@[Rule m' Return]@rs\<^sub>2);
                  matches \<gamma> m' p; \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> Undecided \<rbrakk> \<Longrightarrow>
                \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call chain)], Undecided\<rangle> \<Rightarrow> Undecided" |
 call_result:  "\<lbrakk> matches \<gamma> m p; \<Gamma> chain = Some rs; \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Undecided\<rangle> \<Rightarrow> t \<rbrakk> \<Longrightarrow>
                \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call chain)], Undecided\<rangle> \<Rightarrow> t"
 
 text\<open>
 The semantic rules again in pretty format:
 \begin{center}
 @{thm[mode=Axiom] skip [no_vars]}\\[1ex]
 @{thm[mode=Rule] accept [no_vars]}\\[1ex]
 @{thm[mode=Rule] drop [no_vars]}\\[1ex]
 @{thm[mode=Rule] reject [no_vars]}\\[1ex]
 @{thm[mode=Rule] log [no_vars]}\\[1ex]
 @{thm[mode=Rule] empty [no_vars]}\\[1ex]
 @{thm[mode=Rule] nomatch [no_vars]}\\[1ex]
 @{thm[mode=Rule] decision [no_vars]}\\[1ex]
 @{thm[mode=Rule] seq [no_vars]} \\[1ex]
 @{thm[mode=Rule] call_return [no_vars]}\\[1ex] 
 @{thm[mode=Rule] call_result [no_vars]}
 \end{center}
 \<close>
 
 
 (*future work:
   Add abstraction function for unknown actions. At the moment, only the explicitly listed actions are supported.
   This would also require a @{text "Decision FinalUnknown"} state
   Problem: An unknown action may modify a packet.
   Assume that we have a firewall which accepts the packets A->B and rewrites the header to A->C.
   After that firewall, there is another firewall which only accepts packets for A->C.
   A can send through both firewalls.
   
   If our model says that the firewall accepts packets A->B but does not consider packet modification,
   A might not be able to pass the second firewall with this model.
   
   Luckily, our model is correct for the filtering behaviour and explicitly does not support any actions with packet modification.
   Thus, the described scenario is not a counterexample that our model is wrong but a hint for future features
   we may want to support. Luckily, we introduced the @{term "Decision state"}, which should make adding packet modification states easy.
 *)
 
 lemma deny:
   "matches \<gamma> m p \<Longrightarrow> a = Drop \<or> a = Reject \<Longrightarrow> iptables_bigstep \<Gamma> \<gamma> p [Rule m a] Undecided (Decision FinalDeny)"
 by (auto intro: drop reject)
 
 lemma seq_cons:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r],Undecided\<rangle> \<Rightarrow> t" and "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,t\<rangle> \<Rightarrow> t'"
   shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs, Undecided\<rangle> \<Rightarrow> t'"
 proof -
   from assms have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r] @ rs, Undecided\<rangle> \<Rightarrow> t'" by (rule seq)
   thus ?thesis by simp
 qed
 
 lemma iptables_bigstep_induct
   [case_names Skip Allow Deny Log Nomatch Decision Seq Call_return Call_result,
    induct pred: iptables_bigstep]:
   "\<lbrakk> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,s\<rangle> \<Rightarrow> t;
      \<And>t. P [] t t;
      \<And>m a. matches \<gamma> m p \<Longrightarrow> a = Accept \<Longrightarrow> P [Rule m a] Undecided (Decision FinalAllow);
      \<And>m a. matches \<gamma> m p \<Longrightarrow> a = Drop \<or> a = Reject \<Longrightarrow> P [Rule m a] Undecided (Decision FinalDeny);
      \<And>m a. matches \<gamma> m p \<Longrightarrow> a = Log \<or> a = Empty \<Longrightarrow> P [Rule m a] Undecided Undecided;
      \<And>m a. \<not> matches \<gamma> m p \<Longrightarrow> P [Rule m a] Undecided Undecided;
      \<And>rs X. P rs (Decision X) (Decision X);
      \<And>rs rs\<^sub>1 rs\<^sub>2 t t'. rs = rs\<^sub>1 @ rs\<^sub>2 \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> P rs\<^sub>1 Undecided t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t\<rangle> \<Rightarrow> t' \<Longrightarrow> P rs\<^sub>2 t t' \<Longrightarrow> P rs Undecided t';
      \<And>m a chain rs\<^sub>1 m' rs\<^sub>2. matches \<gamma> m p \<Longrightarrow> a = Call chain \<Longrightarrow> \<Gamma> chain = Some (rs\<^sub>1 @ [Rule m' Return] @ rs\<^sub>2) \<Longrightarrow> matches \<gamma> m' p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,Undecided\<rangle> \<Rightarrow> Undecided \<Longrightarrow> P rs\<^sub>1 Undecided Undecided \<Longrightarrow> P [Rule m a] Undecided Undecided;
      \<And>m a chain rs t. matches \<gamma> m p \<Longrightarrow> a = Call chain \<Longrightarrow> \<Gamma> chain = Some rs \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> P rs Undecided t \<Longrightarrow> P [Rule m a] Undecided t \<rbrakk> \<Longrightarrow>
    P rs s t"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma skipD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [] \<Longrightarrow> s = t"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma decisionD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> s = Decision X \<Longrightarrow> t = Decision X"
 by (induction rule: iptables_bigstep_induct) auto
 
 context
   notes skipD[dest] list_app_singletonE[elim]
 begin
 
 lemma acceptD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m Accept] \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> s = Undecided \<Longrightarrow> t = Decision FinalAllow"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma dropD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m Drop] \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> s = Undecided \<Longrightarrow> t = Decision FinalDeny"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma rejectD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m Reject] \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> s = Undecided \<Longrightarrow> t = Decision FinalDeny"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma logD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m Log] \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> s = Undecided \<Longrightarrow> t = Undecided"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma emptyD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m Empty] \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> s = Undecided \<Longrightarrow> t = Undecided"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma nomatchD: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t \<Longrightarrow> r = [Rule m a] \<Longrightarrow> s = Undecided \<Longrightarrow> \<not> matches \<gamma> m p \<Longrightarrow> t = Undecided"
 by (induction rule: iptables_bigstep.induct) auto
 
 lemma callD:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r, s\<rangle> \<Rightarrow> t" "r = [Rule m (Call chain)]" "s = Undecided" "matches \<gamma> m p" "\<Gamma> chain = Some rs"
   obtains "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,s\<rangle> \<Rightarrow> t"
         | rs\<^sub>1 rs\<^sub>2 m' where "rs = rs\<^sub>1 @ Rule m' Return # rs\<^sub>2" "matches \<gamma> m' p" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,s\<rangle> \<Rightarrow> Undecided" "t = Undecided"
   using assms
   proof (induction r s t arbitrary: rs rule: iptables_bigstep.induct)
     case (seq rs\<^sub>1)
     thus ?case by (cases rs\<^sub>1) auto
   qed auto
 
 end
 
 lemmas iptables_bigstepD = skipD acceptD dropD rejectD logD emptyD nomatchD decisionD callD
 
 lemma seq':
   assumes "rs = rs\<^sub>1 @ rs\<^sub>2" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,s\<rangle> \<Rightarrow> t" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t\<rangle> \<Rightarrow> t'"
   shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,s\<rangle> \<Rightarrow> t'"
 using assms by (cases s) (auto intro: seq decision dest: decisionD)
 
 lemma seq'_cons: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r],s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,t\<rangle> \<Rightarrow> t' \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs, s\<rangle> \<Rightarrow> t'"
 by (metis decision decisionD state.exhaust seq_cons)
 
 lemma seq_split:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" "rs = rs\<^sub>1@rs\<^sub>2"
   obtains t' where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,s\<rangle> \<Rightarrow> t'" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t'\<rangle> \<Rightarrow> t"
   using assms
   proof (induction rs s t arbitrary: rs\<^sub>1 rs\<^sub>2 thesis rule: iptables_bigstep_induct)
     case Allow thus ?case by (cases rs\<^sub>1) (auto intro: iptables_bigstep.intros)
   next
     case Deny thus ?case by (cases rs\<^sub>1) (auto intro: iptables_bigstep.intros)
   next
     case Log thus ?case by (cases rs\<^sub>1) (auto intro: iptables_bigstep.intros)
   next
     case Nomatch thus ?case by (cases rs\<^sub>1) (auto intro: iptables_bigstep.intros)
   next
     case (Seq rs rsa rsb t t')
     hence rs: "rsa @ rsb = rs\<^sub>1 @ rs\<^sub>2" by simp
     note List.append_eq_append_conv_if[simp]
     from rs show ?case
       proof (cases rule: list_app_eq_cases)
         case longer
         with Seq have t1: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>take (length rsa) rs\<^sub>1, Undecided\<rangle> \<Rightarrow> t"
           by simp
         from Seq longer obtain t2
           where t2a: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>drop (length rsa) rs\<^sub>1,t\<rangle> \<Rightarrow> t2"
             and rs2_t2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t2\<rangle> \<Rightarrow> t'"
           by blast
         with t1 rs2_t2 have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>take (length rsa) rs\<^sub>1 @ drop (length rsa) rs\<^sub>1,Undecided\<rangle> \<Rightarrow> t2"
           by (blast intro: iptables_bigstep.seq)
         with Seq rs2_t2 show ?thesis
           by simp
       next
         case shorter
         with rs have rsa': "rsa = rs\<^sub>1 @ take (length rsa - length rs\<^sub>1) rs\<^sub>2"
           by (metis append_eq_conv_conj length_drop)
         from shorter rs have rsb': "rsb = drop (length rsa - length rs\<^sub>1) rs\<^sub>2"
           by (metis append_eq_conv_conj length_drop)
         from Seq rsa' obtain t1
           where t1a: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,Undecided\<rangle> \<Rightarrow> t1"
             and t1b: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>take (length rsa - length rs\<^sub>1) rs\<^sub>2,t1\<rangle> \<Rightarrow> t"
           by blast
         from rsb' Seq.hyps have t2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>drop (length rsa - length rs\<^sub>1) rs\<^sub>2,t\<rangle> \<Rightarrow> t'"
           by blast
         with seq' t1b have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t1\<rangle> \<Rightarrow> t'"
           by fastforce
         with Seq t1a show ?thesis
           by fast
       qed
   next
     case Call_return
     hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> Undecided" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, Undecided\<rangle> \<Rightarrow> Undecided"
       by (case_tac [!] rs\<^sub>1) (auto intro: iptables_bigstep.skip iptables_bigstep.call_return)
     thus ?case by fact
   next
     case (Call_result _ _ _ _ t)
     show ?case
       proof (cases rs\<^sub>1)
         case Nil
         with Call_result have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> Undecided" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, Undecided\<rangle> \<Rightarrow> t"
           by (auto intro: iptables_bigstep.intros)
         thus ?thesis by fact
       next
         case Cons
         with Call_result have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> t" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, t\<rangle> \<Rightarrow> t"
           by (auto intro: iptables_bigstep.intros)
         thus ?thesis by fact
       qed
   qed (auto intro: iptables_bigstep.intros)
 
 lemma seqE:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1@rs\<^sub>2, s\<rangle> \<Rightarrow> t"
   obtains ti where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1,s\<rangle> \<Rightarrow> ti" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,ti\<rangle> \<Rightarrow> t"
   using assms by (force elim: seq_split)
 
 lemma seqE_cons:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs, s\<rangle> \<Rightarrow> t"
   obtains ti where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r],s\<rangle> \<Rightarrow> ti" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs,ti\<rangle> \<Rightarrow> t"
   using assms by (metis append_Cons append_Nil seqE)
 
 lemma nomatch':
   assumes "\<And>r. r \<in> set rs \<Longrightarrow> \<not> matches \<gamma> (get_match r) p"
   shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> s"
   proof(cases s)
     case Undecided
     have "\<forall>r\<in>set rs. \<not> matches \<gamma> (get_match r) p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Undecided\<rangle> \<Rightarrow> Undecided"
       proof(induction rs)
         case Nil
         thus ?case by (fast intro: skip)
       next
         case (Cons r rs)
         hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r], Undecided\<rangle> \<Rightarrow> Undecided"
           by (cases r) (auto intro: nomatch)
         with Cons show ?case
           by (fastforce intro: seq_cons)
       qed
     with assms Undecided show ?thesis by simp
   qed (blast intro: decision)
 
 
 text\<open>there are only two cases when there can be a Return on top-level:
 
   \<^item> the firewall is in a Decision state
   \<^item> the return does not match
 
 In both cases, it is not applied!
 \<close>
 lemma no_free_return: assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Return], Undecided\<rangle> \<Rightarrow> t" and "matches \<gamma> m p" shows "False"
   proof -
   { fix a s
     have no_free_return_hlp: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>a,s\<rangle> \<Rightarrow> t \<Longrightarrow> matches \<gamma> m p \<Longrightarrow>  s = Undecided \<Longrightarrow> a = [Rule m Return] \<Longrightarrow> False"
     proof (induction rule: iptables_bigstep.induct)
       case (seq rs\<^sub>1)
       thus ?case
         by (cases rs\<^sub>1) (auto dest: skipD)
     qed simp_all
   } with assms show ?thesis by blast
   qed
 
 
 (* seq_split is elim, seq_progress is dest *)
 lemma seq_progress: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t \<Longrightarrow> rs = rs\<^sub>1@rs\<^sub>2 \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, s\<rangle> \<Rightarrow> t' \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, t'\<rangle> \<Rightarrow> t"
   proof(induction arbitrary: rs\<^sub>1 rs\<^sub>2 t' rule: iptables_bigstep_induct)
     case Allow
     thus ?case
       by (cases "rs\<^sub>1") (auto intro: iptables_bigstep.intros dest: iptables_bigstepD)
   next
     case Deny
     thus ?case
       by (cases "rs\<^sub>1") (auto intro: iptables_bigstep.intros dest: iptables_bigstepD)
   next
     case Log
     thus ?case
       by (cases "rs\<^sub>1") (auto intro: iptables_bigstep.intros dest: iptables_bigstepD)
   next
     case Nomatch
     thus ?case
       by (cases "rs\<^sub>1") (auto intro: iptables_bigstep.intros dest: iptables_bigstepD)
   next
     case Decision
     thus ?case
       by (cases "rs\<^sub>1") (auto intro: iptables_bigstep.intros dest: iptables_bigstepD)
   next
     case(Seq rs rsa rsb t t' rs\<^sub>1 rs\<^sub>2 t'')
     hence rs: "rsa @ rsb = rs\<^sub>1 @ rs\<^sub>2" by simp
     note List.append_eq_append_conv_if[simp]
     (* TODO larsrh custom case distinction rule *)
 
     from rs show "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2,t''\<rangle> \<Rightarrow> t'"
       proof(cases rule: list_app_eq_cases)
         case longer
         have "rs\<^sub>1 = take (length rsa) rs\<^sub>1 @ drop (length rsa) rs\<^sub>1"
           by auto
         with Seq longer show ?thesis
           by (metis append_Nil2 skipD seq_split)
       next
         case shorter
         with Seq(7) Seq.hyps(3) Seq.IH(1) rs show ?thesis
           by (metis seq' append_eq_conv_conj)
       qed
   next
     case(Call_return m a chain rsa m' rsb)
     have xx: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call chain)], Undecided\<rangle> \<Rightarrow> t' \<Longrightarrow> matches \<gamma> m p \<Longrightarrow>
           \<Gamma> chain = Some (rsa @ Rule m' Return # rsb) \<Longrightarrow>
           matches \<gamma> m' p \<Longrightarrow>
           \<Gamma>,\<gamma>,p\<turnstile> \<langle>rsa, Undecided\<rangle> \<Rightarrow> Undecided \<Longrightarrow>
           t' = Undecided"
       apply(erule callD)
            apply(simp_all)
       apply(erule seqE)
       apply(erule seqE_cons)
       by (metis Call_return.IH no_free_return self_append_conv skipD)
 
     show ?case
       proof (cases rs\<^sub>1)
         case (Cons r rs)
         thus ?thesis
           using Call_return
           apply(case_tac "[Rule m a] = rs\<^sub>2")
            apply(simp)
           apply(simp)
           using xx by blast
       next
         case Nil
         moreover hence "t' = Undecided"
           by (metis Call_return.hyps(1) Call_return.prems(2) append.simps(1) decision no_free_return seq state.exhaust)
         moreover have "\<And>m. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Undecided"
           by (metis (no_types) Call_return(2) Call_return.hyps(3) Call_return.hyps(4) Call_return.hyps(5) call_return nomatch)
         ultimately show ?thesis
           using Call_return.prems(1) by auto
       qed
   next
     case(Call_result m a chain rs t)
     thus ?case
       proof (cases rs\<^sub>1)
         case Cons
         thus ?thesis
           using Call_result
           apply(auto simp add: iptables_bigstep.skip iptables_bigstep.call_result dest: skipD)
           apply(drule callD, simp_all)
            apply blast
           by (metis Cons_eq_appendI append_self_conv2 no_free_return seq_split)
       qed (fastforce intro: iptables_bigstep.intros dest: skipD)
   qed (auto dest: iptables_bigstepD)
 
 
 theorem iptables_bigstep_deterministic: assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" and "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t'" shows "t = t'"
 proof -
   { fix r1 r2 m t
     assume a1: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r1 @ Rule m Return # r2, Undecided\<rangle> \<Rightarrow> t" and a2: "matches \<gamma> m p" and a3: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r1,Undecided\<rangle> \<Rightarrow> Undecided"
     have False
     proof -
       from a1 a3 have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m Return # r2, Undecided\<rangle> \<Rightarrow> t"
         by (blast intro: seq_progress)
       hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Return] @ r2, Undecided\<rangle> \<Rightarrow> t"
         by simp
       from seqE[OF this] obtain ti where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Return], Undecided\<rangle> \<Rightarrow> ti" by blast
       with no_free_return a2 show False by fast (*by (blast intro: no_free_return elim: seq_split)*)
     qed
   } note no_free_return_seq=this
   
   from assms show ?thesis
   proof (induction arbitrary: t' rule: iptables_bigstep_induct)
     case Seq
     thus ?case
       by (metis seq_progress)
   next
     case Call_result
     thus ?case
       by (metis no_free_return_seq callD)
   next
     case Call_return
     thus ?case
       by (metis append_Cons callD no_free_return_seq)
   qed (auto dest: iptables_bigstepD)
 qed
 
 lemma iptables_bigstep_to_undecided: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> Undecided \<Longrightarrow> s = Undecided"
   by (metis decisionD state.exhaust)
 
 lemma iptables_bigstep_to_decision: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Decision Y\<rangle> \<Rightarrow> Decision X \<Longrightarrow> Y = X"
   by (metis decisionD state.inject)
 
 lemma Rule_UndecidedE:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Undecided"
   obtains (nomatch) "\<not> matches \<gamma> m p"
         | (log) "a = Log \<or> a = Empty"
         | (call) c where "a = Call c" "matches \<gamma> m p"
   using assms
   proof (induction "[Rule m a]" Undecided Undecided rule: iptables_bigstep_induct)
     case Seq
     thus ?case
       by (metis append_eq_Cons_conv append_is_Nil_conv iptables_bigstep_to_undecided)
   qed simp_all
 
 lemma Rule_DecisionE:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Decision X"
   obtains (call) chain where "matches \<gamma> m p" "a = Call chain"
         | (accept_reject) "matches \<gamma> m p" "X = FinalAllow \<Longrightarrow> a = Accept" "X = FinalDeny \<Longrightarrow> a = Drop \<or> a = Reject"
   using assms
   proof (induction "[Rule m a]" Undecided "Decision X" rule: iptables_bigstep_induct)
     case (Seq rs\<^sub>1)
     thus ?case
       by (cases rs\<^sub>1) (auto dest: skipD)
   qed simp_all
 
 
 lemma log_remove:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1 @ [Rule m Log] @ rs\<^sub>2, s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1 @ rs\<^sub>2, s\<rangle> \<Rightarrow> t"
   proof -
     from assms obtain t' where t': "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, s\<rangle> \<Rightarrow> t'" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Log] @ rs\<^sub>2, t'\<rangle> \<Rightarrow> t"
       by (blast elim: seqE)
     hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m Log # rs\<^sub>2, t'\<rangle> \<Rightarrow> t"
       by simp
     then obtain t'' where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Log], t'\<rangle> \<Rightarrow> t''" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, t''\<rangle> \<Rightarrow> t"
       by (blast elim: seqE_cons)
     with t' show ?thesis
       by (metis state.exhaust iptables_bigstep_deterministic decision log nomatch seq)
   qed
 lemma empty_empty:
   assumes "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1 @ [Rule m Empty] @ rs\<^sub>2, s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1 @ rs\<^sub>2, s\<rangle> \<Rightarrow> t"
   proof -
     from assms obtain t' where t': "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>1, s\<rangle> \<Rightarrow> t'" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Empty] @ rs\<^sub>2, t'\<rangle> \<Rightarrow> t"
       by (blast elim: seqE)
     hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m Empty # rs\<^sub>2, t'\<rangle> \<Rightarrow> t"
       by simp
     then obtain t'' where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Empty], t'\<rangle> \<Rightarrow> t''" "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs\<^sub>2, t''\<rangle> \<Rightarrow> t"
       by (blast elim: seqE_cons)
     with t' show ?thesis
       by (metis state.exhaust iptables_bigstep_deterministic decision empty nomatch seq)
   qed
 
 
 
 lemma Unknown_actions_False: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r # rs, Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> r = Rule m a \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> a = Unknown \<or> (\<exists>chain. a = Goto chain) \<Longrightarrow> False"
 proof -
   have 1: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Unknown], Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> False"
   by (induction "[Rule m Unknown]" Undecided t rule: iptables_bigstep.induct)
      (auto elim: list_app_singletonE dest: skipD)
   
   { fix chain
     have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Goto chain)], Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> False"
     by (induction "[Rule m (Goto chain)]" Undecided t rule: iptables_bigstep.induct)
        (auto elim: list_app_singletonE dest: skipD)
   }note 2=this
   show "\<Gamma>,\<gamma>,p\<turnstile> \<langle>r # rs, Undecided\<rangle> \<Rightarrow> t \<Longrightarrow> r = Rule m a \<Longrightarrow> matches \<gamma> m p \<Longrightarrow> a = Unknown \<or> (\<exists>chain. a = Goto chain) \<Longrightarrow> False"
   apply(erule seqE_cons)
   apply(case_tac ti)
    apply(simp_all)
    using Rule_UndecidedE apply fastforce
   by (metis "1" "2" decision iptables_bigstep_deterministic)
 qed
 
 text\<open>
 The notation we prefer in the paper. The semantics are defined for fixed \<open>\<Gamma>\<close> and \<open>\<gamma>\<close>
 \<close>
 locale iptables_bigstep_fixedbackground =
   fixes \<Gamma>::"'a ruleset"
   and \<gamma>::"('a, 'p) matcher"
   begin
 
   inductive iptables_bigstep' :: "'p \<Rightarrow> 'a rule list \<Rightarrow> state \<Rightarrow> state \<Rightarrow> bool"
-    ("_\<turnstile>' \<langle>_, _\<rangle> \<Rightarrow> _"  [60,20,98,98] 89)
+    ("_\<turnstile>'' \<langle>_, _\<rangle> \<Rightarrow> _"  [60,20,98,98] 89)
     for p where
   skip:    "p\<turnstile>' \<langle>[], t\<rangle> \<Rightarrow> t" |
   accept:  "matches \<gamma> m p \<Longrightarrow> p\<turnstile>' \<langle>[Rule m Accept], Undecided\<rangle> \<Rightarrow> Decision FinalAllow" |
   drop:    "matches \<gamma> m p \<Longrightarrow> p\<turnstile>' \<langle>[Rule m Drop], Undecided\<rangle> \<Rightarrow> Decision FinalDeny" |
   reject:  "matches \<gamma> m p \<Longrightarrow>  p\<turnstile>' \<langle>[Rule m Reject], Undecided\<rangle> \<Rightarrow> Decision FinalDeny" |
   log:     "matches \<gamma> m p \<Longrightarrow> p\<turnstile>' \<langle>[Rule m Log], Undecided\<rangle> \<Rightarrow> Undecided" |
   empty:   "matches \<gamma> m p \<Longrightarrow> p\<turnstile>' \<langle>[Rule m Empty], Undecided\<rangle> \<Rightarrow> Undecided" |
   nomatch: "\<not> matches \<gamma> m p \<Longrightarrow> p\<turnstile>' \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Undecided" |
   decision: "p\<turnstile>' \<langle>rs, Decision X\<rangle> \<Rightarrow> Decision X" |
   seq:      "\<lbrakk>p\<turnstile>' \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> t; p\<turnstile>' \<langle>rs\<^sub>2, t\<rangle> \<Rightarrow> t'\<rbrakk> \<Longrightarrow> p\<turnstile>' \<langle>rs\<^sub>1@rs\<^sub>2, Undecided\<rangle> \<Rightarrow> t'" |
   call_return:  "\<lbrakk> matches \<gamma> m p; \<Gamma> chain = Some (rs\<^sub>1@[Rule m' Return]@rs\<^sub>2);
                    matches \<gamma> m' p; p\<turnstile>' \<langle>rs\<^sub>1, Undecided\<rangle> \<Rightarrow> Undecided \<rbrakk> \<Longrightarrow>
                  p\<turnstile>' \<langle>[Rule m (Call chain)], Undecided\<rangle> \<Rightarrow> Undecided" |
   call_result:  "\<lbrakk> matches \<gamma> m p; p\<turnstile>' \<langle>the (\<Gamma> chain), Undecided\<rangle> \<Rightarrow> t \<rbrakk> \<Longrightarrow>
                  p\<turnstile>' \<langle>[Rule m (Call chain)], Undecided\<rangle> \<Rightarrow> t"
 
   definition wf_\<Gamma>:: "'a rule list \<Rightarrow> bool" where
     "wf_\<Gamma> rs \<equiv> \<forall>rsg \<in> ran \<Gamma> \<union> {rs}. (\<forall>r \<in> set rsg. \<forall> chain. get_action r = Call chain \<longrightarrow> \<Gamma> chain \<noteq> None)"
 
   lemma wf_\<Gamma>_append: "wf_\<Gamma> (rs1@rs2) \<longleftrightarrow> wf_\<Gamma> rs1 \<and> wf_\<Gamma> rs2"
     by(simp add: wf_\<Gamma>_def, blast)
   lemma wf_\<Gamma>_tail: "wf_\<Gamma> (r # rs) \<Longrightarrow> wf_\<Gamma> rs" by(simp add: wf_\<Gamma>_def)
   lemma wf_\<Gamma>_Call: "wf_\<Gamma> [Rule m (Call chain)] \<Longrightarrow> wf_\<Gamma> (the (\<Gamma> chain)) \<and> (\<exists>rs. \<Gamma> chain = Some rs)"
     apply(simp add: wf_\<Gamma>_def)
     by (metis option.collapse ranI)
   
   lemma "wf_\<Gamma> rs \<Longrightarrow> p\<turnstile>' \<langle>rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
     apply(rule iffI)
      apply(rotate_tac 1)
      apply(induction rs s t rule: iptables_bigstep'.induct)
                apply(auto intro: iptables_bigstep.intros simp: wf_\<Gamma>_append dest!: wf_\<Gamma>_Call)[11]
     apply(rotate_tac 1)
     apply(induction rs s t rule: iptables_bigstep.induct)
               apply(auto intro: iptables_bigstep'.intros simp: wf_\<Gamma>_append dest!: wf_\<Gamma>_Call)[11]
     done
     
   end
 
 
 
 
 text\<open>Showing that semantics are defined.
   For rulesets which can be loaded by the Linux kernel. The kernel does not allow loops.\<close>
 
 
 
 
 text\<open>
   We call a ruleset well-formed (wf) iff all @{const Call}s are into actually existing chains.
 \<close>
 definition wf_chain :: "'a ruleset \<Rightarrow> 'a rule list \<Rightarrow> bool" where
   "wf_chain \<Gamma> rs \<equiv> (\<forall>r \<in> set rs. \<forall> chain. get_action r = Call chain \<longrightarrow> \<Gamma> chain \<noteq> None)"
 lemma wf_chain_append: "wf_chain \<Gamma> (rs1@rs2) \<longleftrightarrow> wf_chain \<Gamma> rs1 \<and> wf_chain \<Gamma> rs2"
   by(simp add: wf_chain_def, blast)
 
 lemma wf_chain_fst: "wf_chain \<Gamma> (r # rs) \<Longrightarrow>  wf_chain \<Gamma> (rs)"
   by(simp add: wf_chain_def)
 
 
 text\<open>This is what our tool will check at runtime\<close>
 definition sanity_wf_ruleset :: "(string \<times> 'a rule list) list \<Rightarrow> bool" where
   "sanity_wf_ruleset \<Gamma> \<equiv> distinct (map fst \<Gamma>) \<and>
           (\<forall> rs \<in> ran (map_of \<Gamma>). (\<forall>r \<in> set rs. case get_action r of Accept \<Rightarrow> True
                                                                     | Drop \<Rightarrow> True
                                                                     | Reject \<Rightarrow> True
                                                                     | Log \<Rightarrow> True
                                                                     | Empty \<Rightarrow> True
                                                                     | Call chain \<Rightarrow> chain \<in> dom (map_of \<Gamma>)
                                                                     | Goto chain \<Rightarrow> chain \<in> dom (map_of \<Gamma>)
                                                                     | Return \<Rightarrow> True
                                                                     | _ \<Rightarrow> False))"
 
 lemma sanity_wf_ruleset_wf_chain: "sanity_wf_ruleset \<Gamma> \<Longrightarrow> rs \<in> ran (map_of \<Gamma>) \<Longrightarrow> wf_chain (map_of \<Gamma>) rs"
   apply(simp add: sanity_wf_ruleset_def wf_chain_def)
   by fastforce
 
 lemma sanity_wf_ruleset_start: "sanity_wf_ruleset \<Gamma> \<Longrightarrow> chain_name \<in> dom (map_of \<Gamma>) \<Longrightarrow>
   default_action = Accept \<or> default_action = Drop \<Longrightarrow> 
   wf_chain (map_of \<Gamma>) [Rule MatchAny (Call chain_name), Rule MatchAny default_action]"
  apply(simp add: sanity_wf_ruleset_def wf_chain_def)
  apply(safe)
   apply(simp_all)
   apply blast+
  done
 
 lemma [code]: "sanity_wf_ruleset \<Gamma> =
   (let dom = map fst \<Gamma>;
        ran = map snd \<Gamma>
    in distinct dom \<and>
     (\<forall> rs \<in> set ran. (\<forall>r \<in> set rs. case get_action r of Accept \<Rightarrow> True
                                                        | Drop \<Rightarrow> True
                                                        | Reject \<Rightarrow> True
                                                        | Log \<Rightarrow> True
                                                        | Empty \<Rightarrow> True
                                                        | Call chain \<Rightarrow> chain \<in> set dom
                                                        | Goto chain \<Rightarrow> chain \<in> set dom
                                                        | Return \<Rightarrow> True
                                                        | _ \<Rightarrow> False)))"
   proof -
   have set_map_fst: "set (map fst \<Gamma>) = dom (map_of \<Gamma>)"
     by (simp add: dom_map_of_conv_image_fst)
   have set_map_snd: "distinct (map fst \<Gamma>) \<Longrightarrow> set (map snd \<Gamma>) = ran (map_of \<Gamma>)"
     by (simp add: ran_distinct)
   show ?thesis
   unfolding sanity_wf_ruleset_def Let_def
   apply(subst set_map_fst)+
   apply(rule iffI)
    apply(elim conjE)
    apply(subst set_map_snd)
     apply(simp)
    apply(simp)
   apply(elim conjE)
   apply(subst(asm) set_map_snd)
    apply(simp_all)
   done
 qed
 
 
 
 
 
 lemma semantics_bigstep_defined1: assumes "\<forall>rsg \<in> ran \<Gamma> \<union> {rs}. wf_chain \<Gamma> rsg"
   and "\<forall>rsg \<in> ran \<Gamma> \<union> {rs}. \<forall> r \<in> set rsg. (\<forall>chain. get_action r \<noteq> Goto chain) \<and> get_action r \<noteq> Unknown"
   and "\<forall> r \<in> set rs. get_action r \<noteq> Return" (*no toplevel return*)
   and "(\<forall>name \<in> dom \<Gamma>. \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>the (\<Gamma> name), Undecided\<rangle> \<Rightarrow> t)" (*defined for all chains in the background ruleset*)
   shows "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
 using assms proof(induction rs)
 case Nil thus ?case
  apply(rule_tac x=s in exI)
  by(simp add: skip)
 next
 case (Cons r rs)
   from Cons.prems Cons.IH obtain t' where t': "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t'"
     apply simp
     apply(elim conjE)
     apply(simp add: wf_chain_fst)
     by blast
 
   obtain m a where r: "r = Rule m a" by(cases r) blast
 
   show ?case
   proof(cases "matches \<gamma> m p")
   case False
     hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r], s\<rangle> \<Rightarrow> s"
       apply(cases s)
        apply(simp add: nomatch r)
       by(simp add: decision)
     thus ?thesis
       apply(rule_tac x=t' in exI)
       apply(rule_tac t=s in seq'_cons)
        apply assumption
       using t' by(simp)
   next
   case True
     show ?thesis
     proof(cases s)
     case (Decision X) thus ?thesis
       apply(rule_tac x="Decision X" in exI)
       by(simp add: decision)
     next
     case Undecided
       have "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m a # rs, Undecided\<rangle> \<Rightarrow> t"
       proof(cases a)
         case Accept with True show ?thesis
           apply(rule_tac x="Decision FinalAllow" in exI)
           apply(rule_tac t="Decision FinalAllow" in seq'_cons)
            by(auto intro: iptables_bigstep.intros)
         next
         case Drop with True show ?thesis
           apply(rule_tac x="Decision FinalDeny" in exI)
           apply(rule_tac t="Decision FinalDeny" in seq'_cons)
            by(auto intro: iptables_bigstep.intros)
         next
         case Log with True t' Undecided show ?thesis
           apply(rule_tac x=t' in exI)
           apply(rule_tac t=Undecided in seq'_cons)
            by(auto intro: iptables_bigstep.intros)
         next
         case Reject with True show ?thesis
           apply(rule_tac x="Decision FinalDeny" in exI)
           apply(rule_tac t="Decision FinalDeny" in seq'_cons)
            by(auto intro: iptables_bigstep.intros)[2]
         next
         case Return with Cons.prems(3)[simplified r] show ?thesis by simp
         next
         case Goto with Cons.prems(2)[simplified r] show ?thesis by auto
         next
         case (Call chain_name)
           from Call Cons.prems(1) obtain rs' where 1: "\<Gamma> chain_name = Some rs'" by(simp add: r wf_chain_def) blast
           with Cons.prems(4) obtain t'' where 2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>the (\<Gamma> chain_name), Undecided\<rangle> \<Rightarrow> t''" by blast
           from 1 2 True have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call chain_name)], Undecided\<rangle> \<Rightarrow> t''" by(auto dest: call_result)
           with Call t' Undecided show ?thesis
           apply(simp add: r)
           apply(cases t'')
            apply simp
            apply(rule_tac x=t' in exI)
            apply(rule_tac t=Undecided in seq'_cons)
             apply(auto intro: iptables_bigstep.intros)[2]
           apply(simp)
           apply(rule_tac x=t'' in exI)
           apply(rule_tac t=t'' in seq'_cons)
            apply(auto intro: iptables_bigstep.intros)
          done
         next
         case Empty  with True t' Undecided show ?thesis
          apply(rule_tac x=t' in exI)
          apply(rule_tac t=Undecided in seq'_cons)
           by(auto intro: iptables_bigstep.intros)
         next
         case Unknown with Cons.prems(2)[simplified r] show ?thesis by(simp)
       qed
       thus ?thesis
       unfolding r Undecided by simp
     qed
   qed
 qed
 
 text\<open>Showing the main theorem\<close>
 
 context
 begin
   private lemma iptables_bigstep_defined_if_singleton_rules:
   "\<forall> r \<in> set rs. (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[r], s\<rangle> \<Rightarrow> t) \<Longrightarrow> \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
   proof(induction rs arbitrary: s)
   case Nil hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[], s\<rangle> \<Rightarrow> s" by(simp add: skip)
      thus ?case by blast
   next
   case(Cons r rs s)
     from Cons.prems obtain t where t: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[r], s\<rangle> \<Rightarrow> t" by simp blast
     with Cons show ?case
     proof(cases t)
       case Decision with t show ?thesis by (meson decision seq'_cons)
       next
       case Undecided
       from Cons obtain t' where t': "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t'" by simp blast
       with Undecided t show ?thesis
       apply(rule_tac x=t' in exI)
       apply(rule seq'_cons)
        apply(simp)
       using iptables_bigstep_to_undecided by fastforce
     qed
   qed
   
   
   
   
   
   
   
   text\<open>well founded relation.\<close>
   definition calls_chain :: "'a ruleset \<Rightarrow> (string \<times> string) set" where
     "calls_chain \<Gamma> = {(r, s). case \<Gamma> r of Some rs \<Rightarrow> \<exists>m. Rule m (Call s) \<in> set rs | None \<Rightarrow> False}"  
   
   lemma calls_chain_def2: "calls_chain \<Gamma> = {(caller, callee). \<exists>rs m. \<Gamma> caller = Some rs \<and> Rule m (Call callee) \<in> set rs}"
     unfolding calls_chain_def
     apply(safe)
      apply(simp split: option.split_asm)
     apply(simp)
     by blast
   
   text\<open>example\<close>
   private lemma "calls_chain [
       ''FORWARD'' \<mapsto> [(Rule m1 Log), (Rule m2 (Call ''foo'')), (Rule m3 Accept), (Rule m' (Call ''baz''))],
       ''foo'' \<mapsto> [(Rule m4 Log), (Rule m5 Return), (Rule m6 (Call ''bar''))], 
       ''bar'' \<mapsto> [],
       ''baz'' \<mapsto> []] =
       {(''FORWARD'', ''foo''), (''FORWARD'', ''baz''), (''foo'', ''bar'')}"
     unfolding calls_chain_def by(auto split: option.split_asm if_split_asm)
   
   private lemma "wf (calls_chain [
       ''FORWARD'' \<mapsto> [(Rule m1 Log), (Rule m2 (Call ''foo'')), (Rule m3 Accept), (Rule m' (Call ''baz''))],
       ''foo'' \<mapsto> [(Rule m4 Log), (Rule m5 Return), (Rule m6 (Call ''bar''))], 
       ''bar'' \<mapsto> [],
       ''baz'' \<mapsto> []])"
   proof -
     have g: "calls_chain [''FORWARD'' \<mapsto> [(Rule m1 Log), (Rule m2 (Call ''foo'')), (Rule m3 Accept), (Rule m' (Call ''baz''))],
             ''foo'' \<mapsto> [(Rule m4 Log), (Rule m5 Return), (Rule m6 (Call ''bar''))], 
             ''bar'' \<mapsto> [],
             ''baz'' \<mapsto> []] = {(''FORWARD'', ''foo''), (''FORWARD'', ''baz''), (''foo'', ''bar'')}"
     by(auto simp add: calls_chain_def split: option.split_asm if_split_asm)
     show ?thesis
       unfolding g
       apply(simp)
       apply safe
        apply(erule rtranclE, simp_all)
       apply(erule rtranclE, simp_all)
       done
   qed    
       
   
   text\<open>In our proof, we will need the reverse.\<close>
   private definition called_by_chain :: "'a ruleset \<Rightarrow> (string \<times> string) set" where
     "called_by_chain \<Gamma> = {(callee, caller). case \<Gamma> caller of Some rs \<Rightarrow> \<exists>m. Rule m (Call callee) \<in> set rs | None \<Rightarrow> False}"
   private lemma called_by_chain_converse: "calls_chain \<Gamma> = converse (called_by_chain \<Gamma>)"
     apply(simp add: calls_chain_def called_by_chain_def)
     by blast
   private lemma wf_called_by_chain: "finite (calls_chain \<Gamma>) \<Longrightarrow> wf (calls_chain \<Gamma>) \<Longrightarrow> wf (called_by_chain \<Gamma>)"
     apply(frule Wellfounded.wf_acyclic)
     apply(drule(1) Wellfounded.finite_acyclic_wf_converse)
     apply(simp add: called_by_chain_converse)
     done
   
   
   private lemma helper_cases_call_subchain_defined_or_return:
         "(\<forall>x\<in>ran \<Gamma>. wf_chain \<Gamma> x) \<Longrightarrow>
          \<forall>rsg\<in>ran \<Gamma>. \<forall>r\<in>set rsg. (\<forall>chain. get_action r \<noteq> Goto chain) \<and> get_action r \<noteq> Unknown \<Longrightarrow>
          \<forall>y m. \<forall>r\<in>set rs_called. r = Rule m (Call y) \<longrightarrow> (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call y)], Undecided\<rangle> \<Rightarrow> t) \<Longrightarrow>
          wf_chain \<Gamma> rs_called \<Longrightarrow> 
          \<forall>r\<in>set rs_called. (\<forall>chain. get_action r \<noteq> Goto chain) \<and> get_action r \<noteq> Unknown \<Longrightarrow>
          (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called, Undecided\<rangle> \<Rightarrow> t) \<or>
          (\<exists>rs_called1 rs_called2 m'.
              rs_called = (rs_called1 @ [Rule m' Return] @ rs_called2) \<and>
              matches \<gamma> m' p \<and> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided)"
   proof(induction rs_called arbitrary:)
   case Nil hence "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[], Undecided\<rangle> \<Rightarrow> t"
      apply(rule_tac x=Undecided in exI)
      by(simp add: skip)
    thus ?case by simp
   next
   case (Cons r rs)
     from Cons.prems have "wf_chain \<Gamma> [r]" by(simp add: wf_chain_def)
     from Cons.prems have IH:"(\<exists>t'. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Undecided\<rangle> \<Rightarrow> t') \<or>
       (\<exists>rs_called1 rs_called2 m'.
           rs = (rs_called1 @ [Rule m' Return] @ rs_called2) \<and>
           matches \<gamma> m' p \<and> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided)"
       apply -
       apply(rule Cons.IH)
           apply(auto dest: wf_chain_fst)
       done
   
     from Cons.prems have case_call: "r = Rule m (Call y) \<Longrightarrow> (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call y)], Undecided\<rangle> \<Rightarrow> t)" for y m
       by(simp)
   
     obtain m a where r: "r = Rule m a" by(cases r) simp
   
     from Cons.prems have a_not: "(\<forall>chain. a \<noteq> Goto chain) \<and> a \<noteq> Unknown" by(simp add: r)
   
     have ex_neq_ret: "a \<noteq> Return \<Longrightarrow> \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> t"
     proof(cases "matches \<gamma> m p")
     case False thus ?thesis by(rule_tac x=Undecided in exI)(simp add: nomatch; fail)
     next
     case True
       assume "a \<noteq> Return"
       show ?thesis
       proof(cases a)
       case Accept with True show ?thesis
         by(rule_tac x="Decision FinalAllow" in exI) (simp add: accept; fail)
       next
       case Drop with True show ?thesis
         by(rule_tac x="Decision FinalDeny" in exI) (simp add: drop; fail)
       next
       case Log with True show ?thesis
         by(rule_tac x="Undecided" in exI)(simp add: log; fail)
       next
       case Reject with True show ?thesis
         by(rule_tac x="Decision FinalDeny" in exI) (simp add: reject; fail)
       next
       case Call with True show ?thesis
         apply(simp)
         apply(rule case_call)
         apply(simp add: r; fail)
         done
       next
       case Empty with True show ?thesis by(rule_tac x="Undecided" in exI) (simp add: empty; fail)
       next
       case Return with \<open>a \<noteq> Return\<close> show ?thesis by simp
       qed(simp_all add: a_not)
     qed
   
     have *: "?case"
       if pre: "rs = rs_called1 @ Rule m' Return # rs_called2 \<and> matches \<gamma> m' p \<and> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided"
       for rs_called1 m' rs_called2
     proof(cases "matches \<gamma> m p")
     case False thus ?thesis
       apply -
       apply(rule disjI2)
       apply(rule_tac x="r#rs_called1" in exI)
       apply(rule_tac x=rs_called2 in exI)
       apply(rule_tac x=m' in exI)
       apply(simp add: r pre)
       apply(rule_tac t=Undecided in seq_cons)
        apply(simp add: r nomatch; fail)
       apply(simp add: pre; fail)
       done
     next
     case True
       from pre have rule_case_dijs1: "\<exists>X. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Decision X \<Longrightarrow> ?thesis"
         apply -
         apply(rule disjI1)
         apply(elim exE conjE, rename_tac X)
         apply(simp)
         apply(rule_tac x="Decision X" in exI)
         apply(rule_tac t="Decision X" in seq_cons)
          apply(simp add: r; fail)
         apply(simp add: decision; fail)
         done
 
       from pre have rule_case_dijs2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> Undecided \<Longrightarrow> ?thesis"
         apply -
         apply(rule disjI2)
         apply(rule_tac x="r#rs_called1" in exI)
         apply(rule_tac x=rs_called2 in exI)
         apply(rule_tac x=m' in exI)
         apply(simp add: r)
         apply(rule_tac t=Undecided in seq_cons)
          apply(simp; fail)
         apply(simp;fail)
         done
 
       show ?thesis
       proof(cases a)
       case Accept show ?thesis
         apply(rule rule_case_dijs1)
         apply(rule_tac x="FinalAllow" in exI)
         using True pre Accept by(simp add: accept)
       next
       case Drop show ?thesis
         apply(rule rule_case_dijs1)
         apply(rule_tac x="FinalDeny" in exI)
         using True Drop by(simp add: deny)
       next
       case Log show ?thesis
         apply(rule rule_case_dijs2)
         using Log True by(simp add: log)
       next
       case Reject show ?thesis
         apply(rule rule_case_dijs1)
         apply(rule_tac x="FinalDeny" in exI)
         using Reject True by(simp add: reject)
       next
       case (Call x5)
         have "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call x5)], Undecided\<rangle> \<Rightarrow> t" by(rule case_call) (simp add: r Call)
         with Call pre True show ?thesis
         apply(simp)
         apply(elim exE, rename_tac t_called)
         apply(case_tac t_called)
          apply(simp)
          apply(rule disjI2)
          apply(rule_tac x="r#rs_called1" in exI)
          apply(rule_tac x=rs_called2 in exI)
          apply(rule_tac x=m' in exI)
          apply(simp add: r)
          apply(rule_tac t=Undecided in seq_cons)
           apply(simp add: r; fail)
          apply(simp; fail)
         apply(rule disjI1)
         apply(rule_tac x=t_called in exI)
         apply(rule_tac t=t_called in seq_cons)
          apply(simp add: r; fail)
         apply(simp add: decision; fail)
         done
       next
       case Empty show ?thesis
         apply(rule rule_case_dijs2)
         using Empty True by(simp add: pre empty)
       next
       case Return show ?thesis
        apply(rule disjI2)
        apply(rule_tac x="[]" in exI)
        apply(rule_tac x="rs_called1 @ Rule m' Return # rs_called2" in exI)
        apply(rule_tac x=m in exI)
        using Return True pre by(simp add: skip r)
       qed(simp_all add: a_not)
     qed
      
     from IH have **: "a \<noteq> Return \<longrightarrow> (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> t) \<Longrightarrow> ?case"
     proof(elim disjE, goal_cases)
     case 2
       from this obtain rs_called1 m' rs_called2 where 
         a1: "rs = rs_called1 @ [Rule m' Return] @ rs_called2" and
         a2: "matches \<gamma> m' p" and a3: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided" by blast
       show ?case
         apply(rule *)
         using a1 a2 a3 by simp
     next
     case 1 thus ?case 
       proof(cases "a \<noteq> Return")
       case True
         with 1 obtain t1 t2 where t1: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> t1"
                               and t2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Undecided\<rangle> \<Rightarrow> t2" by blast
         from t1 t2 show ?thesis
         apply -
         apply(rule disjI1)
         apply(simp add: r)
         apply(cases t1)
          apply(simp_all)
          apply(rule_tac x=t2 in exI)
          apply(rule_tac seq'_cons)
           apply(simp_all)
         apply (meson decision seq_cons)
         done
       next
       case False show ?thesis
         proof(cases "matches \<gamma> m p")
           assume "\<not> matches \<gamma> m p" with 1 show ?thesis
             apply -
             apply(rule disjI1)
             apply(elim exE)
             apply(rename_tac t')
             apply(rule_tac x=t' in exI)
             apply(rule_tac t=Undecided in seq_cons)
              apply(simp add: r nomatch; fail)
             by(simp)
         next
           assume "matches \<gamma> m p" with False show ?thesis
             apply -
             apply(rule disjI2)
             apply(rule_tac x="[]" in exI)
             apply(rule_tac x=rs in exI)
             apply(rule_tac x=m in exI)
             apply(simp add: r skip; fail)
             done
         qed
       qed
     qed
     thus ?case using ex_neq_ret by blast
   qed
   
   
   lemma helper_defined_single: 
     assumes "wf (called_by_chain \<Gamma>)" 
     and "\<forall>rsg \<in> ran \<Gamma> \<union> {[Rule m a]}. wf_chain \<Gamma> rsg"
     and "\<forall>rsg \<in> ran \<Gamma> \<union> {[Rule m a]}. \<forall> r \<in> set rsg. (\<not>(\<exists>chain. get_action r = Goto chain)) \<and> get_action r \<noteq> Unknown"
     and "a \<noteq> Return" (*no toplevel Return*)
     shows "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], s\<rangle> \<Rightarrow> t"
   proof(cases s)
   case (Decision decision) thus ?thesis
     apply(rule_tac x="Decision decision" in exI)
     apply(simp)
     using iptables_bigstep.decision by fast
   next
   case Undecided
     have "\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], Undecided\<rangle> \<Rightarrow> t"
     proof(cases "matches \<gamma> m p")
     case False with assms show ?thesis
       apply(rule_tac x=Undecided in exI)
       apply(rule_tac t=Undecided in seq'_cons)
        apply (metis empty_iff empty_set insert_iff list.simps(15) nomatch' rule.sel(1)) 
       apply(simp add: skip; fail)
       done
     next
     case True
     show ?thesis
       proof(cases a)
       case Unknown with assms(3) show ?thesis by simp
       next
       case Goto with assms(3) show ?thesis by auto
       next
       case Accept with True show ?thesis by(auto intro: iptables_bigstep.intros)
       next
       case Drop with True show ?thesis by(auto intro: iptables_bigstep.intros)
       next
       case Reject with True show ?thesis by(auto intro: iptables_bigstep.intros)
       next
       case Log with True show ?thesis by(auto intro: iptables_bigstep.intros)
       next
       case Empty with True show ?thesis by(auto intro: iptables_bigstep.intros)
       next
       case Return with assms show ?thesis by simp
       next
       case (Call chain_name)
         thm wf_induct_rule[where r="(calls_chain \<Gamma>)" and P="\<lambda>x. \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call x)], Undecided\<rangle> \<Rightarrow> t"]
         \<comment> \<open>Only the assumptions we will need\<close>
         from assms have "wf (called_by_chain \<Gamma>)"
             "\<forall>rsg\<in>ran \<Gamma>. wf_chain \<Gamma> rsg"
             "\<forall>rsg\<in>ran \<Gamma>. \<forall>r\<in>set rsg. (\<forall>chain. get_action r \<noteq> Goto chain) \<and> get_action r \<noteq> Unknown" by auto
         \<comment> \<open>strengthening the IH to do a well-founded induction\<close>
         hence "matches \<gamma> m p \<Longrightarrow> wf_chain \<Gamma> [Rule m (Call chain_name)] \<Longrightarrow> (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call chain_name)], Undecided\<rangle> \<Rightarrow> t)"
         proof(induction arbitrary: m rule: wf_induct_rule[where r="called_by_chain \<Gamma>"])
         case (less chain_name_neu)
           from less.prems have "\<Gamma> chain_name_neu \<noteq> None" by(simp add: wf_chain_def)
           from this obtain rs_called where rs_called: "\<Gamma> chain_name_neu = Some rs_called" by blast
   
           from less rs_called have "wf_chain \<Gamma> rs_called" by (simp add: ranI)
           from less rs_called have "rs_called \<in> ran \<Gamma>" by (simp add: ranI)
   
           (*get good IH*)
           from less.prems rs_called have
             "\<forall>y m. \<forall>r \<in> set rs_called. r = Rule m (Call y) \<longrightarrow> (y, chain_name_neu) \<in> called_by_chain \<Gamma> \<and> wf_chain \<Gamma> [Rule m (Call y)]"
              apply(simp)
              apply(intro impI allI conjI)
               apply(simp add: called_by_chain_def)
               apply blast
              apply(simp add: wf_chain_def)
              apply (meson ranI rule.sel(2))
              done
           with less have "\<forall>y m. \<forall>r\<in>set rs_called. r = Rule m (Call y) \<longrightarrow> (\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m (Call y)], Undecided\<rangle> \<Rightarrow> t)"
              apply(intro allI, rename_tac y my)
              apply(case_tac "matches \<gamma> my p")
               apply blast
              apply(intro ballI impI)
              apply(rule_tac x=Undecided in exI)
              apply(simp add: nomatch; fail)
              done
           from less.prems(4) rs_called \<open>rs_called \<in> ran \<Gamma>\<close>
             helper_cases_call_subchain_defined_or_return[OF less.prems(3) less.prems(4) this \<open>wf_chain \<Gamma> rs_called\<close>] have
             "(\<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called, Undecided\<rangle> \<Rightarrow> t) \<or>
              (\<exists>rs_called1 rs_called2 m'.
                   \<Gamma> chain_name_neu = Some (rs_called1@[Rule m' Return]@rs_called2) \<and>
                   matches \<gamma> m' p \<and> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided)" by simp
           thus ?case
           proof(elim disjE exE conjE)
             fix t
             assume a: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called, Undecided\<rangle> \<Rightarrow> t" show ?case
             using call_result[OF less.prems(1) rs_called a] by(blast)
           next
             fix m' rs_called1 rs_called2
             assume a1: "\<Gamma> chain_name_neu = Some (rs_called1 @ [Rule m' Return] @ rs_called2)"
             and a2: "matches \<gamma> m' p" and a3: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs_called1, Undecided\<rangle> \<Rightarrow> Undecided"
             show ?case using call_return[OF less.prems(1) a1 a2 a3 ] by(blast)
           qed
         qed
         with True assms Call show ?thesis by simp
       qed
     qed
   with Undecided show ?thesis by simp
   qed
   
   
   private lemma helper_defined_ruleset_calledby: "wf (called_by_chain \<Gamma>) \<Longrightarrow> 
     \<forall>rsg \<in> ran \<Gamma> \<union> {rs}. wf_chain \<Gamma> rsg \<Longrightarrow>
     \<forall>rsg \<in> ran \<Gamma> \<union> {rs}. \<forall> r \<in> set rsg. (\<not>(\<exists>chain. get_action r = Goto chain)) \<and> get_action r \<noteq> Unknown \<Longrightarrow>
     \<forall> r \<in> set rs. get_action r \<noteq> Return \<Longrightarrow>
     \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
   apply(rule iptables_bigstep_defined_if_singleton_rules)
   apply(intro ballI, rename_tac r, case_tac r, rename_tac m a, simp)
   apply(rule helper_defined_single)
      apply(simp; fail)
     apply(simp add: wf_chain_def; fail)
    apply fastforce
   apply fastforce
   done
   
   corollary semantics_bigstep_defined: "finite (calls_chain \<Gamma>) \<Longrightarrow> wf (calls_chain \<Gamma>) \<Longrightarrow> \<comment> \<open>call relation finite and terminating\<close>
     \<forall>rsg \<in> ran \<Gamma> \<union> {rs}. wf_chain \<Gamma> rsg \<Longrightarrow> \<comment> \<open>All calls to defined chains\<close>
     \<forall>rsg \<in> ran \<Gamma> \<union> {rs}. \<forall> r \<in> set rsg. (\<forall>x. get_action r \<noteq> Goto x) \<and> get_action r \<noteq> Unknown \<Longrightarrow> \<comment> \<open>no bad actions\<close>
     \<forall> r \<in> set rs. get_action r \<noteq> Return \<comment> \<open>no toplevel return\<close> \<Longrightarrow>
     \<exists>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
   apply(drule(1) wf_called_by_chain)
   apply(thin_tac "wf (calls_chain \<Gamma>)")
   apply(rule helper_defined_ruleset_calledby)
      apply(simp_all)
   done
 end
 
 
 
 
 
 
 
 
 
 text\<open>Common Algorithms\<close>
 
 lemma iptables_bigstep_rm_LogEmpty: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rm_LogEmpty rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
 proof(induction rs arbitrary: s)
 case Nil thus ?case by(simp)
 next
 case (Cons r rs)
   have step_IH: "(\<And>s. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs1, s\<rangle> \<Rightarrow> t = \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs2, s\<rangle> \<Rightarrow> t) \<Longrightarrow>
          \<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs1, s\<rangle> \<Rightarrow> t = \<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs2, s\<rangle> \<Rightarrow> t" for rs1 rs2 r
   by (meson seq'_cons seqE_cons)
   have case_log: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m Log # rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" for m
     apply(rule iffI)
      apply(erule seqE_cons)
      apply (metis append_Nil log_remove seq')
     apply(rule_tac t=s in seq'_cons)
      apply(cases s)
       apply(cases "matches \<gamma> m p")
        apply(simp add: log; fail)
       apply(simp add: nomatch; fail)
      apply(simp add: decision; fail)
     apply simp
    done
   have case_empty: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule m Empty # rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" for m
     apply(rule iffI)
      apply(erule seqE_cons)
      apply (metis append_Nil empty_empty seq')
     apply(rule_tac t=s in seq'_cons)
      apply(cases s)
       apply(cases "matches \<gamma> m p")
        apply(simp add: empty; fail)
       apply(simp add: nomatch; fail)
      apply(simp add: decision; fail)
     apply simp
    done
 
   from Cons show ?case  
   apply(cases r, rename_tac m a)
   apply(case_tac a)
           apply(simp_all)
           apply(simp_all cong: step_IH)
    apply(simp_all add: case_log case_empty)
   done
 qed
 
 lemma iptables_bigstep_rw_Reject: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rw_Reject rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
 proof(induction rs arbitrary: s)
 case Nil thus ?case by(simp)
 next
 case (Cons r rs)
   have step_IH: "(\<And>s. \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs1, s\<rangle> \<Rightarrow> t = \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs2, s\<rangle> \<Rightarrow> t) \<Longrightarrow>
          \<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs1, s\<rangle> \<Rightarrow> t = \<Gamma>,\<gamma>,p\<turnstile> \<langle>r#rs2, s\<rangle> \<Rightarrow> t" for rs1 rs2 r
   by (meson seq'_cons seqE_cons)
   have fst_rule: "(\<And>t. \<Gamma>,\<gamma>,p\<turnstile> \<langle>[r1], s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[r2], s\<rangle> \<Rightarrow> t) \<Longrightarrow> 
     \<Gamma>,\<gamma>,p\<turnstile> \<langle>r1 # rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>r2 # rs, s\<rangle> \<Rightarrow> t" for r1 r2 rs s t
   by (meson seq'_cons seqE_cons)
   have dropreject: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Drop], s\<rangle> \<Rightarrow> t = \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m Reject], s\<rangle> \<Rightarrow> t" for m t
     apply(cases s)
      apply(cases "matches \<gamma> m p")
       using drop reject dropD rejectD apply fast
      using nomatch nomatchD apply fast
     using decision decisionD apply fast
     done
 
   from Cons show ?case
   apply(cases r, rename_tac m a)
   apply simp
   apply(case_tac a)
           apply(simp_all)
           apply(simp_all cong: step_IH)
    apply(rule fst_rule)
    apply(simp add: dropreject)
   done
 qed
 
 
 
 end
diff --git a/thys/Jacobson_Basic_Algebra/Group_Theory.thy b/thys/Jacobson_Basic_Algebra/Group_Theory.thy
--- a/thys/Jacobson_Basic_Algebra/Group_Theory.thy
+++ b/thys/Jacobson_Basic_Algebra/Group_Theory.thy
@@ -1,1700 +1,1700 @@
 (*
   Copyright (c) 2014-2019 by Clemens Ballarin
   This file is licensed under the 3-clause BSD license.
 *)
 
 theory Group_Theory imports Set_Theory begin
 
 hide_const monoid
 hide_const group
 hide_const inverse
 
 no_notation quotient (infixl "'/'/" 90)
 
 
 section \<open>Monoids and Groups\<close>
 
 subsection \<open>Monoids of Transformations and Abstract Monoids\<close>
 
 text \<open>Def 1.1\<close>
 text \<open>p 28, ll 28--30\<close>
 locale monoid =
   fixes M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
   assumes composition_closed [intro, simp]: "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> a \<cdot> b \<in> M"
     and unit_closed [intro, simp]: "\<one> \<in> M"
     and associative [intro]: "\<lbrakk> a \<in> M; b \<in> M; c \<in> M \<rbrakk> \<Longrightarrow> (a \<cdot> b) \<cdot> c = a \<cdot> (b \<cdot> c)"
     and left_unit [intro, simp]: "a \<in> M \<Longrightarrow> \<one> \<cdot> a = a"
     and right_unit [intro, simp]: "a \<in> M \<Longrightarrow> a \<cdot> \<one> = a"
 
 text \<open>p 29, ll 27--28\<close>
 locale submonoid = monoid M "(\<cdot>)" \<one>
   for N and M and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes subset [intro, simp]: "N \<subseteq> M"
     and sub_composition_closed: "\<lbrakk> a \<in> N; b \<in> N \<rbrakk> \<Longrightarrow> a \<cdot> b \<in> N"
     and sub_unit_closed: "\<one> \<in> N"
 begin
 
 text \<open>p 29, ll 27--28\<close>
 lemma sub [intro, simp]:
   "a \<in> N \<Longrightarrow> a \<in> M"
   using subset by blast
 
 text \<open>p 29, ll 32--33\<close>
 sublocale sub: monoid N "(\<cdot>)" \<one>
   by unfold_locales (auto simp: sub_composition_closed sub_unit_closed)
 
 end (* submonoid *)
 
 text \<open>p 29, ll 33--34\<close>
 theorem submonoid_transitive:
   assumes "submonoid K N composition unit"
     and "submonoid N M composition unit"
   shows "submonoid K M composition unit"
 proof -
   interpret K: submonoid K N composition unit by fact
   interpret M: submonoid N M composition unit by fact
   show ?thesis by unfold_locales auto
 qed
 
 text \<open>p 28, l 23\<close>
 locale transformations =
   fixes S :: "'a set"
 
 (*  assumes non_vacuous: "S \<noteq> {}" *) (* Jacobson requires this but we don't need it, strange. *)
 
 text \<open>Monoid of all transformations\<close>
 text \<open>p 28, ll 23--24\<close>
 sublocale transformations \<subseteq> monoid "S \<rightarrow>\<^sub>E S" "compose S" "identity S"
   by unfold_locales (auto simp: PiE_def compose_eq compose_assoc Id_compose compose_Id)
 
 text \<open>@{term N} is a monoid of transformations of the set @{term S}.\<close>
 text \<open>p 29, ll 34--36\<close>
 locale transformation_monoid =
   transformations S + submonoid M "S \<rightarrow>\<^sub>E S" "compose S" "identity S" for M and S
 begin
 
 text \<open>p 29, ll 34--36\<close>
 lemma transformation_closed [intro, simp]:
   "\<lbrakk> \<alpha> \<in> M; x \<in> S \<rbrakk> \<Longrightarrow> \<alpha> x \<in> S"
   by (metis PiE_iff sub)
 
 text \<open>p 29, ll 34--36\<close>
 lemma transformation_undefined [intro, simp]:
   "\<lbrakk> \<alpha> \<in> M; x \<notin> S \<rbrakk> \<Longrightarrow> \<alpha> x = undefined"
   by (metis PiE_arb sub)
 
 end (* transformation_monoid *)
 
 
 subsection \<open>Groups of Transformations and Abstract Groups\<close>
 
 context monoid begin
 
 text \<open>Invertible elements\<close>
 
 text \<open>p 31, ll 3--5\<close>
 definition invertible where "u \<in> M \<Longrightarrow> invertible u \<longleftrightarrow> (\<exists>v \<in> M. u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>)"
 
 text \<open>p 31, ll 3--5\<close>
 lemma invertibleI [intro]:
   "\<lbrakk> u \<cdot> v = \<one>; v \<cdot> u = \<one>; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> invertible u"
   unfolding invertible_def by fast
 
 text \<open>p 31, ll 3--5\<close>
 lemma invertibleE [elim]:
   "\<lbrakk> invertible u; \<And>v. \<lbrakk> u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>; v \<in> M \<rbrakk> \<Longrightarrow> P; u \<in> M \<rbrakk> \<Longrightarrow> P"
   unfolding invertible_def by fast
 
 text \<open>p 31, ll 6--7\<close>
 theorem inverse_unique:
   "\<lbrakk> u \<cdot> v' = \<one>; v \<cdot> u = \<one>; u \<in> M;  v \<in> M; v' \<in> M \<rbrakk> \<Longrightarrow> v = v'"
   by (metis associative left_unit right_unit)
 
 text \<open>p 31, l 7\<close>
 definition inverse where "inverse = (\<lambda>u \<in> M. THE v. v \<in> M \<and> u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>)"
 
 text \<open>p 31, l 7\<close>
 theorem inverse_equality:
   "\<lbrakk> u \<cdot> v = \<one>; v \<cdot> u = \<one>; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> inverse u = v"
   unfolding inverse_def using inverse_unique by simp blast
 
 text \<open>p 31, l 7\<close>
 lemma invertible_inverse_closed [intro, simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse u \<in> M"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma inverse_undefined [intro, simp]:
   "u \<notin> M \<Longrightarrow> inverse u = undefined"
   by (simp add: inverse_def)
 
 text \<open>p 31, l 7\<close>
 lemma invertible_left_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse u \<cdot> u = \<one>"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma invertible_right_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> u \<cdot> inverse u = \<one>"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma invertible_left_cancel [simp]:
   "\<lbrakk> invertible x; x \<in> M; y \<in> M; z \<in> M \<rbrakk> \<Longrightarrow> x \<cdot> y = x \<cdot> z \<longleftrightarrow> y = z"
   by (metis associative invertible_def left_unit)
 
 text \<open>p 31, l 7\<close>
 lemma invertible_right_cancel [simp]:
   "\<lbrakk> invertible x; x \<in> M; y \<in> M; z \<in> M \<rbrakk> \<Longrightarrow> y \<cdot> x = z \<cdot> x \<longleftrightarrow> y = z"
   by (metis associative invertible_def right_unit)
 
 text \<open>p 31, l 7\<close>
 lemma inverse_unit [simp]: "inverse \<one> = \<one>"
   using inverse_equality by blast
 
 text \<open>p 31, ll 7--8\<close>
 theorem invertible_inverse_invertible [intro, simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> invertible (inverse u)"
   using invertible_left_inverse invertible_right_inverse by blast
 
 text \<open>p 31, l 8\<close>
 theorem invertible_inverse_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse (inverse u) = u"
   by (simp add: inverse_equality)
 
 end (* monoid *)
 
 context submonoid begin
 
 text \<open>Reasoning about @{term invertible} and @{term inverse} in submonoids.\<close>
 
 text \<open>p 31, l 7\<close>
 lemma submonoid_invertible [intro, simp]:
   "\<lbrakk> sub.invertible u; u \<in> N \<rbrakk> \<Longrightarrow> invertible u"
   using invertibleI by blast
 
 text \<open>p 31, l 7\<close>
 lemma submonoid_inverse_closed [intro, simp]:
   "\<lbrakk> sub.invertible u; u \<in> N \<rbrakk> \<Longrightarrow> inverse u \<in> N"
   using inverse_equality by auto
 
 end (* submonoid *)
 
 text \<open>Def 1.2\<close>
 text \<open>p 31, ll 9--10\<close>
 locale group =
   monoid G "(\<cdot>)" \<one> for G and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes invertible [simp, intro]: "u \<in> G \<Longrightarrow> invertible u"
 
 text \<open>p 31, ll 11--12\<close>
 locale subgroup = submonoid G M "(\<cdot>)" \<one> + sub: group G "(\<cdot>)" \<one>
   for G and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 begin
 
 text \<open>Reasoning about @{term invertible} and @{term inverse} in subgroups.\<close>
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_inverse_equality [simp]:
   "u \<in> G \<Longrightarrow> inverse u = sub.inverse u"
   by (simp add: inverse_equality)
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_inverse_iff [simp]:
   "\<lbrakk> invertible x; x \<in> M \<rbrakk> \<Longrightarrow> inverse x \<in> G \<longleftrightarrow> x \<in> G"
   using invertible_inverse_inverse sub.invertible_inverse_closed by fastforce
 
 end (* subgroup *)
 
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_transitive [trans]:
   assumes "subgroup K H composition unit"
     and "subgroup H G composition unit"
   shows "subgroup K G composition unit"
 proof -
   interpret K: subgroup K H composition unit by fact
   interpret H: subgroup H G composition unit by fact
   show ?thesis by unfold_locales auto
 qed
 
 context monoid begin
 
 text \<open>Jacobson states both directions, but the other one is trivial.\<close>
 text \<open>p 31, ll 12--15\<close>
 theorem subgroupI:
   fixes G
   assumes subset [THEN subsetD, intro]: "G \<subseteq> M"
     and [intro]: "\<one> \<in> G"
     and [intro]: "\<And>g h. \<lbrakk> g \<in> G; h \<in> G \<rbrakk> \<Longrightarrow> g \<cdot> h \<in> G"
     and [intro]: "\<And>g. g \<in> G \<Longrightarrow> invertible g"
     and [intro]: "\<And>g. g \<in> G \<Longrightarrow> inverse g \<in> G"
   shows "subgroup G M (\<cdot>) \<one>"
 proof -
   interpret sub: monoid G "(\<cdot>)" \<one> by unfold_locales auto
   show ?thesis
   proof unfold_locales
     fix u assume [intro]: "u \<in> G" show "sub.invertible u"
     using invertible_left_inverse invertible_right_inverse by blast
   qed auto
 qed
 
 text \<open>p 31, l 16\<close>
 definition "Units = {u \<in> M. invertible u}"
 
 text \<open>p 31, l 16\<close>
 lemma mem_UnitsI:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> u \<in> Units"
   unfolding Units_def by clarify
 
 text \<open>p 31, l 16\<close>
 lemma mem_UnitsD:
   "\<lbrakk> u \<in> Units \<rbrakk> \<Longrightarrow> invertible u \<and> u \<in> M"
   unfolding Units_def by clarify
 
 text \<open>p 31, ll 16--21\<close>
 interpretation units: subgroup Units M
 proof (rule subgroupI)
   fix u1 u2
   assume Units [THEN mem_UnitsD, simp]: "u1 \<in> Units" "u2 \<in> Units"
   have "(u1 \<cdot> u2) \<cdot> (inverse u2 \<cdot> inverse u1) = (u1 \<cdot> (u2 \<cdot> inverse u2)) \<cdot> inverse u1"
     by (simp add: associative del: invertible_left_inverse invertible_right_inverse)
   also have "\<dots> = \<one>" by simp
   finally have inv1: "(u1 \<cdot> u2) \<cdot> (inverse u2 \<cdot> inverse u1) = \<one>" by simp  \<comment> \<open>ll 16--18\<close>
   have "(inverse u2 \<cdot> inverse u1) \<cdot> (u1 \<cdot> u2) = (inverse u2 \<cdot> (inverse u1 \<cdot> u1)) \<cdot> u2"
     by (simp add: associative del: invertible_left_inverse invertible_right_inverse)
   also have "\<dots> = \<one>" by simp
   finally have inv2: "(inverse u2 \<cdot> inverse u1) \<cdot> (u1 \<cdot> u2) = \<one>" by simp  \<comment> \<open>l 9, “and similarly”\<close>
   show "u1 \<cdot> u2 \<in> Units" using inv1 inv2 invertibleI mem_UnitsI by auto
 qed (auto simp: Units_def)
 
 text \<open>p 31, ll 21--22\<close>
 theorem group_of_Units [intro, simp]:
   "group Units (\<cdot>) \<one>"
   ..
 
 text \<open>p 31, l 19\<close>
 lemma composition_invertible [simp, intro]:
   "\<lbrakk> invertible x; invertible y; x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> invertible (x \<cdot> y)"
   using mem_UnitsD mem_UnitsI by blast
 
 text \<open>p 31, l 20\<close>
 lemma unit_invertible:
   "invertible \<one>"
   by fast
 
 text \<open>Useful simplification rules\<close>
 text \<open>p 31, l 22\<close>
 lemma invertible_right_inverse2:
   "\<lbrakk> invertible u; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> u \<cdot> (inverse u \<cdot> v) = v"
   by (simp add: associative [THEN sym])
 
 text \<open>p 31, l 22\<close>
 lemma invertible_left_inverse2:
   "\<lbrakk> invertible u; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> inverse u \<cdot> (u \<cdot> v) = v"
   by (simp add: associative [THEN sym])
 
 text \<open>p 31, l 22\<close>
 lemma inverse_composition_commute:
   assumes [simp]: "invertible x" "invertible y" "x \<in> M" "y \<in> M"
   shows "inverse (x \<cdot> y) = inverse y \<cdot> inverse x"
 proof -
   have "inverse (x \<cdot> y) \<cdot> (x \<cdot> y) = (inverse y \<cdot> inverse x) \<cdot> (x \<cdot> y)"
   by (simp add: invertible_left_inverse2 associative)
   then show ?thesis by (simp del: invertible_left_inverse)
 qed
 
 end (* monoid *)
 
 text \<open>p 31, l 24\<close>
 context transformations begin
 
 text \<open>p 31, ll 25--26\<close>
 theorem invertible_is_bijective:
   assumes dom: "\<alpha> \<in> S \<rightarrow>\<^sub>E S"
   shows "invertible \<alpha> \<longleftrightarrow> bij_betw \<alpha> S S"
 proof -
   from dom interpret map \<alpha> S S by unfold_locales
   show ?thesis by (auto simp add: bij_betw_iff_has_inverse invertible_def)
 qed
 
 text \<open>p 31, ll 26--27\<close>
 theorem Units_bijective:
   "Units = {\<alpha> \<in> S \<rightarrow>\<^sub>E S. bij_betw \<alpha> S S}"
   unfolding Units_def by (auto simp add: invertible_is_bijective)
 
 text \<open>p 31, ll 26--27\<close>
 lemma Units_bij_betwI [intro, simp]:
   "\<alpha> \<in> Units \<Longrightarrow> bij_betw \<alpha> S S"
   by (simp add: Units_bijective)
 
 text \<open>p 31, ll 26--27\<close>
 lemma Units_bij_betwD [dest, simp]:
   "\<lbrakk> \<alpha> \<in> S \<rightarrow>\<^sub>E S; bij_betw \<alpha> S S \<rbrakk> \<Longrightarrow> \<alpha> \<in> Units"
   unfolding Units_bijective by simp
 
 text \<open>p 31, ll 28--29\<close>
 abbreviation "Sym \<equiv> Units"
 
 text \<open>p 31, ll 26--28\<close>
 sublocale symmetric: group "Sym" "compose S" "identity S"
   by (fact group_of_Units)
 
 end (* transformations *)
 
 text \<open>p 32, ll 18--19\<close>
 locale transformation_group =
   transformations S + symmetric: subgroup G Sym "compose S" "identity S" for G and S
 begin
 
 text \<open>p 32, ll 18--19\<close>
 lemma transformation_group_closed [intro, simp]:
   "\<lbrakk> \<alpha> \<in> G; x \<in> S \<rbrakk> \<Longrightarrow> \<alpha> x \<in> S"
   using bij_betwE by blast
 
 text \<open>p 32, ll 18--19\<close>
 lemma transformation_group_undefined [intro, simp]:
   "\<lbrakk> \<alpha> \<in> G; x \<notin> S \<rbrakk> \<Longrightarrow> \<alpha> x = undefined"
   by (metis compose_def symmetric.sub.right_unit restrict_apply)
 
 end (* transformation_group *)
 
 
 subsection \<open>Isomorphisms.  Cayley's Theorem\<close>
 
 text \<open>Def 1.3\<close>
 text \<open>p 37, ll 7--11\<close>
 locale monoid_isomorphism =
   bijective_map \<eta> M M' +  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> x \<cdot>' \<eta> y = \<eta> (x \<cdot> y)"
     and commutes_with_unit: "\<eta> \<one> = \<one>'"
 
 text \<open>p 37, l 10\<close>
 definition isomorphic_as_monoids (infixl "\<cong>\<^sub>M" 50)
   where "\<M> \<cong>\<^sub>M \<M>' \<longleftrightarrow> (let (M, composition, unit) = \<M>; (M', composition', unit') = \<M>' in
   (\<exists>\<eta>. monoid_isomorphism \<eta> M composition unit M' composition' unit'))"
 
 text \<open>p 37, ll 11--12\<close>
 locale monoid_isomorphism' =
   bijective_map \<eta> M M' +  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> x \<cdot>' \<eta> y = \<eta> (x \<cdot> y)"
 
 text \<open>p 37, ll 11--12\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_isomorphism'
   by unfold_locales (simp add: commutes_with_composition)
 
 text \<open>Both definitions are equivalent.\<close>
 text \<open>p 37, ll 12--15\<close>
 sublocale monoid_isomorphism' \<subseteq> monoid_isomorphism
 proof unfold_locales
   {
     fix y assume "y \<in> M'"
     then obtain x where "\<eta> x = y" "x \<in> M" by (metis image_iff surjective)
     then have "y \<cdot>' \<eta> \<one> = y" using commutes_with_composition by auto
   }
   then show "\<eta> \<one> = \<one>'" by fastforce
 qed (simp add: commutes_with_composition)
 
 context monoid_isomorphism begin
 
 text \<open>p 37, ll 30--33\<close>
 theorem inverse_monoid_isomorphism:
   "monoid_isomorphism (restrict (inv_into M \<eta>) M') M' (\<cdot>') \<one>' M (\<cdot>) \<one>"
   using commutes_with_composition commutes_with_unit surjective by unfold_locales auto
 
 end (* monoid_isomorphism *)
 
 text \<open>We only need that @{term \<eta>} is symmetric.\<close>
 text \<open>p 37, ll 28--29\<close>
 theorem isomorphic_as_monoids_symmetric:
   "(M, composition, unit) \<cong>\<^sub>M (M', composition', unit') \<Longrightarrow> (M', composition', unit') \<cong>\<^sub>M (M, composition, unit)"
   by (simp add: isomorphic_as_monoids_def) (meson monoid_isomorphism.inverse_monoid_isomorphism)
 
 text \<open>p 38, l 4\<close>
 locale left_translations_of_monoid = monoid begin
 
 (*
   We take the liberty of omitting "left_" from the name of the translation operation.  The derived
   transformation monoid and group won't be qualified with "left" either.  This avoids qualifications
   such as "left.left_...".  In contexts where left and right translations are used simultaneously,
   notably subgroup_of_group, qualifiers are needed.
 *)
 
 text \<open>p 38, ll 5--7\<close>
 definition translation ("'(_')\<^sub>L") where "translation = (\<lambda>a \<in> M. \<lambda>x \<in> M. a \<cdot> x)"
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_map [intro, simp]:
   "a \<in> M \<Longrightarrow> (a)\<^sub>L \<in> M \<rightarrow>\<^sub>E M"
   unfolding translation_def by simp
 
 text \<open>p 38, ll 5--7\<close>
 lemma Translations_maps [intro, simp]:
   "translation ` M \<subseteq> M \<rightarrow>\<^sub>E M"
   by (simp add: image_subsetI)
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_apply:
   "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> (a)\<^sub>L b = a \<cdot> b"
   unfolding translation_def by auto
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_exist:
   "f \<in> translation ` M \<Longrightarrow> \<exists>a \<in> M. f = (a)\<^sub>L"
   by auto
 
 text \<open>p 38, ll 5--7\<close>
 lemmas Translations_E [elim] = translation_exist [THEN bexE]
 
 text \<open>p 38, l 10\<close>
 theorem translation_unit_eq [simp]:
   "identity M = (\<one>)\<^sub>L"
   unfolding translation_def by auto
 
 text \<open>p 38, ll 10--11\<close>
 theorem translation_composition_eq [simp]:
   assumes [simp]: "a \<in> M" "b \<in> M"
   shows "compose M (a)\<^sub>L (b)\<^sub>L = (a \<cdot> b)\<^sub>L"
   unfolding translation_def by rule (simp add: associative compose_def)
 
 (* Activate @{locale monoid} to simplify subsequent proof. *)
 text \<open>p 38, ll 7--9\<close>
 sublocale transformation: transformations M .
 
 text \<open>p 38, ll 7--9\<close>
 theorem Translations_transformation_monoid:
   "transformation_monoid (translation ` M) M"
   by unfold_locales auto
 
 text \<open>p 38, ll 7--9\<close>
 sublocale transformation: transformation_monoid "translation ` M" M
   by (fact Translations_transformation_monoid)
 
 text \<open>p 38, l 12\<close>
 sublocale map translation M "translation ` M"
   by unfold_locales (simp add: translation_def)
 
 text \<open>p 38, ll 12--16\<close>
 theorem translation_isomorphism [intro]:
   "monoid_isomorphism translation M (\<cdot>) \<one> (translation ` M) (compose M) (identity M)"
 proof unfold_locales
   have "inj_on translation M"
   proof (rule inj_onI)
     fix a b
     assume [simp]: "a \<in> M" "b \<in> M" "(a)\<^sub>L = (b)\<^sub>L"
     have "(a)\<^sub>L \<one> = (b)\<^sub>L \<one>" by simp
     then show "a = b" by (simp add: translation_def)
   qed
   then show "bij_betw translation M (translation ` M)"
     by (simp add: inj_on_imp_bij_betw)
 qed simp_all
 
 text \<open>p 38, ll 12--16\<close>
 sublocale monoid_isomorphism translation M "(\<cdot>)" \<one> "translation ` M" "compose M" "identity M" ..
 
 end (* left_translations_of_monoid *)
 
 context monoid begin
 
 text \<open>p 38, ll 1--2\<close>
 interpretation left_translations_of_monoid ..
 
 text \<open>p 38, ll 1--2\<close>
 theorem cayley_monoid:
   "\<exists>M' composition' unit'. transformation_monoid M' M \<and> (M, (\<cdot>), \<one>) \<cong>\<^sub>M (M', composition', unit')"
   by (simp add: isomorphic_as_monoids_def) (fast intro: Translations_transformation_monoid)
 
 end (* monoid *)
 
 text \<open>p 38, l 17\<close>
 locale left_translations_of_group = group begin
 
 text \<open>p 38, ll 17--18\<close>
 sublocale left_translations_of_monoid where M = G ..
 
 text \<open>p 38, ll 17--18\<close>
 notation translation ("'(_')\<^sub>L")
 
 text \<open>
   The group of left translations is a subgroup of the symmetric group,
   hence @{term transformation.sub.invertible}.
 \<close>
 text \<open>p 38, ll 20--22\<close>
 theorem translation_invertible [intro, simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.invertible (a)\<^sub>L"
 proof
   show "compose G (a)\<^sub>L (inverse a)\<^sub>L = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>L (a)\<^sub>L = identity G" by simp
 qed auto
 
 text \<open>p 38, ll 19--20\<close>
 theorem translation_bijective [intro, simp]:
   "a \<in> G \<Longrightarrow> bij_betw (a)\<^sub>L G G"
   by (blast intro: transformation.invertible_is_bijective [THEN iffD1])
 
 text \<open>p 38, ll 18--20\<close>
 theorem Translations_transformation_group:
   "transformation_group (translation ` G) G"
 proof unfold_locales
   show "(translation ` G) \<subseteq> transformation.Sym"
     unfolding transformation.Units_bijective by auto
 next
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> translation ` G"
   then obtain a where a: "a \<in> G" and eq: "\<alpha> = (a)\<^sub>L" ..
   with translation_invertible show "transformation.sub.invertible \<alpha>" by simp
 qed auto
 
 text \<open>p 38, ll 18--20\<close>
 sublocale transformation: transformation_group "translation ` G" G
   by (fact Translations_transformation_group)
 
 end (* left_translations_of_group *)
 
 context group begin
 
 text \<open>p 38, ll 2--3\<close>
 interpretation left_translations_of_group ..
 
 text \<open>p 38, ll 2--3\<close>
 theorem cayley_group:
   "\<exists>G' composition' unit'. transformation_group G' G \<and> (G, (\<cdot>), \<one>) \<cong>\<^sub>M (G', composition', unit')"
   by (simp add: isomorphic_as_monoids_def) (fast intro: Translations_transformation_group)
 
 end (* group *)
 
 text \<open>Exercise 3\<close>
 
 text \<open>p 39, ll 9--10\<close>
 locale right_translations_of_group = group begin
 
 text \<open>p 39, ll 9--10\<close>
 definition translation ("'(_')\<^sub>R") where "translation = (\<lambda>a \<in> G. \<lambda>x \<in> G. x \<cdot> a)"
 
 text \<open>p 39, ll 9--10\<close>
 abbreviation "Translations \<equiv> translation ` G"
 
 text \<open>The isomorphism that will be established is a map different from @{term translation}.\<close>
 text \<open>p 39, ll 9--10\<close>
 interpretation aux: map translation G Translations
   by unfold_locales (simp add: translation_def)
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_map [intro, simp]:
   "a \<in> G \<Longrightarrow> (a)\<^sub>R \<in> G \<rightarrow>\<^sub>E G"
   unfolding translation_def by simp
 
 text \<open>p 39, ll 9--10\<close>
 lemma Translation_maps [intro, simp]:
   "Translations \<subseteq> G \<rightarrow>\<^sub>E G"
   by (simp add: image_subsetI)
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_apply:
   "\<lbrakk> a \<in> G; b \<in> G \<rbrakk> \<Longrightarrow> (a)\<^sub>R b = b \<cdot> a"
   unfolding translation_def by auto
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_exist:
   "f \<in> Translations \<Longrightarrow> \<exists>a \<in> G. f = (a)\<^sub>R"
   by auto
 
 text \<open>p 39, ll 9--10\<close>
 lemmas Translations_E [elim] = translation_exist [THEN bexE]
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_unit_eq [simp]:
   "identity G = (\<one>)\<^sub>R"
   unfolding translation_def by auto
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_composition_eq [simp]:
   assumes [simp]: "a \<in> G" "b \<in> G"
   shows "compose G (a)\<^sub>R (b)\<^sub>R = (b \<cdot> a)\<^sub>R"
   unfolding translation_def by rule (simp add: associative compose_def)
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformations G .
 
 text \<open>p 39, ll 10--11\<close>
 lemma Translations_transformation_monoid:
   "transformation_monoid Translations G"
   by unfold_locales auto
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformation_monoid Translations G
   by (fact Translations_transformation_monoid)
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_invertible [intro, simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.invertible (a)\<^sub>R"
 proof
   show "compose G (a)\<^sub>R (inverse a)\<^sub>R = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>R (a)\<^sub>R = identity G" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_bijective [intro, simp]:
   "a \<in> G \<Longrightarrow> bij_betw (a)\<^sub>R G G"
   by (blast intro: transformation.invertible_is_bijective [THEN iffD1])
 
 text \<open>p 39, ll 10--11\<close>
 theorem Translations_transformation_group:
   "transformation_group Translations G"
 proof unfold_locales
   show "Translations \<subseteq> transformation.Sym"
   unfolding transformation.Units_bijective by auto
 next
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> Translations"
   then obtain a where a: "a \<in> G" and eq: "\<alpha> = (a)\<^sub>R" ..
   with translation_invertible show "transformation.sub.invertible \<alpha>" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformation_group Translations G
   by (rule Translations_transformation_group)
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_inverse_eq [simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.inverse (a)\<^sub>R = (inverse a)\<^sub>R"
 proof (rule transformation.sub.inverse_equality)
   show "compose G (a)\<^sub>R (inverse a)\<^sub>R = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>R (a)\<^sub>R = identity G" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 theorem translation_inverse_monoid_isomorphism [intro]:
   "monoid_isomorphism (\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R) G (\<cdot>) \<one> Translations (compose G) (identity G)"
   (is "monoid_isomorphism ?inv _ _ _ _ _ _")
 proof unfold_locales
   show "?inv \<in> G \<rightarrow>\<^sub>E Translations" by (simp del: translation_unit_eq)
 next
   note bij_betw_compose [trans]
   have "bij_betw inverse G G"
     by (rule bij_betwI [where g = inverse]) auto
   also have "bij_betw translation G Translations"
     by (rule bij_betwI [where g = "\<lambda>\<alpha>\<in>Translations. \<alpha> \<one>"]) (auto simp: translation_apply)
   finally show "bij_betw ?inv G Translations"
     by (simp cong: bij_betw_cong add: compose_eq del: translation_unit_eq)
 next
   fix x and y
   assume [simp]: "x \<in> G" "y \<in> G"
   show "compose G (?inv x) (?inv y) = (?inv (x \<cdot> y))" by (simp add: inverse_composition_commute del: translation_unit_eq)
 next
   show "?inv \<one> = identity G" by (simp del: translation_unit_eq) simp
 qed
 
 text \<open>p 39, ll 10--11\<close>
 sublocale monoid_isomorphism
   "\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R" G "(\<cdot>)" \<one> Translations "compose G" "identity G" ..
 
 end (* right_translations_of_group *)
 
 
 subsection \<open>Generalized Associativity.  Commutativity\<close>
 
 text \<open>p 40, l 27; p 41, ll 1--2\<close>
 locale commutative_monoid = monoid +
   assumes commutative: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> x \<cdot> y = y \<cdot> x"
   
 text \<open>p 41, l 2\<close>
 locale abelian_group = group + commutative_monoid G "(\<cdot>)" \<one>
 
 
 subsection \<open>Orbits.  Cosets of a Subgroup\<close>
 
 context transformation_group begin
 
 text \<open>p 51, ll 18--20\<close>
 definition Orbit_Relation
   where "Orbit_Relation = {(x, y). x \<in> S \<and> y \<in> S \<and> (\<exists>\<alpha> \<in> G. y = \<alpha> x)}"
 
 text \<open>p 51, ll 18--20\<close>
 lemma Orbit_Relation_memI [intro]:
   "\<lbrakk> \<exists>\<alpha> \<in> G. y = \<alpha> x; x \<in> S \<rbrakk> \<Longrightarrow> (x, y) \<in> Orbit_Relation"
   unfolding Orbit_Relation_def by auto
 
 text \<open>p 51, ll 18--20\<close>
 lemma Orbit_Relation_memE [elim]:
   "\<lbrakk> (x, y) \<in> Orbit_Relation; \<And>\<alpha>. \<lbrakk> \<alpha> \<in> G; x \<in> S; y = \<alpha> x \<rbrakk> \<Longrightarrow> Q \<rbrakk> \<Longrightarrow> Q"
   unfolding Orbit_Relation_def by auto
 
 text \<open>p 51, ll 20--23, 26--27\<close>
 sublocale orbit: equivalence S Orbit_Relation
 proof (unfold_locales, auto simp: Orbit_Relation_def)
   fix x
   assume x: "x \<in> S"
   then have id: "x = identity S x" by simp
   with x show "\<exists>\<alpha> \<in> G. x = \<alpha> x" by fast
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> G"
   with x id have y: "x = compose S (symmetric.inverse \<alpha>) \<alpha> x" by auto
   with x \<alpha> show "\<exists>\<alpha>' \<in> G. x = \<alpha>' (\<alpha> x)"
     by (metis compose_eq symmetric.sub.invertible symmetric.submonoid_inverse_closed)
   fix \<beta>
   assume \<beta>: "\<beta> \<in> G"
   with x have "\<beta> (\<alpha> x) = compose S \<beta> \<alpha> x" by (simp add: compose_eq)
   with \<alpha> \<beta> show "\<exists>\<gamma> \<in> G. \<beta> (\<alpha> x) = \<gamma> x" by fast
 qed
 
 text \<open>p 51, ll 23--24\<close>
 theorem orbit_equality:
   "x \<in> S \<Longrightarrow> orbit.Class x = {\<alpha> x | \<alpha>. \<alpha> \<in> G}"
 by (simp add: orbit.Class_def) (blast intro: orbit.symmetric dest: orbit.symmetric)
 
 end (* transformation_group *)
 
 context monoid_isomorphism begin
 
 text \<open>p 52, ll 16--17\<close>
 theorem image_subgroup:
   assumes "subgroup G M (\<cdot>) \<one>"
   shows "subgroup (\<eta> ` G) M' (\<cdot>') \<one>'"
 proof -
   interpret subgroup G M "(\<cdot>)" \<one> by fact
   interpret image: monoid "\<eta> ` G" "(\<cdot>')" "\<one>'"
     by unfold_locales (auto simp add: commutes_with_composition commutes_with_unit [symmetric])
   show ?thesis
   proof (unfold_locales, auto)
     fix x
     assume x: "x \<in> G"
     show "image.invertible (\<eta> x)"
     proof
       show "\<eta> (sub.inverse x) \<in> \<eta> ` G" using x by simp
     qed (auto simp: x commutes_with_composition commutes_with_unit)
   qed
 qed
 
 end (* monoid_isomorphism *)
 
 text \<open>
   Technical device to achieve Jacobson's notation for @{text Right_Coset} and @{text Left_Coset}.  The
   definitions are pulled out of @{text subgroup_of_group} to a context where @{text H} is not a parameter.
 \<close>
 text \<open>p 52, l 20\<close>
 locale coset_notation = fixes composition (infixl "\<cdot>" 70)  begin
 
 text \<open>Equation 23\<close>
 text \<open>p 52, l 20\<close>
 definition Right_Coset (infixl "|\<cdot>" 70) where "H |\<cdot> x = {h \<cdot> x | h. h \<in> H}"
 
 text \<open>p 53, ll 8--9\<close>
 definition Left_Coset (infixl "\<cdot>|" 70) where "x \<cdot>| H = {x \<cdot> h | h. h \<in> H}"
 
 text \<open>p 52, l 20\<close>
 lemma Right_Coset_memI [intro]:
   "h \<in> H \<Longrightarrow> h \<cdot> x \<in> H |\<cdot> x"
   unfolding Right_Coset_def by blast
 
 text \<open>p 52, l 20\<close>
 lemma Right_Coset_memE [elim]:
   "\<lbrakk> a \<in> H |\<cdot> x; \<And>h. \<lbrakk> h \<in> H; a = h \<cdot> x \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   unfolding Right_Coset_def by blast
 
 text \<open>p 53, ll 8--9\<close>
 lemma Left_Coset_memI [intro]:
   "h \<in> H \<Longrightarrow> x \<cdot> h \<in> x \<cdot>| H"
   unfolding Left_Coset_def by blast
 
 text \<open>p 53, ll 8--9\<close>
 lemma Left_Coset_memE [elim]:
   "\<lbrakk> a \<in> x \<cdot>| H; \<And>h. \<lbrakk> h \<in> H; a = x \<cdot> h \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   unfolding Left_Coset_def by blast
 
 end (* coset_notation *)
 
 text \<open>p 52, l 12\<close>
 locale subgroup_of_group = subgroup H G "(\<cdot>)" \<one> + coset_notation "(\<cdot>)" + group G "(\<cdot>)" \<one>
   for H and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 begin
 
 text \<open>p 52, ll 12--14\<close>
 interpretation left: left_translations_of_group ..
 interpretation right: right_translations_of_group ..
 
 text \<open>
   @{term "left.translation ` H"} denotes Jacobson's @{text "H\<^sub>L(G)"} and
   @{term "left.translation ` G"} denotes Jacobson's @{text "G\<^sub>L"}.
 \<close>
 
 text \<open>p 52, ll 16--18\<close>
 theorem left_translations_of_subgroup_are_transformation_group [intro]:
   "transformation_group (left.translation ` H) G"
 proof -
   have "subgroup (left.translation ` H) (left.translation ` G) (compose G) (identity G)"
     by (rule left.image_subgroup) unfold_locales
   also have "subgroup (left.translation ` G) left.transformation.Sym (compose G) (identity G)" ..
   finally interpret right_coset: subgroup "left.translation ` H" left.transformation.Sym "compose G" "identity G" .
   show ?thesis ..
 qed
 
 text \<open>p 52, l 18\<close>
 interpretation transformation_group "left.translation ` H" G ..
 
 text \<open>p 52, ll 19--20\<close>
 theorem Right_Coset_is_orbit:
   "x \<in> G \<Longrightarrow> H |\<cdot> x = orbit.Class x"
   using left.translation_apply by (auto simp: orbit_equality Right_Coset_def) (metis imageI sub)
 
 text \<open>p 52, ll 24--25\<close>
 theorem Right_Coset_Union:
   "(\<Union>x\<in>G. H |\<cdot> x) = G"
   by (simp add: Right_Coset_is_orbit)
 
 text \<open>p 52, l 26\<close>
 theorem Right_Coset_bij:
   assumes G [simp]: "x \<in> G" "y \<in> G"
   shows "bij_betw (inverse x \<cdot> y)\<^sub>R (H |\<cdot> x) (H |\<cdot> y)"
 proof (rule bij_betw_imageI)
   show "inj_on (inverse x \<cdot> y)\<^sub>R (H |\<cdot> x)"
     by (fastforce intro: inj_onI simp add: Right_Coset_is_orbit right.translation_apply orbit.block_closed)
 next
   show "(inverse x \<cdot> y)\<^sub>R ` (H |\<cdot> x) = H |\<cdot> y"
     by (force simp add: right.translation_apply associative invertible_right_inverse2)
 qed
 
 text \<open>p 52, ll 25--26\<close>
 theorem Right_Cosets_cardinality:
   "\<lbrakk> x \<in> G; y \<in> G \<rbrakk> \<Longrightarrow> card (H |\<cdot> x) = card (H |\<cdot> y)"
   by (fast intro: bij_betw_same_card Right_Coset_bij)
 
 text \<open>p 52, l 27\<close>
 theorem Right_Coset_unit:
   "H |\<cdot> \<one> = H"
   by (force simp add: Right_Coset_def)
 
 text \<open>p 52, l 27\<close>
 theorem Right_Coset_cardinality:
   "x \<in> G \<Longrightarrow> card (H |\<cdot> x) = card H"
   using Right_Coset_unit Right_Cosets_cardinality unit_closed by presburger
 
 text \<open>p 52, ll 31--32\<close>
 definition "index = card orbit.Partition"
 
 text \<open>Theorem 1.5\<close>
 text \<open>p 52, ll 33--35; p 53, ll 1--2\<close>
 theorem lagrange:
   "finite G \<Longrightarrow> card G = card H * index"
   unfolding index_def
   apply (subst card_partition)
       apply (auto simp: finite_UnionD orbit.complete orbit.disjoint)
   apply (metis Right_Coset_cardinality Right_Coset_is_orbit orbit.Block_self orbit.element_exists)
   done
 
 end (* subgroup_of_group *)
 
 text \<open>Left cosets\<close>
 
 context subgroup begin
 
 text \<open>p 31, ll 11--12\<close>
 lemma image_of_inverse [intro, simp]:
   "x \<in> G \<Longrightarrow> x \<in> inverse ` G"
   by (metis image_eqI sub.invertible sub.invertible_inverse_closed sub.invertible_inverse_inverse subgroup_inverse_equality)
 
 end (* subgroup *)
 
 context group begin
 
 (* Does Jacobson show this somewhere? *)
 text \<open>p 53, ll 6--7\<close>
 lemma inverse_subgroupI:
   assumes sub: "subgroup H G (\<cdot>) \<one>"
   shows "subgroup (inverse ` H) G (\<cdot>) \<one>"
 proof -
   from sub interpret subgroup H G "(\<cdot>)" \<one> .
   interpret inv: monoid "inverse ` H" "(\<cdot>)" \<one>
     by unfold_locales (auto simp del: subgroup_inverse_equality)
   interpret inv: group "inverse ` H" "(\<cdot>)" \<one>
     by unfold_locales (force simp del: subgroup_inverse_equality)
   show ?thesis
     by unfold_locales (auto simp del: subgroup_inverse_equality)
 qed
 
 text \<open>p 53, ll 6--7\<close>
 lemma inverse_subgroupD:
   assumes sub: "subgroup (inverse ` H) G (\<cdot>) \<one>"
     and inv: "H \<subseteq> Units"
   shows "subgroup H G (\<cdot>) \<one>"
 proof -
   from sub have "subgroup (inverse ` inverse ` H) G (\<cdot>) \<one>" by (rule inverse_subgroupI)
   moreover from inv [THEN subsetD, simplified Units_def] have "inverse ` inverse ` H = H"
     by (simp cong: image_cong add: image_comp)
   ultimately show ?thesis by simp
 qed
 
 end (* group *)
 
 context subgroup_of_group begin
 
 text \<open>p 53, l 6\<close>
 interpretation right_translations_of_group ..
 
 text \<open>
   @{term "translation ` H"} denotes Jacobson's @{text "H\<^sub>R(G)"} and
   @{term "Translations"} denotes Jacobson's @{text "G\<^sub>R"}.
 \<close>
 
 text \<open>p 53, ll 6--7\<close>
 theorem right_translations_of_subgroup_are_transformation_group [intro]:
   "transformation_group (translation ` H) G"
 proof -
   have "subgroup ((\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R) ` H) Translations (compose G) (identity G)"
     by (rule image_subgroup) unfold_locales
   also have "subgroup Translations transformation.Sym (compose G) (identity G)" ..
   finally interpret left_coset: subgroup "translation ` H" transformation.Sym "compose G" "identity G"
     by (auto intro: transformation.symmetric.inverse_subgroupD cong: image_cong
       simp: image_image transformation.symmetric.Units_def simp del: translation_unit_eq)
   show ?thesis ..
 qed
 
 text \<open>p 53, ll 6--7\<close>
 interpretation transformation_group "translation ` H" G ..
 
 text \<open>Equation 23 for left cosets\<close>
 text \<open>p 53, ll 7--8\<close>
 theorem Left_Coset_is_orbit:
   "x \<in> G \<Longrightarrow> x \<cdot>| H = orbit.Class x"
   using translation_apply
   by (auto simp: orbit_equality Left_Coset_def) (metis imageI sub)
 
 end (* subgroup_of_group *)
 
 
 subsection \<open>Congruences.  Quotient Monoids and Groups\<close>
 
 text \<open>Def 1.4\<close>
 text \<open>p 54, ll 19--22\<close>
 locale monoid_congruence = monoid + equivalence where S = M +
   assumes cong: "\<lbrakk> (a, a') \<in> E; (b, b') \<in> E \<rbrakk> \<Longrightarrow> (a \<cdot> b, a' \<cdot> b') \<in> E"
 begin
 
 text \<open>p 54, ll 26--28\<close>
 theorem Class_cong:
   "\<lbrakk> Class a = Class a'; Class b = Class b'; a \<in> M; a' \<in> M; b \<in> M; b' \<in> M \<rbrakk> \<Longrightarrow> Class (a \<cdot> b) = Class (a' \<cdot> b')"
   by (simp add: Class_equivalence cong)
 
 text \<open>p 54, ll 28--30\<close>
 definition quotient_composition (infixl "[\<cdot>]" 70)
   where "quotient_composition = (\<lambda>A \<in> M / E. \<lambda>B \<in> M / E. THE C. \<exists>a \<in> A. \<exists>b \<in> B. C = Class (a \<cdot> b))"
 
 text \<open>p 54, ll 28--30\<close>
 theorem Class_commutes_with_composition:
   "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> Class a [\<cdot>] Class b = Class (a \<cdot> b)"
   by (auto simp: quotient_composition_def intro: Class_cong [OF Class_eq Class_eq] del: equalityI)
 
 text \<open>p 54, ll 30--31\<close>
 theorem quotient_composition_closed [intro, simp]:
   "\<lbrakk> A \<in> M / E; B \<in> M / E \<rbrakk> \<Longrightarrow> A [\<cdot>] B \<in> M / E"
   by (erule quotient_ClassE)+ (simp add: Class_commutes_with_composition)
 
 text \<open>p 54, l 32; p 55, ll 1--3\<close>
 sublocale quotient: monoid "M / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (auto simp: Class_commutes_with_composition associative elim!: quotient_ClassE)
 
 end (* monoid_congruence *)
 
 text \<open>p 55, ll 16--17\<close>
 locale group_congruence = group + monoid_congruence where M = G begin
 
 text \<open>p 55, ll 16--17\<close>
 notation quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 55, l 18\<close>
 theorem Class_right_inverse:
   "a \<in> G \<Longrightarrow> Class a [\<cdot>] Class (inverse a) = Class \<one>"
   by (simp add: Class_commutes_with_composition)
 
 text \<open>p 55, l 18\<close>
 theorem Class_left_inverse:
   "a \<in> G \<Longrightarrow> Class (inverse a) [\<cdot>] Class a = Class \<one>"
   by (simp add: Class_commutes_with_composition)
 
 text \<open>p 55, l 18\<close>
 theorem Class_invertible:
   "a \<in> G \<Longrightarrow> quotient.invertible (Class a)"
   by (blast intro!: Class_right_inverse Class_left_inverse)+
 
 text \<open>p 55, l 18\<close>
 theorem Class_commutes_with_inverse:
   "a \<in> G \<Longrightarrow> quotient.inverse (Class a) = Class (inverse a)"
   by (rule quotient.inverse_equality) (auto simp: Class_right_inverse Class_left_inverse)
 
 text \<open>p 55, l 17\<close>
 sublocale quotient: group "G / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (metis Block_self Class_invertible element_exists)
 
 end (* group_congruence *)
 
 text \<open>Def 1.5\<close>
 text \<open>p 55, ll 22--25\<close>
 locale normal_subgroup =
   subgroup_of_group K G "(\<cdot>)" \<one> for K and G and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes normal: "\<lbrakk> g \<in> G; k \<in> K \<rbrakk> \<Longrightarrow> inverse g \<cdot> k \<cdot> g \<in> K"
 
 text \<open>Lemmas from the proof of Thm 1.6\<close>
 
 context subgroup_of_group begin
 
 text \<open>We use @{term H} for @{term K}.\<close>
 text \<open>p 56, ll 14--16\<close>
 theorem Left_equals_Right_coset_implies_normality:
   assumes [simp]: "\<And>g. g \<in> G \<Longrightarrow> g \<cdot>| H = H |\<cdot> g"
   shows "normal_subgroup H G (\<cdot>) \<one>"
 proof
   fix g k
   assume [simp]: "g \<in> G" "k \<in> H"
   have "k \<cdot> g \<in> g \<cdot>| H" by auto
   then obtain k' where "k \<cdot> g = g \<cdot> k'" and "k' \<in> H" by blast
   then show "inverse g \<cdot> k \<cdot> g \<in> H" by (simp add: associative invertible_left_inverse2)
 qed
 
 end (* subgroup_of_group *)
 
 text \<open>Thm 1.6, first part\<close>
 
 context group_congruence begin
 
 text \<open>Jacobson's $K$\<close>
 text \<open>p 56, l 29\<close>
 definition "Normal = Class \<one>"
 
 text \<open>p 56, ll 3--6\<close>
 interpretation subgroup "Normal" G "(\<cdot>)" \<one>
   unfolding Normal_def
 proof (rule subgroupI)
   fix k1 and k2
   assume K: "k1 \<in> Class \<one>" "k2 \<in> Class \<one>"
   then have "k1 \<cdot> k2 \<in> Class (k1 \<cdot> k2)" by blast
   also have "\<dots> = Class k1 [\<cdot>] Class k2" using K by (auto simp add: Class_commutes_with_composition Class_closed)
   also have "\<dots> = Class \<one> [\<cdot>] Class \<one>" using K by (metis ClassD Class_eq unit_closed)
   also have "\<dots> = Class \<one>" by simp
   finally show "k1 \<cdot> k2 \<in> Class \<one>" .
 next
   fix k
   assume K: "k \<in> Class \<one>"
   then have "inverse k \<in> Class (inverse k)" by blast
   also have "\<dots> = quotient.inverse (Class k)" using Class_commutes_with_inverse K by blast
   also have "\<dots> = quotient.inverse (Class \<one>)" using Block_self K by auto
   also have "\<dots> = Class \<one>" using quotient.inverse_unit by blast
   finally show "inverse k \<in> Class \<one>" .
 qed auto
 
 text \<open>Coset notation\<close>
 text \<open>p 56, ll 5--6\<close>
 interpretation subgroup_of_group "Normal" G "(\<cdot>)" \<one> ..
 
 text \<open>Equation 25 for right cosets\<close>
 text \<open>p 55, ll 29--30; p 56, ll 6--11\<close>
 theorem Right_Coset_Class_unit:
   assumes g: "g \<in> G" shows "Normal |\<cdot> g = Class g"
   unfolding Normal_def
 proof auto
   fix a  \<comment> \<open>ll 6--8\<close>
   assume a: "a \<in> Class g"
   from a g have "a \<cdot> inverse g \<in> Class (a \<cdot> inverse g)" by blast
   also from a g have "\<dots> = Class a [\<cdot>] Class (inverse g)"
     by (simp add: Class_commutes_with_composition block_closed)
   also from a g have "\<dots> = Class g [\<cdot>] quotient.inverse (Class g)"
     using Block_self Class_commutes_with_inverse by auto
   also from g have "\<dots> = Class \<one>" by simp
   finally show "a \<in> Class \<one> |\<cdot> g"
     unfolding Right_Coset_def
     by simp (metis Class_closed a associative g inverse_equality invertible invertible_def right_unit) 
 next
   fix a  \<comment> \<open>ll 8--9\<close>
   assume a: "a \<in> Class \<one> |\<cdot> g"
   then obtain k where eq: "a = k \<cdot> g" and k: "k \<in> Class \<one>" by blast
   with g have "Class a = Class k [\<cdot>] Class g" using Class_commutes_with_composition by auto
   also from k have "\<dots> = Class \<one> [\<cdot>] Class g" using Block_self by auto
   also from g have "\<dots> = Class g" by simp
   finally show "a \<in> Class g" using g eq k composition_closed quotient.unit_closed by blast
 qed
 
 text \<open>Equation 25 for left cosets\<close>
 text \<open>p 55, ll 29--30; p 56, ll 6--11\<close>
 theorem Left_Coset_Class_unit:
   assumes g: "g \<in> G" shows "g \<cdot>| Normal = Class g"
   unfolding Normal_def
 proof auto
   fix a  \<comment> \<open>ll 6--8\<close>
   assume a: "a \<in> Class g"
   from a g have "inverse g \<cdot> a \<in> Class (inverse g \<cdot> a)" by blast
   also from a g have "\<dots> = Class (inverse g) [\<cdot>] Class a"
     by (simp add: Class_commutes_with_composition block_closed)
   also from a g have "\<dots> = quotient.inverse (Class g) [\<cdot>] Class g"
     using Block_self Class_commutes_with_inverse by auto
   also from g have "\<dots> = Class \<one>" by simp
   finally show "a \<in> g \<cdot>| Class \<one>"
     unfolding Left_Coset_def
     by simp (metis Class_closed a associative g inverse_equality invertible invertible_def right_unit) 
 next
   fix a  \<comment> \<open>ll 8--9, ``the same thing holds''\<close>
   assume a: "a \<in> g \<cdot>| Class \<one>"
   then obtain k where eq: "a = g \<cdot> k" and k: "k \<in> Class \<one>" by blast
   with g have "Class a = Class g [\<cdot>] Class k" using Class_commutes_with_composition by auto
   also from k have "\<dots> = Class g [\<cdot>] Class \<one>" using Block_self by auto
   also from g have "\<dots> = Class g" by simp
   finally show "a \<in> Class g" using g eq k composition_closed quotient.unit_closed by blast
 qed
 
 text \<open>Thm 1.6, statement of first part\<close>
 text \<open>p 55, ll 28--29; p 56, ll 12--16\<close>
 theorem Class_unit_is_normal:
   "normal_subgroup Normal G (\<cdot>) \<one>"
 proof -
   {
     fix g
     assume "g \<in> G"
     then have "g \<cdot>| Normal = Normal |\<cdot> g" by (simp add: Right_Coset_Class_unit Left_Coset_Class_unit)
   }
   then show ?thesis by (rule Left_equals_Right_coset_implies_normality)
 qed
 
 sublocale normal: normal_subgroup Normal G "(\<cdot>)" \<one>
   by (fact Class_unit_is_normal)
 
 end (* group_congruence *)
 
 context normal_subgroup begin
 
 text \<open>p 56, ll 16--19\<close>
 theorem Left_equals_Right_coset:
   "g \<in> G \<Longrightarrow> g \<cdot>| K = K |\<cdot> g"
 proof
   assume [simp]: "g \<in> G"
   show "K |\<cdot> g \<subseteq> g \<cdot>| K"
   proof
     fix x
     assume x: "x \<in> K |\<cdot> g"
     then obtain k where "x = k \<cdot> g" and [simp]: "k \<in> K" by (auto simp add: Right_Coset_def)
     then have "x = g \<cdot> (inverse g \<cdot> k \<cdot> g)" by (simp add: associative invertible_right_inverse2)
     also from normal have "\<dots> \<in> g \<cdot>| K" by (auto simp add: Left_Coset_def)
     finally show "x \<in> g \<cdot>| K" .
   qed
 next
   assume [simp]: "g \<in> G"
   show "g \<cdot>| K \<subseteq> K |\<cdot> g"
   proof
     fix x
     assume x: "x \<in> g \<cdot>| K"
     then obtain k where "x = g \<cdot> k" and [simp]: "k \<in> K" by (auto simp add: Left_Coset_def)
     then have "x = (inverse (inverse g) \<cdot> k \<cdot> inverse g) \<cdot> g" by (simp add: associative del: invertible_right_inverse)
     also from normal [where g = "inverse g"] have "\<dots> \<in> K |\<cdot> g" by (auto simp add: Right_Coset_def)
     finally show "x \<in> K |\<cdot> g" .
   qed
 qed
 
 text \<open>Thm 1.6, second part\<close>
 
 text \<open>p 55, ll 31--32; p 56, ll 20--21\<close>
 definition "Congruence = {(a, b). a \<in> G \<and> b \<in> G \<and> inverse a \<cdot> b \<in> K}"
 
 text \<open>p 56, ll 21--22\<close>
 interpretation right_translations_of_group ..
 
 text \<open>p 56, ll 21--22\<close>
 interpretation transformation_group "translation ` K" G rewrites "Orbit_Relation = Congruence"
 proof -
   interpret transformation_group "translation ` K" G ..
   show "Orbit_Relation = Congruence"
     unfolding Orbit_Relation_def Congruence_def
     by (force simp: invertible_left_inverse2 invertible_right_inverse2 translation_apply simp del: restrict_apply)
 qed rule
 
 text \<open>p 56, ll 20--21\<close>
 lemma CongruenceI: "\<lbrakk> a = b \<cdot> k; a \<in> G; b \<in> G; k \<in> K \<rbrakk> \<Longrightarrow> (a, b) \<in> Congruence"
   by (clarsimp simp: Congruence_def associative inverse_composition_commute)
 
 text \<open>p 56, ll 20--21\<close>
 lemma CongruenceD: "(a, b) \<in> Congruence \<Longrightarrow> \<exists>k\<in>K. a = b \<cdot> k"
   by (drule orbit.symmetric) (force simp: Congruence_def invertible_right_inverse2)
 
 text \<open>
   ``We showed in the last section that the relation we are considering is an equivalence relation in
   @{term G} for any subgroup @{term K} of @{term G}.  We now proceed to show that normality of @{term K}
   ensures that [...] $a \equiv b \pmod{K}$ is a congruence.''
 \<close>
 text \<open>p 55, ll 30--32; p 56, ll 1, 22--28\<close>
 sublocale group_congruence where E = Congruence rewrites "Normal = K"
 proof -
   show "group_congruence G (\<cdot>) \<one> Congruence"
   proof unfold_locales
     note CongruenceI [intro] CongruenceD [dest]
     fix a g b h
     assume 1: "(a, g) \<in> Congruence" and 2: "(b, h) \<in> Congruence"
     then have G: "a \<in> G" "g \<in> G" "b \<in> G" "h \<in> G" unfolding Congruence_def by clarify+
     from 1 obtain k1 where a: "a = g \<cdot> k1" and k1: "k1 \<in> K" by blast
     from 2 obtain k2 where b: "b = h \<cdot> k2" and k2: "k2 \<in> K" by blast
     from G Left_equals_Right_coset have "K |\<cdot> h = h \<cdot>| K" by blast
     with k1 obtain k3 where c: "k1 \<cdot> h = h \<cdot> k3" and k3: "k3 \<in> K"
       unfolding Left_Coset_def Right_Coset_def by blast
     from G k1 k2 a b have "a \<cdot> b = g \<cdot> k1 \<cdot> h \<cdot> k2" by (simp add: associative)
     also from G k1 k3 c have "\<dots> = g \<cdot> h \<cdot> k3 \<cdot> k2" by (simp add: associative)
     also have "\<dots> = (g \<cdot> h) \<cdot> (k3 \<cdot> k2)" using G k2 k3 by (simp add: associative)
     finally show "(a \<cdot> b, g \<cdot> h) \<in> Congruence" using G k2 k3 by blast
   qed
   then interpret group_congruence where E = Congruence .
   show "Normal = K"
     unfolding Normal_def orbit.Class_def unfolding Congruence_def
     using invertible_inverse_inverse submonoid_inverse_closed by fastforce 
 qed
 
 end (* normal_subgroup *)  (* deletes translations and orbits, recovers Class for congruence class *)
 
 context group begin
 
 text \<open>Pulled out of @{locale normal_subgroup} to achieve standard notation.\<close>
 text \<open>p 56, ll 31--32\<close>
 abbreviation Factor_Group (infixl "'/'/" 75)
   where "S // K \<equiv> S / (normal_subgroup.Congruence K G (\<cdot>) \<one>)"
 
 end (* group *)
 
 context normal_subgroup begin
 
 text \<open>p 56, ll 28--29\<close>
 theorem Class_unit_normal_subgroup: "Class \<one> = K"
   unfolding Class_def unfolding Congruence_def
   using invertible_inverse_inverse submonoid_inverse_closed by fastforce
 
 text \<open>p 56, ll 1--2; p 56, l 29\<close>
 theorem Class_is_Left_Coset:
   "g \<in> G \<Longrightarrow> Class g = g \<cdot>| K"
   using Left_Coset_Class_unit Class_unit_normal_subgroup by simp
 
 text \<open>p 56, l 29\<close>
 lemma Left_CosetE: "\<lbrakk> A \<in> G // K; \<And>a. a \<in> G \<Longrightarrow> P (a \<cdot>| K) \<rbrakk> \<Longrightarrow> P A"
   by (metis Class_is_Left_Coset quotient_ClassE)
 
 text \<open>Equation 26\<close>
 text \<open>p 56, ll 32--34\<close>
 theorem factor_composition [simp]:
   "\<lbrakk> g \<in> G; h \<in> G \<rbrakk> \<Longrightarrow> (g \<cdot>| K) [\<cdot>] (h \<cdot>| K) = g \<cdot> h \<cdot>| K"
   using Class_commutes_with_composition Class_is_Left_Coset by auto
 
 text \<open>p 56, l 35\<close>
 theorem factor_unit:
   "K = \<one> \<cdot>| K"
   using Class_is_Left_Coset Class_unit_normal_subgroup by blast
 
 text \<open>p 56, l 35\<close>
 theorem factor_inverse [simp]:
   "g \<in> G \<Longrightarrow> quotient.inverse (g \<cdot>| K) = (inverse g \<cdot>| K)"
   using Class_commutes_with_inverse Class_is_Left_Coset by auto
 
 end (* normal_subgroup *)
 
 text \<open>p 57, ll 4--5\<close>
 locale subgroup_of_abelian_group = subgroup_of_group H G "(\<cdot>)" \<one> + abelian_group G "(\<cdot>)" \<one>
   for H and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 
 text \<open>p 57, ll 4--5\<close>
 sublocale subgroup_of_abelian_group \<subseteq> normal_subgroup H G "(\<cdot>)" \<one>
   using commutative invertible_right_inverse2 by unfold_locales auto
 
 
 subsection \<open>Homomorphims\<close>
 
 text \<open>Def 1.6\<close>
 text \<open>p 58, l 33; p 59, ll 1--2\<close>
 locale monoid_homomorphism =
   map \<eta> M M'+  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> (x \<cdot> y) = \<eta> x \<cdot>' \<eta> y"
     and commutes_with_unit: "\<eta> \<one> = \<one>'"
 begin
 
 text \<open>Jacobson notes that @{thm [source] commutes_with_unit} is not necessary for groups, but doesn't make use of that later.\<close>
 
 text \<open>p 58, l 33; p 59, ll 1--2\<close>
 notation source.invertible ("invertible _" [100] 100)
 notation source.inverse ("inverse _" [100] 100)
-notation target.invertible ("invertible' _" [100] 100)
-notation target.inverse ("inverse' _" [100] 100)
+notation target.invertible ("invertible'' _" [100] 100)
+notation target.inverse ("inverse'' _" [100] 100)
 
 end (* monoid_homomorphism *)
 
 text \<open>p 59, ll 29--30\<close>
 locale monoid_epimorphism = monoid_homomorphism + surjective_map \<eta> M M'
 
 text \<open>p 59, l 30\<close>
 locale monoid_monomorphism = monoid_homomorphism + injective_map \<eta> M M'
 
 text \<open>p 59, ll 30--31\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_epimorphism
   by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
 
 text \<open>p 59, ll 30--31\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_monomorphism
   by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
 
 context monoid_homomorphism begin
 
 text \<open>p 59, ll 33--34\<close>
 theorem invertible_image_lemma:
   assumes "invertible a" "a \<in> M"
   shows "\<eta> a \<cdot>' \<eta> (inverse a) = \<one>'" and "\<eta> (inverse a) \<cdot>' \<eta> a = \<one>'"
   using assms commutes_with_composition commutes_with_unit source.inverse_equality
   by auto (metis source.invertible_inverse_closed source.invertible_left_inverse)
 
 text \<open>p 59, l 34; p 60, l 1\<close>
 theorem invertible_target_invertible [intro, simp]:
   "\<lbrakk> invertible a; a \<in> M \<rbrakk> \<Longrightarrow> invertible' (\<eta> a)"
   using invertible_image_lemma by blast
 
 text \<open>p 60, l 1\<close>
 theorem invertible_commutes_with_inverse:
   "\<lbrakk> invertible a; a \<in> M \<rbrakk> \<Longrightarrow> \<eta> (inverse a) = inverse' (\<eta> a)"
   using invertible_image_lemma target.inverse_equality by fastforce
 
 end (* monoid_homomorphism *)
 
 text \<open>p 60, ll 32--34; p 61, l 1\<close>
 sublocale monoid_congruence \<subseteq> natural: monoid_homomorphism Class M "(\<cdot>)" \<one> "M / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (auto simp: PiE_I Class_commutes_with_composition)
 
 text \<open>Fundamental Theorem of Homomorphisms of Monoids\<close>
 
 text \<open>p 61, ll 5, 14--16\<close>
 sublocale monoid_homomorphism \<subseteq> image: submonoid "\<eta> ` M" M' "(\<cdot>')" "\<one>'"
   by unfold_locales (auto simp: commutes_with_composition [symmetric] commutes_with_unit [symmetric])
 
 text \<open>p 61, l 4\<close>
 locale monoid_homomorphism_fundamental = monoid_homomorphism begin
 
 text \<open>p 61, ll 17--18\<close>
 sublocale fiber_relation \<eta> M M' ..
 notation Fiber_Relation ("E'(_')")
 
 text \<open>p 61, ll 6--7, 18--20\<close>
 sublocale monoid_congruence where E = "E(\<eta>)"
   using Class_eq
   by unfold_locales (rule Class_equivalence [THEN iffD1],
     auto simp: left_closed right_closed commutes_with_composition Fiber_equality)
 
 text \<open>p 61, ll 7--9\<close>
 text \<open>
   @{term induced} denotes Jacobson's $\bar{\eta}$.  We have the commutativity of the diagram, where
   @{term induced} is unique: @{thm [display] factorization} @{thm [display] uniqueness}.
 \<close>
 
 text \<open>p 61, l 20\<close>
 notation quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 61, ll 7--8, 22--25\<close>
 sublocale induced: monoid_homomorphism induced "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" "M'" "(\<cdot>')" "\<one>'"
   apply unfold_locales
     apply (auto simp: commutes_with_unit)
   apply (fastforce simp: commutes_with_composition commutes_with_unit Class_commutes_with_composition)
   done
 
 text \<open>p 61, ll 9, 26\<close>
 sublocale natural: monoid_epimorphism Class M "(\<cdot>)" \<one> "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" ..
 
 text \<open>p 61, ll 9, 26--27\<close>
 sublocale induced: monoid_monomorphism induced "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" "M'" "(\<cdot>')" "\<one>'" ..
 
 end (* monoid_homomorphism_fundamental *)
 
 text \<open>p 62, ll 12--13\<close>
 locale group_homomorphism =
   monoid_homomorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'" +
   source: group G "(\<cdot>)" \<one> + target: group G' "(\<cdot>')" "\<one>'"
   for \<eta> and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and G' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''")
 begin
 
 text \<open>p 62, l 13\<close>
 sublocale image: subgroup "\<eta> ` G" G' "(\<cdot>')" "\<one>'"
   using invertible_image_lemma by unfold_locales auto
 
 text \<open>p 62, ll 13--14\<close>
 definition "Ker = \<eta> -` {\<one>'} \<inter> G"
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_equality:
   "Ker = {a | a. a \<in> G \<and> \<eta> a = \<one>'}"
   unfolding Ker_def by auto
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_closed [intro, simp]:
   "a \<in> Ker \<Longrightarrow> a \<in> G"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_image [intro]: (* loops as a simprule *)
   "a \<in> Ker \<Longrightarrow> \<eta> a = \<one>'"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_memI [intro]: (* loops as a simprule *)
   "\<lbrakk> \<eta> a = \<one>'; a \<in> G \<rbrakk> \<Longrightarrow> a \<in> Ker"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 15--16\<close>
 sublocale kernel: normal_subgroup Ker G
 proof -
   interpret kernel: submonoid Ker G
     unfolding Ker_def by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
   interpret kernel: subgroup Ker G
     by unfold_locales (force intro: source.invertible_right_inverse simp: Ker_image invertible_commutes_with_inverse)
   show "normal_subgroup Ker G (\<cdot>) \<one>"
     apply unfold_locales
     unfolding Ker_def
     by (auto simp: commutes_with_composition invertible_image_lemma(2))
 qed
 
 text \<open>p 62, ll 17--20\<close>
 theorem injective_iff_kernel_unit:
   "inj_on \<eta> G \<longleftrightarrow> Ker = {\<one>}"
 proof (rule Not_eq_iff [THEN iffD1, OF iffI])
   assume "Ker \<noteq> {\<one>}"
   then obtain b where b: "b \<in> Ker" "b \<noteq> \<one>" by blast
   then have "\<eta> b = \<eta> \<one>" by (simp add: Ker_image)
   with b show "\<not> inj_on \<eta> G"  by (meson inj_onD kernel.sub source.unit_closed)
 next
   assume "\<not> inj_on \<eta> G"
   then obtain a b where "a \<noteq> b" and ab: "a \<in> G" "b \<in> G" "\<eta> a = \<eta> b" by (meson inj_onI)
   then have "inverse a \<cdot> b \<noteq> \<one>" "\<eta> (inverse a \<cdot> b) = \<one>'"
     using ab source.invertible_right_inverse2
     by force (metis ab commutes_with_composition invertible_image_lemma(2) source.invertible source.invertible_inverse_closed)
   then have "inverse a \<cdot> b \<in> Ker" using Ker_memI ab by blast
   then show "Ker \<noteq> {\<one>}" using \<open>inverse a \<cdot> b \<noteq> \<one>\<close> by blast
 qed
 
 end (* group_homomorphism *)
 
 text \<open>p 62, l 24\<close>
 locale group_epimorphism = group_homomorphism + monoid_epimorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'"
 
 text \<open>p 62, l 21\<close>
 locale normal_subgroup_in_kernel =
   group_homomorphism + contained: normal_subgroup L G "(\<cdot>)" \<one> for L +
   assumes subset: "L \<subseteq> Ker"
 begin
 
 text \<open>p 62, l 21\<close>
 notation contained.quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>"homomorphism onto @{term "G // L"}"\<close>
 text \<open>p 62, ll 23--24\<close>
 sublocale natural: group_epimorphism contained.Class G "(\<cdot>)" \<one> "G // L" "([\<cdot>])" "contained.Class \<one>" ..
 
 text \<open>p 62, ll 25--26\<close>
 theorem left_coset_equality:
   assumes eq: "a \<cdot>| L = b \<cdot>| L" and [simp]: "a \<in> G" and b: "b \<in> G"
   shows "\<eta> a = \<eta> b"
 proof -
   obtain l where l: "b = a \<cdot> l" "l \<in> L"
     by (metis b contained.Class_is_Left_Coset contained.Class_self eq kernel.Left_Coset_memE)
   then have "\<eta> a = \<eta> a \<cdot>' \<eta> l" using Ker_image monoid_homomorphism.commutes_with_composition subset by auto
   also have "\<dots> = \<eta> b" by (simp add: commutes_with_composition l)
   finally show ?thesis .
 qed
 
 text \<open>$\bar{\eta}$\<close>
 text \<open>p 62, ll 26--27\<close>
 definition "induced = (\<lambda>A \<in> G // L. THE b. \<exists>a \<in> G. a \<cdot>| L = A \<and> b = \<eta> a)"
 
 text \<open>p 62, ll 26--27\<close>
 lemma induced_closed [intro, simp]:
   assumes [simp]: "A \<in> G // L" shows "induced A \<in> G'"
 proof -
   obtain a where a: "a \<in> G" "a \<cdot>| L = A" using contained.Class_is_Left_Coset contained.Partition_def assms by auto
   have "(THE b. \<exists>a \<in> G. a \<cdot>| L = A \<and> b = \<eta> a) \<in> G'"
     apply (rule theI2)
     using a by (auto intro: left_coset_equality)
   then show ?thesis unfolding induced_def by simp
 qed
 
 text \<open>p 62, ll 26--27\<close>
 lemma induced_undefined [intro, simp]:
   "A \<notin> G // L \<Longrightarrow> induced A = undefined"
   unfolding induced_def by simp
 
 text \<open>p 62, ll 26--27\<close>
 theorem induced_left_coset_closed [intro, simp]:
   "a \<in> G \<Longrightarrow> induced (a \<cdot>| L) \<in> G'"
   using contained.Class_is_Left_Coset contained.Class_in_Partition by auto 
 
 text \<open>p 62, ll 26--27\<close>
 theorem induced_left_coset_equality [simp]:
   assumes [simp]: "a \<in> G" shows "induced (a \<cdot>| L) = \<eta> a"
 proof -
   have "(THE b. \<exists>a' \<in> G. a' \<cdot>| L = a \<cdot>| L \<and> b = \<eta> a') = \<eta> a"
     by (rule the_equality) (auto intro: left_coset_equality)
   then show ?thesis unfolding induced_def
     using contained.Class_is_Left_Coset contained.Class_in_Partition by auto 
 qed
 
 text \<open>p 62, l 27\<close>
 theorem induced_Left_Coset_commutes_with_composition [simp]:
   "\<lbrakk> a \<in> G; b \<in> G \<rbrakk> \<Longrightarrow> induced ((a \<cdot>| L) [\<cdot>] (b \<cdot>| L)) = induced (a \<cdot>| L) \<cdot>' induced (b \<cdot>| L)"
   by (simp add: commutes_with_composition)
 
 text \<open>p 62, ll 27--28\<close>
 theorem induced_group_homomorphism:
   "group_homomorphism induced (G // L) ([\<cdot>]) (contained.Class \<one>) G' (\<cdot>') \<one>'"
   apply unfold_locales
     apply (auto elim!: contained.Left_CosetE simp: commutes_with_composition commutes_with_unit)
   using contained.factor_unit induced_left_coset_equality apply (fastforce simp: contained.Class_unit_normal_subgroup)
   done
 
 text \<open>p 62, l 28\<close>
 sublocale induced: group_homomorphism induced "G // L" "([\<cdot>])" "contained.Class \<one>" G' "(\<cdot>')" "\<one>'"
   by (fact induced_group_homomorphism)
 
 text \<open>p 62, ll 28--29\<close>
 theorem factorization_lemma: "a \<in> G \<Longrightarrow> compose G induced contained.Class a = \<eta> a"
   unfolding compose_def by (simp add: contained.Class_is_Left_Coset)
 
 text \<open>p 62, ll 29--30\<close>
 theorem factorization [simp]: "compose G induced contained.Class = \<eta>"
   by rule (simp add: compose_def contained.Class_is_Left_Coset)
 
 text \<open>
   Jacobson does not state the uniqueness of @{term induced} explicitly but he uses it later,
   for rings, on p 107.
 \<close>
 text \<open>p 62, l 30\<close>
 theorem uniqueness:
   assumes map: "\<beta> \<in> G // L \<rightarrow>\<^sub>E G'"
     and factorization: "compose G \<beta> contained.Class = \<eta>"
   shows "\<beta> = induced"
 proof
   fix A
   show "\<beta> A = induced A"
   proof (cases "A \<in> G // L")
     case True
     then obtain a where [simp]: "A = contained.Class a" "a \<in> G" by fast
     then have "\<beta> (contained.Class a) = \<eta> a" by (metis compose_eq factorization)
     also have "\<dots> = induced (contained.Class a)" by (simp add: contained.Class_is_Left_Coset)
     finally show ?thesis by simp
   qed (simp add: induced_def PiE_arb [OF map])
 qed
 
 text \<open>p 62, l 31\<close>
 theorem induced_image:
   "induced ` (G // L) = \<eta> ` G"
   by (metis factorization contained.natural.surjective surj_compose)
 
 text \<open>p 62, l 33\<close>
 interpretation L: normal_subgroup L Ker
   by unfold_locales (auto simp: subset, metis kernel.sub kernel.subgroup_inverse_equality contained.normal)
 
 text \<open>p 62, ll 31--33\<close>
 theorem induced_kernel:
   "induced.Ker = Ker / L.Congruence" (* Ker // L is apparently not the right thing *)
 proof -
   have "induced.Ker = { a \<cdot>| L | a. a \<in> G \<and> a \<in> Ker }"
     unfolding induced.Ker_equality
     by simp (metis (hide_lams) contained.Class_is_Left_Coset Ker_image Ker_memI
         induced_left_coset_equality contained.Class_in_Partition contained.representant_exists)
   also have "\<dots> = Ker / L.Congruence"
     using L.Class_is_Left_Coset L.Class_in_Partition
     by auto (metis L.Class_is_Left_Coset L.representant_exists kernel.sub)
   finally show ?thesis .
 qed
 
 text \<open>p 62, ll 34--35\<close>
 theorem induced_inj_on:
   "inj_on induced (G // L) \<longleftrightarrow> L = Ker"
   apply (simp add: induced.injective_iff_kernel_unit induced_kernel contained.Class_unit_normal_subgroup)
   apply rule
   using L.block_exists apply auto [1]
   using L.Block_self L.Class_unit_normal_subgroup L.quotient.unit_closed L.representant_exists
   apply auto
   done
 
 end (* normal_subgroup_in_kernel *)
 
 text \<open>Fundamental Theorem of Homomorphisms of Groups\<close>
 
 text \<open>p 63, l 1\<close>
 locale group_homomorphism_fundamental = group_homomorphism begin
 
 text \<open>p 63, l 1\<close>
 notation kernel.quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 63, l 1\<close>
 sublocale normal_subgroup_in_kernel where L = Ker by unfold_locales rule
 
 text \<open>p 62, ll 36--37; p 63, l 1\<close>
 text \<open>
   @{term induced} denotes Jacobson's $\bar{\eta}$.  We have the commutativity of the diagram, where
   @{term induced} is unique: @{thm [display] factorization} @{thm [display] uniqueness}
 \<close>
 
 end (* group_homomorphism_fundamental *)
 
 text \<open>p 63, l 5\<close>
 locale group_isomorphism = group_homomorphism + bijective_map \<eta> G G' begin
 
 text \<open>p 63, l 5\<close>
 sublocale monoid_isomorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'" 
   by unfold_locales (auto simp: commutes_with_composition)
 
 text \<open>p 63, l 6\<close>
 lemma inverse_group_isomorphism:
   "group_isomorphism (restrict (inv_into G \<eta>) G') G' (\<cdot>') \<one>' G (\<cdot>) \<one>"
   using commutes_with_composition commutes_with_unit surjective by unfold_locales auto
 
 end (* group_isomorphism *)
 
 text \<open>p 63, l 6\<close>
 definition isomorphic_as_groups (infixl "\<cong>\<^sub>G" 50)
   where "\<G> \<cong>\<^sub>G \<G>' \<longleftrightarrow> (let (G, composition, unit) = \<G>; (G', composition', unit') = \<G>' in
   (\<exists>\<eta>. group_isomorphism \<eta> G composition unit G' composition' unit'))"
 
 text \<open>p 63, l 6\<close>
 lemma isomorphic_as_groups_symmetric:
   "(G, composition, unit) \<cong>\<^sub>G (G', composition', unit') \<Longrightarrow> (G', composition', unit') \<cong>\<^sub>G (G, composition, unit)"
   by (simp add: isomorphic_as_groups_def) (meson group_isomorphism.inverse_group_isomorphism)
 
 text \<open>p 63, l 1\<close>
 sublocale group_isomorphism \<subseteq> group_epimorphism ..
 
 text \<open>p 63, l 1\<close>
 locale group_epimorphism_fundamental = group_homomorphism_fundamental + group_epimorphism begin
 
 text \<open>p 63, ll 1--2\<close>
 interpretation image: group_homomorphism induced "G // Ker" "([\<cdot>])" "kernel.Class \<one>" "(\<eta> ` G)" "(\<cdot>')" "\<one>'"
   by (simp add: surjective group_homomorphism_fundamental.intro induced_group_homomorphism)
 
 text \<open>p 63, ll 1--2\<close>
 sublocale image: group_isomorphism induced "G // Ker" "([\<cdot>])" "kernel.Class \<one>" "(\<eta> ` G)" "(\<cdot>')" "\<one>'"
   using induced_group_homomorphism
   by unfold_locales (auto simp: bij_betw_def induced_image induced_inj_on induced.commutes_with_composition)
 
 end (* group_epimorphism_fundamental *)
 
 context group_homomorphism begin
 
 text \<open>p 63, ll 5--7\<close>
 theorem image_isomorphic_to_factor_group:
   "\<exists>K composition unit. normal_subgroup K G (\<cdot>) \<one> \<and> (\<eta> ` G, (\<cdot>'), \<one>') \<cong>\<^sub>G (G // K, composition, unit)"
 proof -
   interpret image: group_epimorphism_fundamental where G' = "\<eta> ` G"
     by unfold_locales (auto simp: commutes_with_composition)
   have "group_isomorphism image.induced (G // Ker) ([\<cdot>]) (kernel.Class \<one>) (\<eta> ` G) (\<cdot>') \<one>'" ..
   then have "(\<eta> ` G, (\<cdot>'), \<one>') \<cong>\<^sub>G (G // Ker, ([\<cdot>]), kernel.Class \<one>)"
     by (simp add: isomorphic_as_groups_def) (meson group_isomorphism.inverse_group_isomorphism)
   moreover have "normal_subgroup Ker G (\<cdot>) \<one>" ..
   ultimately show ?thesis by blast
 qed
 
 end (* group_homomorphism *)
 
 end
diff --git a/thys/Jinja/BV/JVM_SemiType.thy b/thys/Jinja/BV/JVM_SemiType.thy
--- a/thys/Jinja/BV/JVM_SemiType.thy
+++ b/thys/Jinja/BV/JVM_SemiType.thy
@@ -1,256 +1,256 @@
 (*  Title:      HOL/MicroJava/BV/JVM.thy
 
     Author:     Gerwin Klein
     Copyright   2000 TUM
 
 *)
 
 section \<open>The JVM Type System as Semilattice\<close>
 
 theory JVM_SemiType imports SemiType begin
 
 type_synonym ty\<^sub>l = "ty err list"
 type_synonym ty\<^sub>s = "ty list"
 type_synonym ty\<^sub>i = "ty\<^sub>s \<times> ty\<^sub>l"
 type_synonym ty\<^sub>i' = "ty\<^sub>i option"
 type_synonym ty\<^sub>m = "ty\<^sub>i' list"
 type_synonym ty\<^sub>P = "mname \<Rightarrow> cname \<Rightarrow> ty\<^sub>m"
 
 
 definition stk_esl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>s esl"
 where
   "stk_esl P mxs \<equiv> upto_esl mxs (SemiType.esl P)"
 
 definition loc_sl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>l sl"
 where
   "loc_sl P mxl \<equiv> Listn.sl mxl (Err.sl (SemiType.esl P))"
 
 definition sl :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err sl"
 where
   "sl P mxs mxl \<equiv>
   Err.sl(Opt.esl(Product.esl (stk_esl P mxs) (Err.esl(loc_sl P mxl))))"
 
 
 definition states :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err set"
 where "states P mxs mxl \<equiv> fst(sl P mxs mxl)"
 
 definition le :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err ord"
 where
   "le P mxs mxl \<equiv> fst(snd(sl P mxs mxl))"
 
 definition sup :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err binop"
 where
   "sup P mxs mxl \<equiv> snd(snd(sl P mxs mxl))"
 
 
 definition sup_ty_opt :: "['c prog,ty err,ty err] \<Rightarrow> bool" 
     ("_ \<turnstile> _ \<le>\<^sub>\<top> _" [71,71,71] 70)
 where
   "sup_ty_opt P \<equiv> Err.le (subtype P)"
 
 definition sup_state :: "['c prog,ty\<^sub>i,ty\<^sub>i] \<Rightarrow> bool"   
     ("_ \<turnstile> _ \<le>\<^sub>i _" [71,71,71] 70)
 where
   "sup_state P \<equiv> Product.le (Listn.le (subtype P)) (Listn.le (sup_ty_opt P))"
 
 definition sup_state_opt :: "['c prog,ty\<^sub>i',ty\<^sub>i'] \<Rightarrow> bool" 
-    ("_ \<turnstile> _ \<le>' _" [71,71,71] 70)
+    ("_ \<turnstile> _ \<le>'' _" [71,71,71] 70)
 where
   "sup_state_opt P \<equiv> Opt.le (sup_state P)"
 
 abbreviation
   sup_loc :: "['c prog,ty\<^sub>l,ty\<^sub>l] \<Rightarrow> bool"  ("_ \<turnstile> _ [\<le>\<^sub>\<top>] _"  [71,71,71] 70)
   where "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> list_all2 (sup_ty_opt P) LT LT'"
 
 notation (ASCII)
   sup_ty_opt  ("_ |- _ <=T _" [71,71,71] 70) and
   sup_state  ("_ |- _ <=i _"  [71,71,71] 70) and
   sup_state_opt  ("_ |- _ <=' _"  [71,71,71] 70) and
   sup_loc  ("_ |- _ [<=T] _"  [71,71,71] 70)
 
 
 subsection "Unfolding"
 
 lemma JVM_states_unfold: 
   "states P mxs mxl \<equiv> err(opt((Union {list n (types P) |n. n <= mxs}) \<times>
                                  list mxl (err(types P))))"
 (*<*)
   apply (unfold states_def sl_def Opt.esl_def Err.sl_def
          stk_esl_def loc_sl_def Product.esl_def
          Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
   apply simp
   done
 (*>*)
 
 lemma JVM_le_unfold:
  "le P m n \<equiv> 
   Err.le(Opt.le(Product.le(Listn.le(subtype P))(Listn.le(Err.le(subtype P)))))" 
 (*<*)
   apply (unfold le_def sl_def Opt.esl_def Err.sl_def
          stk_esl_def loc_sl_def Product.esl_def  
          Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def) 
   apply simp
   done
 (*>*)
     
 lemma sl_def2:
   "JVM_SemiType.sl P mxs mxl \<equiv> 
   (states P mxs mxl, JVM_SemiType.le P mxs mxl, JVM_SemiType.sup P mxs mxl)"
 (*<*) by (unfold JVM_SemiType.sup_def states_def JVM_SemiType.le_def) simp (*>*)
 
 
 lemma JVM_le_conv:
   "le P m n (OK t1) (OK t2) = P \<turnstile> t1 \<le>' t2"
 (*<*) by (simp add: JVM_le_unfold Err.le_def lesub_def sup_state_opt_def  
                 sup_state_def sup_ty_opt_def) (*>*)
 
 lemma JVM_le_Err_conv:
   "le P m n = Err.le (sup_state_opt P)"
 (*<*) by (unfold sup_state_opt_def sup_state_def  
              sup_ty_opt_def JVM_le_unfold) simp (*>*)
 
 lemma err_le_unfold [iff]: 
   "Err.le r (OK a) (OK b) = r a b"
 (*<*) by (simp add: Err.le_def lesub_def) (*>*)
   
 
 subsection \<open>Semilattice\<close>
 
 lemma order_sup_state_opt [intro, simp]: 
   "wf_prog wf_mb P \<Longrightarrow> order (sup_state_opt P)"   
 (*<*) by (unfold sup_state_opt_def sup_state_def sup_ty_opt_def) blast (*>*)
 
 lemma semilat_JVM [intro?]:
   "wf_prog wf_mb P \<Longrightarrow> semilat (JVM_SemiType.sl P mxs mxl)"
 (*<*)
   apply (unfold JVM_SemiType.sl_def stk_esl_def loc_sl_def)  
   apply (blast intro: err_semilat_Product_esl err_semilat_upto_esl 
                       Listn_sl err_semilat_JType_esl)
   done
 (*>*)
 
 lemma acc_JVM [intro]:
   "wf_prog wf_mb P \<Longrightarrow> acc (JVM_SemiType.le P mxs mxl)"
 (*<*) by (unfold JVM_le_unfold) blast (*>*)
 
 
 subsection \<open>Widening with \<open>\<top>\<close>\<close>
 
 lemma subtype_refl[iff]: "subtype P t t" (*<*) by (simp add: fun_of_def) (*>*)
 
 lemma sup_ty_opt_refl [iff]: "P \<turnstile> T \<le>\<^sub>\<top> T"
 (*<*)
   apply (unfold sup_ty_opt_def)
   apply (fold lesub_def)
   apply (rule le_err_refl)
   apply (simp add: lesub_def)
   done
 (*>*)
 
 lemma Err_any_conv [iff]: "P \<turnstile> Err \<le>\<^sub>\<top> T = (T = Err)"
 (*<*) by (unfold sup_ty_opt_def) (rule Err_le_conv [simplified lesub_def]) (*>*)
 
 lemma any_Err [iff]: "P \<turnstile> T \<le>\<^sub>\<top> Err"
 (*<*) by (unfold sup_ty_opt_def) (rule le_Err [simplified lesub_def]) (*>*)
 
 lemma OK_OK_conv [iff]:
   "P \<turnstile> OK T \<le>\<^sub>\<top> OK T' = P \<turnstile> T \<le> T'"
 (*<*) by (simp add: sup_ty_opt_def fun_of_def) (*>*)
 
 lemma any_OK_conv [iff]:
   "P \<turnstile> X \<le>\<^sub>\<top> OK T' = (\<exists>T. X = OK T \<and> P \<turnstile> T \<le> T')"
 (*<*)
   apply (unfold sup_ty_opt_def) 
   apply (rule le_OK_conv [simplified lesub_def])
   done  
 (*>*)
 
 lemma OK_any_conv:
  "P \<turnstile> OK T \<le>\<^sub>\<top> X = (X = Err \<or> (\<exists>T'. X = OK T' \<and> P \<turnstile> T \<le> T'))"
 (*<*)
   apply (unfold sup_ty_opt_def) 
   apply (rule OK_le_conv [simplified lesub_def])
   done
 (*>*)
 
 lemma sup_ty_opt_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>\<^sub>\<top> b; P \<turnstile> b \<le>\<^sub>\<top> c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>\<top> c"
 (*<*) by (auto intro: widen_trans  
            simp add: sup_ty_opt_def Err.le_def lesub_def fun_of_def
            split: err.splits) (*>*)
 
 
 subsection "Stack and Registers"
 
 lemma stk_convert:
   "P \<turnstile> ST [\<le>] ST' = Listn.le (subtype P) ST ST'"
 (*<*) by (simp add: Listn.le_def lesub_def) (*>*)
 
 lemma sup_loc_refl [iff]: "P \<turnstile> LT [\<le>\<^sub>\<top>] LT"
 (*<*) by (rule list_all2_refl) simp (*>*)
 
 lemmas sup_loc_Cons1 [iff] = list_all2_Cons1 [of "sup_ty_opt P"] for P
 
 lemma sup_loc_def:
   "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> Listn.le (sup_ty_opt P) LT LT'"
 (*<*) by (simp add: Listn.le_def lesub_def) (*>*)
 
 lemma sup_loc_widens_conv [iff]:
   "P \<turnstile> map OK Ts [\<le>\<^sub>\<top>] map OK Ts' = P \<turnstile> Ts [\<le>] Ts'"
 (*<*)
   by (simp add: list_all2_map1 list_all2_map2)
 (*>*)
 
 
 lemma sup_loc_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a [\<le>\<^sub>\<top>] b; P \<turnstile> b [\<le>\<^sub>\<top>] c\<rbrakk> \<Longrightarrow> P \<turnstile> a [\<le>\<^sub>\<top>] c"
 (*<*) by (rule list_all2_trans, rule sup_ty_opt_trans) (*>*)
 
 
 subsection "State Type"
 
 lemma sup_state_conv [iff]:
   "P \<turnstile> (ST,LT) \<le>\<^sub>i (ST',LT') = (P \<turnstile> ST [\<le>] ST' \<and> P \<turnstile> LT [\<le>\<^sub>\<top>] LT')"
 (*<*) by (auto simp add: sup_state_def stk_convert lesub_def Product.le_def sup_loc_def) (*>*)
   
 lemma sup_state_conv2:
   "P \<turnstile> s1 \<le>\<^sub>i s2 = (P \<turnstile> fst s1 [\<le>] fst s2 \<and> P \<turnstile> snd s1 [\<le>\<^sub>\<top>] snd s2)"
 (*<*) by (cases s1, cases s2) simp (*>*)
 
 lemma sup_state_refl [iff]: "P \<turnstile> s \<le>\<^sub>i s"
 (*<*) by (auto simp add: sup_state_conv2) (*>*)
 
 lemma sup_state_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>\<^sub>i b; P \<turnstile> b \<le>\<^sub>i c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>i c"
 (*<*) by (auto intro: sup_loc_trans widens_trans simp add: sup_state_conv2) (*>*)
 
 
 lemma sup_state_opt_None_any [iff]:
   "P \<turnstile> None \<le>' s"
 (*<*) by (simp add: sup_state_opt_def Opt.le_def) (*>*)
 
 lemma sup_state_opt_any_None [iff]:
   "P \<turnstile> s \<le>' None = (s = None)"
 (*<*) by (simp add: sup_state_opt_def Opt.le_def) (*>*)
 
 lemma sup_state_opt_Some_Some [iff]:
   "P \<turnstile> Some a \<le>' Some b = P \<turnstile> a \<le>\<^sub>i b"  
 (*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)
 
 lemma sup_state_opt_any_Some:
   "P \<turnstile> (Some s) \<le>' X = (\<exists>s'. X = Some s' \<and> P \<turnstile> s \<le>\<^sub>i s')"
 (*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)
 
 lemma sup_state_opt_refl [iff]: "P \<turnstile> s \<le>' s"
 (*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)
 
 lemma sup_state_opt_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>' b; P \<turnstile> b \<le>' c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>' c"
 (*<*)
   apply (unfold sup_state_opt_def Opt.le_def lesub_def)
   apply (simp del: split_paired_All)
   apply (rule sup_state_trans, assumption+)
   done
 (*>*)
 
 end
diff --git a/thys/Jinja/J/Progress.thy b/thys/Jinja/J/Progress.thy
--- a/thys/Jinja/J/Progress.thy
+++ b/thys/Jinja/J/Progress.thy
@@ -1,626 +1,626 @@
 (*  Title:      Jinja/J/SmallProgress.thy
 
     Author:     Tobias Nipkow
     Copyright   2003 Technische Universitaet Muenchen
 *)
 
 section \<open>Progress of Small Step Semantics\<close>
 
 theory Progress
 imports Equivalence WellTypeRT DefAss "../Common/Conform"
 begin
 
 lemma final_addrE:
   "\<lbrakk> P,E,h \<turnstile> e : Class C; final e;
     \<And>a. e = addr a \<Longrightarrow> R;
     \<And>a. e = Throw a \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
 (*<*)by(auto simp:final_def)(*>*)
 
 
 lemma finalRefE:
  "\<lbrakk> P,E,h \<turnstile> e : T; is_refT T; final e;
    e = null \<Longrightarrow> R;
    \<And>a C. \<lbrakk> e = addr a; T = Class C \<rbrakk> \<Longrightarrow> R;
    \<And>a. e = Throw a \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
 (*<*)by(auto simp:final_def is_refT_def)(*>*)
 
 
 text\<open>Derivation of new induction scheme for well typing:\<close>
 
 inductive
   WTrt' :: "[J_prog,heap,env,expr,ty] \<Rightarrow> bool"
   and WTrts' :: "[J_prog,heap,env,expr list, ty list] \<Rightarrow> bool"
   and WTrt2' :: "[J_prog,env,heap,expr,ty] \<Rightarrow> bool"
-        ("_,_,_ \<turnstile> _ :' _"   [51,51,51]50)
+        ("_,_,_ \<turnstile> _ :'' _"   [51,51,51]50)
   and WTrts2' :: "[J_prog,env,heap,expr list, ty list] \<Rightarrow> bool"
         ("_,_,_ \<turnstile> _ [:''] _" [51,51,51]50)
   for P :: J_prog and h :: heap
 where
   "P,E,h \<turnstile> e :' T \<equiv> WTrt' P h E e T"
 | "P,E,h \<turnstile> es [:'] Ts \<equiv> WTrts' P h E es Ts"
 
 | "is_class P C  \<Longrightarrow>  P,E,h \<turnstile> new C :' Class C"
 | "\<lbrakk> P,E,h \<turnstile> e :' T; is_refT T; is_class P C \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> Cast C e :' Class C"
 | "typeof\<^bsub>h\<^esub> v = Some T \<Longrightarrow> P,E,h \<turnstile> Val v :' T"
 | "E v = Some T  \<Longrightarrow>  P,E,h \<turnstile> Var v :' T"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2 :' T\<^sub>2 \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1 \<guillemotleft>Eq\<guillemotright> e\<^sub>2 :' Boolean"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' Integer;  P,E,h \<turnstile> e\<^sub>2 :' Integer \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1 \<guillemotleft>Add\<guillemotright> e\<^sub>2 :' Integer"
 | "\<lbrakk> P,E,h \<turnstile> Var V :' T;  P,E,h \<turnstile> e :' T';  P \<turnstile> T' \<le> T \<^cancel>\<open>V \<noteq> This\<close> \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> V:=e :' Void"
 | "\<lbrakk> P,E,h \<turnstile> e :' Class C; P \<turnstile> C has F:T in D \<rbrakk> \<Longrightarrow> P,E,h \<turnstile> e\<bullet>F{D} :' T"
 | "P,E,h \<turnstile> e :' NT \<Longrightarrow> P,E,h \<turnstile> e\<bullet>F{D} :' T"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' Class C;  P \<turnstile> C has F:T in D;
     P,E,h \<turnstile> e\<^sub>2 :' T\<^sub>2;  P \<turnstile> T\<^sub>2 \<le> T \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1\<bullet>F{D}:=e\<^sub>2 :' Void"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1:'NT; P,E,h \<turnstile> e\<^sub>2 :' T\<^sub>2 \<rbrakk> \<Longrightarrow> P,E,h \<turnstile> e\<^sub>1\<bullet>F{D}:=e\<^sub>2 :' Void"
 | "\<lbrakk> P,E,h \<turnstile> e :' Class C; P \<turnstile> C sees M:Ts \<rightarrow> T = (pns,body) in D;
     P,E,h \<turnstile> es [:'] Ts'; P \<turnstile> Ts' [\<le>] Ts \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> e\<bullet>M(es) :' T"
 | "\<lbrakk> P,E,h \<turnstile> e :' NT; P,E,h \<turnstile> es [:'] Ts \<rbrakk> \<Longrightarrow> P,E,h \<turnstile> e\<bullet>M(es) :' T"
 | "P,E,h \<turnstile> [] [:'] []"
 | "\<lbrakk> P,E,h \<turnstile> e :' T;  P,E,h \<turnstile> es [:'] Ts \<rbrakk> \<Longrightarrow>  P,E,h \<turnstile> e#es [:'] T#Ts"
 | "\<lbrakk> typeof\<^bsub>h\<^esub> v = Some T\<^sub>1; P \<turnstile> T\<^sub>1 \<le> T; P,E(V\<mapsto>T),h \<turnstile> e\<^sub>2 :' T\<^sub>2 \<rbrakk>
   \<Longrightarrow>  P,E,h \<turnstile> {V:T := Val v; e\<^sub>2} :' T\<^sub>2"
 | "\<lbrakk> P,E(V\<mapsto>T),h \<turnstile> e :' T'; \<not> assigned V e \<rbrakk> \<Longrightarrow>  P,E,h \<turnstile> {V:T; e} :' T'"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2:'T\<^sub>2 \<rbrakk>  \<Longrightarrow>  P,E,h \<turnstile> e\<^sub>1;;e\<^sub>2 :' T\<^sub>2"
 | "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2:' T\<^sub>2;
     P \<turnstile> T\<^sub>1 \<le> T\<^sub>2 \<or> P \<turnstile> T\<^sub>2 \<le> T\<^sub>1;
     P \<turnstile> T\<^sub>1 \<le> T\<^sub>2 \<longrightarrow> T = T\<^sub>2; P \<turnstile> T\<^sub>2 \<le> T\<^sub>1 \<longrightarrow> T = T\<^sub>1 \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :' T"
 (*
  "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2:' T\<^sub>2; P \<turnstile> T\<^sub>1 \<le> T\<^sub>2 \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :' T\<^sub>2"
  "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1;  P,E,h \<turnstile> e\<^sub>2:' T\<^sub>2; P \<turnstile> T\<^sub>2 \<le> T\<^sub>1 \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :' T\<^sub>1"
 *)
 | "\<lbrakk> P,E,h \<turnstile> e :' Boolean;  P,E,h \<turnstile> c:' T \<rbrakk>
   \<Longrightarrow>  P,E,h \<turnstile> while(e) c :' Void"
 | "\<lbrakk> P,E,h \<turnstile> e :' T\<^sub>r; is_refT T\<^sub>r \<rbrakk>  \<Longrightarrow>  P,E,h \<turnstile> throw e :' T"
 | "\<lbrakk> P,E,h \<turnstile> e\<^sub>1 :' T\<^sub>1;  P,E(V \<mapsto> Class C),h \<turnstile> e\<^sub>2 :' T\<^sub>2; P \<turnstile> T\<^sub>1 \<le> T\<^sub>2 \<rbrakk>
   \<Longrightarrow> P,E,h \<turnstile> try e\<^sub>1 catch(C V) e\<^sub>2 :' T\<^sub>2"
 
 (*<*)
 lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
   and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]
 
 inductive_cases WTrt'_elim_cases[elim!]:
   "P,E,h \<turnstile> V :=e :' T"
 (*>*)
 
 lemma [iff]: "P,E,h \<turnstile> e\<^sub>1;;e\<^sub>2 :' T\<^sub>2 = (\<exists>T\<^sub>1. P,E,h \<turnstile> e\<^sub>1:' T\<^sub>1 \<and> P,E,h \<turnstile> e\<^sub>2:' T\<^sub>2)"
 (*<*)
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 (*>*)
 
 lemma [iff]: "P,E,h \<turnstile> Val v :' T = (typeof\<^bsub>h\<^esub> v = Some T)"
 (*<*)
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 (*>*)
 
 lemma [iff]: "P,E,h \<turnstile> Var v :' T = (E v = Some T)"
 (*<*)
 apply(rule iffI)
 apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
 done
 (*>*)
 
 
 lemma wt_wt': "P,E,h \<turnstile> e : T \<Longrightarrow> P,E,h \<turnstile> e :' T"
 and wts_wts': "P,E,h \<turnstile> es [:] Ts \<Longrightarrow> P,E,h \<turnstile> es [:'] Ts"
 (*<*)
 apply (induct rule:WTrt_inducts)
 prefer 14
 apply(case_tac "assigned V e")
 apply(clarsimp simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
 apply(erule (2) WTrt'_WTrts'.intros)
 apply(erule (1) WTrt'_WTrts'.intros)
 apply(blast intro:WTrt'_WTrts'.intros)+
 done
 (*>*)
 
 
 lemma wt'_wt: "P,E,h \<turnstile> e :' T \<Longrightarrow> P,E,h \<turnstile> e : T"
 and wts'_wts: "P,E,h \<turnstile> es [:'] Ts \<Longrightarrow> P,E,h \<turnstile> es [:] Ts"
 (*<*)
 apply (induct rule:WTrt'_inducts)
 prefer 16
 apply(rule WTrt_WTrts.intros)
 apply(rule WTrt_WTrts.intros)
 apply(rule WTrt_WTrts.intros)
 apply simp
 apply(erule (2) WTrt_WTrts.intros)
 apply(blast intro:WTrt_WTrts.intros)+
 done
 (*>*)
 
 
 corollary wt'_iff_wt: "(P,E,h \<turnstile> e :' T) = (P,E,h \<turnstile> e : T)"
 (*<*)by(blast intro:wt_wt' wt'_wt)(*>*)
 
 
 corollary wts'_iff_wts: "(P,E,h \<turnstile> es [:'] Ts) = (P,E,h \<turnstile> es [:] Ts)"
 (*<*)by(blast intro:wts_wts' wts'_wts)(*>*)
 
 (*<*)
 lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
  case_names WTrtNew WTrtCast WTrtVal WTrtVar WTrtBinOpEq WTrtBinOpAdd WTrtLAss WTrtFAcc WTrtFAccNT WTrtFAss
  WTrtFAssNT WTrtCall WTrtCallNT WTrtNil WTrtCons WTrtInitBlock WTrtBlock WTrtSeq WTrtCond
  WTrtWhile WTrtThrow WTrtTry, consumes 1]
 (*>*)
 
 theorem assumes wf: "wwf_J_prog P" and hconf: "P \<turnstile> h \<surd>"
 shows progress: "P,E,h \<turnstile> e : T \<Longrightarrow>
  (\<And>l. \<lbrakk> \<D> e \<lfloor>dom l\<rfloor>; \<not> final e \<rbrakk> \<Longrightarrow> \<exists>e' s'. P \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>)"
 and "P,E,h \<turnstile> es [:] Ts \<Longrightarrow>
  (\<And>l. \<lbrakk> \<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es \<rbrakk> \<Longrightarrow> \<exists>es' s'. P \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>)"
 (*<*)
 proof (induct rule:WTrt_inducts2)
   case WTrtNew
   show ?case
   proof cases
     assume "\<exists>a. h a = None"
     with assms WTrtNew show ?thesis
       by (fastforce del:exE intro!:RedNew simp add:new_Addr_def
                    elim!:wf_Fields_Ex[THEN exE])
   next
     assume "\<not>(\<exists>a. h a = None)"
     with assms WTrtNew show ?thesis
       by(fastforce intro:RedNewFail simp add:new_Addr_def)
   qed
 next
   case (WTrtCast E e T C)
   have wte: "P,E,h \<turnstile> e : T" and ref: "is_refT T"
    and IH: "\<And>l. \<lbrakk>\<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                 \<Longrightarrow> \<exists>e' s'. P \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and D: "\<D> (Cast C e) \<lfloor>dom l\<rfloor>" by fact+
   from D have De: "\<D> e \<lfloor>dom l\<rfloor>" by auto
   show ?case
   proof cases
     assume "final e"
     with wte ref show ?thesis
     proof (rule finalRefE)
       assume "e = null" thus ?case by(fastforce intro:RedCastNull)
     next
       fix D a assume A: "T = Class D" "e = addr a"
       show ?thesis
       proof cases
         assume "P \<turnstile> D \<preceq>\<^sup>* C"
         thus ?thesis using A wte by(fastforce intro:RedCast)
       next
         assume "\<not> P \<turnstile> D \<preceq>\<^sup>* C"
         thus ?thesis using A wte by(force intro!:RedCastFail)
       qed
     next
       fix a assume "e = Throw a"
       thus ?thesis by(blast intro!:red_reds.CastThrow)
     qed
   next
     assume nf: "\<not> final e"
     from IH[OF De nf] show ?thesis by (blast intro:CastRed)
   qed
 next
   case WTrtVal thus ?case by(simp add:final_def)
 next
   case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
 next
   case (WTrtBinOpEq E e1 T1 e2 T2)
   show ?case
   proof cases
     assume "final e1"
     thus ?thesis
     proof (rule finalE)
       fix v1 assume [simp]: "e1 = Val v1"
       show ?thesis
       proof cases
         assume "final e2"
         thus ?thesis
         proof (rule finalE)
           fix v2 assume "e2 = Val v2"
           thus ?thesis using WTrtBinOpEq by(fastforce intro:RedBinOp)
         next
           fix a assume "e2 = Throw a"
           thus ?thesis by(auto intro:red_reds.BinOpThrow2)
         qed
       next
         assume "\<not> final e2" with WTrtBinOpEq show ?thesis
           by simp (fast intro!:BinOpRed2)
       qed
     next
       fix a assume "e1 = Throw a"
       thus ?thesis by simp (fast intro:red_reds.BinOpThrow1)
     qed
   next
     assume "\<not> final e1" with WTrtBinOpEq show ?thesis
       by simp (fast intro:BinOpRed1)
   qed
 next
   case (WTrtBinOpAdd E e1 e2)
   show ?case
   proof cases
     assume "final e1"
     thus ?thesis
     proof (rule finalE)
       fix v1 assume [simp]: "e1 = Val v1"
       show ?thesis
       proof cases
         assume "final e2"
         thus ?thesis
         proof (rule finalE)
           fix v2 assume "e2 = Val v2"
           thus ?thesis using WTrtBinOpAdd by(fastforce intro:RedBinOp)
         next
           fix a assume "e2 = Throw a"
           thus ?thesis by(auto intro:red_reds.BinOpThrow2)
         qed
       next
         assume "\<not> final e2" with WTrtBinOpAdd show ?thesis
           by simp (fast intro!:BinOpRed2)
       qed
     next
       fix a assume "e1 = Throw a"
       thus ?thesis by simp (fast intro:red_reds.BinOpThrow1)
     qed
   next
     assume "\<not> final e1" with WTrtBinOpAdd show ?thesis
       by simp (fast intro:BinOpRed1)
   qed
 next
   case (WTrtLAss E V T e T')
   show ?case
   proof cases
     assume "final e" with WTrtLAss show ?thesis
       by(auto simp:final_def intro!:RedLAss red_reds.LAssThrow)
   next
     assume "\<not> final e" with WTrtLAss show ?thesis
       by simp (fast intro:LAssRed)
   qed
 next
   case (WTrtFAcc E e C F T D)
   have wte: "P,E,h \<turnstile> e : Class C"
    and field: "P \<turnstile> C has F:T in D" by fact+
   show ?case
   proof cases
     assume "final e"
     with wte show ?thesis
     proof (rule final_addrE)
       fix a assume e: "e = addr a"
       with wte obtain fs where hp: "h a = Some(C,fs)" by auto
       with hconf have "P,h \<turnstile> (C,fs) \<surd>" using hconf_def by fastforce
       then obtain v where "fs(F,D) = Some v" using field
         by(fastforce dest:has_fields_fun simp:oconf_def has_field_def)
       with hp e show ?thesis by(fastforce intro:RedFAcc)
     next
       fix a assume "e = Throw a"
       thus ?thesis by(fastforce intro:red_reds.FAccThrow)
     qed
   next
     assume "\<not> final e" with WTrtFAcc show ?thesis
       by(fastforce intro!:FAccRed)
   qed
 next
   case (WTrtFAccNT E e F D T)
   show ?case
   proof cases
     assume "final e"  \<comment> \<open>@{term e} is @{term null} or @{term throw}\<close>
     with WTrtFAccNT show ?thesis
       by(fastforce simp:final_def intro: RedFAccNull red_reds.FAccThrow)
   next
     assume "\<not> final e" \<comment> \<open>@{term e} reduces by IH\<close>
     with WTrtFAccNT show ?thesis by simp (fast intro:FAccRed)
   qed
 next
   case (WTrtFAss E e1 C F T D e2 T2)
   have wte1: "P,E,h \<turnstile> e1 : Class C" by fact
   show ?case
   proof cases
     assume "final e1"
     with wte1 show ?thesis
     proof (rule final_addrE)
       fix a assume e1: "e1 = addr a"
       show ?thesis
       proof cases
         assume "final e2"
         thus ?thesis
         proof (rule finalE)
           fix v assume "e2 = Val v"
           thus ?thesis using e1 wte1 by(fastforce intro:RedFAss)
         next
           fix a assume "e2 = Throw a"
           thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
         qed
       next
         assume "\<not> final e2" with WTrtFAss e1 show ?thesis
           by simp (fast intro!:FAssRed2)
       qed
     next
       fix a assume "e1 = Throw a"
       thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
     qed
   next
     assume "\<not> final e1" with WTrtFAss show ?thesis
       by simp (blast intro!:FAssRed1)
   qed
 next
   case (WTrtFAssNT E e\<^sub>1 e\<^sub>2 T\<^sub>2 F D)
   show ?case
   proof cases
     assume e1: "final e\<^sub>1"  \<comment> \<open>@{term e\<^sub>1} is @{term null} or @{term throw}\<close>
     show ?thesis
     proof cases
       assume "final e\<^sub>2"  \<comment> \<open>@{term e\<^sub>2} is @{term Val} or @{term throw}\<close>
       with WTrtFAssNT e1 show ?thesis
         by(fastforce simp:final_def intro: RedFAssNull red_reds.FAssThrow1 red_reds.FAssThrow2)
     next
       assume "\<not> final e\<^sub>2" \<comment> \<open>@{term e\<^sub>2} reduces by IH\<close>
       with WTrtFAssNT e1 show ?thesis
         by (fastforce  simp:final_def intro!:red_reds.FAssRed2 red_reds.FAssThrow1)
     qed
   next
     assume "\<not> final e\<^sub>1" \<comment> \<open>@{term e\<^sub>1} reduces by IH\<close>
     with WTrtFAssNT show ?thesis by (fastforce intro:FAssRed1)
   qed
 next
   case (WTrtCall E e C M Ts T pns body D es Ts')
   have wte: "P,E,h \<turnstile> e : Class C"
    and "method": "P \<turnstile> C sees M:Ts\<rightarrow>T = (pns,body) in D"
    and wtes: "P,E,h \<turnstile> es [:] Ts'"and sub: "P \<turnstile> Ts' [\<le>] Ts"
    and IHes: "\<And>l.
              \<lbrakk>\<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es\<rbrakk>
              \<Longrightarrow> \<exists>es' s'. P \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>"
    and D: "\<D> (e\<bullet>M(es)) \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume "final e"
     with wte show ?thesis
     proof (rule final_addrE)
       fix a assume e_addr: "e = addr a"
       show ?thesis
       proof cases
         assume es: "\<exists>vs. es = map Val vs"
         from wte e_addr obtain fs where ha: "h a = Some(C,fs)" by auto
         show ?thesis
           using e_addr ha "method" WTrts_same_length[OF wtes] sub es sees_wf_mdecl[OF wf "method"]
           by (fastforce intro!: RedCall simp:list_all2_iff wf_mdecl_def)
       next
         assume "\<not>(\<exists>vs. es = map Val vs)"
         hence not_all_Val: "\<not>(\<forall>e \<in> set es. \<exists>v. e = Val v)"
           by(simp add:ex_map_conv)
         let ?ves = "takeWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?rest = "dropWhile (\<lambda>e. \<exists>v. e = Val v) es"
         let ?ex = "hd ?rest" let ?rst = "tl ?rest"
         from not_all_Val have nonempty: "?rest \<noteq> []" by auto
         hence es: "es = ?ves @ ?ex # ?rst" by simp
         have "\<forall>e \<in> set ?ves. \<exists>v. e = Val v" by(fastforce dest:set_takeWhileD)
         then obtain vs where ves: "?ves = map Val vs"
           using ex_map_conv by blast
         show ?thesis
         proof cases
           assume "final ?ex"
           moreover from nonempty have "\<not>(\<exists>v. ?ex = Val v)"
             by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
               (simp add:dropWhile_eq_Cons_conv)
           ultimately obtain b where ex_Throw: "?ex = Throw b"
             by(fast elim!:finalE)
           show ?thesis using e_addr es ex_Throw ves
             by(fastforce intro:CallThrowParams)
         next
           assume not_fin: "\<not> final ?ex"
           have "finals es = finals(?ves @ ?ex # ?rst)" using es
             by(rule arg_cong)
           also have "\<dots> = finals(?ex # ?rst)" using ves by simp
           finally have "finals es = finals(?ex # ?rst)" .
           hence "\<not> finals es" using not_finals_ConsI[OF not_fin] by blast
           thus ?thesis using e_addr D IHes  by(fastforce intro!:CallParams)
         qed
       qed
     next
       fix a assume "e = Throw a"
       with WTrtCall.prems show ?thesis by(fast intro!:CallThrowObj)
     qed
   next
     assume "\<not> final e"
     with WTrtCall show ?thesis by simp (blast intro!:CallObj)
   qed
 next
   case (WTrtCallNT E e es Ts M T)
   show ?case
   proof cases
     assume "final e"
     moreover
     { fix v assume e: "e = Val v"
       hence "e = null" using WTrtCallNT by simp
       have ?case
       proof cases
         assume "finals es"
         moreover
         { fix vs assume "es = map Val vs"
           with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull) }
         moreover
         { fix vs a es' assume "es = map Val vs @ Throw a # es'"
           with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
         ultimately show ?thesis by(fastforce simp:finals_def)
       next
         assume "\<not> finals es" \<comment> \<open>@{term es} reduces by IH\<close>
         with WTrtCallNT e show ?thesis by(fastforce intro: CallParams)
       qed
     }
     moreover
     { fix a assume "e = Throw a"
       with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
     ultimately show ?thesis by(fastforce simp:final_def)
   next
     assume "\<not> final e" \<comment> \<open>@{term e} reduces by IH\<close>
     with WTrtCallNT show ?thesis by (fastforce intro:CallObj)
   qed
 next
   case WTrtNil thus ?case by simp
 next
   case (WTrtCons E e T es Ts)
   have IHe: "\<And>l. \<lbrakk>\<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                 \<Longrightarrow> \<exists>e' s'. P \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and IHes: "\<And>l. \<lbrakk>\<D>s es \<lfloor>dom l\<rfloor>; \<not> finals es\<rbrakk>
              \<Longrightarrow> \<exists>es' s'. P \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>"
    and D: "\<D>s (e#es) \<lfloor>dom l\<rfloor>" and not_fins: "\<not> finals(e # es)" by fact+
   have De: "\<D> e \<lfloor>dom l\<rfloor>" and Des: "\<D>s es (\<lfloor>dom l\<rfloor> \<squnion> \<A> e)"
     using D by auto
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume e: "e = Val v"
       hence Des': "\<D>s es \<lfloor>dom l\<rfloor>" using De Des by auto
       have not_fins_tl: "\<not> finals es" using not_fins e by simp
       show ?thesis using e IHes[OF Des' not_fins_tl]
         by (blast intro!:ListRed2)
     next
       fix a assume "e = Throw a"
       hence False using not_fins by simp
       thus ?thesis ..
     qed
   next
     assume "\<not> final e"
     with IHe[OF De] show ?thesis by(fast intro!:ListRed1)
   qed
 next
   case (WTrtInitBlock v T\<^sub>1 T E V e\<^sub>2 T\<^sub>2)
   have IH2: "\<And>l. \<lbrakk>\<D> e\<^sub>2 \<lfloor>dom l\<rfloor>; \<not> final e\<^sub>2\<rbrakk>
                   \<Longrightarrow> \<exists>e' s'. P \<turnstile> \<langle>e\<^sub>2,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and D: "\<D> {V:T := Val v; e\<^sub>2} \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume "final e\<^sub>2"
     then show ?thesis
     proof (rule finalE)
       fix v\<^sub>2 assume "e\<^sub>2 = Val v\<^sub>2"
       thus ?thesis by(fast intro:RedInitBlock)
     next
       fix a assume "e\<^sub>2 = Throw a"
       thus ?thesis by(fast intro:red_reds.InitBlockThrow)
     qed
   next
     assume not_fin2: "\<not> final e\<^sub>2"
     from D have D2: "\<D> e\<^sub>2 \<lfloor>dom(l(V\<mapsto>v))\<rfloor>" by (auto simp:hyperset_defs)
     from IH2[OF D2 not_fin2]
     obtain h' l' e' where red2: "P \<turnstile> \<langle>e\<^sub>2,(h, l(V\<mapsto>v))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
       by auto
     from red_lcl_incr[OF red2] have "V \<in> dom l'" by auto
     with red2 show ?thesis by(fastforce intro:InitBlockRed)
   qed
 next
   case (WTrtBlock E V T e T')
   have IH: "\<And>l. \<lbrakk>\<D> e \<lfloor>dom l\<rfloor>; \<not> final e\<rbrakk>
                  \<Longrightarrow> \<exists>e' s'. P \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
    and unass: "\<not> assigned V e" and D: "\<D> {V:T; e} \<lfloor>dom l\<rfloor>" by fact+
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume "e = Val v" thus ?thesis by(fast intro:RedBlock)
     next
       fix a assume "e = Throw a"
       thus ?thesis by(fast intro:red_reds.BlockThrow)
     qed
   next
     assume not_fin: "\<not> final e"
     from D have De: "\<D> e \<lfloor>dom(l(V:=None))\<rfloor>" by(simp add:hyperset_defs)
     from IH[OF De not_fin]
     obtain h' l' e' where red: "P \<turnstile> \<langle>e,(h,l(V:=None))\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
       by auto
     show ?thesis
     proof (cases "l' V")
       assume "l' V = None"
       with red unass show ?thesis by(blast intro: BlockRedNone)
     next
       fix v assume "l' V = Some v"
       with red unass show ?thesis by(blast intro: BlockRedSome)
     qed
   qed
 next
   case (WTrtSeq E e1 T1 e2 T2)
   show ?case
   proof cases
     assume "final e1"
     thus ?thesis
       by(fast elim:finalE intro:RedSeq red_reds.SeqThrow)
   next
     assume "\<not> final e1" with WTrtSeq show ?thesis
       by simp (blast intro:SeqRed)
   qed
 next
   case (WTrtCond E e e\<^sub>1 T\<^sub>1 e\<^sub>2 T\<^sub>2 T)
   have wt: "P,E,h \<turnstile> e : Boolean" by fact
   show ?case
   proof cases
     assume "final e"
     thus ?thesis
     proof (rule finalE)
       fix v assume val: "e = Val v"
       then obtain b where v: "v = Bool b" using wt by auto
       show ?thesis
       proof (cases b)
         case True with val v show ?thesis by(auto intro:RedCondT)
       next
         case False with val v show ?thesis by(auto intro:RedCondF)
       qed
     next
       fix a assume "e = Throw a"
       thus ?thesis by(fast intro:red_reds.CondThrow)
     qed
   next
     assume "\<not> final e" with WTrtCond show ?thesis
       by simp (fast intro:CondRed)
   qed
 next
   case WTrtWhile show ?case by(fast intro:RedWhile)
 next
   case (WTrtThrow E e T\<^sub>r T)
   show ?case
   proof cases
     assume "final e" \<comment> \<open>Then @{term e} must be @{term throw} or @{term null}\<close>
     with WTrtThrow show ?thesis
       by(fastforce simp:final_def is_refT_def
                   intro:red_reds.ThrowThrow red_reds.RedThrowNull)
   next
     assume "\<not> final e" \<comment> \<open>Then @{term e} must reduce\<close>
     with WTrtThrow show ?thesis by simp (blast intro:ThrowRed)
   qed
 next
   case (WTrtTry E e1 T1 V C e2 T2)
   have wt1: "P,E,h \<turnstile> e1 : T1" by fact
   show ?case
   proof cases
     assume "final e1"
     thus ?thesis
     proof (rule finalE)
       fix v assume "e1 = Val v"
       thus ?thesis by(fast intro:RedTry)
     next
       fix a assume e1_Throw: "e1 = Throw a"
       with wt1 obtain D fs where ha: "h a = Some(D,fs)" by fastforce
       show ?thesis
       proof cases
         assume "P \<turnstile> D \<preceq>\<^sup>* C"
         with e1_Throw ha show ?thesis by(fastforce intro!:RedTryCatch)
       next
         assume "\<not> P \<turnstile> D \<preceq>\<^sup>* C"
         with e1_Throw ha show ?thesis by(force intro!:RedTryFail)
       qed
     qed
   next
     assume "\<not> final e1"
     with WTrtTry show ?thesis by simp (fast intro:TryRed)
   qed
 qed
 (*>*)
 
 
 end
diff --git a/thys/JinjaThreads/BV/JVM_SemiType.thy b/thys/JinjaThreads/BV/JVM_SemiType.thy
--- a/thys/JinjaThreads/BV/JVM_SemiType.thy
+++ b/thys/JinjaThreads/BV/JVM_SemiType.thy
@@ -1,235 +1,235 @@
 (*  Title:      JinjaThreads/BV/JVM_SemiType.thy
     Author:     Gerwin Klein, Andreas Lochbihler
 
     Based on the theory Jinja/BV/JVM_SemiType
 *)
 
 chapter \<open>Bytecode verifier\<close>
 
 section \<open>The JVM Type System as Semilattice\<close>
 
 theory JVM_SemiType
 imports
   "../Common/SemiType"
 begin
 
 type_synonym ty\<^sub>l = "ty err list"
 type_synonym ty\<^sub>s = "ty list"
 type_synonym ty\<^sub>i = "ty\<^sub>s \<times> ty\<^sub>l"
 type_synonym ty\<^sub>i' = "ty\<^sub>i option"
 type_synonym ty\<^sub>m = "ty\<^sub>i' list"
 type_synonym ty\<^sub>P = "mname \<Rightarrow> cname \<Rightarrow> ty\<^sub>m"
 
 definition stk_esl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>s esl"
 where
   "stk_esl P mxs \<equiv> upto_esl mxs (SemiType.esl P)"
 
 definition loc_sl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>l sl"
 where
   "loc_sl P mxl \<equiv> Listn.sl mxl (Err.sl (SemiType.esl P))"
 
 definition sl :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err sl"
 where
   "sl P mxs mxl \<equiv>
   Err.sl(Opt.esl(Product.esl (stk_esl P mxs) (Err.esl(loc_sl P mxl))))"
 
 definition "states" :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err set"
 where
   "states P mxs mxl \<equiv> fst(sl P mxs mxl)"
 
 definition le :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err ord"
 where
   "le P mxs mxl \<equiv> fst(snd(sl P mxs mxl))"
 
 definition sup :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err binop"
 where
   "sup P mxs mxl \<equiv> snd(snd(sl P mxs mxl))"
 
 definition sup_ty_opt :: "['c prog,ty err,ty err] \<Rightarrow> bool" 
   ("_ \<turnstile> _ \<le>\<^sub>\<top> _" [71,71,71] 70)
 where
   "sup_ty_opt P \<equiv> Err.le (widen P)"
 
 definition sup_state :: "['c prog,ty\<^sub>i,ty\<^sub>i] \<Rightarrow> bool"   
   ("_ \<turnstile> _ \<le>\<^sub>i _" [71,71,71] 70)
 where
   "sup_state P \<equiv> Product.le (Listn.le (widen P)) (Listn.le (sup_ty_opt P))"
 
 definition sup_state_opt :: "['c prog,ty\<^sub>i',ty\<^sub>i'] \<Rightarrow> bool" 
-  ("_ \<turnstile> _ \<le>' _" [71,71,71] 70)
+  ("_ \<turnstile> _ \<le>'' _" [71,71,71] 70)
 where
   "sup_state_opt P \<equiv> Opt.le (sup_state P)"
 
 abbreviation sup_loc :: "['c prog,ty\<^sub>l,ty\<^sub>l] \<Rightarrow> bool" ("_ \<turnstile> _ [\<le>\<^sub>\<top>] _"  [71,71,71] 70)
 where "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> list_all2 (sup_ty_opt P) LT LT'"
 
 notation (ASCII)
   sup_ty_opt ("_ |- _ <=T _" [71,71,71] 70) and
   sup_state ("_ |- _ <=i _"  [71,71,71] 70) and
   sup_state_opt ("_ |- _ <=' _"  [71,71,71] 70) and
   sup_loc ("_ |- _ [<=T] _"  [71,71,71] 70)
 
 subsection "Unfolding"
 
 lemma JVM_states_unfold: 
   "states P mxs mxl \<equiv> err(opt((Union {list n (types P) |n. n <= mxs}) \<times>
                                  list mxl (err(types P))))"
   apply (unfold states_def sl_def Opt.esl_def Err.sl_def
          stk_esl_def loc_sl_def Product.esl_def
          Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
   apply simp
   done
 
 lemma JVM_le_unfold:
  "le P m n \<equiv> 
   Err.le(Opt.le(Product.le(Listn.le(widen P))(Listn.le(Err.le(widen P)))))" 
   apply (unfold le_def sl_def Opt.esl_def Err.sl_def
          stk_esl_def loc_sl_def Product.esl_def  
          Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def) 
   apply simp
   done
 
 lemma sl_def2:
   "JVM_SemiType.sl P mxs mxl \<equiv> 
   (states P mxs mxl, JVM_SemiType.le P mxs mxl, JVM_SemiType.sup P mxs mxl)"
  by (unfold JVM_SemiType.sup_def states_def JVM_SemiType.le_def) simp 
 
 
 lemma JVM_le_conv:
   "le P m n (OK t1) (OK t2) = P \<turnstile> t1 \<le>' t2"
  by (simp add: JVM_le_unfold Err.le_def lesub_def sup_state_opt_def  
                 sup_state_def sup_ty_opt_def) 
 
 lemma JVM_le_Err_conv:
   "le P m n = Err.le (sup_state_opt P)"
  by (unfold sup_state_opt_def sup_state_def  
              sup_ty_opt_def JVM_le_unfold) simp 
 
 lemma err_le_unfold [iff]: 
   "Err.le r (OK a) (OK b) = r a b"
  by (simp add: Err.le_def lesub_def) 
   
 
 subsection \<open>Semilattice\<close>
 
 lemma order_sup_state_opt [intro, simp]: 
   "wf_prog wf_mb P \<Longrightarrow> order (sup_state_opt P)"   
  by (unfold sup_state_opt_def sup_state_def sup_ty_opt_def) blast 
 
 lemma semilat_JVM [intro?]:
   "wf_prog wf_mb P \<Longrightarrow> semilat (JVM_SemiType.sl P mxs mxl)"
   apply (unfold JVM_SemiType.sl_def stk_esl_def loc_sl_def)  
   apply (blast intro: err_semilat_Product_esl err_semilat_upto_esl 
                       Listn_sl err_semilat_JType_esl)
   done
 
 lemma acc_JVM [intro]:
   "wf_prog wf_mb P \<Longrightarrow> acc (JVM_SemiType.states P mxs mxl) (JVM_SemiType.le P mxs mxl)"
 by(unfold JVM_le_unfold JVM_states_unfold) blast
 
 subsection \<open>Widening with \<open>\<top>\<close>\<close>
 
 lemma widen_refl[iff]: "widen P t t"  by (simp add: fun_of_def) 
 
 lemma sup_ty_opt_refl [iff]: "P \<turnstile> T \<le>\<^sub>\<top> T"
   apply (unfold sup_ty_opt_def)
   apply (fold lesub_def)
   apply (rule le_err_refl)
   apply (simp add: lesub_def)
   done
 
 lemma Err_any_conv [iff]: "P \<turnstile> Err \<le>\<^sub>\<top> T = (T = Err)"
  by (unfold sup_ty_opt_def) (rule Err_le_conv [simplified lesub_def]) 
 
 lemma any_Err [iff]: "P \<turnstile> T \<le>\<^sub>\<top> Err"
  by (unfold sup_ty_opt_def) (rule le_Err [simplified lesub_def]) 
 
 lemma OK_OK_conv [iff]:
   "P \<turnstile> OK T \<le>\<^sub>\<top> OK T' = P \<turnstile> T \<le> T'"
  by (simp add: sup_ty_opt_def fun_of_def) 
 
 lemma any_OK_conv [iff]:
   "P \<turnstile> X \<le>\<^sub>\<top> OK T' = (\<exists>T. X = OK T \<and> P \<turnstile> T \<le> T')"
   apply (unfold sup_ty_opt_def) 
   apply (rule le_OK_conv [simplified lesub_def])
   done  
 
 lemma OK_any_conv:
  "P \<turnstile> OK T \<le>\<^sub>\<top> X = (X = Err \<or> (\<exists>T'. X = OK T' \<and> P \<turnstile> T \<le> T'))"
   apply (unfold sup_ty_opt_def) 
   apply (rule OK_le_conv [simplified lesub_def])
   done
 
 lemma sup_ty_opt_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>\<^sub>\<top> b; P \<turnstile> b \<le>\<^sub>\<top> c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>\<top> c"
  by (auto intro: widen_trans  
            simp add: sup_ty_opt_def Err.le_def lesub_def fun_of_def
            split: err.splits) 
 
 subsection "Stack and Registers"
 
 lemma stk_convert:
   "P \<turnstile> ST [\<le>] ST' = Listn.le (widen P) ST ST'"
  by (simp add: Listn.le_def lesub_def) 
 
 lemma sup_loc_refl [iff]: "P \<turnstile> LT [\<le>\<^sub>\<top>] LT"
  by (rule list_all2_refl) simp 
 
 lemmas sup_loc_Cons1 [iff] = list_all2_Cons1 [of "sup_ty_opt P"] for P
 
 lemma sup_loc_def:
   "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> Listn.le (sup_ty_opt P) LT LT'"
  by (simp add: Listn.le_def lesub_def) 
 
 lemma sup_loc_widens_conv [iff]:
   "P \<turnstile> map OK Ts [\<le>\<^sub>\<top>] map OK Ts' = P \<turnstile> Ts [\<le>] Ts'"
   by (simp add: list_all2_map1 list_all2_map2)
 
 lemma sup_loc_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a [\<le>\<^sub>\<top>] b; P \<turnstile> b [\<le>\<^sub>\<top>] c\<rbrakk> \<Longrightarrow> P \<turnstile> a [\<le>\<^sub>\<top>] c"
  by (rule list_all2_trans, rule sup_ty_opt_trans) 
 
 subsection "State Type"
 
 lemma sup_state_conv [iff]:
   "P \<turnstile> (ST,LT) \<le>\<^sub>i (ST',LT') = (P \<turnstile> ST [\<le>] ST' \<and> P \<turnstile> LT [\<le>\<^sub>\<top>] LT')"
  by (auto simp add: sup_state_def stk_convert lesub_def Product.le_def sup_loc_def) 
   
 lemma sup_state_conv2:
   "P \<turnstile> s1 \<le>\<^sub>i s2 = (P \<turnstile> fst s1 [\<le>] fst s2 \<and> P \<turnstile> snd s1 [\<le>\<^sub>\<top>] snd s2)"
  by (cases s1, cases s2) simp 
 
 lemma sup_state_refl [iff]: "P \<turnstile> s \<le>\<^sub>i s"
 by (auto simp add: sup_state_conv2 intro: list_all2_refl)
 
 lemma sup_state_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>\<^sub>i b; P \<turnstile> b \<le>\<^sub>i c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>i c"
  by (auto intro: sup_loc_trans widens_trans simp add: sup_state_conv2) 
 
 lemma sup_state_opt_None_any [iff]:
   "P \<turnstile> None \<le>' s"
  by (simp add: sup_state_opt_def Opt.le_def) 
 
 lemma sup_state_opt_any_None [iff]:
   "P \<turnstile> s \<le>' None = (s = None)"
  by (simp add: sup_state_opt_def Opt.le_def) 
 
 lemma sup_state_opt_Some_Some [iff]:
   "P \<turnstile> Some a \<le>' Some b = P \<turnstile> a \<le>\<^sub>i b"  
  by (simp add: sup_state_opt_def Opt.le_def lesub_def) 
 
 lemma sup_state_opt_any_Some:
   "P \<turnstile> (Some s) \<le>' X = (\<exists>s'. X = Some s' \<and> P \<turnstile> s \<le>\<^sub>i s')"
  by (simp add: sup_state_opt_def Opt.le_def lesub_def) 
 
 lemma sup_state_opt_refl [iff]: "P \<turnstile> s \<le>' s"
  by (simp add: sup_state_opt_def Opt.le_def lesub_def) 
 
 lemma sup_state_opt_trans [intro?, trans]:
   "\<lbrakk>P \<turnstile> a \<le>' b; P \<turnstile> b \<le>' c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>' c"
   apply (unfold sup_state_opt_def Opt.le_def lesub_def)
   apply (simp del: split_paired_All)
   apply (rule sup_state_trans, assumption+)
   done
 
 end
diff --git a/thys/JinjaThreads/Compiler/J1JVMBisim.thy b/thys/JinjaThreads/Compiler/J1JVMBisim.thy
--- a/thys/JinjaThreads/Compiler/J1JVMBisim.thy
+++ b/thys/JinjaThreads/Compiler/J1JVMBisim.thy
@@ -1,5582 +1,5582 @@
 (*  Title:      JinjaThreads/Compiler/J1JVMBisim.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>The delay bisimulation between intermediate language and JVM\<close>
 
 theory J1JVMBisim imports 
   Execs
   "../BV/BVNoTypeError"
   J1
 begin
 
 declare Listn.lesub_list_impl_same_size[simp del]
 
 lemma (in JVM_heap_conf_base') \<tau>exec_1_\<tau>exec_1_d:
   "\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P; \<tau>exec_1 P t \<sigma> \<sigma>'; \<Phi> |- t:\<sigma> [ok] \<rbrakk> \<Longrightarrow> \<tau>exec_1_d P t \<sigma> \<sigma>'"
 by(auto simp add: \<tau>exec_1_def \<tau>exec_1_d_def welltyped_commute[symmetric] elim: jvmd_NormalE)
 
 context JVM_conf_read begin
 
 lemma \<tau>Exec_1r_preserves_correct_state:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and exec: "\<tau>Exec_1r P t \<sigma> \<sigma>'"
   shows "\<Phi> |- t:\<sigma> [ok] \<Longrightarrow> \<Phi> |- t:\<sigma>' [ok]"
 using exec
 by(induct)(blast intro: BV_correct_1[OF wf])+
 
 lemma \<tau>Exec_1t_preserves_correct_state:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and exec: "\<tau>Exec_1t P t \<sigma> \<sigma>'"
   shows "\<Phi> |- t:\<sigma> [ok] \<Longrightarrow> \<Phi> |- t:\<sigma>' [ok]"
 using exec
 by(induct)(blast intro: BV_correct_1[OF wf])+
 
 lemma \<tau>Exec_1r_\<tau>Exec_1_dr:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   shows "\<lbrakk> \<tau>Exec_1r P t \<sigma> \<sigma>'; \<Phi> |- t:\<sigma> [ok] \<rbrakk> \<Longrightarrow> \<tau>Exec_1_dr P t \<sigma> \<sigma>'"
 apply(induct rule: rtranclp_induct)
 apply(blast intro: rtranclp.rtrancl_into_rtrancl \<tau>exec_1_\<tau>exec_1_d[OF wf] \<tau>Exec_1r_preserves_correct_state[OF wf])+
 done
 
 lemma \<tau>Exec_1t_\<tau>Exec_1_dt:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   shows "\<lbrakk> \<tau>Exec_1t P t \<sigma> \<sigma>'; \<Phi> |- t:\<sigma> [ok] \<rbrakk> \<Longrightarrow> \<tau>Exec_1_dt P t \<sigma> \<sigma>'"
 apply(induct rule: tranclp_induct)
 apply(blast intro: tranclp.trancl_into_trancl \<tau>exec_1_\<tau>exec_1_d[OF wf] \<tau>Exec_1t_preserves_correct_state[OF wf])+
 done
 
 lemma \<tau>Exec_1_dr_preserves_correct_state:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and exec: "\<tau>Exec_1_dr P t \<sigma> \<sigma>'"
   shows "\<Phi> |- t: \<sigma> [ok] \<Longrightarrow> \<Phi> |- t: \<sigma>' [ok]"
 using exec
 by(induct)(blast intro: BV_correct_1[OF wf])+
 
 lemma \<tau>Exec_1_dt_preserves_correct_state:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and exec: "\<tau>Exec_1_dt P t \<sigma> \<sigma>'"
   shows "\<Phi> |- t:\<sigma> [ok] \<Longrightarrow> \<Phi> |- t:\<sigma>' [ok]"
 using exec
 by(induct)(blast intro: BV_correct_1[OF wf])+
 
 end
 
 locale J1_JVM_heap_base =
   J1_heap_base +
   JVM_heap_base +
   constrains addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
 begin
 
 inductive bisim1 ::
   "'m prog \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 \<Rightarrow> ('addr expr1 \<times> 'addr locals1)
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
 
   and bisims1 :: 
   "'m prog \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 list \<Rightarrow> ('addr expr1 list \<times> 'addr locals1)
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
   
   and bisim1_syntax :: 
   "'m prog \<Rightarrow> 'addr expr1 \<Rightarrow> 'heap \<Rightarrow> ('addr expr1 \<times> 'addr locals1)
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
   ("_,_,_ \<turnstile> _ \<leftrightarrow> _" [50, 0, 0, 0, 50] 100)
 
   and bisims1_syntax :: 
   "'m prog \<Rightarrow> 'addr expr1 list \<Rightarrow> 'heap \<Rightarrow> ('addr expr1 list \<times> 'addr locals1)
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
   ("_,_,_ \<turnstile> _ [\<leftrightarrow>] _" [50, 0, 0, 0, 50] 100)
   for P :: "'m prog" and  h :: 'heap
 where
   "P, e, h \<turnstile> exs \<leftrightarrow> s \<equiv> bisim1 P h e exs s"
 | "P, es, h \<turnstile> esxs [\<leftrightarrow>] s \<equiv> bisims1 P h es esxs s"
 
 | bisim1Val2:
   "pc = length (compE2 e) \<Longrightarrow> P, e, h \<turnstile> (Val v, xs) \<leftrightarrow> (v # [], xs, pc, None)"
 
 | bisim1New:
   "P, new C, h \<turnstile> (new C, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1NewThrow:
   "P, new C, h \<turnstile> (THROW OutOfMemory, xs) \<leftrightarrow> ([], xs, 0, \<lfloor>addr_of_sys_xcpt OutOfMemory\<rfloor>)"
 
 
 | bisim1NewArray:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, newA T\<lfloor>e\<rceil>, h \<turnstile> (newA T\<lfloor>e'\<rceil>, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1NewArrayThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, newA T\<lfloor>e\<rceil>, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1NewArrayFail:
   "P, newA T\<lfloor>e\<rceil>, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([v], xs, length (compE2 e), \<lfloor>a\<rfloor>)"
 
 
 | bisim1Cast:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, Cast T e, h \<turnstile> (Cast T e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CastThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, Cast T e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CastFail:
   "P, Cast T e, h \<turnstile> (THROW ClassCast, xs) \<leftrightarrow> ([v], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt ClassCast\<rfloor>)"
 
 
 | bisim1InstanceOf:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, e instanceof T, h \<turnstile> (e' instanceof T, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1InstanceOfThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, e instanceof T, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Val: "P, Val v, h \<turnstile> (Val v, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1Var: "P, Var V, h \<turnstile> (Var V, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 
 | bisim1BinOp1:
   "P, e1, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, h \<turnstile> (e'\<guillemotleft>bop\<guillemotright>e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1BinOp2:
   "P, e2, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, h \<turnstile> (Val v1 \<guillemotleft>bop\<guillemotright> e', xs) \<leftrightarrow> (stk @ [v1], loc, length (compE2 e1) + pc, xcp)"
 
 | bisim1BinOpThrow1:
   "P, e1, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1BinOpThrow2:
   "P, e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)"
 
 | bisim1BinOpThrow:
   "P, e1\<guillemotleft>bop\<guillemotright>e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([v1, v2], xs, length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1LAss1:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, V:=e, h \<turnstile> (V:=e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1LAss2:
   "P, V:=e, h \<turnstile> (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 e)), None)"
 
 | bisim1LAssThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, V:=e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1AAcc1:
   "P, a, h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, h \<turnstile> (a'\<lfloor>i\<rceil>, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1AAcc2:
   "P, i, h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, h \<turnstile> (Val v\<lfloor>i'\<rceil>, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, xcp)"
 
 | bisim1AAccThrow1:
   "P, a, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAccThrow2:
   "P, i, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAccFail:
   "P, a\<lfloor>i\<rceil>, h \<turnstile> (Throw ad, xs) \<leftrightarrow> ([v, v'], xs, length (compE2 a) + length (compE2 i), \<lfloor>ad\<rfloor>)"
 
 
 | bisim1AAss1:
   "P, a, h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (a'\<lfloor>i\<rceil> := e, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1AAss2:
   "P, i, h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Val v\<lfloor>i'\<rceil> := e, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, xcp)"
 
 | bisim1AAss3:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Val v\<lfloor>Val v'\<rceil> := e', xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 a) + length (compE2 i) + pc, xcp)"
 
 | bisim1AAssThrow1:
   "P, a, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssThrow2:
   "P, i, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssThrow3:
   "P, e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 a) + length (compE2 i) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssFail:
   "P, a\<lfloor>i\<rceil> := e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> ([v', v, v''], xs, length (compE2 a) + length (compE2 i) + length (compE2 e), \<lfloor>ad\<rfloor>)"
 
 | bisim1AAss4:
   "P, a\<lfloor>i\<rceil> := e, h \<turnstile> (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 a) + length (compE2 i) + length (compE2 e)), None)"
 
 
 | bisim1ALength: 
   "P, a, h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<bullet>length, h \<turnstile> (a'\<bullet>length, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1ALengthThrow:
   "P, a, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<bullet>length, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 
 | bisim1ALengthNull:
   "P, a\<bullet>length, h \<turnstile> (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 a), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 
 | bisim1FAcc: 
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e\<bullet>F{D}, h \<turnstile> (e'\<bullet>F{D}, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1FAccThrow:
   "P, e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e\<bullet>F{D}, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAccNull:
   "P, e\<bullet>F{D}, h \<turnstile> (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 
 | bisim1FAss1: 
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e\<bullet>F{D} := e2, h \<turnstile> (e'\<bullet>F{D} := e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1FAss2: 
   "P, e2, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e\<bullet>F{D} := e2, h \<turnstile> (Val v\<bullet>F{D} := e', xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e) + pc, xcp)"
 
 | bisim1FAssThrow1:
   "P, e, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e\<bullet>F{D} := e2, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAssThrow2:
   "P, e2, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e\<bullet>F{D} := e2, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAssNull:
   "P, e\<bullet>F{D} := e2, h \<turnstile> (THROW NullPointer, xs) \<leftrightarrow> ([v, Null], xs, length (compE2 e) + length (compE2 e2), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1FAss3:
   "P, e\<bullet>F{D} := e2, h \<turnstile> (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 e) + length (compE2 e2)), None)"
 
 
 | bisim1CAS1:
   "P, e1, h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (e1'\<bullet>compareAndSwap(D\<bullet>F, e2, e3), xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CAS2:
   "P, e2, h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, e2', e3), xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e1) + pc, xcp)"
 
 | bisim1CAS3:
   "P, e3, h \<turnstile> (e3', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', e3'), xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 e1) + length (compE2 e2) + pc, xcp)"
 
 | bisim1CASThrow1:
   "P, e1, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASThrow2:
   "P, e2, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e1) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASThrow3:
   "P, e3, h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Throw ad, xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 e1) + length (compE2 e2) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASFail:
   "P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), h \<turnstile> (Throw ad, xs) \<leftrightarrow> ([v', v, v''], xs, length (compE2 e1) + length (compE2 e2) + length (compE2 e3), \<lfloor>ad\<rfloor>)"
 
 
 | bisim1Call1:
   "P, obj, h \<turnstile> (obj', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, obj\<bullet>M(ps), h \<turnstile> (obj'\<bullet>M(ps), xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CallParams:
   "P, ps, h \<turnstile> (ps', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)
   \<Longrightarrow> P, obj\<bullet>M(ps), h \<turnstile> (Val v\<bullet>M(ps'), xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 obj) +  pc, xcp)"
 
 | bisim1CallThrowObj:
   "P, obj, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, obj\<bullet>M(ps), h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CallThrowParams:
   "P, ps, h \<turnstile> (map Val vs @ Throw a # ps', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, obj\<bullet>M(ps), h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 obj) + pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CallThrow:
   "length ps = length vs
   \<Longrightarrow> P, obj\<bullet>M(ps), h \<turnstile> (Throw a, xs) \<leftrightarrow> (vs @ [v], xs, length (compE2 obj) + length (compEs2 ps), \<lfloor>a\<rfloor>)"
 
 | bisim1BlockSome1:
   "P, {V:T=\<lfloor>v\<rfloor>; e}, h \<turnstile> ({V:T=\<lfloor>v\<rfloor>; e}, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1BlockSome2:
   "P, {V:T=\<lfloor>v\<rfloor>; e}, h \<turnstile> ({V:T=\<lfloor>v\<rfloor>; e}, xs) \<leftrightarrow> ([v], xs, Suc 0, None)"
 
 | bisim1BlockSome4:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, h \<turnstile> ({V:T=None; e'}, xs) \<leftrightarrow> (stk, loc, Suc (Suc pc), xcp)"
 
 | bisim1BlockThrowSome:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (Suc pc), \<lfloor>a\<rfloor>)"
 
 | bisim1BlockNone:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, {V:T=None; e}, h \<turnstile> ({V:T=None; e'}, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1BlockThrowNone:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
    \<Longrightarrow> P, {V:T=None; e}, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Sync1:
   "P, e1, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (sync\<^bsub>V\<^esub> (e') e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1Sync2:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (sync\<^bsub>V\<^esub> (Val v) e2, xs) \<leftrightarrow> ([v, v], xs, Suc (length (compE2 e1)), None)"
 
 | bisim1Sync3:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (sync\<^bsub>V\<^esub> (Val v) e2, xs) \<leftrightarrow> ([v], xs[V := v], Suc (Suc (length (compE2 e1))), None)"
 
 | bisim1Sync4:
   "P, e2, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (insync\<^bsub>V\<^esub> (a) e', xs) \<leftrightarrow> (stk, loc, Suc (Suc (Suc (length (compE2 e1) + pc))), xcp)"
 
 | bisim1Sync5:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (insync\<^bsub>V\<^esub> (a) Val v, xs) \<leftrightarrow> ([xs ! V, v], xs, 4 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync6:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Val v, xs) \<leftrightarrow> ([v], xs, 5 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync7:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (insync\<^bsub>V\<^esub> (a) Throw a', xs) \<leftrightarrow> ([Addr a'], xs, 6 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync8:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (insync\<^bsub>V\<^esub> (a) Throw a', xs) \<leftrightarrow>
                          ([xs ! V, Addr a'], xs, 7 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync9:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([Addr a], xs, 8 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync10:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([Addr a], xs, 8 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1Sync11:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, Suc (Suc (length (compE2 e1))), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1Sync12:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([v, v'], xs, 4 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1Sync14:
   "P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow>
         ([v, Addr a'], xs, 7 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1SyncThrow:
   "P, e1, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1InSync: \<comment> \<open>This rule only exists such that @{text "P,e,h \<turnstile> (e, xs) \<leftrightarrow> ([], xs, 0, None)"} holds for all @{text "e"}\<close> 
   "P, insync\<^bsub>V\<^esub> (a) e, h \<turnstile> (insync\<^bsub>V\<^esub> (a) e, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 
 | bisim1Seq1:
   "P, e1, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, e1;;e2, h \<turnstile> (e';;e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1SeqThrow1:
   "P, e1, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, e1;;e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1Seq2:
   "P, e2, h \<turnstile> exs \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e1;;e2, h \<turnstile> exs \<leftrightarrow> (stk, loc, Suc (length (compE2 e1) + pc), xcp)"
 
 
 | bisim1Cond1:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, if (e) e1 else e2, h \<turnstile> (if (e') e1 else e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CondThen:
   "P, e1, h \<turnstile> exs \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, if (e) e1 else e2, h \<turnstile> exs \<leftrightarrow> (stk, loc, Suc (length (compE2 e) + pc), xcp)"
 
 | bisim1CondElse:
   "P, e2, h \<turnstile> exs \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, if (e) e1 else e2, h \<turnstile> exs \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + length (compE2 e1) +  pc)), xcp)"
 
 | bisim1CondThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, if (e) e1 else e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1While1:
   "P, while (c) e, h \<turnstile> (while (c) e, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1While3:
   "P, c, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, while (c) e, h \<turnstile> (if (e') (e;; while (c) e) else unit, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1While4:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, while (c) e, h  \<turnstile> (e';; while (c) e, xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 c) + pc), xcp)"
 
 | bisim1While6:
   "P, while (c) e, h \<turnstile> (while (c) e, xs) \<leftrightarrow> ([], xs, Suc (Suc (length (compE2 c) + length (compE2 e))), None)"
 
 | bisim1While7:
   "P, while (c) e, h \<turnstile> (unit, xs) \<leftrightarrow> ([], xs, Suc (Suc (Suc (length (compE2 c) + length (compE2 e)))), None)"
 
 | bisim1WhileThrow1:
   "P, c, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, while (c) e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1WhileThrow2:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
    \<Longrightarrow> P, while (c) e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 c) + pc), \<lfloor>a\<rfloor>)"
 
 
 | bisim1Throw1:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, throw e, h \<turnstile> (throw e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1Throw2:
   "P, throw e, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([Addr a], xs, length (compE2 e), \<lfloor>a\<rfloor>)"
 
 | bisim1ThrowNull:
   "P, throw e, h \<turnstile> (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1ThrowThrow:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> P, throw e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Try:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
    \<Longrightarrow> P, try e catch(C V) e2, h \<turnstile> (try e' catch(C V) e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1TryCatch1:
   "\<lbrakk> P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); typeof_addr h a = \<lfloor>Class_type C'\<rfloor>; P \<turnstile> C' \<preceq>\<^sup>* C \<rbrakk>
   \<Longrightarrow> P, try e catch(C V) e2, h \<turnstile> ({V:Class C=None; e2}, xs[V := Addr a]) \<leftrightarrow> ([Addr a], loc, Suc (length (compE2 e)), None)"
 
 | bisim1TryCatch2:
   "P, e2, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
    \<Longrightarrow> P, try e catch(C V) e2, h \<turnstile> ({V:Class C=None; e'}, xs) \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + pc)), xcp)"
 
 | bisim1TryFail:
   "\<lbrakk> P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); typeof_addr h a = \<lfloor>Class_type C'\<rfloor>; \<not> P \<turnstile> C' \<preceq>\<^sup>* C \<rbrakk> 
   \<Longrightarrow> P, try e catch(C V) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1TryCatchThrow:
   "P, e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
    \<Longrightarrow> P, try e catch(C V) e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + pc)), \<lfloor>a\<rfloor>)"
 
 | bisims1Nil: "P, [], h \<turnstile> ([], xs) [\<leftrightarrow>] ([], xs, 0, None)"
 
 | bisims1List1:
   "P, e, h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> P, e#es, h \<turnstile> (e'#es, xs) [\<leftrightarrow>] (stk, loc, pc, xcp)"
 
 | bisims1List2:
   "P, es, h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)
   \<Longrightarrow> P, e#es, h \<turnstile> (Val v # es', xs) [\<leftrightarrow>] (stk @ [v], loc, length (compE2 e) + pc, xcp)"
 
 
 inductive_cases bisim1_cases:
   "P,e,h \<turnstile> (Val v, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 
 lemma bisim1_refl: "P,e,h \<turnstile> (e, xs) \<leftrightarrow> ([], xs, 0, None)"
   and bisims1_refl: "P,es,h \<turnstile> (es, xs) [\<leftrightarrow>] ([], xs, 0, None)"
 apply(induct e and es rule: call.induct calls.induct)
 apply(auto intro: bisim1_bisims1.intros simp add: nat_fun_sum_eq_conv)
 apply(rename_tac option a)
 apply(case_tac option)
 apply(auto intro: bisim1_bisims1.intros split: if_split_asm)
 done
 
 lemma bisims1_lengthD: "P, es, h \<turnstile> (es', xs) [\<leftrightarrow>] s \<Longrightarrow> length es = length es'"
 apply(induct es arbitrary: es' s)
 apply(auto elim: bisims1.cases)
 done
 
 text \<open>
   Derive an alternative induction rule for @{term bisim1} such that
   (i) induction hypothesis are generated for all subexpressions and
   (ii) the number of surrounding blocks is passed through.
 \<close>
 
 inductive bisim1' :: 
   "'m prog \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 \<Rightarrow> nat \<Rightarrow> ('addr expr1 \<times> 'addr locals1) 
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
 
   and bisims1' :: 
   "'m prog \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 list \<Rightarrow> nat \<Rightarrow> ('addr expr1 list \<times> 'addr locals1)
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
 
   and bisim1'_syntax :: 
   "'m prog \<Rightarrow> 'addr expr1 \<Rightarrow> nat \<Rightarrow> 'heap \<Rightarrow> ('addr expr1 \<times> 'addr locals1) 
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
-  ("_,_,_,_ \<turnstile>' _ \<leftrightarrow> _" [50, 0, 0, 0, 0, 50] 100)
+  ("_,_,_,_ \<turnstile>'' _ \<leftrightarrow> _" [50, 0, 0, 0, 0, 50] 100)
 
   and bisims1'_syntax :: 
   "'m prog \<Rightarrow> 'addr expr1 list \<Rightarrow> nat \<Rightarrow> 'heap \<Rightarrow> ('addr expr1 list \<times> 'addr val list) 
   \<Rightarrow> ('addr val list \<times> 'addr val list \<times> pc \<times> 'addr option) \<Rightarrow> bool"
-  ("_,_,_,_ \<turnstile>' _ [\<leftrightarrow>] _" [50, 0, 0, 0, 0, 50] 100)
+  ("_,_,_,_ \<turnstile>'' _ [\<leftrightarrow>] _" [50, 0, 0, 0, 0, 50] 100)
   for P :: "'m prog" and  h :: 'heap
 where
   "P, e, n, h \<turnstile>' exs \<leftrightarrow> s \<equiv> bisim1' P h e n exs s"
 | "P, es, n, h \<turnstile>' esxs [\<leftrightarrow>] s \<equiv> bisims1' P h es n esxs s"
 
 | bisim1Val2':
   "P, e, n, h \<turnstile>' (Val v, xs) \<leftrightarrow> (v # [], xs, length (compE2 e), None)"
 
 | bisim1New':
   "P, new C, n, h \<turnstile>' (new C, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1NewThrow':
   "P, new C, n, h \<turnstile>' (THROW OutOfMemory, xs) \<leftrightarrow> ([], xs, 0, \<lfloor>addr_of_sys_xcpt OutOfMemory\<rfloor>)"
 
 
 | bisim1NewArray':
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, newA T\<lfloor>e\<rceil>, n, h \<turnstile>' (newA T\<lfloor>e'\<rceil>, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1NewArrayThrow':
   "P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, newA T\<lfloor>e\<rceil>, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1NewArrayFail':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, newA T\<lfloor>e\<rceil>, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([v], xs, length (compE2 e), \<lfloor>a\<rfloor>)"
 
 
 | bisim1Cast':
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, Cast T e, n, h \<turnstile>' (Cast T e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CastThrow':
   "P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, Cast T e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CastFail':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, Cast T e, n, h \<turnstile>' (THROW ClassCast, xs) \<leftrightarrow> ([v], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt ClassCast\<rfloor>)"
 
 
 | bisim1InstanceOf':
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e instanceof T, n, h \<turnstile>' (e' instanceof T, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1InstanceOfThrow':
   "P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, e instanceof T, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Val': "P, Val v, n, h \<turnstile>' (Val v, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1Var': "P, Var V, n, h \<turnstile>' (Var V, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 
 | bisim1BinOp1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, n, h \<turnstile>' (e'\<guillemotleft>bop\<guillemotright>e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1BinOp2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, n, h \<turnstile>' (Val v1 \<guillemotleft>bop\<guillemotright> e', xs) \<leftrightarrow> (stk @ [v1], loc, length (compE2 e1) + pc, xcp)"
 
 | bisim1BinOpThrow1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1BinOpThrow2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)"
 
 | bisim1BinOpThrow':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None); 
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<guillemotleft>bop\<guillemotright>e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([v1, v2], xs, length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1LAss1':
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, V:=e, n, h \<turnstile>' (V:=e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1LAss2':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
    \<Longrightarrow> P, V:=e, n, h \<turnstile>' (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 e)), None)"
 
 | bisim1LAssThrow':
   "P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, V:=e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1AAcc1':
   "\<lbrakk> P, a, n, h \<turnstile>' (a', xs) \<leftrightarrow> (stk, loc, pc, xcp); \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, n, h \<turnstile>' (a'\<lfloor>i\<rceil>, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1AAcc2':
   "\<lbrakk> P, i, n, h \<turnstile>' (i', xs) \<leftrightarrow> (stk, loc, pc, xcp); \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, n, h \<turnstile>' (Val v\<lfloor>i'\<rceil>, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, xcp)"
 
 | bisim1AAccThrow1':
   "\<lbrakk> P, a, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAccThrow2':
   "\<lbrakk> P, i, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAccFail':
   "\<lbrakk> \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None); \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil>, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> ([v, v'], xs, length (compE2 a) + length (compE2 i), \<lfloor>ad\<rfloor>)"
 
 
 | bisim1AAss1':
   "\<lbrakk> P, a, n, h \<turnstile>' (a', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (a'\<lfloor>i\<rceil> := e, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1AAss2':
   "\<lbrakk> P, i, n, h \<turnstile>' (i', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Val v\<lfloor>i'\<rceil> := e, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, xcp)"
 
 | bisim1AAss3':
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
      \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Val v\<lfloor>Val v'\<rceil> := e', xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 a) + length (compE2 i) + pc, xcp)"
 
 | bisim1AAssThrow1':
   "\<lbrakk> P, a, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None); 
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssThrow2':
   "\<lbrakk> P, i, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>); 
      \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 a) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssThrow3':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None); 
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 a) + length (compE2 i) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1AAssFail':
   "\<lbrakk> \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None);  
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> ([v', v, v''], xs, length (compE2 a) + length (compE2 i) + length (compE2 e), \<lfloor>ad\<rfloor>)"
 
 | bisim1AAss4':
   "\<lbrakk> \<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None);  
      \<And>xs. P, i, n, h \<turnstile>' (i, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, a\<lfloor>i\<rceil> := e, n, h \<turnstile>' (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 a) + length (compE2 i) + length (compE2 e)), None)"
 
 
 | bisim1ALength': 
   "P, a, n, h \<turnstile>' (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, a\<bullet>length, n, h \<turnstile>' (a'\<bullet>length, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1ALengthThrow':
   "P, a, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, a\<bullet>length, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 
 | bisim1ALengthNull':
   "(\<And>xs. P, a, n, h \<turnstile>' (a, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, a\<bullet>length, n, h \<turnstile>' (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 a), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 
 | bisim1FAcc': 
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, e\<bullet>F{D}, n, h \<turnstile>' (e'\<bullet>F{D}, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1FAccThrow':
   "P, e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)
   \<Longrightarrow> P, e\<bullet>F{D}, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAccNull':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
    \<Longrightarrow> P, e\<bullet>F{D}, n, h \<turnstile>' (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 
 | bisim1FAss1': 
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (e'\<bullet>F{D} := e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1FAss2': 
   "\<lbrakk> P, e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (Val v\<bullet>F{D} := e', xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e) + pc, xcp)"
 
 | bisim1FAssThrow1':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAssThrow2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1FAssNull':
   "\<lbrakk> \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (THROW NullPointer, xs) \<leftrightarrow> ([v, Null], xs, length (compE2 e) + length (compE2 e2), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1FAss3':
   "\<lbrakk> \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None); 
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, e\<bullet>F{D} := e2, n, h \<turnstile>' (unit, xs) \<leftrightarrow> ([], xs, Suc (length (compE2 e) + length (compE2 e2)), None)"
 
 
 | bisim1CAS1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
     \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e3, n, h \<turnstile>' (e3, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (e1'\<bullet>compareAndSwap(D\<bullet>F, e2, e3), xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CAS2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
     \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e3, n, h \<turnstile>' (e3, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Val v\<bullet>compareAndSwap(D\<bullet>F, e2', e3), xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e1) + pc, xcp)"
 
 | bisim1CAS3':
   "\<lbrakk> P, e3, n, h \<turnstile>' (e3', xs) \<leftrightarrow> (stk, loc, pc, xcp);
     \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', e3'), xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 e1) + length (compE2 e2) + pc, xcp)"
 
 | bisim1CASThrow1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
     \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e3, n, h \<turnstile>' (e3, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASThrow2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
     \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e3, n, h \<turnstile>' (e3, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 e1) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASThrow3':
   "\<lbrakk> P, e3, n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>ad\<rfloor>);
     \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> (stk @ [v', v], loc, length (compE2 e1) + length (compE2 e2) + pc, \<lfloor>ad\<rfloor>)"
 
 | bisim1CASFail':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None); 
     \<And>xs. P, e3, n, h \<turnstile>' (e3, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3), n, h \<turnstile>' (Throw ad, xs) \<leftrightarrow> ([v', v, v''], xs, length (compE2 e1) + length (compE2 e2) + length (compE2 e3), \<lfloor>ad\<rfloor>)"
 
 
 | bisim1Call1':
   "\<lbrakk> P, obj, n, h \<turnstile>' (obj', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, ps, n, h \<turnstile>' (ps, xs) [\<leftrightarrow>] ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, obj\<bullet>M(ps), n, h \<turnstile>' (obj'\<bullet>M(ps), xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CallParams':
   "\<lbrakk> P, ps, n, h \<turnstile>' (ps', xs) [\<leftrightarrow>] (stk, loc, pc, xcp); ps \<noteq> [];
      \<And>xs. P, obj, n, h \<turnstile>' (obj, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, obj\<bullet>M(ps), n, h \<turnstile>' (Val v\<bullet>M(ps'), xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 obj) +  pc, xcp)"
 
 | bisim1CallThrowObj':
   "\<lbrakk> P, obj, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, ps, n, h \<turnstile>' (ps, xs) [\<leftrightarrow>] ([], xs, 0, None)\<rbrakk>
   \<Longrightarrow> P, obj\<bullet>M(ps), n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CallThrowParams':
   "\<lbrakk> P, ps, n, h \<turnstile>' (map Val vs @ Throw a # ps', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, obj, n, h \<turnstile>' (obj, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, obj\<bullet>M(ps), n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk @ [v], loc, length (compE2 obj) + pc, \<lfloor>a\<rfloor>)"
 
 | bisim1CallThrow':
   "\<lbrakk> length ps = length vs;
      \<And>xs. P, obj, n, h \<turnstile>' (obj, xs) \<leftrightarrow> ([], xs, 0, None); \<And>xs. P, ps, n, h \<turnstile>' (ps, xs) [\<leftrightarrow>] ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, obj\<bullet>M(ps), n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (vs @ [v], xs, length (compE2 obj) + length (compEs2 ps), \<lfloor>a\<rfloor>)"
 
 | bisim1BlockSome1':
   "(\<And>xs. P, e, Suc n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, n, h \<turnstile>' ({V:T=\<lfloor>v\<rfloor>; e}, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1BlockSome2':
   "(\<And>xs. P, e, Suc n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, n, h \<turnstile>' ({V:T=\<lfloor>v\<rfloor>; e}, xs) \<leftrightarrow> ([v], xs, Suc 0, None)"
 
 | bisim1BlockSome4':
   "P, e, Suc n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, n, h \<turnstile>' ({V:T=None; e'}, xs) \<leftrightarrow> (stk, loc, Suc (Suc pc), xcp)"
 
 | bisim1BlockThrowSome':
   "P, e, Suc n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, {V:T=\<lfloor>v\<rfloor>; e}, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (Suc pc), \<lfloor>a\<rfloor>)"
 
 | bisim1BlockNone':
   "P, e, Suc n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, {V:T=None; e}, n, h \<turnstile>' ({V:T=None; e'}, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1BlockThrowNone':
   "P, e, Suc n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, {V:T=None; e}, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Sync1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
      \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (sync\<^bsub>V\<^esub> (e') e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1Sync2':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (sync\<^bsub>V\<^esub> (Val v) e2, xs) \<leftrightarrow> ([v, v], xs, Suc (length (compE2 e1)), None)"
 
 | bisim1Sync3':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (sync\<^bsub>V\<^esub> (Val v) e2, xs) \<leftrightarrow> ([v], xs[V := v], Suc (Suc (length (compE2 e1))), None)"
 
 | bisim1Sync4':
   "\<lbrakk> P, e2, Suc n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); 
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (insync\<^bsub>V\<^esub> (a) e', xs) \<leftrightarrow> (stk, loc, Suc (Suc (Suc (length (compE2 e1) + pc))), xcp)"
 
 | bisim1Sync5':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (insync\<^bsub>V\<^esub> (a) Val v, xs) \<leftrightarrow> ([xs ! V, v], xs, 4 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync6':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Val v, xs) \<leftrightarrow> ([v], xs, 5 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync7':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (insync\<^bsub>V\<^esub> (a) Throw a', xs) \<leftrightarrow> ([Addr a'], xs, 6 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync8':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (insync\<^bsub>V\<^esub> (a) Throw a', xs) \<leftrightarrow>
         ([xs ! V, Addr a'], xs, 7 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync9':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([Addr a], xs, 8 + length (compE2 e1) + length (compE2 e2), None)"
 
 | bisim1Sync10':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([Addr a], xs, 8 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1Sync11':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, Suc (Suc (length (compE2 e1))), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1Sync12':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([v, v'], xs, 4 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1Sync14':
   "\<lbrakk> \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow>
         ([v, Addr a'], xs, 7 + length (compE2 e1) + length (compE2 e2), \<lfloor>a\<rfloor>)"
 
 | bisim1SyncThrow':
   "\<lbrakk> P, e1, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); 
     \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, sync\<^bsub>V\<^esub> (e1) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1InSync':
   "P, insync\<^bsub>V\<^esub> (a) e, n, h \<turnstile>' (insync\<^bsub>V\<^esub> (a) e, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 
 | bisim1Seq1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, e1;;e2, n, h \<turnstile>' (e';;e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1SeqThrow1':
   "\<lbrakk> P, e1, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, e1;;e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1Seq2':
   "\<lbrakk> P, e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e1;;e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 e1) + pc), xcp)"
 
 
 | bisim1Cond1':
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, if (e) e1 else e2, n, h \<turnstile>' (if (e') e1 else e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1CondThen':
   "\<lbrakk> P, e1, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, if (e) e1 else e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 e) + pc), xcp)"
 
 | bisim1CondElse':
   "\<lbrakk> P, e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, if (e) e1 else e2, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + length (compE2 e1) +  pc)), xcp)"
 
 | bisim1CondThrow':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e1, n, h \<turnstile>' (e1, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e2, n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, if (e) e1 else e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1While1':
   "\<lbrakk> \<And>xs. P, c, n, h \<turnstile>' (c, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, while (c) e, n, h \<turnstile>' (while (c) e, xs) \<leftrightarrow> ([], xs, 0, None)"
 
 | bisim1While3':
   "\<lbrakk> P, c, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, while (c) e, n, h \<turnstile>' (if (e') (e;; while (c) e) else unit, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1While4':
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, c, n, h \<turnstile>' (c, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, while (c) e, n, h  \<turnstile>' (e';; while (c) e, xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 c) + pc), xcp)"
 
 | bisim1While6':
   "\<lbrakk> \<And>xs. P, c, n, h \<turnstile>' (c, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk> \<Longrightarrow> 
   P, while (c) e, n, h \<turnstile>' (while (c) e, xs) \<leftrightarrow> ([], xs, Suc (Suc (length (compE2 c) + length (compE2 e))), None)"
 
 | bisim1While7':
   "\<lbrakk> \<And>xs. P, c, n, h \<turnstile>' (c, xs) \<leftrightarrow> ([], xs, 0, None);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk> \<Longrightarrow> 
   P, while (c) e, n, h \<turnstile>' (unit, xs) \<leftrightarrow> ([], xs, Suc (Suc (Suc (length (compE2 c) + length (compE2 e)))), None)"
 
 | bisim1WhileThrow1':
   "\<lbrakk> P, c, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, while (c) e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1WhileThrow2':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); 
      \<And>xs. P, c, n, h \<turnstile>' (c, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, while (c) e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (length (compE2 c) + pc), \<lfloor>a\<rfloor>)"
 
 
 | bisim1Throw1':
   "P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> P, throw e, n, h \<turnstile>' (throw e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1Throw2':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, throw e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> ([Addr a], xs, length (compE2 e), \<lfloor>a\<rfloor>)"
 
 | bisim1ThrowNull':
   "(\<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None))
   \<Longrightarrow> P, throw e, n, h \<turnstile>' (THROW NullPointer, xs) \<leftrightarrow> ([Null], xs, length (compE2 e), \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>)"
 
 | bisim1ThrowThrow':
   "P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> P, throw e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 
 | bisim1Try':
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, try e catch(C V) e2, n, h \<turnstile>' (try e' catch(C V) e2, xs) \<leftrightarrow> (stk, loc, pc, xcp)"
 
 | bisim1TryCatch1':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); typeof_addr h a = \<lfloor>Class_type C'\<rfloor>; P \<turnstile> C' \<preceq>\<^sup>* C;
      \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, try e catch(C V) e2, n, h \<turnstile>' ({V:Class C=None; e2}, xs[V := Addr a]) \<leftrightarrow> ([Addr a], loc, Suc (length (compE2 e)), None)"
 
 | bisim1TryCatch2':
   "\<lbrakk> P, e2, Suc n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, try e catch(C V) e2, n, h \<turnstile>' ({V:Class C=None; e'}, xs) \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + pc)), xcp)"
 
 | bisim1TryFail':
   "\<lbrakk> P, e, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>); typeof_addr h a = \<lfloor>Class_type C'\<rfloor>; \<not> P \<turnstile> C' \<preceq>\<^sup>* C;
      \<And>xs. P, e2, Suc n, h \<turnstile>' (e2, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk> 
   \<Longrightarrow> P, try e catch(C V) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)"
 
 | bisim1TryCatchThrow':
   "\<lbrakk> P, e2, Suc n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
    \<Longrightarrow> P, try e catch(C V) e2, n, h \<turnstile>' (Throw a, xs) \<leftrightarrow> (stk, loc, Suc (Suc (length (compE2 e) + pc)), \<lfloor>a\<rfloor>)"
 
 | bisims1Nil': "P, [], n, h \<turnstile>' ([], xs) [\<leftrightarrow>] ([], xs, 0, None)"
 
 | bisims1List1':
   "\<lbrakk> P, e, n, h \<turnstile>' (e', xs) \<leftrightarrow> (stk, loc, pc, xcp);
      \<And>xs. P, es, n, h \<turnstile>' (es, xs) [\<leftrightarrow>] ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e#es, n, h \<turnstile>' (e'#es, xs) [\<leftrightarrow>] (stk, loc, pc, xcp)"
 
 | bisims1List2':
   "\<lbrakk> P, es, n, h \<turnstile>' (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp);
      \<And>xs. P, e, n, h \<turnstile>' (e, xs) \<leftrightarrow> ([], xs, 0, None) \<rbrakk>
   \<Longrightarrow> P, e#es, n, h \<turnstile>' (Val v # es', xs) [\<leftrightarrow>] (stk @ [v], loc, length (compE2 e) + pc, xcp)"
 
 lemma bisim1'_refl: "P,e,n,h \<turnstile>' (e,xs) \<leftrightarrow> ([],xs,0,None)"
   and bisims1'_refl: "P,es,n,h \<turnstile>' (es,xs) [\<leftrightarrow>] ([],xs,0,None)"
 apply(induct e and es arbitrary: n xs and n xs rule: call.induct calls.induct)
 apply(auto intro: bisim1'_bisims1'.intros simp add: nat_fun_sum_eq_conv)
 apply(rename_tac option a b c)
 apply(case_tac option)
 apply(auto intro: bisim1'_bisims1'.intros simp add: fun_eq_iff split: if_split_asm)
 done
 
 lemma bisim1_imp_bisim1': "P, e, h \<turnstile> exs \<leftrightarrow> s \<Longrightarrow> P, e, n, h \<turnstile>' exs \<leftrightarrow> s"
   and bisims1_imp_bisims1': "P, es, h \<turnstile> esxs [\<leftrightarrow>] s \<Longrightarrow> P, es, n, h \<turnstile>' esxs [\<leftrightarrow>] s"
 proof(induct arbitrary: n and n rule: bisim1_bisims1.inducts)
   case (bisim1CallParams ps ps' xs stk loc pc xcp obj M v)
   show ?case
   proof(cases "ps = []")
     case True
     with \<open>P,ps,h \<turnstile> (ps', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)\<close> have "ps' = []" "pc = 0" "stk = []" "loc = xs" "xcp = None"
       by(auto elim: bisims1.cases)
     moreover have "P,obj,n,h \<turnstile>' (Val v,xs) \<leftrightarrow> ([v],xs,length (compE2 obj),None)"
       by(blast intro: bisim1Val2' bisim1'_refl)
     hence "P,obj\<bullet>M([]),n,h \<turnstile>' (Val v\<bullet>M([]),xs) \<leftrightarrow> ([v],xs,length (compE2 obj),None)"
       by-(rule bisim1Call1', auto intro!: bisims1Nil' simp add: bsoks_def)
     ultimately show ?thesis using True by simp
   next
     case False with bisim1CallParams show ?thesis
       by(auto intro: bisim1CallParams' bisims1'_refl bisim1'_refl)
   qed
 qed(auto intro: bisim1'_bisims1'.intros bisim1'_refl bisims1'_refl)
 
 lemma bisim1'_imp_bisim1: "P, e, n, h \<turnstile>' exs \<leftrightarrow> s \<Longrightarrow> P, e, h \<turnstile> exs \<leftrightarrow> s"
   and bisims1'_imp_bisims1: "P, es, n, h \<turnstile>' esxs [\<leftrightarrow>] s \<Longrightarrow> P, es, h \<turnstile> esxs [\<leftrightarrow>] s"
 apply(induct rule: bisim1'_bisims1'.inducts)
 apply(blast intro: bisim1_bisims1.intros)+
 done
 
 lemma bisim1'_eq_bisim1: "bisim1' P h e n = bisim1 P h e"
   and bisims1'_eq_bisims1: "bisims1' P h es n = bisims1 P h es"
 by(blast intro!: ext bisim1_imp_bisim1' bisims1_imp_bisims1' bisim1'_imp_bisim1 bisims1'_imp_bisims1)+
 
 end
 
 (* FIXME: Take lemmas out of locale to speed up opening the context *)
 
 lemmas bisim1_bisims1_inducts = 
   J1_JVM_heap_base.bisim1'_bisims1'.inducts
   [simplified J1_JVM_heap_base.bisim1'_eq_bisim1 J1_JVM_heap_base.bisims1'_eq_bisims1, 
   consumes 1,
   case_names bisim1Val2 bisim1New bisim1NewThrow
   bisim1NewArray bisim1NewArrayThrow bisim1NewArrayFail bisim1Cast bisim1CastThrow bisim1CastFail
   bisim1InstanceOf bisim1InstanceOfThrow
   bisim1Val bisim1Var bisim1BinOp1 bisim1BinOp2 bisim1BinOpThrow1 bisim1BinOpThrow2 bisim1BinOpThrow
   bisim1LAss1 bisim1LAss2 bisim1LAssThrow
   bisim1AAcc1 bisim1AAcc2 bisim1AAccThrow1 bisim1AAccThrow2 bisim1AAccFail
   bisim1AAss1 bisim1AAss2 bisim1AAss3 bisim1AAssThrow1 bisim1AAssThrow2
   bisim1AAssThrow3 bisim1AAssFail bisim1AAss4
   bisim1ALength bisim1ALengthThrow bisim1ALengthNull
   bisim1FAcc bisim1FAccThrow bisim1FAccNull
   bisim1FAss1 bisim1FAss2 bisim1FAssThrow1 bisim1FAssThrow2 bisim1FAssNull bisim1FAss3
   bisim1CAS1 bisim1CAS2 bisim1CAS3 bisim1CASThrow1 bisim1CASThrow2
   bisim1CASThrow3 bisim1CASFail
   bisim1Call1 bisim1CallParams bisim1CallThrowObj bisim1CallThrowParams
   bisim1CallThrow
   bisim1BlockSome1 bisim1BlockSome2 bisim1BlockSome4 bisim1BlockThrowSome
   bisim1BlockNone bisim1BlockThrowNone
   bisim1Sync1 bisim1Sync2 bisim1Sync3 bisim1Sync4 bisim1Sync5 bisim1Sync6
   bisim1Sync7 bisim1Sync8 bisim1Sync9 bisim1Sync10 bisim1Sync11 bisim1Sync12
   bisim1Sync14 bisim1SyncThrow bisim1InSync
   bisim1Seq1 bisim1SeqThrow1 bisim1Seq2
   bisim1Cond1 bisim1CondThen bisim1CondElse bisim1CondThrow
   bisim1While1 bisim1While3 bisim1While4
   bisim1While6 bisim1While7 bisim1WhileThrow1 bisim1WhileThrow2
   bisim1Throw1 bisim1Throw2 bisim1ThrowNull bisim1ThrowThrow
   bisim1Try bisim1TryCatch1 bisim1TryCatch2 bisim1TryFail bisim1TryCatchThrow
   bisims1Nil bisims1List1 bisims1List2]
 
 lemmas bisim1_bisims1_inducts_split = bisim1_bisims1_inducts[split_format (complete)]
 
 context J1_JVM_heap_base begin
 
 lemma bisim1_pc_length_compE2: "P,E,h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> pc \<le> length (compE2 E)"
   and bisims1_pc_length_compEs2: "P,Es,h \<turnstile> (es, xs) [\<leftrightarrow>] (stk, loc, pc, xcp) \<Longrightarrow> pc \<le> length (compEs2 Es)"
 apply(induct "(stk, loc, pc, xcp)" and "(stk, loc, pc, xcp)" 
   arbitrary: stk loc pc xcp and stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(auto)
 done
 
 lemma bisim1_pc_length_compE2D:
   "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk,loc,length (compE2 e),xcp)
   \<Longrightarrow> xcp = None \<and> call1 e' = None \<and> (\<exists>v. stk = [v] \<and> (is_val e' \<longrightarrow> e' = Val v \<and> xs = loc))"
 
   and bisims1_pc_length_compEs2D:
   "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk,loc,length (compEs2 es),xcp)
   \<Longrightarrow> xcp = None \<and> calls1 es' = None \<and> (\<exists>vs. stk = rev vs \<and> length vs = length es \<and> (is_vals es' \<longrightarrow> es' = map Val vs \<and> xs = loc))"
 proof(induct "(e', xs)" "(stk, loc, length (compE2 e), xcp)"
         and "(es', xs)" "(stk, loc, length (compEs2 es), xcp)" 
  arbitrary: e' xs stk loc xcp and es' xs stk loc xcp rule: bisim1_bisims1.inducts)
   case (bisims1List2 es es' xs stk loc pc xcp e v)
   then obtain vs where "xcp = None" "calls1 es' = None" 
     "stk = rev vs" "length vs = length es" "is_vals es' \<longrightarrow> es' = map Val vs \<and> xs = loc" by auto
   thus ?case
     by(clarsimp)(rule_tac x="v#vs" in exI, auto)
 qed(simp_all (no_asm_use), (fastforce dest: bisim1_pc_length_compE2 bisims1_pc_length_compEs2 split: bop.split_asm if_split_asm)+)
 
 corollary bisim1_call_pcD: "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); call1 e' = \<lfloor>aMvs\<rfloor> \<rbrakk> \<Longrightarrow> pc < length (compE2 e)"
   and bisims1_calls_pcD: "\<lbrakk> P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp); calls1 es' = \<lfloor>aMvs\<rfloor> \<rbrakk> \<Longrightarrow> pc < length (compEs2 es)"
 proof -
   assume bisim: "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)"
     and call: "call1 e' = \<lfloor>aMvs\<rfloor>"
 
   { assume "pc = length (compE2 e)"
     with bisim call have False
       by(auto dest: bisim1_pc_length_compE2D) }
   moreover from bisim have "pc \<le> length (compE2 e)"
     by(rule bisim1_pc_length_compE2)
   ultimately show "pc < length (compE2 e)"
     by(cases "pc < length (compE2 e)")(auto)
 next
   assume bisim: "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)"
     and call: "calls1 es' = \<lfloor>aMvs\<rfloor>"
   { assume "pc = length (compEs2 es)"
     with bisim call have False
       by(auto dest: bisims1_pc_length_compEs2D) }
   moreover from bisim have "pc \<le> length (compEs2 es)"
     by(rule bisims1_pc_length_compEs2)
   ultimately show "pc < length (compEs2 es)"
     by(cases "pc < length (compEs2 es)")(auto)
 qed
 
 lemma bisim1_length_xs: "P,e,h \<turnstile> (e',xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> length xs = length loc"
   and bisims1_length_xs: "P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk, loc, pc, xcp) \<Longrightarrow> length xs = length loc"
 by(induct "(e',xs)" "(stk, loc, pc, xcp)" and "(es',xs)" "(stk, loc, pc, xcp)"
   arbitrary: e' xs stk loc pc xcp and es' xs stk loc pc xcp rule: bisim1_bisims1.inducts)
   auto
 
 lemma bisim1_Val_length_compE2D:
   "P,e,h \<turnstile> (Val v,xs) \<leftrightarrow> (stk, loc, length (compE2 e), xcp) \<Longrightarrow> stk = [v] \<and> xs = loc \<and> xcp = None"
 
   and bisims1_Val_length_compEs2D:
   "P,es,h \<turnstile> (map Val vs,xs) [\<leftrightarrow>] (stk, loc, length (compEs2 es), xcp) \<Longrightarrow> stk = rev vs \<and> xs = loc \<and> xcp = None"
 by(auto dest: bisim1_pc_length_compE2D bisims1_pc_length_compEs2D)
 
 lemma bisim_Val_loc_eq_xcp_None:
   "P, e, h \<turnstile> (Val v, xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> xs = loc \<and> xcp = None"
 
   and bisims_Val_loc_eq_xcp_None:
   "P, es, h \<turnstile> (map Val vs, xs) [\<leftrightarrow>] (stk, loc, pc, xcp) \<Longrightarrow> xs = loc \<and> xcp = None"
 apply(induct "(Val v :: 'addr expr1, xs)" "(stk, loc, pc, xcp)" 
   and "(map Val vs :: 'addr expr1 list, xs)" "(stk, loc, pc, xcp)"
   arbitrary: v xs stk loc pc xcp and vs xs stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(auto)
 done
 
 lemma bisim_Val_pc_not_Invoke: 
   "\<lbrakk> P,e,h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp); pc < length (compE2 e) \<rbrakk> \<Longrightarrow> compE2 e ! pc \<noteq> Invoke M n'"
 
   and bisims_Val_pc_not_Invoke: 
   "\<lbrakk> P,es,h \<turnstile> (map Val vs,xs) [\<leftrightarrow>] (stk,loc,pc,xcp); pc < length (compEs2 es) \<rbrakk> \<Longrightarrow> compEs2 es ! pc \<noteq> Invoke M n'"
 apply(induct "(Val v :: 'addr expr1, xs)" "(stk, loc, pc, xcp)"
          and "(map Val vs :: 'addr expr1 list, xs)" "(stk, loc, pc, xcp)"
   arbitrary: v xs stk loc pc xcp and vs xs stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(auto simp add: nth_append compEs2_map_Val dest: bisim1_pc_length_compE2)
 done
 
 lemma bisim1_VarD: "P, E, h \<turnstile> (Var V,xs) \<leftrightarrow> (stk,loc,pc,xcp) \<Longrightarrow> xs = loc"
   and "P, es, h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp) \<Longrightarrow> True"
 by(induct "(Var V :: 'addr expr1, xs)" "(stk, loc, pc, xcp)" and arbitrary: V xs stk loc pc xcp and rule: bisim1_bisims1.inducts) auto
 
 lemma bisim1_ThrowD:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, xcp)
   \<Longrightarrow> pc < length (compE2 e) \<and> (xcp = \<lfloor>a\<rfloor> \<or> xcp = None) \<and> xs = loc"
 
   and bisims1_ThrowD:
   "P, es, h \<turnstile> (map Val vs @ Throw a # es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)
   \<Longrightarrow> pc < length (compEs2 es) \<and> (xcp = \<lfloor>a\<rfloor> \<or> xcp = None) \<and> xs = loc"
 apply(induct "(Throw a :: 'addr expr1, xs)" "(stk, loc, pc, xcp)"
          and "(map Val vs @ Throw a # es', xs)" "(stk, loc, pc, xcp)"
          arbitrary: xs stk loc pc xcp and vs es' xs stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(fastforce dest: bisim1_pc_length_compE2 bisim_Val_loc_eq_xcp_None simp add: Cons_eq_append_conv)+
 done
 
 lemma fixes P :: "'addr J1_prog"
   shows bisim1_Invoke_stkD:
   "\<lbrakk> P,e,h \<turnstile> exs \<leftrightarrow> (stk,loc,pc,None); pc < length (compE2 e); compE2 e ! pc = Invoke M n' \<rbrakk> 
   \<Longrightarrow> \<exists>vs v stk'. stk = vs @ v # stk' \<and> length vs = n'"
 
   and bisims1_Invoke_stkD: 
   "\<lbrakk> P,es,h \<turnstile> esxs [\<leftrightarrow>] (stk,loc,pc,None); pc < length (compEs2 es); compEs2 es ! pc = Invoke M n' \<rbrakk>
   \<Longrightarrow> \<exists>vs v stk'. stk = vs @ v # stk' \<and> length vs = n'"
 proof(induct "(stk, loc, pc, None :: 'addr option)" and "(stk, loc, pc, None :: 'addr option)"
     arbitrary: stk loc pc and stk loc pc rule: bisim1_bisims1.inducts)
   case bisim1Call1
   thus ?case
     apply(clarsimp simp add: nth_append append_eq_append_conv2 neq_Nil_conv split: if_split_asm)
     apply(drule bisim1_pc_length_compE2, clarsimp simp add: neq_Nil_conv nth_append)
     apply(frule bisim1_pc_length_compE2, clarsimp)
     apply(drule bisim1_pc_length_compE2D, fastforce)
     done
 next
   case bisim1CallParams thus ?case
     apply(clarsimp simp add: nth_append append_eq_Cons_conv split: if_split_asm)
     apply(fastforce simp add: append_eq_append_conv2 Cons_eq_append_conv)
     apply(frule bisims1_pc_length_compEs2, clarsimp)
     apply(drule bisims1_pc_length_compEs2D, fastforce simp add: append_eq_append_conv2)
     done
 qed(fastforce simp add: nth_append append_eq_append_conv2 neq_Nil_conv split: if_split_asm bop.split_asm dest: bisim1_pc_length_compE2 bisims1_pc_length_compEs2)+
 
 lemma fixes P :: "'addr J1_prog"
   shows bisim1_call_xcpNone: "P,e,h \<turnstile> (e',xs) \<leftrightarrow> (stk,loc,pc,\<lfloor>a\<rfloor>) \<Longrightarrow> call1 e' = None"
   and bisims1_calls_xcpNone: "P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc,\<lfloor>a\<rfloor>) \<Longrightarrow> calls1 es' = None"
 apply(induct "(e', xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)" and "(es',xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)"
   arbitrary: e' xs stk loc pc and es' xs stk loc pc rule: bisim1_bisims1.inducts)
 apply(auto dest: bisim_Val_loc_eq_xcp_None bisims_Val_loc_eq_xcp_None simp add: is_vals_conv)
 done
 
 lemma bisims1_map_Val_append:
   assumes bisim: "P, es', h \<turnstile> (es'', xs) [\<leftrightarrow>] (stk, loc, pc, xcp)"
   shows "length es = length vs
           \<Longrightarrow> P, es @ es', h \<turnstile> (map Val vs @ es'', xs) [\<leftrightarrow>] (stk @ rev vs, loc, length (compEs2 es) + pc, xcp)"
 proof(induction vs arbitrary: es)
   case Nil thus ?case using bisim by simp
 next
   case (Cons v vs)
   from \<open>length es = length (v # vs)\<close> obtain e es''' where [simp]: "es = e # es'''" by(cases es, auto)
   with \<open>length es = length (v # vs)\<close> have len: "length es''' = length vs" by simp
   from Cons.IH[OF len]
   show ?case by(simp add: add.assoc append_assoc[symmetric] del: append_assoc)(rule bisims1List2, auto)
 qed
 
 lemma bisim1_hext_mono: "\<lbrakk> P,e,h \<turnstile> exs \<leftrightarrow> s; hext h h' \<rbrakk> \<Longrightarrow> P,e,h' \<turnstile> exs \<leftrightarrow> s" (is "PROP ?thesis1")
   and bisims1_hext_mono: "\<lbrakk> P,es,h \<turnstile> esxs [\<leftrightarrow>] s; hext h h' \<rbrakk> \<Longrightarrow> P,es,h' \<turnstile> esxs [\<leftrightarrow>] s" (is "PROP ?thesis2")
 proof -
   assume hext: "hext h h'"
   have "P,e,h \<turnstile> exs \<leftrightarrow> s \<Longrightarrow> P,e,h' \<turnstile> exs \<leftrightarrow> s"
     and "P,es,h \<turnstile> esxs [\<leftrightarrow>] s \<Longrightarrow> P,es,h' \<turnstile> esxs [\<leftrightarrow>] s"
     apply(induct rule: bisim1_bisims1.inducts)
     apply(insert hext)
     apply(auto intro: bisim1_bisims1.intros dest: hext_objD)
     done
   thus "PROP ?thesis1" and "PROP ?thesis2" by auto
 qed
 
 declare match_ex_table_append_not_pcs [simp]
        match_ex_table_eq_NoneI[simp]
        outside_pcs_compxE2_not_matches_entry[simp]
        outside_pcs_compxEs2_not_matches_entry[simp]
 
 lemma bisim1_xcp_Some_not_caught:
   "P, e, h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e pc' d) = None"
 
   and bisims1_xcp_Some_not_caught:
   "P, es, h \<turnstile> (map Val vs @ Throw a # es', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>)
   \<Longrightarrow> match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxEs2 es pc' d) = None"
 proof(induct "(Throw a :: 'addr expr1, xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)" 
     and "(map Val vs @ Throw a # es' :: 'addr expr1 list, xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)"
     arbitrary: xs stk loc pc pc' d and xs stk loc pc vs es' pc' d rule: bisim1_bisims1.inducts)
   case bisim1Sync10
   thus ?case by(simp add: matches_ex_entry_def)
 next
   case bisim1Sync11
   thus ?case by(simp add: matches_ex_entry_def)
 next
   case (bisim1SyncThrow e1 xs stk loc pc e2)
   note IH = \<open>match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e1 pc' d) = None\<close>
   from \<open>P,e1,h \<turnstile> (Throw a,xs) \<leftrightarrow> (stk,loc,pc,\<lfloor>a\<rfloor>)\<close> have "pc < length (compE2 e1)" by(auto dest: bisim1_ThrowD)
   with IH show ?case
     by(auto simp add: match_ex_table_append matches_ex_entry_def dest: match_ex_table_pc_length_compE2 intro: match_ex_table_not_pcs_None)
 next
   case bisims1List1 thus ?case
     by(auto simp add: Cons_eq_append_conv dest: bisim1_ThrowD bisim_Val_loc_eq_xcp_None)
 next
   case (bisims1List2 es es'' xs stk loc pc e v)
   hence "\<And>pc' d. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxEs2 es pc' d) = None"
     by(auto simp add: Cons_eq_append_conv)
   from this[of "pc' + length (compE2 e)" "Suc d"] show ?case by(auto simp add: add.assoc)
 next
   case (bisim1BlockThrowSome e xs stk loc pc T v)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e pc' d) = None" by auto
   from this[of "2+pc'"] show ?case by(auto)
 next
   case (bisim1Seq2 e2 stk loc pc e1 xs)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e2 pc' d) = None" by auto
   from this[of "Suc (pc' + length (compE2 e1))"] show ?case by(simp add: add.assoc)
 next
   case (bisim1CondThen e1 stk loc pc e e2 xs)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e1 pc' d) = None" by auto
   note this[of "Suc (pc' + length (compE2 e))"]
   moreover from \<open>P,e1,h \<turnstile> (Throw a,xs) \<leftrightarrow> (stk,loc,pc,\<lfloor>a\<rfloor>)\<close>
   have "pc < length (compE2 e1)" by(auto dest: bisim1_ThrowD)
   ultimately show ?case by(simp add: add.assoc match_ex_table_eq_NoneI outside_pcs_compxE2_not_matches_entry)
 next
   case (bisim1CondElse e2 stk loc pc e e1 xs)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e2 pc' d) = None" by auto
   note this[of "Suc (Suc (pc' + (length (compE2 e) + length (compE2 e1))))"]
   thus ?case by(simp add: add.assoc)
 next
   case (bisim1WhileThrow2 e xs stk loc pc c)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e pc' d) = None" by auto
   from this[of "Suc (pc' + (length (compE2 c)))"]
   show ?case by(simp add: add.assoc)
 next
   case (bisim1Throw1 e xs stk loc pc)
   thus ?case by(auto dest: bisim_Val_loc_eq_xcp_None)
 next
   case (bisim1TryFail e xs stk loc pc C' C e2)
   hence "match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e pc' d) = None" by auto
   moreover from \<open>P,e,h \<turnstile> (Throw a,xs) \<leftrightarrow> (stk,loc,pc,\<lfloor>a\<rfloor>)\<close> have "pc < length (compE2 e)"
     by(auto dest: bisim1_ThrowD)
   ultimately show ?case using \<open>typeof_addr h a = \<lfloor>Class_type C'\<rfloor>\<close> \<open>\<not> P \<turnstile> C' \<preceq>\<^sup>* C\<close>
     by(simp add: matches_ex_entry_def cname_of_def)
 next
   case (bisim1TryCatchThrow e2 xs stk loc pc e C)
   hence "\<And>pc'. match_ex_table (compP f P) (cname_of h a) (pc' + pc) (compxE2 e2 pc' d) = None" by auto
   from this[of "Suc (Suc (pc' + (length (compE2 e))))"]
   show ?case by(simp add: add.assoc matches_ex_entry_def)
 next
   case bisim1Sync12 thus ?case
     by(auto dest: bisim1_ThrowD simp add: match_ex_table_append eval_nat_numeral, simp add: matches_ex_entry_def)
 next
   case bisim1Sync14 thus ?case
     by(auto dest: bisim1_ThrowD simp add: match_ex_table_append eval_nat_numeral, simp add: matches_ex_entry_def)
 qed(fastforce dest: bisim1_ThrowD simp add: add.assoc[symmetric])+
 
 declare match_ex_table_append_not_pcs [simp del]
        match_ex_table_eq_NoneI[simp del]
        outside_pcs_compxE2_not_matches_entry[simp del]
        outside_pcs_compxEs2_not_matches_entry[simp del]
 
 lemma bisim1_xcp_pcD: "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> pc < length (compE2 e)"
   and bisims1_xcp_pcD: "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> pc < length (compEs2 es)"
 by(induct "(e', xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)" and "(es', xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)"
   arbitrary: e' xs stk loc pc and es' xs stk loc pc rule: bisim1_bisims1.inducts)
   auto
 
 declare nth_Cons_subtract[simp]
 declare nth_append [simp]
 
 lemma bisim1_Val_\<tau>Exec_move:
   "\<lbrakk> P, E, h \<turnstile> (Val v, xs) \<leftrightarrow> (stk, loc, pc, xcp); pc < length (compE2 E) \<rbrakk> 
   \<Longrightarrow> xs = loc \<and> xcp = None \<and>
      \<tau>Exec_mover_a P t E h (stk, xs, pc, None) ([v], xs, length (compE2 E), None)"
 
  and bisims1_Val_\<tau>Exec_moves:
   "\<lbrakk> P, Es, h \<turnstile> (map Val vs, xs) [\<leftrightarrow>] (stk, loc, pc, xcp); pc < length (compEs2 Es) \<rbrakk> 
   \<Longrightarrow> xs = loc \<and> xcp = None \<and>
     \<tau>Exec_movesr_a P t Es h (stk, xs, pc, None) (rev vs, xs, length (compEs2 Es), None)"
 proof(induct "(Val v :: 'addr expr1, xs)" "(stk, loc, pc, xcp)" 
     and "(map Val vs :: 'addr expr1 list, xs)" "(stk, loc, pc, xcp)"
     arbitrary: v xs stk loc pc xcp and vs xs stk loc pc xcp rule: bisim1_bisims1.inducts)
   case bisim1Val thus ?case by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2Val simp add: exec_move_def)
 next
   case (bisim1LAss2 V e xs)
   have "\<tau>Exec_mover_a P t (V:=e) h ([], xs, Suc (length (compE2 e)), None) ([Unit], xs, Suc (Suc (length (compE2 e))), None)"
     by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2LAssRed2 simp add: nth_append exec_move_def)
   with bisim1LAss2 show ?case by simp
 next
   case (bisim1AAss4 a i e xs)
   have "\<tau>Exec_mover_a P t (a\<lfloor>i\<rceil> := e) h ([], xs, Suc (length (compE2 a) + length (compE2 i) + length (compE2 e)), None) ([Unit], xs, Suc (Suc (length (compE2 a) + length (compE2 i) + length (compE2 e))), None)"
     by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2AAssRed simp add: nth_append exec_move_def)
   with bisim1AAss4 show ?case by(simp add: ac_simps)
 next
   case (bisim1FAss3 e F D e2 xs)
   have "\<tau>Exec_mover_a P t (e\<bullet>F{D} := e2) h ([], xs, Suc (length (compE2 e) + length (compE2 e2)), None) ([Unit], xs, Suc (Suc (length (compE2 e) + length (compE2 e2))), None)"
     by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2FAssRed simp add: nth_append exec_move_def)
   with bisim1FAss3 show ?case by simp
 next
   case (bisim1Sync6 V e1 e2 v xs)
   have "\<tau>Exec_mover_a P t (sync\<^bsub>V\<^esub> (e1) e2) h ([v], xs, 5 + length (compE2 e1) + length (compE2 e2), None)
                                         ([v], xs, 9 + length (compE2 e1) + length (compE2 e2), None)"
     by(rule \<tau>Execr1step)(auto intro: exec_instr \<tau>move2Sync6 simp add: exec_move_def)
   with bisim1Sync6 show ?case by(auto simp add: eval_nat_numeral)
 next
   case (bisim1Seq2 e2 stk loc pc xcp e1 v xs)
   from \<open>Suc (length (compE2 e1) + pc) < length (compE2 (e1;; e2))\<close> have pc: "pc < length (compE2 e2)" by simp
   with \<open>pc < length (compE2 e2) \<Longrightarrow> xs = loc \<and> xcp = None \<and> \<tau>Exec_mover_a P t e2 h (stk, xs, pc, None) ([v], xs, length (compE2 e2), None)\<close>
   have "xs = loc" "xcp = None"
     "\<tau>Exec_mover_a P t e2 h (stk, xs, pc, None) ([v], xs, length (compE2 e2), None)" by auto
   moreover 
   hence "\<tau>Exec_mover_a P t (e1;;e2) h (stk, xs, Suc (length (compE2 e1) + pc), None) ([v], xs, Suc (length (compE2 e1) + length (compE2 e2)), None)"
     by -(rule Seq_\<tau>ExecrI2)
   ultimately show ?case by(simp)
 next
   case (bisim1CondThen e1 stk loc pc xcp e e2 v xs)
   from \<open>P, e1, h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close>
   have "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
 
   have e: "\<tau>Exec_mover_a P t (if (e) e1 else e2) h
                      ([v], xs, Suc (length (compE2 e) + (length (compE2 e1))), None)
                      ([v], xs, length (compE2 (if (e) e1 else e2)), None)" 
     by(rule \<tau>Execr1step)(auto simp add: nth_append exec_move_def intro!: exec_instr \<tau>move2CondThenExit)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     with \<open>pc < length (compE2 e1)
          \<Longrightarrow> xs = loc \<and> xcp = None \<and> \<tau>Exec_mover_a P t e1 h (stk, xs, pc, None) ([v], xs, length (compE2 e1), None)\<close>
     have s: "xs = loc" "xcp = None"
       and "\<tau>Exec_mover_a P t e1 h (stk, xs, pc, None) ([v], xs, length (compE2 e1), None)" by auto
     hence "\<tau>Exec_mover_a P t (if (e) e1 else e2) h
                      (stk, xs, Suc (length (compE2 e) + pc), None)
                      ([v], xs, Suc (length (compE2 e) + length (compE2 e1)), None)"
       by -(rule Cond_\<tau>ExecrI2)
     with e True s show ?thesis by(simp)
   next
     case False
     with \<open>pc \<le> length (compE2 e1)\<close> have pc: "pc = length (compE2 e1)" by auto
     with \<open>P, e1, h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close>
     have "stk = [v]" "xs = loc" "xcp = None" by(auto dest: bisim1_Val_length_compE2D)
     with pc e show ?thesis by(simp)
   qed
 next
   case (bisim1CondElse e2 stk loc pc xcp e e1 v xs)
   from \<open>P, e2, h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close>
   have "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
 
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case True
     with \<open>pc < length (compE2 e2)
          \<Longrightarrow> xs = loc \<and> xcp = None \<and> \<tau>Exec_mover_a P t e2 h (stk, xs, pc, None) ([v], xs, length (compE2 e2), None)\<close>
     have s: "xs = loc" "xcp = None"
       and e: "\<tau>Exec_mover_a P t e2 h (stk, xs, pc, None) ([v], xs, length (compE2 e2), None)" by auto
     from e have "\<tau>Exec_mover_a P t (if (e) e1 else e2) h (stk, xs, Suc (Suc (length (compE2 e) + length (compE2 e1) + pc)), None) ([v], xs, Suc (Suc (length (compE2 e) + length (compE2 e1) + length (compE2 e2))), None)"
       by(rule Cond_\<tau>ExecrI3)
     with True s show ?thesis by(simp add: add.assoc)
   next
     case False
     with \<open>pc \<le> length (compE2 e2)\<close> have pc: "pc = length (compE2 e2)" by auto
     with \<open>P, e2, h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close>
     have "stk = [v]" "xs = loc" "xcp = None" by(auto dest: bisim1_Val_length_compE2D)
     with pc show ?thesis by(simp add: add.assoc)
   qed
 next
   case (bisim1While7 c e xs)
   have "\<tau>Exec_mover_a P t (while (c) e) h
                    ([], xs, Suc (Suc (Suc (length (compE2 c) + length (compE2 e)))), None)
                    ([Unit], xs, length (compE2 (while (c) e)), None)"
     by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2While4 simp add: nth_append exec_move_def)
   thus ?case by(simp)
 next
   case (bisims1List1 e e' xs stk loc pc xcp es)
   from \<open>e' # es = map Val vs\<close> obtain v vs' where [simp]: "vs = v # vs'" "e' = Val v" "es = map Val vs'" by auto
   from \<open>P,e,h \<turnstile> (e',xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close>
   have length: "pc \<le> length (compE2 e)" by(auto dest: bisim1_pc_length_compE2)
   hence "xs = loc \<and> xcp = None \<and> \<tau>Exec_mover_a P t e h (stk, xs, pc, None) ([v], xs, length (compE2 e), None)"
   proof(cases "pc < length (compE2 e)")
     case True
     with \<open>\<lbrakk>e' = Val v; pc < length (compE2 e)\<rbrakk> \<Longrightarrow> xs = loc \<and> xcp = None \<and> \<tau>Exec_mover_a P t e h (stk, xs, pc, None) ([v], xs, length (compE2 e), None)\<close>
     show ?thesis by auto
   next
     case False
     with length have pc: "pc = length (compE2 e)" by auto
     with \<open>P,e,h \<turnstile> (e',xs) \<leftrightarrow> (stk,loc,pc,xcp)\<close> have "stk = [v]" "xs = loc" "xcp = None"
       by(auto dest: bisim1_Val_length_compE2D)
     with pc show ?thesis by(auto)
   qed
   hence s: "xs = loc" "xcp = None"
     and exec1: "\<tau>Exec_mover_a P t e h (stk, xs, pc, None) ([v], xs, length (compE2 e), None)" by auto
   from exec1 have "\<tau>Exec_movesr_a P t (e # es) h (stk, xs, pc, None) ([v], xs, length (compE2 e), None)"
     by(auto intro: \<tau>Exec_mover_\<tau>Exec_movesr)
   moreover have "\<tau>Exec_movesr_a P t (map Val vs') h ([], xs, 0, None) (rev vs', xs, length (compEs2 (map Val vs')), None)"
     by(rule \<tau>Exec_movesr_map_Val)
   hence "\<tau>Exec_movesr_a P t ([e] @ map Val vs') h ([] @ [v], xs, length (compEs2 [e]) + 0, None) (rev vs' @ [v], xs, length (compEs2 [e]) + length (compEs2 (map Val vs')), None)"
     by -(rule append_\<tau>Exec_movesr, auto)
   ultimately show ?case using s by(auto)
 next
   case (bisims1List2 es es' xs stk loc pc xcp e v)
   from \<open>Val v # es' = map Val vs\<close> obtain vs' where [simp]: "vs = v # vs'" "es' = map Val vs'" by auto
   from \<open>P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc,xcp)\<close>
   have length: "pc \<le> length (compEs2 es)" by(auto dest: bisims1_pc_length_compEs2)
   hence "xs = loc \<and> xcp = None \<and> \<tau>Exec_movesr_a P t es h (stk, xs, pc, None) (rev vs', xs, length (compEs2 es), None)"
   proof(cases "pc < length (compEs2 es)")
     case True
     with \<open>\<lbrakk>es' = map Val vs'; pc < length (compEs2 es)\<rbrakk> \<Longrightarrow> xs = loc \<and> xcp = None \<and> \<tau>Exec_movesr_a P t es h (stk, xs, pc, None)
       (rev vs', xs, length (compEs2 es), None)\<close>
     show ?thesis by auto
   next
     case False
     with length have pc: "pc = length (compEs2 es)" by auto
     with \<open>P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc,xcp)\<close> have "stk = rev vs'" "xs = loc" "xcp = None"
       by(auto dest: bisims1_Val_length_compEs2D)
     with pc show ?thesis by(auto)
   qed
   hence s: "xs = loc" "xcp = None"
     and exec1: "\<tau>Exec_movesr_a P t es h (stk, xs, pc, None) (rev vs', xs, length (compEs2 es), None)" by auto
   from exec1 have "\<tau>Exec_movesr_a P t ([e] @ es) h (stk @ [v], xs, length (compEs2 [e]) + pc, None) (rev vs' @ [v], xs, length (compEs2 [e]) + length (compEs2 es), None)"
     by -(rule append_\<tau>Exec_movesr, auto)
   thus ?case using s by(auto)
 qed(auto)
 
 lemma bisim1Val2D1:
   assumes bisim: "P, e, h \<turnstile> (Val v,xs) \<leftrightarrow> (stk,loc,pc,xcp)"
   shows "xcp = None \<and> xs = loc \<and> \<tau>Exec_mover_a P t e h (stk, loc, pc, xcp) ([v], loc, length (compE2 e), None)"
 proof -
   from bisim have "xcp = None" "xs = loc" by(auto dest: bisim_Val_loc_eq_xcp_None)
   moreover 
   have "\<tau>Exec_mover_a P t e h (stk, loc, pc, xcp) ([v], loc, length (compE2 e), None)"
   proof(cases "pc < length (compE2 e)")
     case True
     from bisim1_Val_\<tau>Exec_move[OF bisim True] show ?thesis by auto
   next
     case False
     from bisim have "pc \<le> length (compE2 e)" by(auto dest: bisim1_pc_length_compE2)
     with False have "pc = length (compE2 e)" by auto
     with bisim have "stk = [v]" "loc = xs" "xcp=None" by(auto dest: bisim1_Val_length_compE2D)
     with \<open>pc = length (compE2 e)\<close> show ?thesis by(auto)
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma bisim1_Throw_\<tau>Exec_movet:
   "\<lbrakk> P, e, h \<turnstile> (Throw a,xs) \<leftrightarrow> (stk,loc,pc,None) \<rbrakk>
   \<Longrightarrow> \<exists>pc'. \<tau>Exec_movet_a P t e h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and>
       P, e, h \<turnstile> (Throw a,xs) \<leftrightarrow> ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and> xs = loc"
 
   and bisims1_Throw_\<tau>Exec_movest:
   "\<lbrakk> P, es, h \<turnstile>  (map Val vs @ Throw a # es',xs) [\<leftrightarrow>] (stk,loc,pc,None) \<rbrakk>
   \<Longrightarrow> \<exists>pc'. \<tau>Exec_movest_a P t es h (stk, loc, pc, None) (Addr a # rev vs, loc, pc', \<lfloor>a\<rfloor>) \<and>
       P, es, h \<turnstile> (map Val vs @ Throw a # es',xs) [\<leftrightarrow>] (Addr a # rev vs, loc, pc', \<lfloor>a\<rfloor>) \<and> xs = loc"
 proof(induct e "n :: nat" "Throw a :: 'addr expr1" xs stk loc pc "None :: 'addr option"
     and es "n :: nat" "map Val vs @ Throw a # es' :: 'addr expr1 list" xs stk loc pc "None :: 'addr option"
     arbitrary: and vs rule: bisim1_bisims1_inducts_split)
   case (bisim1Sync9 e1 n e2 V xs)
   let ?pc = "8 + length (compE2 e1) + length (compE2 e2)"
   have "\<tau>Exec_movet_a P t (sync\<^bsub>V\<^esub> (e1) e2) h ([Addr a], xs, ?pc, None) ([Addr a], xs, ?pc, \<lfloor>a\<rfloor>)"
     by(rule \<tau>Exect1step)(auto intro: exec_instr \<tau>move2_\<tau>moves2.intros simp add: is_Ref_def exec_move_def)
   moreover
   have "P,sync\<^bsub>V\<^esub> (e1) e2,h \<turnstile> (Throw a,xs) \<leftrightarrow> ([Addr a],xs,?pc,\<lfloor>a\<rfloor>)" by(rule bisim1Sync10)
   ultimately show ?case by auto
 next
   case (bisim1Seq2 e2 n xs stk loc pc e1)
   then obtain pc' where "\<tau>Exec_movet_a P t e2 h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>)"
     "P, e2, h \<turnstile> (Throw a,xs) \<leftrightarrow> ([Addr a],loc,pc',\<lfloor>a\<rfloor>)" "xs = loc" by auto
   thus ?case by(auto intro: Seq_\<tau>ExectI2 bisim1_bisims1.bisim1Seq2)
 next
   case (bisim1CondThen e1 n xs stk loc pc e e2)
   then obtain pc' where exec: "\<tau>Exec_movet_a P t e1 h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>)"
     and bisim: "P, e1, h \<turnstile> (Throw a,xs) \<leftrightarrow> ([Addr a],loc,pc',\<lfloor>a\<rfloor>)" and s: "xs = loc" by auto
   from exec have "\<tau>Exec_movet_a P t (if (e) e1 else e2) h (stk, loc, Suc (length (compE2 e) + pc), None) ([Addr a], loc, Suc (length (compE2 e) + pc'), \<lfloor>a\<rfloor>)"
     by(rule Cond_\<tau>ExectI2)
   moreover from bisim
   have "P, if (e) e1 else e2, h \<turnstile> (Throw a, xs) \<leftrightarrow> ([Addr a], loc, Suc (length (compE2 e) + pc'), \<lfloor>a\<rfloor>)"
     by(rule bisim1_bisims1.bisim1CondThen)
   ultimately show ?case using s by(auto)
 next
   case (bisim1CondElse e2 n xs stk loc pc e e1)
   then obtain pc' where exec: "\<tau>Exec_movet_a P t e2 h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>)"
     and bisim: "P, e2, h \<turnstile> (Throw a, xs ) \<leftrightarrow> ([Addr a], loc, pc', \<lfloor>a\<rfloor>)" and s: "xs = loc" by auto
   let "?pc pc" = "Suc (Suc (length (compE2 e) + length (compE2 e1) + pc))"
   from exec have "\<tau>Exec_movet_a P t (if (e) e1 else e2) h (stk, loc, (?pc pc), None) ([Addr a], loc, ?pc pc', \<lfloor>a\<rfloor>)"
     by(rule Cond_\<tau>ExectI3)
   moreover from bisim
   have "P, if (e) e1 else e2, h \<turnstile> (Throw a, xs ) \<leftrightarrow> ([Addr a], loc, ?pc pc', \<lfloor>a\<rfloor>)"
     by(rule bisim1_bisims1.bisim1CondElse)
   ultimately show ?case using s by auto
 next
   case (bisim1Throw1 e n xs stk loc pc)
   note bisim = \<open>P, e, h \<turnstile> (addr a, xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   hence s: "xs = loc" 
     and exec: "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) ([Addr a], loc, length (compE2 e), None)"
     by(auto dest: bisim1Val2D1)
   from exec have "\<tau>Exec_mover_a P t (throw e) h (stk, loc, pc, None) ([Addr a], loc, length (compE2 e), None)"
     by(rule Throw_\<tau>ExecrI)
   also have "\<tau>Exec_movet_a P t (throw e) h ([Addr a], loc, length (compE2 e), None) ([Addr a], loc, length (compE2 e), \<lfloor>a\<rfloor>)"
     by(rule \<tau>Exect1step, auto intro: exec_instr \<tau>move2Throw2 simp add: is_Ref_def exec_move_def)
   also have "P, throw e, h \<turnstile> (Throw a, loc ) \<leftrightarrow> ([Addr a], loc, length (compE2 e), \<lfloor>a\<rfloor>)"
     by(rule bisim1Throw2)
   ultimately show ?case using s by auto
 next
   case (bisims1List1 e n e' xs stk loc pc es vs)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   show ?case
   proof(cases "is_val e'")
     case True
     with \<open>e' # es = map Val vs @ Throw a # es'\<close> obtain v vs' where "vs = v # vs'" "e' = Val v"
       and es: "es = map Val vs' @ Throw a # es'" by(auto simp add: Cons_eq_append_conv)
     with bisim have "P,e,h \<turnstile> (Val v, xs) \<leftrightarrow> (stk, loc, pc, None)" by simp
     from bisim1Val2D1[OF this] have [simp]: "xs = loc"
       and exec: "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       by auto
     from exec have "\<tau>Exec_movesr_a P t (e # es) h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       by(rule \<tau>Exec_mover_\<tau>Exec_movesr)
     also from es \<open>es = map Val vs' @ Throw a # es'
          \<Longrightarrow> \<exists>pc'. \<tau>Exec_movest_a P t es h ([], loc, 0, None) (Addr a # rev vs', loc, pc', \<lfloor>a\<rfloor>) \<and>
            P,es,h \<turnstile> (map Val vs' @ Throw a # es', loc) [\<leftrightarrow>] (Addr a # rev vs', loc, pc', \<lfloor>a\<rfloor>) \<and> loc = loc\<close>
     obtain pc' where execes: "\<tau>Exec_movest_a P t es h ([], loc, 0, None) (Addr a # rev vs', loc, pc', \<lfloor>a\<rfloor>)"
       and bisim': "P,es,h \<turnstile> (map Val vs' @ Throw a # es', loc) [\<leftrightarrow>] (Addr a # rev vs', loc, pc', \<lfloor>a\<rfloor>)" by auto
     from append_\<tau>Exec_movest[OF _ execes, of "[v]" "[e]"]
     have "\<tau>Exec_movest_a P t (e # es) h ([v], loc, length (compE2 e), None) (Addr a # rev vs' @ [v], loc, length (compE2 e) + pc', \<lfloor>a\<rfloor>)" by simp
     also from bisims1List2[OF bisim', of e v] es \<open>e' = Val v\<close> \<open>vs = v # vs'\<close>
     have "P,e # es,h \<turnstile> (e' # es, xs) [\<leftrightarrow>] ((Addr a # rev vs), loc, length (compE2 e) + pc', \<lfloor>a\<rfloor>)" by simp
     ultimately show ?thesis using \<open>vs = v # vs'\<close> es \<open>e' = Val v\<close> by auto
   next
     case False
     with \<open>e' # es = map Val vs @ Throw a # es'\<close> have [simp]: "e' = Throw a" "es = es'" "vs = []"
       by(auto simp add: Cons_eq_append_conv)
     from \<open>e' = Throw a \<Longrightarrow> \<exists>pc'. \<tau>Exec_movet_a P t e h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and> P,e,h \<turnstile> (Throw a, xs ) \<leftrightarrow> ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and> xs = loc\<close>
     obtain pc' where "\<tau>Exec_movet_a P t e h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>)"
       and bisim: "P,e,h \<turnstile> (Throw a, xs ) \<leftrightarrow> ([Addr a], loc, pc', \<lfloor>a\<rfloor>)" and s: "xs = loc" by auto
     hence "\<tau>Exec_movest_a P t (e # es) h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>)"
       by-(rule \<tau>Exec_movet_\<tau>Exec_movest)
     moreover from bisim
     have "P,e#es,h \<turnstile> (Throw a#es,xs) [\<leftrightarrow>] ([Addr a],loc,pc',\<lfloor>a\<rfloor>)" by(rule bisim1_bisims1.bisims1List1)
     ultimately show ?thesis using s by auto
   qed
 next
   case (bisims1List2 es n es'' xs stk loc pc e v)
   note IH = \<open>\<And>vs. es'' = map Val vs @ Throw a # es'
     \<Longrightarrow> \<exists>pc'. \<tau>Exec_movest_a P t es h (stk, loc, pc, None) (Addr a # rev vs, loc, pc', \<lfloor>a\<rfloor>) \<and>
            P,es,h \<turnstile> (map Val vs @ Throw a # es',xs) [\<leftrightarrow>] (Addr a # rev vs,loc,pc',\<lfloor>a\<rfloor>) \<and> xs = loc\<close>
   from \<open>Val v # es'' = map Val vs @ Throw a # es'\<close>
   obtain vs' where [simp]: "vs = v # vs'" "es'' = map Val vs' @ Throw a # es'" by(auto simp add: Cons_eq_append_conv)
   from IH[OF \<open>es'' = map Val vs' @ Throw a # es'\<close>]
   obtain pc' where exec: "\<tau>Exec_movest_a P t es h (stk, loc, pc, None) (Addr a # rev vs', loc, pc', \<lfloor>a\<rfloor>)"
     and bisim: "P,es,h \<turnstile> (map Val vs' @ Throw a # es',xs) [\<leftrightarrow>] (Addr a # rev vs',loc,pc',\<lfloor>a\<rfloor>)"
     and [simp]: "xs = loc" by auto
   from append_\<tau>Exec_movest[OF _ exec, of "[v]" "[e]"]
   have "\<tau>Exec_movest_a P t (e # es) h (stk @ [v], loc, length (compE2 e) + pc, None) (Addr a # rev vs, loc, length (compE2 e) + pc', \<lfloor>a\<rfloor>)" by simp
   moreover from bisim 
   have "P,e#es,h \<turnstile> (Val v # map Val vs' @ Throw a # es',xs) [\<leftrightarrow>] ((Addr a # rev vs')@[v],loc,length (compE2 e) + pc',\<lfloor>a\<rfloor>)"
     by(rule bisim1_bisims1.bisims1List2)
   ultimately show ?case by(auto)
 qed(auto)
 
 lemma bisim1_Throw_\<tau>Exec_mover:
   "\<lbrakk> P, e, h \<turnstile> (Throw a,xs) \<leftrightarrow> (stk,loc,pc,None) \<rbrakk>
   \<Longrightarrow> \<exists>pc'. \<tau>Exec_mover_a P t e h (stk, loc, pc, None) ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and>
       P, e, h \<turnstile> (Throw a,xs) \<leftrightarrow> ([Addr a], loc, pc', \<lfloor>a\<rfloor>) \<and> xs = loc"
 by(drule bisim1_Throw_\<tau>Exec_movet)(blast intro: tranclp_into_rtranclp)
 
 lemma bisims1_Throw_\<tau>Exec_movesr:
   "\<lbrakk> P, es, h \<turnstile>  (map Val vs @ Throw a # es',xs) [\<leftrightarrow>] (stk,loc,pc,None) \<rbrakk>
   \<Longrightarrow> \<exists>pc'. \<tau>Exec_movesr_a P t es h (stk, loc, pc, None) (Addr a # rev vs, loc, pc', \<lfloor>a\<rfloor>) \<and>
       P, es, h \<turnstile> (map Val vs @ Throw a # es',xs) [\<leftrightarrow>] (Addr a # rev vs, loc, pc', \<lfloor>a\<rfloor>) \<and> xs = loc"
 by(drule bisims1_Throw_\<tau>Exec_movest)(blast intro: tranclp_into_rtranclp)
 
 declare split_beta [simp]
 
 lemma bisim1_inline_call_Throw:
   "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None); call1 e' = \<lfloor>(a, M, vs)\<rfloor>;
      compE2 e ! pc = Invoke M n0; pc < length (compE2 e) \<rbrakk>
   \<Longrightarrow> n0 = length vs \<and> P,e,h \<turnstile> (inline_call (Throw A) e', xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>A\<rfloor>)"
   (is "\<lbrakk> _; _; _; _ \<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc")
 
   and bisims1_inline_calls_Throw:
   "\<lbrakk> P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, None); calls1 es' = \<lfloor>(a, M, vs)\<rfloor>;
      compEs2 es ! pc = Invoke M n0; pc < length (compEs2 es) \<rbrakk>
   \<Longrightarrow> n0 = length vs \<and> P,es,h \<turnstile> (inline_calls (Throw A) es', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>A\<rfloor>)"
   (is "\<lbrakk> _; _; _; _ \<rbrakk> \<Longrightarrow> ?concls es n es' xs pc stk loc")
 proof(induct e "n :: nat" e' xs stk loc pc "None :: 'addr option"
         and es "n :: nat" es' xs stk loc pc "None :: 'addr option"
       rule: bisim1_bisims1_inducts_split)
   case (bisim1BinOp1 e1 n e' xs stk loc pc e2 bop)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e1 ! pc = Invoke M n0; pc < length (compE2 e1) \<rbrakk>
               \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 (e1 \<guillemotleft>bop\<guillemotright> e2) ! pc = Invoke M n0\<close>
   note call = \<open>call1 (e' \<guillemotleft>bop\<guillemotright> e2) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e1)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1BinOp1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e1)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e1)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e1)" by(cases "pc < length (compE2 e1)") auto
     from call ins show ?thesis by simp
   qed
 next
   case bisim1BinOp2 thus ?case
     by(auto split: if_split_asm bop.split_asm dest: bisim1_bisims1.bisim1BinOp2)
 next
   case (bisim1AAcc1 A n a' xs stk loc pc i)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M, vs)\<rfloor>; compE2 A ! pc = Invoke M n0; pc < length (compE2 A) \<rbrakk>
               \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil>) ! pc = Invoke M n0\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil>) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val a'")
     case False
     with bisim1 call have "pc < length (compE2 A)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1AAcc1)
   next
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 A)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 A)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 A)" by(cases "pc < length (compE2 A)") auto
     from call ins show ?thesis by simp
   qed
 next
   case bisim1AAcc2 thus ?case
     by(auto split: if_split_asm dest: bisim1_bisims1.bisim1AAcc2)
 next
   case (bisim1AAss1 A n a' xs stk loc pc i e)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M, vs)\<rfloor>; compE2 A ! pc = Invoke M n0; pc < length (compE2 A) \<rbrakk>
               \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil> := e) ! pc = Invoke M n0\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil> := e) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val a'")
     case False
     with bisim1 call have "pc < length (compE2 A)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1AAss1)
   next
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 A)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 A)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 A)" by(cases "pc < length (compE2 A)") auto
     from call ins show ?thesis by simp
   qed
 next
   case (bisim1AAss2 i n i' xs stk loc pc A e v)
   note IH1 = \<open>\<lbrakk>call1 i' = \<lfloor>(a, M, vs)\<rfloor>; compE2 i ! pc = Invoke M n0; pc < length (compE2 i) \<rbrakk>
               \<Longrightarrow> ?concl i n i' xs pc stk loc\<close>
   note bisim1 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil> := e) ! (length (compE2 A) + pc) = Invoke M n0\<close>
   note call = \<open>call1 (Val v\<lfloor>i'\<rceil> := e) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val i'")
     case False
     with bisim1 call have "pc < length (compE2 i)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1AAss2)
   next
     case True
     then obtain v where [simp]: "i' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 i)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 i)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 i)" by(cases "pc < length (compE2 i)") auto
     from call ins show ?thesis by simp
   qed
 next
   case bisim1AAss3 thus ?case
     by(auto split: if_split_asm nat.split_asm simp add: nth_Cons dest: bisim1_bisims1.bisim1AAss3)
 next
   case (bisim1FAss1 e n e' xs stk loc pc e2 F D)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e ! pc = Invoke M n0; pc < length (compE2 e) \<rbrakk>
               \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 (e\<bullet>F{D} := e2) ! pc = Invoke M n0\<close>
   note call = \<open>call1 (e'\<bullet>F{D} := e2) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1FAss1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e)" by(cases "pc < length (compE2 e)") auto
     from call ins show ?thesis by simp
   qed
 next
   case bisim1FAss2 thus ?case
     by(auto split: if_split_asm nat.split_asm simp add: nth_Cons dest: bisim1_bisims1.bisim1FAss2)
 next
   case (bisim1CAS1 E n e' xs stk loc pc e2 e3 D F)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 E ! pc = Invoke M n0; pc < length (compE2 E) \<rbrakk>
               \<Longrightarrow> ?concl E n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,E,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 _ ! pc = Invoke M n0\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 E)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1CAS1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 E)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 E)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 E)" by(cases "pc < length (compE2 E)") auto
     from call ins show ?thesis by simp
   qed
 next
   case (bisim1CAS2 e2 n e2' xs stk loc pc e1 e3 D F v)
   note IH1 = \<open>\<lbrakk>call1 e2' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e2 ! pc = Invoke M n0; pc < length (compE2 e2) \<rbrakk>
               \<Longrightarrow> ?concl e2 n e2' xs pc stk loc\<close>
   note bisim1 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note ins = \<open>compE2 _ ! (length (compE2 e1) + pc) = Invoke M n0\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M, vs)\<rfloor>\<close>
   show ?case
   proof(cases "is_val e2'")
     case False
     with bisim1 call have "pc < length (compE2 e2)"
       by(auto intro: bisim1_call_pcD)
     with call ins IH1 False show ?thesis
       by(auto simp add: nth_append intro: bisim1_bisims1.bisim1CAS2)
   next
     case True
     then obtain v where [simp]: "e2' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e2)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e2)"
       with bisim1 ins have False
         by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e2)" by(cases "pc < length (compE2 e2)") auto
     from call ins show ?thesis by simp
   qed
 next
   case (bisim1Call1 obj n obj' xs stk loc pc ps M')
   note IH1 = \<open>\<lbrakk>call1 obj' = \<lfloor>(a, M, vs)\<rfloor>; compE2 obj ! pc = Invoke M n0;
               pc < length (compE2 obj) \<rbrakk>
               \<Longrightarrow> ?concl obj n obj' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>calls1 ps = \<lfloor>(a, M, vs)\<rfloor>; compEs2 ps ! 0 = Invoke M n0; 0 < length (compEs2 ps) \<rbrakk>
              \<Longrightarrow> ?concls ps n ps xs 0 [] xs\<close>
   note ins = \<open>compE2 (obj\<bullet>M'(ps)) ! pc = Invoke M n0\<close>
   note bisim1 = \<open>P,obj,h \<turnstile> (obj', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (obj'\<bullet>M'(ps)) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   thus ?case
   proof(cases rule: call1_callE)
     case CallObj
     with bisim1 call have "pc < length (compE2 obj)" by(auto intro: bisim1_call_pcD)
     with call ins CallObj IH1 show ?thesis
       by(auto intro: bisim1_bisims1.bisim1Call1)
   next
     case (CallParams v)
     from bisim1 have "pc \<le> length (compE2 obj)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 obj)"
       with bisim1 ins CallParams have False by(auto dest: bisim_Val_pc_not_Invoke) }
     ultimately have [simp]: "pc = length (compE2 obj)" by(cases "pc < length (compE2 obj)") auto
     with bisim1 CallParams have [simp]: "stk = [v]" "loc = xs" by(auto dest: bisim1_Val_length_compE2D)
     from IH2[of loc] CallParams ins
     show ?thesis
       apply(clarsimp simp add: compEs2_map_Val is_vals_conv split: if_split_asm)
       apply(drule bisim1_bisims1.bisim1CallParams)
       apply(auto simp add: neq_Nil_conv)
       done
   next
     case [simp]: Call
     from bisim1 have "pc \<le> length (compE2 obj)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 obj)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 obj)" by(cases "pc < length (compE2 obj)") auto
     with ins have [simp]: "vs = []" by(auto simp add: nth_append compEs2_map_Val split: if_split_asm)
     from bisim1 have [simp]: "stk = [Addr a]" "xs = loc" by(auto dest: bisim1_Val_length_compE2D)
     from ins show ?thesis by(auto intro: bisim1CallThrow[of "[]" "[]", simplified])
   qed
 next
   case (bisim1CallParams ps n ps' xs stk loc pc obj M' v)
   note IH2 = \<open>\<lbrakk>calls1 ps' = \<lfloor>(a, M, vs)\<rfloor>; compEs2 ps ! pc = Invoke M n0; pc < length (compEs2 ps) \<rbrakk>
              \<Longrightarrow> ?concls ps n ps' xs pc stk loc\<close>
   note ins = \<open>compE2 (obj\<bullet>M'(ps)) ! (length (compE2 obj) + pc) = Invoke M n0\<close>
   note bisim2 = \<open>P,ps,h \<turnstile> (ps', xs) [\<leftrightarrow>] (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v\<bullet>M'(ps')) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   thus ?case
   proof(cases rule: call1_callE)
     case CallObj thus ?thesis by simp
   next
     case (CallParams v')
     hence [simp]: "v' = v" and call': "calls1 ps' = \<lfloor>(a, M, vs)\<rfloor>" by auto
     from bisim2 call' have "pc < length (compEs2 ps)" by(auto intro: bisims1_calls_pcD)
     with IH2 CallParams ins show ?thesis
       by(auto simp add: is_vals_conv split: if_split_asm intro: bisim1_bisims1.bisim1CallParams)
   next
     case Call
     hence [simp]: "v = Addr a" "M' = M" "ps' = map Val vs" by auto
     from bisim2 have "pc \<le> length (compEs2 ps)" by(auto dest: bisims1_pc_length_compEs2)
     moreover {
       assume pc: "pc < length (compEs2 ps)"
       with bisim2 ins have False by(auto dest: bisims_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compEs2 ps)" by(cases "pc < length (compEs2 ps)") auto
     from bisim2 have [simp]: "stk = rev vs" "xs = loc" by(auto dest: bisims1_Val_length_compEs2D)
     from bisim2 have "length ps = length vs" by(auto dest: bisims1_lengthD)
     with ins show ?thesis by(auto intro: bisim1CallThrow)
   qed
 next
   case (bisims1List1 e n e' xs stk loc pc es)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e ! pc = Invoke M n0; pc < length (compE2 e) \<rbrakk>
               \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>calls1 es = \<lfloor>(a, M, vs)\<rfloor>; compEs2 es ! 0 = Invoke M n0; 0 < length (compEs2 es) \<rbrakk>
              \<Longrightarrow> ?concls es n es xs 0 [] xs\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>calls1 (e' # es) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compEs2 (e # es) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis
       by(auto simp add: nth_append split_beta intro: bisim1_bisims1.bisims1List1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e)" by(cases "pc < length (compE2 e)") auto
     with bisim1 have [simp]: "stk = [v]" "loc = xs" by(auto dest: bisim1_Val_length_compE2D)
     from call have "es \<noteq> []" by(cases es) simp_all
     with IH2[of loc] call ins
     show ?thesis by(auto split: if_split_asm dest: bisims1List2)
   qed
 qed(auto split: if_split_asm bop.split_asm intro: bisim1_bisims1.intros dest: bisim1_pc_length_compE2)
 
 lemma bisim1_max_stack: "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> length stk \<le> max_stack e"
   and bisims1_max_stacks: "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, xcp) \<Longrightarrow> length stk \<le> max_stacks es"
 apply(induct "(e', xs)" "(stk, loc, pc, xcp)" and "(es', xs)" "(stk, loc, pc, xcp)"
   arbitrary: e' xs stk loc pc xcp and es' xs stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(auto simp add: max_stack1[simplified] max_def max_stacks_ge_length)
 apply(drule sym, simp add: max_stacks_ge_length, drule sym, simp, rule le_trans[OF max_stacks_ge_length], simp)
 done
 
 inductive bisim1_fr :: "'addr J1_prog \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 \<times> 'addr locals1 \<Rightarrow> 'addr frame \<Rightarrow> bool"
 for P :: "'addr J1_prog" and h :: 'heap
 where
   "\<lbrakk> P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>body\<rfloor> in D;
      P,blocks1 0 (Class D#Ts) body, h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, None);
      call1 e = \<lfloor>(a, M', vs)\<rfloor>;
      max_vars e \<le> length xs \<rbrakk>
   \<Longrightarrow> bisim1_fr P h (e, xs) (stk, loc, C, M, pc)"
 
 declare bisim1_fr.intros [intro]
 declare bisim1_fr.cases [elim]
 
 lemma bisim1_fr_hext_mono:
   "\<lbrakk> bisim1_fr P h exs fr; hext h h' \<rbrakk> \<Longrightarrow>  bisim1_fr P h' exs fr"
 by(auto intro: bisim1_hext_mono)
 
 lemma bisim1_max_vars: "P,E,h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, xcp) \<Longrightarrow> max_vars E \<ge> max_vars e"
   and bisims1_max_varss: "P,Es,h \<turnstile> (es,xs) [\<leftrightarrow>] (stk,loc,pc,xcp) \<Longrightarrow> max_varss Es \<ge> max_varss es"
 apply(induct E "(e, xs)" "(stk, loc, pc, xcp)" and Es "(es, xs)" "(stk, loc, pc, xcp)"
   arbitrary: e xs stk loc pc xcp and es xs stk loc pc xcp rule: bisim1_bisims1.inducts)
 apply(auto)
 done
 
 lemma bisim1_call_\<tau>Exec_move:
   "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None); call1 e' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e' \<le> length xs; \<not> contains_insync e \<rbrakk>
   \<Longrightarrow> \<exists>pc' loc' stk'. \<tau>Exec_mover_a P t e h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None) \<and>
                      pc' < length (compE2 e) \<and> compE2 e ! pc' = Invoke M' (length vs) \<and>
                      P,e,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)"
   (is "\<lbrakk> _; _; _; _ \<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc")
 
   and bisims1_calls_\<tau>Exec_moves:
   "\<lbrakk> P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk, loc, pc, None); calls1 es' = \<lfloor>(a, M', vs)\<rfloor>;
      n + max_varss es' \<le> length xs; \<not> contains_insyncs es \<rbrakk>
   \<Longrightarrow> \<exists>pc' stk' loc'. \<tau>Exec_movesr_a P t es h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None) \<and>
                      pc' < length (compEs2 es) \<and> compEs2 es ! pc' = Invoke M' (length vs) \<and>
                      P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (rev vs @ Addr a # stk', loc', pc', None)"
   (is "\<lbrakk>_; _; _; _ \<rbrakk> \<Longrightarrow> ?concls es n es' xs pc stk loc")
 proof(induct e "n :: nat" e' xs stk loc pc xcp\<equiv>"None :: 'addr option"
     and es "n :: nat" es' xs stk loc pc xcp\<equiv>"None :: 'addr option"
     rule: bisim1_bisims1_inducts_split)
   case bisim1Val2 thus ?case by auto
 next
   case bisim1New thus ?case by auto
 next
   case bisim1NewArray thus ?case
     by auto (fastforce intro: bisim1_bisims1.bisim1NewArray elim!: NewArray_\<tau>ExecrI intro!: exI)
 next
   case bisim1Cast thus ?case
     by(auto)(fastforce intro: bisim1_bisims1.bisim1Cast elim!: Cast_\<tau>ExecrI intro!: exI)+
 next
   case bisim1InstanceOf thus ?case
     by(auto)(fastforce intro: bisim1_bisims1.bisim1InstanceOf elim!: InstanceOf_\<tau>ExecrI intro!: exI)+
 next
   case bisim1Val thus ?case by auto
 next
   case bisim1Var thus ?case by auto
 next
   case (bisim1BinOp1 e1 n e' xs stk loc pc e2 bop)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e' \<le> length xs; \<not> contains_insync e1 \<rbrakk> \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 e2 = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e2 \<le> length xs; \<not> contains_insync e2 \<rbrakk> \<Longrightarrow> ?concl e2 n e2 xs 0 [] xs\<close>
   note call = \<open>call1 (e' \<guillemotleft>bop\<guillemotright> e2) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (e' \<guillemotleft>bop\<guillemotright> e2) \<le> length xs\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note cs = \<open>\<not> contains_insync (e1 \<guillemotleft>bop\<guillemotright> e2)\<close>
   show ?case
   proof(cases "is_val e'")
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "\<tau>Exec_mover_a P t e1 h (stk, loc, pc, None) ([v], loc, length (compE2 e1), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_mover_a P t (e1\<guillemotleft>bop\<guillemotright>e2) h (stk, loc, pc, None) ([v], loc, length (compE2 e1), None)"
       by-(rule BinOp_\<tau>ExecrI1)
     also from call IH2[of loc] len cs  obtain pc' stk' loc'
       where exec: "\<tau>Exec_mover_a P t e2 h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compE2 e2 ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e2)"
       and bisim': "P,e2,h \<turnstile> (e2, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
     from BinOp_\<tau>ExecrI2[OF exec, of e1 bop v]
     have "\<tau>Exec_mover_a P t (e1\<guillemotleft>bop\<guillemotright>e2) h ([v], loc, length (compE2 e1), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 e1) + pc', None)" by simp
     also (rtranclp_trans) from bisim'
     have "P,e1\<guillemotleft>bop\<guillemotright>e2,h \<turnstile> (Val v \<guillemotleft>bop\<guillemotright> e2, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e1) + pc', None)"
       by(rule bisim1BinOp2)
     ultimately show ?thesis using ins by fastforce
   next
     case False with IH1 len False call cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1BinOp1 elim!: BinOp_\<tau>ExecrI1 intro!: exI)
   qed
 next
   case (bisim1BinOp2 e2 n e' xs stk loc pc e1 bop v1)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
   from exec have "\<tau>Exec_mover_a P t (e1 \<guillemotleft>bop\<guillemotright> e2) h (stk @ [v1], loc, length (compE2 e1) + pc, None)
                                               ((rev vs @ Addr a # stk') @ [v1], loc', length (compE2 e1) + pc', None)"
     by(rule BinOp_\<tau>ExecrI2)
   moreover from bisim'
   have "P,e1 \<guillemotleft>bop\<guillemotright> e2,h \<turnstile> (Val v1 \<guillemotleft>bop\<guillemotright> e', xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v1], loc', length (compE2 e1) + pc', None)"
     by(rule bisim1_bisims1.bisim1BinOp2)
   ultimately show ?case using pc' by(fastforce)
 next
   case bisim1LAss1 thus ?case
     by(auto)(fastforce intro: bisim1_bisims1.bisim1LAss1 elim!: LAss_\<tau>ExecrI intro!: exI)
 next
   case bisim1LAss2 thus ?case by simp
 next
   case (bisim1AAcc1 A n a' xs stk loc pc i)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars a' \<le> length xs; \<not> contains_insync A\<rbrakk> \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 i = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars i \<le> length xs; \<not> contains_insync i\<rbrakk> \<Longrightarrow> ?concl i n i xs 0 [] xs\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil>) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (a'\<lfloor>i\<rceil>) \<le> length xs\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note cs = \<open>\<not> contains_insync (A\<lfloor>i\<rceil>)\<close>
   show ?case
   proof(cases "is_val a'")
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "\<tau>Exec_mover_a P t A h (stk, loc, pc, None) ([v], loc, length (compE2 A), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil>) h (stk, loc, pc, None) ([v], loc, length (compE2 A), None)"
       by-(rule AAcc_\<tau>ExecrI1)
     also from call IH2[of loc] len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_mover_a P t i h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compE2 i ! pc' = Invoke M' (length vs)" "pc' < length (compE2 i)"
       and bisim': "P,i,h \<turnstile> (i, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
     from AAcc_\<tau>ExecrI2[OF exec, of A v]
     have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil>) h ([v], loc, length (compE2 A), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 A) + pc', None)" by simp
     also (rtranclp_trans) from bisim'
     have "P,A\<lfloor>i\<rceil>,h \<turnstile> (Val v\<lfloor>i\<rceil>, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 A) + pc', None)"
       by(rule bisim1AAcc2)
     ultimately show ?thesis using ins by fastforce
   next
     case False with IH1 len False call cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1AAcc1 elim!: AAcc_\<tau>ExecrI1 intro!: exI)
   qed
 next
   case (bisim1AAcc2 i n i' xs stk loc pc A v)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 i)" "compE2 i ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t i h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,i,h \<turnstile> (i', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
   from exec have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil>) h (stk @ [v], loc, length (compE2 A) + pc, None)
                                        ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 A) + pc', None)"
     by(rule AAcc_\<tau>ExecrI2)
   moreover from bisim'
   have "P,A\<lfloor>i\<rceil>,h \<turnstile> (Val v\<lfloor>i'\<rceil>, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 A) + pc', None)"
     by(rule bisim1_bisims1.bisim1AAcc2)
   ultimately show ?case using pc' by(fastforce)
 next
   case (bisim1AAss1 A n a' xs stk loc pc i e)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars a' \<le> length xs; \<not> contains_insync A \<rbrakk> \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 i = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars i \<le> length xs; \<not> contains_insync i\<rbrakk> \<Longrightarrow> ?concl i n i xs 0 [] xs\<close>
   note IH3 = \<open>\<And>xs. \<lbrakk>call1 e = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e \<le> length xs; \<not> contains_insync e\<rbrakk> \<Longrightarrow> ?concl e n e xs 0 [] xs\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil> := e) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (a'\<lfloor>i\<rceil> := e) \<le> length xs\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note cs = \<open>\<not> contains_insync (A\<lfloor>i\<rceil> := e)\<close>
   show ?case
   proof(cases "is_val a'")
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "\<tau>Exec_mover_a P t A h (stk, loc, pc, None) ([v], loc, length (compE2 A), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence exec: "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h (stk, loc, pc, None) ([v], loc, length (compE2 A), None)"
       by-(rule AAss_\<tau>ExecrI1)
     show ?thesis
     proof(cases "is_val i")
       case True
       then obtain v' where [simp]: "i = Val v'" by auto
       note exec also from bisim2
       have "\<tau>Exec_mover_a P t i h ([], loc, 0, None) ([v'], loc, length (compE2 i), None)"
         by(auto dest!: bisim1Val2D1)
       from AAss_\<tau>ExecrI2[OF this, of A e v]
       have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h ([v], loc, length (compE2 A), None) ([v', v], loc, length (compE2 A) + length (compE2 i), None)" by simp
       also (rtranclp_trans) from call IH3[of loc] len cs obtain pc' stk' loc'
         where exec: "\<tau>Exec_mover_a P t e h ([], loc, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
         and ins: "compE2 e ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e)"
         and bisim': "P,e,h \<turnstile> (e, loc) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
       from AAss_\<tau>ExecrI3[OF exec, of A i v' v]
       have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h ([v', v], loc, length (compE2 A) + length (compE2 i), None)
                         ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)" by simp
       also (rtranclp_trans) from bisim'
       have "P,A\<lfloor>i\<rceil> := e,h \<turnstile> (Val v\<lfloor>Val v'\<rceil> := e, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)"
         by - (rule bisim1AAss3, simp)
       ultimately show ?thesis using ins by fastforce
     next
       case False
       note exec also from False call IH2[of loc] len cs obtain pc' stk' loc'
         where exec: "\<tau>Exec_mover_a P t i h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
         and ins: "compE2 i ! pc' = Invoke M' (length vs)" "pc' < length (compE2 i)"
         and bisim': "P,i,h \<turnstile> (i, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
       from AAss_\<tau>ExecrI2[OF exec, of A e v]
       have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h ([v], loc, length (compE2 A), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 A) + pc', None)" by simp
       also (rtranclp_trans) from bisim'
       have "P,A\<lfloor>i\<rceil> := e,h \<turnstile> (Val v\<lfloor>i\<rceil> := e, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 A) + pc', None)"
         by(rule bisim1AAss2)
       ultimately show ?thesis using ins False by(fastforce intro!: exI)
     qed
   next
     case False with IH1 len False call cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1AAss1 elim!: AAss_\<tau>ExecrI1 intro!: exI)
   qed
 next
   case (bisim1AAss2 i n i' xs stk loc pc A e v)
   note IH2 = \<open>\<lbrakk>call1 i' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars i' \<le> length xs; \<not> contains_insync i\<rbrakk> \<Longrightarrow> ?concl i n i' xs pc stk loc\<close>
   note IH3 = \<open>\<And>xs. \<lbrakk>call1 e = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e \<le> length xs; \<not> contains_insync e\<rbrakk> \<Longrightarrow> ?concl e n e xs 0 [] xs\<close>
   note call = \<open>call1 (Val v\<lfloor>i'\<rceil> := e) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (Val v\<lfloor>i'\<rceil> := e) \<le> length xs\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note cs = \<open>\<not> contains_insync (A\<lfloor>i\<rceil> := e)\<close>
   show ?case
   proof(cases "is_val i'")
     case True
     then obtain v' where [simp]: "i' = Val v'" by auto
     from bisim2 have exec: "\<tau>Exec_mover_a P t i h (stk, loc, pc, None) ([v'], loc, length (compE2 i), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     from AAss_\<tau>ExecrI2[OF exec, of A e v]
     have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h (stk @ [v], loc, length (compE2 A) + pc, None) ([v', v], loc, length (compE2 A) + length (compE2 i), None)" by simp
     also from call IH3[of loc] len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_mover_a P t e h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compE2 e ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e)"
       and bisim': "P,e,h \<turnstile> (e, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
     from AAss_\<tau>ExecrI3[OF exec, of A i v' v]
     have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil> := e) h ([v', v], loc, length (compE2 A) + length (compE2 i), None)
                        ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)" by simp
     also (rtranclp_trans) from bisim'
     have "P,A\<lfloor>i\<rceil> := e,h \<turnstile> (Val v\<lfloor>Val v'\<rceil> := e, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)"
       by(rule bisim1AAss3)
     ultimately show ?thesis using ins by(fastforce intro!: exI)
   next
     case False
     with IH2 len call cs obtain pc' loc' stk'
       where ins: "pc' < length (compE2 i)" "compE2 i ! pc' = Invoke M' (length vs)"
       and exec: "\<tau>Exec_mover_a P t i h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and bisim': "P,i,h \<turnstile> (i', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
     from bisim' have "P,A\<lfloor>i\<rceil> := e,h \<turnstile> (Val v\<lfloor>i'\<rceil> := e, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 A) + pc', None)"
       by(rule bisim1_bisims1.bisim1AAss2)
     with AAss_\<tau>ExecrI2[OF exec, of A e v] ins False show ?thesis by(auto intro!: exI)
   qed
 next
   case (bisim1AAss3 e n e' xs stk loc pc A i v v')
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e)" "compE2 e ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
   from exec have "\<tau>Exec_mover_a P t (A\<lfloor>i\<rceil>:=e) h (stk @ [v', v], loc, length (compE2 A) + length (compE2 i) + pc, None)
                                        ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)"
     by(rule AAss_\<tau>ExecrI3)
   moreover from bisim'
   have "P,A\<lfloor>i\<rceil> := e,h \<turnstile> (Val v\<lfloor>Val v'\<rceil> := e', xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 A) + length (compE2 i) + pc', None)"
     by(rule bisim1_bisims1.bisim1AAss3)
   ultimately show ?case using pc' by(fastforce intro!: exI)
 next
   case bisim1AAss4 thus ?case by simp
 next
   case bisim1ALength thus ?case
     by(auto)(fastforce intro: bisim1_bisims1.bisim1ALength elim!: ALength_\<tau>ExecrI intro!: exI)
 next
   case bisim1FAcc thus ?case
     by(auto)(fastforce intro: bisim1_bisims1.bisim1FAcc elim!: FAcc_\<tau>ExecrI intro!: exI)
 next
   case (bisim1FAss1 e n e' xs stk loc pc e2 F D)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e' \<le> length xs; \<not> contains_insync e\<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 e2 = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e2 \<le> length xs; \<not> contains_insync e2\<rbrakk> \<Longrightarrow> ?concl e2 n e2 xs 0 [] xs\<close>
   note call = \<open>call1 (e'\<bullet>F{D} := e2) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (e'\<bullet>F{D} := e2) \<le> length xs\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note cs = \<open>\<not> contains_insync (e\<bullet>F{D} := e2)\<close>
   show ?case
   proof(cases "is_val e'")
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_mover_a P t (e\<bullet>F{D} := e2) h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       by-(rule FAss_\<tau>ExecrI1)
     also from call IH2[of loc] len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_mover_a P t e2 h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compE2 e2 ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e2)"
       and bisim': "P,e2,h \<turnstile> (e2, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
     from FAss_\<tau>ExecrI2[OF exec, of e F D v]
     have "\<tau>Exec_mover_a P t (e\<bullet>F{D} := e2) h ([v], loc, length (compE2 e), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 e) + pc', None)" by simp
     also (rtranclp_trans) from bisim'
     have "P,e\<bullet>F{D} := e2,h \<turnstile> (Val v\<bullet>F{D} := e2, xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e) + pc', None)"
       by(rule bisim1FAss2)
     ultimately show ?thesis using ins by fastforce
   next
     case False with IH1 len False call cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1FAss1 elim!: FAss_\<tau>ExecrI1 intro!: exI)
   qed
 next
   case (bisim1FAss2 e2 n e' xs stk loc pc e F D v)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
   from exec have "\<tau>Exec_mover_a P t (e\<bullet>F{D} := e2) h (stk @ [v], loc, length (compE2 e) + pc, None)
                                        ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e) + pc', None)"
     by(rule FAss_\<tau>ExecrI2)
   moreover from bisim'
   have "P,e\<bullet>F{D} := e2,h \<turnstile> (Val v\<bullet>F{D} := e', xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e) + pc', None)"
     by(rule bisim1_bisims1.bisim1FAss2)
   ultimately show ?case using pc' by(fastforce)
 next
   case bisim1FAss3 thus ?case by simp
 next
   case (bisim1CAS1 e1 n e' xs stk loc pc e2 e3 D F)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e' \<le> length xs; \<not> contains_insync e1 \<rbrakk> \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 e2 = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e2 \<le> length xs; \<not> contains_insync e2\<rbrakk> \<Longrightarrow> ?concl e2 n e2 xs 0 [] xs\<close>
   note IH3 = \<open>\<And>xs. \<lbrakk>call1 e3 = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e3 \<le> length xs; \<not> contains_insync e3\<rbrakk> \<Longrightarrow> ?concl e3 n e3 xs 0 [] xs\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars _ \<le> length xs\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note cs = \<open>\<not> contains_insync _\<close>
   show ?case
   proof(cases "is_val e'")
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "\<tau>Exec_mover_a P t e1 h (stk, loc, pc, None) ([v], loc, length (compE2 e1), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence exec: "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h (stk, loc, pc, None) ([v], loc, length (compE2 e1), None)"
       by-(rule CAS_\<tau>ExecrI1)
     show ?thesis
     proof(cases "is_val e2")
       case True
       then obtain v' where [simp]: "e2 = Val v'" by auto
       note exec also from bisim2
       have "\<tau>Exec_mover_a P t e2 h ([], loc, 0, None) ([v'], loc, length (compE2 e2), None)"
         by(auto dest!: bisim1Val2D1)
       from CAS_\<tau>ExecrI2[OF this, of e1 D F e3]
       have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h ([v], loc, length (compE2 e1), None) ([v', v], loc, length (compE2 e1) + length (compE2 e2), None)" by simp
       also (rtranclp_trans) from call IH3[of loc] len cs obtain pc' stk' loc'
         where exec: "\<tau>Exec_mover_a P t e3 h ([], loc, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
         and ins: "compE2 e3 ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e3)"
         and bisim': "P,e3,h \<turnstile> (e3, loc) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
       from CAS_\<tau>ExecrI3[OF exec, of e1 D F e2 v' v]
       have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h ([v', v], loc, length (compE2 e1) + length (compE2 e2), None)
                         ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)" by simp
       also (rtranclp_trans) from bisim'
       have "P,e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3),h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', e3), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)"
         by - (rule bisim1CAS3, simp)
       ultimately show ?thesis using ins by fastforce
     next
       case False
       note exec also from False call IH2[of loc] len cs obtain pc' stk' loc'
         where exec: "\<tau>Exec_mover_a P t e2 h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
         and ins: "compE2 e2 ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e2)"
         and bisim': "P,e2,h \<turnstile> (e2, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
       from CAS_\<tau>ExecrI2[OF exec, of e1 D F e3 v]
       have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h ([v], loc, length (compE2 e1), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 e1) + pc', None)" by simp
       also (rtranclp_trans) from bisim'
       have "P,e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3),h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, e2, e3), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e1) + pc', None)"
         by(rule bisim1CAS2)
       ultimately show ?thesis using ins False by(fastforce intro!: exI)
     qed
   next
     case False with IH1 len False call cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1CAS1 elim!: CAS_\<tau>ExecrI1 intro!: exI)
   qed
 next
   case (bisim1CAS2 e2 n e2' xs stk loc pc e1 e3 D F v)
   note IH2 = \<open>\<lbrakk>call1 e2' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e2' \<le> length xs; \<not> contains_insync e2\<rbrakk> \<Longrightarrow> ?concl e2 n e2' xs pc stk loc\<close>
   note IH3 = \<open>\<And>xs. \<lbrakk>call1 e3 = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e3 \<le> length xs; \<not> contains_insync e3\<rbrakk> \<Longrightarrow> ?concl e3 n e3 xs 0 [] xs\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars _ \<le> length xs\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note cs = \<open>\<not> contains_insync _\<close>
   show ?case
   proof(cases "is_val e2'")
     case True
     then obtain v' where [simp]: "e2' = Val v'" by auto
     from bisim2 have exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) ([v'], loc, length (compE2 e2), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     from CAS_\<tau>ExecrI2[OF exec, of e1 D F e3 v]
     have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h (stk @ [v], loc, length (compE2 e1) + pc, None) ([v', v], loc, length (compE2 e1) + length (compE2 e2), None)" by simp
     also from call IH3[of loc] len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_mover_a P t e3 h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compE2 e3 ! pc' = Invoke M' (length vs)" "pc' < length (compE2 e3)"
       and bisim': "P,e3,h \<turnstile> (e3, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
     from CAS_\<tau>ExecrI3[OF exec, of e1 D F e2 v' v]
     have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h ([v', v], loc, length (compE2 e1) + length (compE2 e2), None)
                        ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)" by simp
     also (rtranclp_trans) from bisim'
     have "P,e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3),h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', e3), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)"
       by(rule bisim1CAS3)
     ultimately show ?thesis using ins by(fastforce intro!: exI)
   next
     case False
     with IH2 len call cs obtain pc' loc' stk'
       where ins: "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
       and exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and bisim': "P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
     from bisim' have "P,e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3),h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, e2', e3), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 e1) + pc', None)"
       by(rule bisim1_bisims1.bisim1CAS2)
     with CAS_\<tau>ExecrI2[OF exec, of e1 D F e3 v] ins False show ?thesis by(auto intro!: exI)
   qed
 next
   case (bisim1CAS3 e3 n e3' xs stk loc pc e1 e2 D F v v')
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e3)" "compE2 e3 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e3 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e3,h \<turnstile> (e3', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by fastforce
   from exec have "\<tau>Exec_mover_a P t (e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) h (stk @ [v', v], loc, length (compE2 e1) + length (compE2 e2) + pc, None)
                                     ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)"
     by(rule CAS_\<tau>ExecrI3)
   moreover from bisim'
   have "P,e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3),h \<turnstile> (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', e3'), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v', v], loc', length (compE2 e1) + length (compE2 e2) + pc', None)"
     by(rule bisim1_bisims1.bisim1CAS3)
   ultimately show ?case using pc' by(fastforce intro!: exI)
 next
   case (bisim1Call1 obj n obj' xs stk loc pc ps M)
   note IH1 = \<open>\<lbrakk>call1 obj' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars obj' \<le> length xs; \<not> contains_insync obj\<rbrakk> \<Longrightarrow> ?concl obj n obj' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>calls1 ps = \<lfloor>(a, M', vs)\<rfloor>; n + max_varss ps \<le> length xs; \<not> contains_insyncs ps\<rbrakk> \<Longrightarrow> ?concls ps n ps xs 0 [] xs\<close>
   note len = \<open>n + max_vars (obj'\<bullet>M(ps)) \<le> length xs\<close>
   note bisim1 = \<open>P,obj,h \<turnstile> (obj', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (obj'\<bullet>M(ps)) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note cs = \<open>\<not> contains_insync (obj\<bullet>M(ps))\<close>
   from call show ?case
   proof(cases rule: call1_callE)
     case CallObj
     hence "\<not> is_val obj'" by auto
     with CallObj IH1 len cs show ?thesis
       by(clarsimp)(fastforce intro: bisim1_bisims1.bisim1Call1 elim!: Call_\<tau>ExecrI1 intro!: exI)
   next
     case (CallParams v)
     with bisim1 have "\<tau>Exec_mover_a P t obj h (stk, loc, pc, None) ([v], loc, length (compE2 obj), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h (stk, loc, pc, None) ([v], loc, length (compE2 obj), None)"
       by-(rule Call_\<tau>ExecrI1)
     also from IH2[of loc] CallParams len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_movesr_a P t ps h ([], loc, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compEs2 ps ! pc' = Invoke M' (length vs)" "pc' < length (compEs2 ps)"
       and bisim': "P,ps,h \<turnstile> (ps, xs) [\<leftrightarrow>] (rev vs @ Addr a # stk',loc',pc',None)" by auto
     from Call_\<tau>ExecrI2[OF exec, of obj M v]
     have "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h ([v], loc, length (compE2 obj), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 obj) + pc', None)" by simp
     also (rtranclp_trans)
     have "P,obj\<bullet>M(ps),h \<turnstile> (Val v\<bullet>M(ps), xs) \<leftrightarrow> ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 obj) + pc', None)"
       using bisim' by(rule bisim1CallParams)
     ultimately show ?thesis using ins CallParams by fastforce
   next
     case [simp]: Call
     from bisim1 have "\<tau>Exec_mover_a P t obj h (stk, loc, pc, None) ([Addr a], loc, length (compE2 obj), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h (stk, loc, pc, None) ([Addr a], loc, length (compE2 obj), None)"
       by-(rule Call_\<tau>ExecrI1)
     also have "\<tau>Exec_movesr_a P t ps h ([], xs, 0, None) (rev vs, xs, length (compEs2 ps), None)"
     proof(cases vs)
       case Nil with Call show ?thesis by(auto)
     next
       case Cons with Call bisims1_Val_\<tau>Exec_moves[OF bisims1_refl[of P h "map Val vs" loc]]
       show ?thesis by(auto simp add: bsoks_def)
     qed
     from Call_\<tau>ExecrI2[OF this, of obj M "Addr a"]
     have "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h ([Addr a], loc, length (compE2 obj), None) (rev vs @ [Addr a], xs, length (compE2 obj) + length (compEs2 ps), None)" by simp
     also (rtranclp_trans)
     have "P,ps,h \<turnstile> (map Val vs,xs) [\<leftrightarrow>] (rev vs,xs,length (compEs2 ps),None)"
       by(rule bisims1_map_Val_append[OF bisims1Nil, simplified])(simp_all add: bsoks_def)
     hence "P,obj\<bullet>M(ps),h \<turnstile> (addr a\<bullet>M(map Val vs), xs) \<leftrightarrow> (rev vs @ [Addr a], xs, length (compE2 obj) + length (compEs2 ps), None)"
       by(rule bisim1CallParams)
     ultimately show ?thesis by fastforce
   qed
 next
   case (bisim1CallParams ps n ps' xs stk loc pc obj M v)
   note IH2 = \<open>\<lbrakk>calls1 ps' = \<lfloor>(a, M', vs)\<rfloor>; n + max_varss ps' \<le> length xs; \<not> contains_insyncs ps\<rbrakk> \<Longrightarrow> ?concls ps n ps' xs pc stk loc\<close>
   note bisim2 = \<open>P,ps,h \<turnstile> (ps', xs) [\<leftrightarrow>] (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v\<bullet>M(ps')) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_vars (Val v\<bullet>M(ps')) \<le> length xs\<close>
   note cs = \<open>\<not> contains_insync (obj\<bullet>M(ps))\<close>
   from call show ?case
   proof(cases rule: call1_callE)
     case CallObj thus ?thesis by simp
   next
     case (CallParams v')
     with IH2 len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_movesr_a P t ps h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "pc' < length (compEs2 ps)" "compEs2 ps ! pc' = Invoke M' (length vs)"
       and bisim': "P,ps,h \<turnstile> (ps', xs) [\<leftrightarrow>] (rev vs @ Addr a # stk',loc',pc',None)" by auto
     from exec have "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h (stk @ [v], loc, length (compE2 obj) + pc, None)
                                 ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 obj) + pc', None)"
       by(rule Call_\<tau>ExecrI2)
     moreover have "P,obj\<bullet>M(ps),h \<turnstile> (Val v\<bullet>M(ps'), xs) \<leftrightarrow>
                                   ((rev vs @ Addr a # stk') @ [v], loc', length (compE2 obj) + pc', None)"
       using bisim' by(rule bisim1_bisims1.bisim1CallParams)
     ultimately show ?thesis using ins by fastforce
   next
     case Call
     hence [simp]: "v = Addr a" "ps' = map Val vs" "M' = M" by simp_all
     have "xs = loc \<and> \<tau>Exec_movesr_a P t ps h (stk, loc, pc, None) (rev vs, loc, length (compEs2 ps), None)"
     proof(cases "pc < length (compEs2 ps)")
       case True with bisim2 show ?thesis by(auto dest: bisims1_Val_\<tau>Exec_moves)
     next
       case False
       from bisim2 have "pc \<le> length (compEs2 ps)" by(rule bisims1_pc_length_compEs2)
       with False have "pc = length (compEs2 ps)" by simp
       with bisim2 show ?thesis by(auto dest: bisims1_Val_length_compEs2D)
     qed
     then obtain [simp]: "xs = loc"
       and exec: "\<tau>Exec_movesr_a P t ps h (stk, loc, pc, None) (rev vs, loc, length (compEs2 ps), None)" ..
     from exec have "\<tau>Exec_mover_a P t (obj\<bullet>M(ps)) h (stk @ [v], loc, length (compE2 obj) + pc, None)
                               (rev vs @ [v], loc, length (compE2 obj) + length (compEs2 ps), None)"
       by(rule Call_\<tau>ExecrI2)
     moreover from bisim2 have len: "length ps = length ps'" by(auto dest: bisims1_lengthD)
     moreover have "P,ps,h \<turnstile> (map Val vs,xs) [\<leftrightarrow>] (rev vs,xs,length (compEs2 ps),None)" using len
       by-(rule bisims1_map_Val_append[OF bisims1Nil, simplified], simp_all)
     hence "P,obj\<bullet>M(ps),h \<turnstile> (addr a\<bullet>M(map Val vs), xs) \<leftrightarrow> (rev vs @ [Addr a], xs, length (compE2 obj) + length (compEs2 ps), None)" by(rule bisim1_bisims1.bisim1CallParams)
     ultimately show ?thesis by fastforce
   qed
 next
   case bisim1BlockSome1 thus ?case by simp
 next
   case bisim1BlockSome2 thus ?case by simp
 next
   case (bisim1BlockSome4 e n e' xs stk loc pc V T v)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e)" "compE2 e ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   note Block_\<tau>ExecrI_Some[OF exec, of V T v]
   moreover from bisim' have "P,{V:T=\<lfloor>v\<rfloor>; e},h \<turnstile> ({V:T=None; e'}, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', Suc (Suc pc'), None)"
     by(rule bisim1_bisims1.bisim1BlockSome4)
   ultimately show ?case using pc' by fastforce
 next  
  case (bisim1BlockNone e n e' xs stk loc pc V T)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e)" "compE2 e ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   note Block_\<tau>ExecrI_None[OF exec, of V T]
   moreover from bisim' have "P,{V:T=None; e},h \<turnstile> ({V:T=None; e'}, xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)"
     by(rule bisim1_bisims1.bisim1BlockNone)
   ultimately show ?case using pc' by fastforce
 next
   case bisim1Sync1 thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1Sync1 elim!: Sync_\<tau>ExecrI intro!: exI)
 next
   case bisim1Sync2 thus ?case by simp
 next
   case bisim1Sync3 thus ?case by simp
 next
   case bisim1Sync4 thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1Sync4 elim!: Insync_\<tau>ExecrI intro!: exI)
 next
   case bisim1Sync5 thus ?case by simp
 next
   case bisim1Sync6 thus ?case by simp
 next
   case bisim1Sync7 thus ?case by simp
 next
   case bisim1Sync8 thus ?case by simp
 next
   case bisim1Sync9 thus ?case by simp
 next
   case bisim1InSync thus ?case by simp
 next
   case bisim1Seq1 thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1Seq1 elim!: Seq_\<tau>ExecrI1 intro!: exI)
 next
   case (bisim1Seq2 e2 n e' xs stk loc pc e1)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   from Seq_\<tau>ExecrI2[OF exec, of e1] pc' bisim'
   show ?case by(fastforce intro: bisim1_bisims1.bisim1Seq2 intro!: exI)
 next
   case bisim1Cond1 thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1Cond1 elim!: Cond_\<tau>ExecrI1 intro!: exI)+
 next
   case (bisim1CondThen e1 n e' xs stk loc pc e e2)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e1)" "compE2 e1 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e1 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   from Cond_\<tau>ExecrI2[OF exec] pc' bisim' show ?case
     by(fastforce intro: bisim1_bisims1.bisim1CondThen intro!: exI)
 next
   case (bisim1CondElse e2 n e' xs stk loc pc e e1)
   then obtain pc' loc' stk' where pc': "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_mover_a P t e2 h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   from Cond_\<tau>ExecrI3[OF exec] pc' bisim' show ?case
     by (fastforce intro: bisim1_bisims1.bisim1CondElse intro!: exI)
 next
   case bisim1While1 thus ?case by simp
 next
   case bisim1While3 thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1While3 elim!: While_\<tau>ExecrI1 intro!: exI)+
 next
   case bisim1While4 thus ?case
     by (auto)(fastforce intro!: While_\<tau>ExecrI2 bisim1_bisims1.bisim1While4 exI)+
 next
   case bisim1While6 thus ?case by simp
 next
   case bisim1While7 thus ?case by simp
 next
   case bisim1Throw1 thus ?case
     by (auto)(fastforce intro!: exI bisim1_bisims1.bisim1Throw1 elim!: Throw_\<tau>ExecrI)+
 next
   case bisim1Try thus ?case
     by (auto)(fastforce intro: bisim1_bisims1.bisim1Try elim!: Try_\<tau>ExecrI1 intro!: exI)+
 next
   case (bisim1TryCatch1 e n a' xs stk loc pc C' C e2 V)
   note IH2 = \<open>\<And>xs. \<lbrakk>call1 e2 = \<lfloor>(a, M', vs)\<rfloor>; Suc n + max_vars e2 \<le> length xs; \<not> contains_insync e2 \<rbrakk> \<Longrightarrow> ?concl e2 (Suc V) e2 xs 0 [] xs\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (Throw a', xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a'\<rfloor>)\<close>
   note bisim2 = \<open>\<And>xs. P,e2,h \<turnstile> (e2, xs) \<leftrightarrow> ([], xs, 0, None)\<close>
   note len = \<open>n + max_vars {V:Class C=None; e2} \<le> length (xs[V := Addr a'])\<close>
   note cs = \<open>\<not> contains_insync (try e catch(C V) e2)\<close>
   from bisim1 have [simp]: "xs = loc" by(auto dest: bisim1_ThrowD)
   from len have "\<tau>Exec_mover_a P t (try e catch(C V) e2) h ([Addr a'], loc, Suc (length (compE2 e)), None) ([], loc[V := Addr a'], Suc (Suc (length (compE2 e))), None)"
     by -(rule \<tau>Execr1step,auto simp add: exec_move_def intro: \<tau>move2_\<tau>moves2.intros exec_instr)
   also from IH2[of "loc[V := Addr a']"] len \<open>call1 {V:Class C=None; e2} = \<lfloor>(a, M', vs)\<rfloor>\<close> cs
   obtain pc' loc' stk'
     where exec: "\<tau>Exec_mover_a P t e2 h ([], loc[V := Addr a'], 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and ins: "pc' < length (compE2 e2)" "compE2 e2 ! pc' = Invoke M' (length vs)"
     and bisim': "P,e2,h \<turnstile> (e2, loc[V := Addr a']) \<leftrightarrow> (rev vs @ Addr a # stk', loc', pc', None)" by auto
   from Try_\<tau>ExecrI2[OF exec, of e C V]
   have "\<tau>Exec_mover_a P t (try e catch(C V) e2) h ([], loc[V := Addr a'], Suc (Suc (length (compE2 e))), None) (rev vs @ Addr a # stk', loc', Suc (Suc (length (compE2 e) + pc')), None)" by simp
   also from bisim'
   have "P,try e catch(C V) e2,h \<turnstile> ({V:Class C=None; e2}, loc[V := Addr a']) \<leftrightarrow> (rev vs @ Addr a # stk', loc', (Suc (Suc (length (compE2 e) + pc'))), None)"
     by(rule bisim1TryCatch2)
   ultimately show ?case using ins by fastforce
 next
   case bisim1TryCatch2 thus ?case
     by (auto)(fastforce intro!: Try_\<tau>ExecrI2 bisim1_bisims1.bisim1TryCatch2 exI)+
 next
   case bisims1Nil thus ?case by simp
 next
   case (bisims1List1 e n e' xs stk loc pc es)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M', vs)\<rfloor>; n + max_vars e' \<le> length xs; \<not> contains_insync e\<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note IH2 = \<open>\<And>xs. \<lbrakk>calls1 es = \<lfloor>(a, M', vs)\<rfloor>; n + max_varss es \<le> length xs; \<not> contains_insyncs es\<rbrakk> \<Longrightarrow> ?concls es n es xs 0 [] xs\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>calls1 (e' # es) = \<lfloor>(a, M', vs)\<rfloor>\<close>
   note len = \<open>n + max_varss (e' # es) \<le> length xs\<close>
   note cs = \<open>\<not> contains_insyncs (e # es)\<close>
   show ?case
   proof(cases "is_val e'")
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     with bisim1 have "\<tau>Exec_mover_a P t e h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       and [simp]: "xs = loc" by(auto dest!: bisim1Val2D1)
     hence "\<tau>Exec_movesr_a P t (e # es) h (stk, loc, pc, None) ([v], loc, length (compE2 e), None)"
       by-(rule \<tau>Exec_mover_\<tau>Exec_movesr)
     also from call IH2[of loc] len cs obtain pc' stk' loc'
       where exec: "\<tau>Exec_movesr_a P t es h ([], xs, 0, None) (rev vs @ Addr a # stk', loc', pc', None)"
       and ins: "compEs2 es ! pc' = Invoke M' (length vs)" "pc' < length (compEs2 es)"
       and bisim': "P,es,h \<turnstile> (es, xs) [\<leftrightarrow>] (rev vs @ Addr a # stk',loc',pc',None)" by auto
     from append_\<tau>Exec_movesr[OF _ exec, of "[v]" "[e]"]
     have "\<tau>Exec_movesr_a P t (e # es) h ([v], loc, length (compE2 e), None) (rev vs @ Addr a # (stk' @ [v]), loc', length (compE2 e) + pc', None)"
       by simp
     also (rtranclp_trans) from bisim'
     have "P,e # es,h \<turnstile> (Val v # es, xs) [\<leftrightarrow>]
                          ((rev vs @ Addr a # stk') @ [v],loc',length (compE2 e) + pc',None)"
       by(rule bisim1_bisims1.bisims1List2)
     ultimately show ?thesis using ins by fastforce
   next
     case False
     with call IH1 len cs show ?thesis
       by (auto)(fastforce intro!: \<tau>Exec_mover_\<tau>Exec_movesr bisim1_bisims1.bisims1List1 exI)+
   qed
 next
   case (bisims1List2 es n es' xs stk loc pc e v)
   then obtain pc' stk' loc' where pc': "pc' < length (compEs2 es)" "compEs2 es ! pc' = Invoke M' (length vs)"
     and exec: "\<tau>Exec_movesr_a P t es h (stk, loc, pc, None) (rev vs @ Addr a # stk', loc', pc', None)"
     and bisim': "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (rev vs @ Addr a # stk', loc', pc', None)" by auto
   note append_\<tau>Exec_movesr[OF _ exec, of "[v]" "[e]"]
   moreover from bisim'
   have "P,e#es,h \<turnstile> (Val v# es', xs) [\<leftrightarrow>] ((rev vs @ Addr a # stk') @ [v],loc',length (compE2 e) + pc',None)"
     by(rule bisim1_bisims1.bisims1List2)
   ultimately show ?case using pc' by fastforce
 qed 
 
 lemma fixes P :: "'addr J1_prog"
   shows bisim1_inline_call_Val:
   "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None); call1 e' = \<lfloor>(a, M, vs)\<rfloor>;
      compE2 e ! pc = Invoke M n0 \<rbrakk>
     \<Longrightarrow> length stk \<ge> Suc (length vs) \<and> n0 = length vs \<and>
        P,e,h \<turnstile> (inline_call (Val v) e', xs) \<leftrightarrow> (v # drop (Suc (length vs)) stk, loc, Suc pc, None)"
   (is "\<lbrakk> _; _; _ \<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc")
 
   and bisims1_inline_calls_Val:
   "\<lbrakk> P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc,None); calls1 es' = \<lfloor>(a, M, vs)\<rfloor>;
      compEs2 es ! pc = Invoke M n0 \<rbrakk>
     \<Longrightarrow> length stk \<ge> Suc (length vs) \<and> n0 = length vs \<and>
        P,es,h \<turnstile> (inline_calls (Val v) es', xs) [\<leftrightarrow>] (v # drop (Suc (length vs)) stk,loc,Suc pc,None)"
   (is "\<lbrakk> _; _; _ \<rbrakk> \<Longrightarrow> ?concls es n es' xs pc stk loc")
 proof(induct "(e', xs)" "(stk, loc, pc, None :: 'addr option)"
     and "(es', xs)" "(stk, loc, pc, None :: 'addr option)"
     arbitrary: e' xs stk loc pc and es' xs stk loc pc rule: bisim1_bisims1.inducts)
   case bisim1Val2 thus ?case by simp
 next
   case bisim1New thus ?case by simp
 next
   case bisim1NewArray thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1NewArray)
 next
   case bisim1Cast thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Cast)
 next
   case bisim1InstanceOf thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1InstanceOf)
 next
   case bisim1Val thus ?case by simp
 next
   case bisim1Var thus ?case by simp
 next
   case (bisim1BinOp1 e1 e' xs stk loc pc bop e2)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e1 ! pc = Invoke M n0 \<rbrakk> \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (e' \<guillemotleft>bop\<guillemotright> e2) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (e1 \<guillemotleft>bop\<guillemotright> e2) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e1)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis
       by(auto intro: bisim1_bisims1.bisim1BinOp1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e1)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e1)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e1)" by(cases "pc < length (compE2 e1)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1BinOp2 e2 e' xs stk loc pc e1 bop v1)
   note IH2 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e2 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e2 n e' xs pc stk loc\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v1 \<guillemotleft>bop\<guillemotright> e') = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (e1 \<guillemotleft>bop\<guillemotright> e2) ! (length (compE2 e1) + pc) = Invoke M n0\<close>
   from call bisim2 have pc: "pc < length (compE2 e2)" by(auto intro: bisim1_call_pcD)
   with ins have ins': "compE2 e2 ! pc = Invoke M n0" by(simp)
   from IH2 ins' pc call show ?case by(auto dest: bisim1_bisims1.bisim1BinOp2)
 next
   case bisim1LAss1 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1LAss1)
 next
   case bisim1LAss2 thus ?case by simp
 next
   case (bisim1AAcc1 A a' xs stk loc pc i)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M, vs)\<rfloor>; compE2 A ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil>) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil>) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val a'")
     case False
     with bisim1 call have "pc < length (compE2 A)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis
       by(auto intro: bisim1_bisims1.bisim1AAcc1)
   next
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 A)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 A)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 A)" by(cases "pc < length (compE2 A)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1AAcc2 i i' xs stk loc pc A v)
   note IH2 = \<open>\<lbrakk>call1 i' = \<lfloor>(a, M, vs)\<rfloor>; compE2 i ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl i n i' xs pc stk loc\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v\<lfloor>i'\<rceil>) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil>) ! (length (compE2 A) + pc) = Invoke M n0\<close>
   from call bisim2 have pc: "pc < length (compE2 i)" by(auto intro: bisim1_call_pcD)
   with ins have ins': "compE2 i ! pc = Invoke M n0" by(simp)
   from IH2 ins' pc call show ?case
     by(auto dest: bisim1_bisims1.bisim1AAcc2)
 next
   case (bisim1AAss1 A a' xs stk loc pc i e)
   note IH1 = \<open>\<lbrakk>call1 a' = \<lfloor>(a, M, vs)\<rfloor>; compE2 A ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl A n a' xs pc stk loc\<close>
   note bisim1 = \<open>P,A,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (a'\<lfloor>i\<rceil> := e) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil> := e) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val a'")
     case False
     with bisim1 call have "pc < length (compE2 A)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis by(auto intro: bisim1_bisims1.bisim1AAss1)
   next
     case True
     then obtain v where [simp]: "a' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 A)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 A)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 A)" by(cases "pc < length (compE2 A)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1AAss2 i i' xs stk loc pc A e v)
   note IH2 = \<open>\<lbrakk>call1 i' = \<lfloor>(a, M, vs)\<rfloor>; compE2 i ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl i n i' xs pc stk loc\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v\<lfloor>i'\<rceil> := e) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (A\<lfloor>i\<rceil> := e) ! (length (compE2 A) + pc) = Invoke M n0\<close>
   show ?case
   proof(cases "is_val i'")
     case False
     with bisim2 call have pc: "pc < length (compE2 i)" by(auto intro: bisim1_call_pcD)
     with ins have ins': "compE2 i ! pc = Invoke M n0" by(simp)
     from IH2 ins' pc False call show ?thesis by(auto dest: bisim1_bisims1.bisim1AAss2)
   next
     case True
     then obtain v where [simp]: "i' = Val v" by auto
     from bisim2 have "pc \<le> length (compE2 i)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 i)"
       with bisim2 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 i)" by(cases "pc < length (compE2 i)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1AAss3 e e' xs stk loc pc i A v v')
   note IH2 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note bisim3 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v\<lfloor>Val v'\<rceil> := e') = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (i\<lfloor>A\<rceil> := e) ! (length (compE2 i) + length (compE2 A) + pc) = Invoke M n0\<close>
   from call bisim3 have pc: "pc < length (compE2 e)" by(auto intro: bisim1_call_pcD)
   with ins have ins': "compE2 e ! pc = Invoke M n0" by(simp)
   from IH2 ins' pc call show ?case by(auto dest: bisim1_bisims1.bisim1AAss3)
 next
   case bisim1AAss4 thus ?case by simp
 next
   case bisim1ALength thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1ALength)
 next
   case bisim1FAcc thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1FAcc)
 next
   case (bisim1FAss1 e1 e' xs stk loc pc F D e2)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e1 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (e'\<bullet>F{D} := e2) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (e1\<bullet>F{D} := e2) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e1)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis
       by(auto intro: bisim1_bisims1.bisim1FAss1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e1)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e1)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e1)" by(cases "pc < length (compE2 e1)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1FAss2 e2 e' xs stk loc pc e1 F D v1)
   note IH2 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e2 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e2 n e' xs pc stk loc\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v1\<bullet>F{D} := e') = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (e1\<bullet>F{D} := e2) ! (length (compE2 e1) + pc) = Invoke M n0\<close>
   from call bisim2 have pc: "pc < length (compE2 e2)" by(auto intro: bisim1_call_pcD)
   with ins have ins': "compE2 e2 ! pc = Invoke M n0" by(simp)
   from IH2 ins' pc call show ?case by(auto dest: bisim1_bisims1.bisim1FAss2)
 next
   case bisim1FAss3 thus ?case by simp
 next
   case (bisim1CAS1 e1 e' xs stk loc pc D F e2 E3)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e1 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e1 n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 _ ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e1)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis by(auto intro: bisim1_bisims1.bisim1CAS1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e1)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e1)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e1)" by(cases "pc < length (compE2 e1)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1CAS2 e2 e2' xs stk loc pc e1 D F e3 v)
   note IH2 = \<open>\<lbrakk>call1 e2' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e2 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e2 n e2' xs pc stk loc\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 _ ! (length (compE2 e1) + pc) = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e2'")
     case False
     with bisim2 call have pc: "pc < length (compE2 e2)" by(auto intro: bisim1_call_pcD)
     with ins have ins': "compE2 e2 ! pc = Invoke M n0" by(simp)
     from IH2 ins' pc False call show ?thesis by(auto dest: bisim1_bisims1.bisim1CAS2)
   next
     case True
     then obtain v where [simp]: "e2' = Val v" by auto
     from bisim2 have "pc \<le> length (compE2 e2)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e2)"
       with bisim2 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e2)" by(cases "pc < length (compE2 e2)") auto
     with ins have False by(simp)
     thus ?thesis ..
   qed
 next
   case (bisim1CAS3 e3 e3' xs stk loc pc e1 D F e2 v v')
   note IH2 = \<open>\<lbrakk>call1 e3' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e3 ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e3 n e3' xs pc stk loc\<close>
   note bisim3 = \<open>P,e3,h \<turnstile> (e3', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 _ = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 _ ! (length (compE2 e1) + length (compE2 e2) + pc) = Invoke M n0\<close>
   from call bisim3 have pc: "pc < length (compE2 e3)" by(auto intro: bisim1_call_pcD)
   with ins have ins': "compE2 e3 ! pc = Invoke M n0" by(simp)
   from IH2 ins' pc call show ?case by(auto dest: bisim1_bisims1.bisim1CAS3)
 next
   case (bisim1Call1 obj obj' xs stk loc pc M' ps)
   note IH1 = \<open>\<lbrakk>call1 obj' = \<lfloor>(a, M, vs)\<rfloor>; compE2 obj ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl obj n obj' xs pc stk loc\<close>
   note bisim1 = \<open>P,obj,h \<turnstile> (obj', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>call1 (obj'\<bullet>M'(ps)) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (obj\<bullet>M'(ps)) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val obj'")
     case False
     with call bisim1 have "pc < length (compE2 obj)" by(auto intro: bisim1_call_pcD)
     with call False ins IH1 False show ?thesis
       by(auto intro: bisim1_bisims1.bisim1Call1)
   next
     case True
     then obtain v' where [simp]: "obj' = Val v'" by auto
     from bisim1 have "pc \<le> length (compE2 obj)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 obj)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 obj)" by(cases "pc < length (compE2 obj)") auto
     with ins have [simp]: "ps = []" "M' = M"
       by(auto simp add: nth_append split: if_split_asm)(auto simp add: neq_Nil_conv nth_append)
     from ins call have [simp]: "vs = []" by(auto split: if_split_asm)
     with bisim1 have [simp]: "stk = [v']" "xs = loc" by(auto dest: bisim1_pc_length_compE2D)
     from bisim1Val2[of "length (compE2 (obj\<bullet>M([])))" "obj\<bullet>M([])" P h v loc] call ins
     show ?thesis by(auto simp add: is_val_iff)
   qed
 next
   case (bisim1CallParams ps ps' xs stk loc pc obj M' v')
   note IH2 = \<open>\<lbrakk>calls1 ps' = \<lfloor>(a, M, vs)\<rfloor>; compEs2 ps ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concls ps n ps' xs pc stk loc\<close>
   note bisim = \<open>P,ps,h \<turnstile> (ps', xs) [\<leftrightarrow>] (stk, loc, pc, None)\<close>
   note call = \<open>call1 (Val v'\<bullet>M'(ps')) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compE2 (obj\<bullet>M'(ps)) ! (length (compE2 obj) + pc) = Invoke M n0\<close>
   from call show ?case
   proof(cases rule: call1_callE)
     case CallObj thus ?thesis by simp
   next
     case (CallParams v'')
     hence [simp]: "v'' = v'" and call': "calls1 ps' = \<lfloor>(a, M, vs)\<rfloor>" by simp_all
     from bisim call' have pc: "pc < length (compEs2 ps)" by(rule bisims1_calls_pcD)
     with ins have ins': "compEs2 ps ! pc = Invoke M n0" by(simp add: nth_append)
     with IH2 call' ins pc
     have "P,ps,h \<turnstile> (inline_calls (Val v) ps', xs)
                 [\<leftrightarrow>] (v # drop (Suc (length vs)) stk, loc, Suc pc, None)"
       and len: "Suc (length vs) \<le> length stk" and n0: "n0 = length vs" by auto
     hence "P,obj\<bullet>M'(ps),h \<turnstile> (Val v'\<bullet>M'(inline_calls (Val v) ps'), xs)
                            \<leftrightarrow> ((v # drop (Suc (length vs)) stk) @ [v'], loc, length (compE2 obj) + Suc pc, None)"
       by-(rule bisim1_bisims1.bisim1CallParams)
     thus ?thesis using call' len n0 by(auto simp add: is_vals_conv)
   next
     case Call
     hence [simp]: "v' = Addr a" "M' = M" "ps' = map Val vs" by auto
     from bisim have "pc \<le> length (compEs2 ps)" by(auto dest: bisims1_pc_length_compEs2)
     moreover {
       assume pc: "pc < length (compEs2 ps)"
       with bisim ins have False by(auto dest: bisims_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compEs2 ps)" by(cases "pc < length (compEs2 ps)") auto
     from bisim have [simp]: "stk = rev vs" "xs = loc" by(auto dest: bisims1_Val_length_compEs2D)
     hence "P,obj\<bullet>M(ps),h \<turnstile> (Val v, loc) \<leftrightarrow> ([v], loc, length (compE2 (obj\<bullet>M(ps))), None)" by-(rule bisim1Val2, simp)
     moreover from bisim have "length ps = length ps'" by(rule bisims1_lengthD)
     ultimately show ?thesis using ins by(auto)
   qed
 next
   case bisim1BlockSome1 thus ?case by simp
 next
   case bisim1BlockSome2 thus ?case by simp
 next
   case bisim1BlockSome4 thus ?case
     by(auto intro: bisim1_bisims1.bisim1BlockSome4)
 next
   case bisim1BlockNone thus ?case
     by(auto intro: bisim1_bisims1.bisim1BlockNone)
 next
   case bisim1Sync1 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Sync1)
 next
   case bisim1Sync2 thus ?case by simp
 next
   case bisim1Sync3 thus ?case by simp
 next
   case bisim1Sync4 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 bisim1_bisims1.bisim1Sync4)
 next
   case bisim1Sync5 thus ?case by simp
 next
   case bisim1Sync6 thus ?case by simp
 next
   case bisim1Sync7 thus ?case by simp
 next
   case bisim1Sync8 thus ?case by simp
 next
   case bisim1Sync9 thus ?case by simp
 next
   case bisim1InSync thus ?case by(simp)
 next
   case bisim1Seq1 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Seq1)
 next
   case bisim1Seq2 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2)(fastforce dest: bisim1_bisims1.bisim1Seq2)
 next
   case bisim1Cond1 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Cond1)
 next
   case (bisim1CondThen e1 stk loc pc e e2 e' xs) thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2)
       (fastforce dest: bisim1_bisims1.bisim1CondThen[where e=e and ?e2.0=e2])
 next
   case (bisim1CondElse e2 stk loc pc e e1 e' xs) thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2)
       (fastforce dest: bisim1_bisims1.bisim1CondElse[where e=e and ?e1.0=e1])
 next
   case bisim1While1 thus ?case by simp
 next
   case bisim1While3 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1While3)
 next
   case bisim1While4 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2)(fastforce dest: bisim1_bisims1.bisim1While4)
 next
   case bisim1While6 thus ?case by simp
 next
   case bisim1While7 thus ?case by simp
 next
   case bisim1Throw1 thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Throw1)
 next
   case bisim1Try thus ?case
     by(auto split: if_split_asm dest: bisim1_pc_length_compE2 intro: bisim1_bisims1.bisim1Try)
 next
   case bisim1TryCatch1 thus ?case by simp
 next
   case bisim1TryCatch2 thus ?case
     by(fastforce dest: bisim1_bisims1.bisim1TryCatch2)
 next
   case bisims1Nil thus ?case by simp
 next
   case (bisims1List1 e e' xs stk loc pc es)
   note IH1 = \<open>\<lbrakk>call1 e' = \<lfloor>(a, M, vs)\<rfloor>; compE2 e ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concl e n e' xs pc stk loc\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, None)\<close>
   note call = \<open>calls1 (e' # es) = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note ins = \<open>compEs2 (e # es) ! pc = Invoke M n0\<close>
   show ?case
   proof(cases "is_val e'")
     case False
     with bisim1 call have "pc < length (compE2 e)" by(auto intro: bisim1_call_pcD)
     with call ins False IH1 show ?thesis
       by(auto intro: bisim1_bisims1.bisims1List1)
   next
     case True
     then obtain v where [simp]: "e' = Val v" by auto
     from bisim1 have "pc \<le> length (compE2 e)" by(auto dest: bisim1_pc_length_compE2)
     moreover {
       assume pc: "pc < length (compE2 e)"
       with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke simp add: nth_append) }
     ultimately have [simp]: "pc = length (compE2 e)" by(cases "pc < length (compE2 e)") auto
     with ins call have False by(cases es)(auto)
     thus ?thesis ..
   qed
 next
   case (bisims1List2 es es' xs stk loc pc e v')
   note IH = \<open>\<lbrakk>calls1 es' = \<lfloor>(a, M, vs)\<rfloor>; compEs2 es ! pc = Invoke M n0\<rbrakk> \<Longrightarrow> ?concls es n es' xs pc stk loc\<close>
   note call = \<open>calls1 (Val v' # es') = \<lfloor>(a, M, vs)\<rfloor>\<close>
   note bisim = \<open>P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, None)\<close>
   note ins = \<open>compEs2 (e # es) ! (length (compE2 e) + pc) = Invoke M n0\<close>
   from call have call': "calls1 es' = \<lfloor>(a, M, vs)\<rfloor>" by simp
   with bisim have pc: "pc < length (compEs2 es)" by(rule bisims1_calls_pcD)
   with ins have ins': "compEs2 es ! pc = Invoke M n0" by(simp add: nth_append)
   from IH call ins pc show ?case
     by(auto split: if_split_asm dest: bisim1_bisims1.bisims1List2)
 qed
 
 lemma bisim1_fv: "P,e,h \<turnstile> (e', xs) \<leftrightarrow> s \<Longrightarrow> fv e' \<subseteq> fv e"
   and bisims1_fvs: "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] s \<Longrightarrow> fvs es' \<subseteq> fvs es"
 apply(induct "(e', xs)" s and "(es', xs)" s arbitrary: e' xs and es' xs rule: bisim1_bisims1.inducts)
 apply(auto)
 done
 
 
 lemma bisim1_syncvars: "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> s; syncvars e \<rbrakk> \<Longrightarrow> syncvars e'"
   and bisims1_syncvarss: "\<lbrakk> P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] s; syncvarss es \<rbrakk> \<Longrightarrow> syncvarss es'"
 apply(induct "(e', xs)" s and "(es', xs)" s arbitrary: e' xs and es' xs rule: bisim1_bisims1.inducts)
 apply(auto dest: bisim1_fv)
 done
 
 declare pcs_stack_xlift [simp]
 
 lemma bisim1_Val_\<tau>red1r:
   "\<lbrakk> P, E, h \<turnstile> (e, xs) \<leftrightarrow> ([v], loc, length (compE2 E), None); n + max_vars e \<le> length xs; \<B> E n \<rbrakk> 
   \<Longrightarrow> \<tau>red1r P t h (e, xs) (Val v, loc)"
 
  and bisims1_Val_\<tau>Reds1r:
   "\<lbrakk> P, Es, h \<turnstile> (es, xs) [\<leftrightarrow>] (rev vs, loc, length (compEs2 Es), None); n + max_varss es \<le> length xs; \<B>s Es n \<rbrakk>
    \<Longrightarrow> \<tau>reds1r P t h (es, xs) (map Val vs, loc)"
 proof(induct E n e xs stk\<equiv>"[v]" loc pc\<equiv>"length (compE2 E)" xcp\<equiv>"None::'addr option"
          and Es n es xs stk\<equiv>"rev vs" loc pc\<equiv>"length (compEs2 Es)" xcp\<equiv>"None::'addr option"
       arbitrary: v and vs rule: bisim1_bisims1_inducts_split)
   case bisim1BlockSome2 thus ?case by(simp (no_asm_use))
 next
   case (bisim1BlockSome4 e n e' xs loc pc V T val)
   from \<open>\<B> {V:T=\<lfloor>val\<rfloor>; e} n\<close> have [simp]: "n = V" and "\<B> e (Suc n)" by auto
   note len = \<open>n + max_vars {V:T=None; e'} \<le> length xs\<close>
   hence V: "V < length xs" by simp
   from \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> ([v], loc, pc, None)\<close>
   have lenxs: "length xs = length loc" by(auto dest: bisim1_length_xs)
   note IH = \<open>\<lbrakk>pc = length (compE2 e); Suc n + max_vars e' \<le> length xs; \<B> e (Suc n)\<rbrakk>
              \<Longrightarrow> \<tau>red1r P t h (e', xs) (Val v, loc)\<close>
   with len \<open>Suc (Suc pc) = length (compE2 {V:T=\<lfloor>val\<rfloor>; e})\<close> \<open>\<B> e (Suc n)\<close>
   have "\<tau>red1r P t h (e', xs) (Val v, loc)" by(simp)
   hence "\<tau>red1r P t h ({V:T=None; e'}, xs) ({V:T=None; Val v}, loc)"
     by(rule Block_None_\<tau>red1r_xt)
   thus ?case using V lenxs by(auto elim!: rtranclp.rtrancl_into_rtrancl intro: Red1Block \<tau>move1BlockRed)
 next
   case (bisim1BlockNone e n e' xs loc V T)
   from \<open>\<B> {V:T=None; e} n\<close> have [simp]: "n = V" and "\<B> e (Suc n)" by auto
   note len = \<open>n + max_vars {V:T=None; e'} \<le> length xs\<close>
   hence V: "V < length xs" by simp
   from \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> ([v], loc, length (compE2 {V:T=None; e}), None)\<close>
   have lenxs: "length xs = length loc" by(auto dest: bisim1_length_xs)
   note IH = \<open>\<lbrakk>length (compE2 {V:T=None; e}) = length (compE2 e); Suc n + max_vars e' \<le> length xs; \<B> e (Suc n) \<rbrakk>
               \<Longrightarrow> \<tau>red1r P t h (e', xs) (Val v, loc)\<close>
   with len \<open>\<B> e (Suc n)\<close> have "\<tau>red1r P t h (e', xs) (Val v, loc)" by(simp)
   hence "\<tau>red1r P t h ({V:T=None; e'}, xs) ({V:T=None; Val v}, loc)"
     by(rule Block_None_\<tau>red1r_xt)
   thus ?case using V lenxs by(auto elim!: rtranclp.rtrancl_into_rtrancl intro: Red1Block \<tau>move1BlockRed)
 next
   case (bisim1TryCatch2 e2 n e' xs loc pc e C V)
   from \<open>\<B> (try e catch(C V) e2) n\<close> have [simp]: "n = V" and "\<B> e2 (Suc n)" by auto
   note len = \<open>n + max_vars {V:Class C=None; e'} \<le> length xs\<close>
   hence V: "V < length xs" by simp
   from \<open>P,e2,h \<turnstile> (e', xs) \<leftrightarrow> ([v], loc, pc, None)\<close>
   have lenxs: "length xs = length loc" by(auto dest: bisim1_length_xs)
   note IH = \<open>\<lbrakk>pc = length (compE2 e2); Suc n + max_vars e' \<le> length xs; \<B> e2 (Suc n)\<rbrakk>
              \<Longrightarrow> \<tau>red1r P t h (e', xs) (Val v, loc)\<close>
   with len \<open>Suc (Suc (length (compE2 e) + pc)) = length (compE2 (try e catch(C V) e2))\<close> \<open>\<B> e2 (Suc n)\<close>
   have "\<tau>red1r P t h (e', xs) (Val v, loc)" by(simp)
   hence "\<tau>red1r P t h ({V:Class C=None; e'}, xs) ({V:Class C=None; Val v}, loc)"
     by(rule Block_None_\<tau>red1r_xt)
   thus ?case using V lenxs by(auto elim!: rtranclp.rtrancl_into_rtrancl intro: Red1Block \<tau>move1BlockRed)
 next
   case (bisims1List1 e n e' xs loc es)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (rev vs, loc, length (compEs2 (e # es)), None)\<close>
   then have es: "es = []" and pc: "length (compEs2 (e # es)) = length (compE2 e)"
     by(auto dest: bisim1_pc_length_compE2)
   with bisim obtain val where stk: "rev vs = [val]" and e': "is_val e' \<Longrightarrow> e' = Val val"
     by(auto dest: bisim1_pc_length_compE2D)
   with es pc bisims1List1 have "\<tau>red1r P t h (e', xs) (Val val, loc)" by simp
   with stk es show ?case by(auto intro: \<tau>red1r_inj_\<tau>reds1r)
 next
   case (bisims1List2 es n es' xs stk loc pc e v)
   from \<open>stk @ [v] = rev vs\<close> obtain vs' where vs: "vs = v # vs'" by(cases vs) auto
   with bisims1List2 show ?case by(auto intro: \<tau>reds1r_cons_\<tau>reds1r)
 qed(fastforce dest: bisim1_pc_length_compE2 bisims1_pc_length_compEs2)+
 
 lemma exec_meth_stk_split:
   "\<lbrakk> P,E,h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, xcp);
      exec_meth_d (compP2 P) (compE2 E) (stack_xlift (length STK) (compxE2 E 0 0)) t
                 h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp') \<rbrakk>
   \<Longrightarrow> \<exists>stk''. stk' = stk'' @ STK \<and> exec_meth_d (compP2 P) (compE2 E) (compxE2 E 0 0) t
                                              h (stk, loc, pc, xcp) ta h' (stk'', loc', pc', xcp')"
   (is "\<lbrakk> _; ?exec E stk STK loc pc xcp stk' loc' pc' xcp' \<rbrakk> \<Longrightarrow> ?concl E stk STK loc pc xcp stk' loc' pc' xcp'")
 
   and exec_meth_stk_splits:
   "\<lbrakk> P,Es,h \<turnstile> (es,xs) [\<leftrightarrow>] (stk,loc,pc,xcp);
      exec_meth_d (compP2 P) (compEs2 Es) (stack_xlift (length STK) (compxEs2 Es 0 0)) t
                 h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp') \<rbrakk>
   \<Longrightarrow> \<exists>stk''. stk' = stk'' @ STK \<and> exec_meth_d (compP2 P) (compEs2 Es) (compxEs2 Es 0 0) t
                                              h (stk, loc, pc, xcp) ta h' (stk'', loc', pc', xcp')"
   (is "\<lbrakk> _; ?execs Es stk STK loc pc xcp stk' loc' pc' xcp' \<rbrakk> \<Longrightarrow> ?concls Es stk STK loc pc xcp stk' loc' pc' xcp'")
 proof(induct E "n :: nat" e xs stk loc pc xcp and Es "n :: nat" es xs stk loc pc xcp
     arbitrary: stk' loc' pc' xcp' STK and stk' loc' pc' xcp' STK rule: bisim1_bisims1_inducts_split)
   case bisim1InSync thus ?case by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
 next
   case bisim1Val2 thus ?case by(auto dest: exec_meth_length_compE2_stack_xliftD)
 next
   case bisim1New thus ?case
     by (fastforce elim: exec_meth.cases intro: exec_meth.intros split: if_split_asm cong del: image_cong_simp)
 next
   case bisim1NewThrow thus ?case by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1NewArray e n e' xs stk loc pc xcp T)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (newA T\<lfloor>e\<rceil>) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis
       apply simp
       apply (erule exec_meth.cases)
        apply (auto 4 4 intro: exec_meth.intros split: if_split_asm cong del: image_cong_simp)
       done
   qed
 next
   case (bisim1NewArrayThrow e n a xs stk loc pc T)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (newA T\<lfloor>e\<rceil>) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case bisim1NewArrayFail thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1Cast e n e' xs stk loc pc xcp T)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (Cast T e) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis apply(simp)
       by(erule exec_meth.cases)(auto intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case (bisim1CastThrow e n a xs stk loc pc T)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (Cast T e) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case bisim1CastFail thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1InstanceOf e n e' xs stk loc pc xcp T)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e instanceof T) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis apply(simp)
       by(erule exec_meth.cases)(auto intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case (bisim1InstanceOfThrow e n a xs stk loc pc T)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e instanceof T) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case bisim1Val thus ?case by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case bisim1Var thus ?case by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1BinOp1 e1 n e1' xs stk loc pc xcp e2 bop)
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec e2 [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec (e1 \<guillemotleft>bop\<guillemotright> e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     with exec have "?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 e1)" by simp
     with exec have "pc' \<ge> length (compE2 e1)"
       by(simp add: compxE2_size_convs stack_xlift_compxE2)(auto split: bop.splits elim!: exec_meth_drop_xt_pc)
     then obtain PC where PC: "pc' = PC + length (compE2 e1)"
       by -(rule_tac PC34="pc' - length (compE2 e1)" in that, simp)
     from pc bisim1 obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec pc have "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2)
    (stack_xlift (length STK) (compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0))) t h (stk @ STK, loc, length (compE2 e1) + 0, xcp) ta h' (stk', loc', pc', xcp')"
       by-(rule exec_meth_take, auto)
     hence "?exec e2 [] (v # STK) loc 0 None stk' loc' (pc' - length (compE2 e1)) xcp'"
       using \<open>stk = [v]\<close> \<open>xcp = None\<close>
       by -(rule exec_meth_drop_xt, auto simp add: stack_xlift_compxE2 shift_compxE2)
     from IH2[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')" by auto
     hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ [BinOpInstr bop])
         (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v]) (compxE2 e2 0 0))) t h
         ([] @ [v], loc, length (compE2 e1) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 e1) + PC, xcp')"
       apply -
       apply(rule exec_meth_append)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by(auto)
     thus ?thesis using \<open>stk = [v]\<close> \<open>xcp = None\<close> stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1BinOp2 e2 n e2' xs stk loc pc xcp e1 bop v1)
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e1, xs) \<leftrightarrow> ([], xs, 0, None)\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec (e1 \<guillemotleft>bop\<guillemotright> e2) (stk @ [v1]) STK loc (length (compE2 e1) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case True
     from exec have "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ [BinOpInstr bop])
       (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 e1) + pc, xcp) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
     hence exec': "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2) (stack_xlift (length STK) (compxE2 e1 0 0) @
       shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 e1) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(simp add: True)
     hence "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))) t
       h (stk @ v1 # STK, loc, pc, xcp) ta h' (stk', loc', pc' - length (compE2 e1), xcp')"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     hence "?exec e2 stk (v1 # STK) loc pc xcp stk' loc' (pc' - length (compE2 e1)) xcp'"
       by(simp add: compxE2_stack_xlift_convs)
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 e1), xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length [v1]) (compxE2 e2 0 0)) t h (stk @ [v1], loc, pc, xcp)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 e1), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e1) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ [BinOpInstr bop]) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e1) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length (compE2 e1)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(simp add: stack_xlift_compxE2 shift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 e2)" by simp
     with bisim2 obtain v2 where [simp]: "stk = [v2]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec pc show ?thesis 
       by(fastforce elim: exec_meth.cases split: sum.split_asm intro!: exec_meth.intros)
   qed
 next
   case (bisim1BinOpThrow1 e1 n a xs stk loc pc e2 bop)
   note bisim1 = \<open>P,e1,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e1 \<guillemotleft>bop\<guillemotright> e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 e1)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e1 @ (compE2 e2 @ [BinOpInstr bop]))
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
   hence "?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt)(rule pc)
   from IH1[OF this] show ?case by(auto)
 next
   case (bisim1BinOpThrow2 e2 n a xs stk loc pc e1 bop v1)
   note bisim2 = \<open>P,e2,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e1 \<guillemotleft>bop\<guillemotright> e2) (stk @ [v1]) STK loc (length (compE2 e1) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc < length (compE2 e2)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ [BinOpInstr bop])
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))))
      t h (stk @ v1 # STK, loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence exec': "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2)
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))) t
      h (stk @ v1 # STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc' - length (compE2 e1), xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   hence "?exec e2 stk (v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 e1)) xcp'"
     by(simp add: compxE2_stack_xlift_convs)
   from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 e1), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length [v1]) (compxE2 e2 0 0)) t h (stk @ [v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 e1), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ [BinOpInstr bop]) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have pc': "pc' \<ge> length (compE2 e1)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case bisim1BinOpThrow thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1LAss1 e n e' xs stk loc pc xcp V)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (V := e) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis apply(simp)
       by(erule exec_meth.cases)(auto intro!: exec_meth.intros)
   qed
 next
   case (bisim1LAss2 e n xs V)
   thus ?case by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1LAssThrow e n a xs stk loc pc V)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (V := e) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case (bisim1AAcc1 a n a' xs stk loc pc xcp i)
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec a stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl a stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec i [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,a,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec (a\<lfloor>i\<rceil>) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 a)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 a)")
     case True
     with exec have "?exec a stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 a)" by simp
     with exec have "pc' \<ge> length (compE2 a)"
       by(simp add: compxE2_size_convs stack_xlift_compxE2)(auto elim!: exec_meth_drop_xt_pc)
     then obtain PC where PC: "pc' = PC + length (compE2 a)"
       by -(rule_tac PC34="pc' - length (compE2 a)" in that, simp)
     from pc bisim1 obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec pc have "exec_meth_d (compP2 P) (compE2 a @ compE2 i)
    (stack_xlift (length STK) (compxE2 a 0 0 @ compxE2 i (length (compE2 a)) (Suc 0))) t h (stk @ STK, loc, length (compE2 a) + 0, xcp) ta h' (stk', loc', pc', xcp')"
       by-(rule exec_meth_take, auto)
     hence "?exec i [] (v # STK) loc 0 None stk' loc' (pc' - length (compE2 a)) xcp'"
       using \<open>stk = [v]\<close> \<open>xcp = None\<close>
       by -(rule exec_meth_drop_xt, auto simp add: stack_xlift_compxE2 shift_compxE2)
     from IH2[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')" by auto
     hence "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ [ALoad])
         (compxE2 a 0 0 @ shift (length (compE2 a)) (stack_xlift (length [v]) (compxE2 i 0 0))) t h
         ([] @ [v], loc, length (compE2 a) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 a) + PC, xcp')"
       apply -
       apply(rule exec_meth_append)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by(auto)
     thus ?thesis using \<open>stk = [v]\<close> \<open>xcp = None\<close> stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1AAcc2 i n i' xs stk loc pc xcp a v1)
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec i stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec (a\<lfloor>i\<rceil>) (stk @ [v1]) STK loc (length (compE2 a) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 i)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 i)")
     case True
     from exec have "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ [ALoad])
       (stack_xlift (length STK) (compxE2 a 0 0) @ shift (length (compE2 a)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 a) + pc, xcp) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
     hence exec': "exec_meth_d (compP2 P) (compE2 a @ compE2 i) (stack_xlift (length STK) (compxE2 a 0 0) @
       shift (length (compE2 a)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 a) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(simp add: True)
     hence "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length STK) (compxE2 i 0 (Suc 0))) t
       h (stk @ v1 # STK, loc, pc, xcp) ta h' (stk', loc', pc' - length (compE2 a), xcp')"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     hence "?exec i stk (v1 # STK) loc pc xcp stk' loc' (pc' - length (compE2 a)) xcp'"
       by(simp add: compxE2_stack_xlift_convs)
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 a), xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length [v1]) (compxE2 i 0 0)) t h (stk @ [v1], loc, pc, xcp)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 a), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) (compE2 a @ compE2 i) (compxE2 a 0 0 @ shift (length (compE2 a)) (stack_xlift (length [v1]) (compxE2 i 0 0))) t h (stk @ [v1], loc, length (compE2 a) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 a) + (pc' - length (compE2 a)), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ [ALoad]) (compxE2 a 0 0 @ shift (length (compE2 a)) (stack_xlift (length [v1]) (compxE2 i 0 0))) t h (stk @ [v1], loc, length (compE2 a) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 a) + (pc' - length (compE2 a)), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length (compE2 a)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(simp add: stack_xlift_compxE2 shift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 i)" by simp
     with bisim2 obtain v2 where [simp]: "stk = [v2]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec pc show ?thesis
       by(clarsimp)(erule exec_meth.cases, auto intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case (bisim1AAccThrow1 A n a xs stk loc pc i)
   note bisim1 = \<open>P,A,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (A\<lfloor>i\<rceil>) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 A)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 A @ (compE2 i @ [ALoad]))
      (stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
   hence "?exec A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'" by(rule exec_meth_take_xt)(rule pc)
   from IH1[OF this] show ?case by(auto)
 next
   case (bisim1AAccThrow2 i n a xs stk loc pc A v1)
   note bisim2 = \<open>P,i,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec i stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (A\<lfloor>i\<rceil>) (stk @ [v1]) STK loc (length (compE2 A) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc < length (compE2 i)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ [ALoad])
      (stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence exec': "exec_meth_d (compP2 P) (compE2 A @ compE2 i)
      (stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length STK) (compxE2 i 0 (Suc 0))) t
      h (stk @ v1 # STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc' - length (compE2 A), xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   hence "?exec i stk (v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 A)) xcp'"
     by(simp add: compxE2_stack_xlift_convs)
   from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 A), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length [v1]) (compxE2 i 0 0)) t h (stk @ [v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 A), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 A @ compE2 i) (compxE2 A 0 0 @ shift (length (compE2 A)) (stack_xlift (length [v1]) (compxE2 i 0 0))) t h (stk @ [v1], loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 A) + (pc' - length (compE2 A)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ [ALoad]) (compxE2 A 0 0 @ shift (length (compE2 A)) (stack_xlift (length [v1]) (compxE2 i 0 0))) t h (stk @ [v1], loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 A) + (pc' - length (compE2 A)), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have pc': "pc' \<ge> length (compE2 A)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case bisim1AAccFail thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1AAss1 a n a' xs stk loc pc xcp i e)
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec a stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl a stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec i [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,a,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec (a\<lfloor>i\<rceil> := e) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 a)" by(rule bisim1_pc_length_compE2)
   from exec have exec': "exec_meth_d (compP2 P) (compE2 a @ compE2 i @ compE2 e @ [AStore, Push Unit]) (stack_xlift (length STK) (compxE2 a 0 0) @ shift (length (compE2 a)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0) @ compxE2 e (length (compE2 i)) (Suc (Suc 0))))) t
     h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   show ?case
   proof(cases "pc < length (compE2 a)")
     case True
     with exec' have "?exec a stk STK loc pc xcp stk' loc' pc' xcp'" by(rule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 a)" by simp
     with exec' have "pc' \<ge> length (compE2 a)" by -(erule exec_meth_drop_xt_pc, auto)
     then obtain PC where PC: "pc' = PC + length (compE2 a)"
       by -(rule_tac PC34="pc' - length (compE2 a)" in that, simp)
     from pc bisim1 obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec PC pc
     have "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ compE2 e @ [AStore, Push Unit]) (stack_xlift (length STK) (compxE2 a 0 0 @ shift (length (compE2 a)) (compxE2 i 0 (Suc 0))) @ shift (length (compE2 a @ compE2 i)) (compxE2 e 0 (length STK + Suc (Suc 0)))) t
     h (v # STK, loc, length (compE2 a) + 0, None) ta h' (stk', loc', length (compE2 a) + PC, xcp')" 
       by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
     hence "exec_meth_d (compP2 P) (compE2 a @ compE2 i)
    (stack_xlift (length STK) (compxE2 a 0 0 @ shift (length (compE2 a)) (compxE2 i 0 (Suc 0)))) t h (v # STK, loc, length (compE2 a) + 0, None) ta h' (stk', loc', length (compE2 a) + PC, xcp')"
       by(rule exec_meth_take_xt) simp
     hence "?exec i [] (v # STK) loc 0 None stk' loc' ((length (compE2 a) + PC) - length (compE2 a)) xcp'"
       by -(rule exec_meth_drop_xt, auto simp add: stack_xlift_compxE2 shift_compxE2)
     from IH2[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')" by auto
     hence "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ (compE2 e @ [AStore, Push Unit]))
         ((compxE2 a 0 0 @ shift (length (compE2 a)) (stack_xlift (length [v]) (compxE2 i 0 0))) @
          shift (length (compE2 a @ compE2 i)) (compxE2 e 0 (Suc (Suc 0)))) t h
         ([] @ [v], loc, length (compE2 a) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 a) + PC, xcp')"
       apply -
       apply(rule exec_meth_append_xt)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by(auto)
     thus ?thesis using \<open>stk = [v]\<close> \<open>xcp = None\<close> stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1AAss2 i n i' xs stk loc pc xcp a e v)
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec i stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH3 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec e [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim2 = \<open>P,i,h \<turnstile> (i', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim3 = \<open>P,e,h \<turnstile> (e, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec (a\<lfloor>i\<rceil> := e) (stk @ [v]) STK loc (length (compE2 a) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 i)" by(rule bisim1_pc_length_compE2)
   from exec have exec': "\<And>v'. exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ compE2 e @ [AStore, Push Unit]) ((compxE2 a 0 (length STK) @ shift (length (compE2 a)) (stack_xlift (length (v # STK)) (compxE2 i 0 0))) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length (v' # v # STK)) (compxE2 e 0 0))) t
     h (stk @ v # STK, loc, length (compE2 a) + pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2)
   show ?case
   proof(cases "pc < length (compE2 i)")
     case True with exec'[of arbitrary]
     have exec'': "exec_meth_d (compP2 P) (compE2 a @ compE2 i) (compxE2 a 0 (length STK) @ shift (length (compE2 a)) (stack_xlift (length (v # STK)) (compxE2 i 0 0))) t h (stk @ v # STK, loc, length (compE2 a) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by-(erule exec_meth_take_xt, simp)
     hence "?exec i stk (v # STK) loc pc xcp stk' loc' (pc' - length (compE2 a)) xcp'"
       by(rule exec_meth_drop_xt) auto
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and exec''': "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 a), xcp')" by blast
     from exec''' have "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ compE2 e @ [AStore, Push Unit]) ((compxE2 a 0 0 @ shift (length (compE2 a)) (stack_xlift (length [v]) (compxE2 i 0 0))) @ shift (length (compE2 a @ compE2 i)) (compxE2 e 0 (Suc (Suc 0)))) t h (stk @ [v], loc, length (compE2 a) + pc, xcp) ta h' (stk'' @ [v], loc', length (compE2 a) + (pc' - length (compE2 a)), xcp')"
       apply -
       apply(rule exec_meth_append_xt)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by auto
     moreover from exec'' have "pc' \<ge> length (compE2 a)"
       by(rule exec_meth_drop_xt_pc) auto
     ultimately show ?thesis using stk' by(auto simp add: shift_compxE2 stack_xlift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 i)" by simp
     with exec'[of arbitrary] have "pc' \<ge> length (compE2 a @ compE2 i)"
       by-(erule exec_meth_drop_xt_pc, auto simp add: shift_compxE2 stack_xlift_compxE2)
     then obtain PC where PC: "pc' = PC + length (compE2 a) + length (compE2 i)"
       by -(rule_tac PC34="pc' - length (compE2 a @ compE2 i)" in that, simp)
     from pc bisim2 obtain v' where stk: "stk = [v']" and xcp: "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     from exec'[of v'] 
     have "exec_meth_d (compP2 P) (compE2 e @ [AStore, Push Unit]) (stack_xlift (length (v' # v # STK)) (compxE2 e 0 0)) t
                     h (v' # v # STK, loc, 0, xcp) ta h' (stk', loc', pc' - length (compE2 a @ compE2 i), xcp')"
       unfolding stk pc append_Cons append_Nil
       by -(rule exec_meth_drop_xt, simp only: add_0_right length_append, auto simp add: shift_compxE2 stack_xlift_compxE2)
     with PC xcp have "?exec e [] (v' # v # STK) loc 0 None stk' loc' PC xcp'"
       by -(rule exec_meth_take,auto)
     from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v' # v # STK"
       and "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')"  by auto
     hence "exec_meth_d (compP2 P) (((compE2 a @ compE2 i) @ compE2 e) @ [AStore, Push Unit]) ((compxE2 a 0 0 @ compxE2 i (length (compE2 a)) (Suc 0)) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length [v', v]) (compxE2 e 0 0))) t h ([] @ [v', v], loc, length (compE2 a @ compE2 i) + 0, None) ta h' (stk'' @ [v', v], loc', length (compE2 a @ compE2 i) + PC, xcp')"
       apply -
       apply(rule exec_meth_append)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by auto
     thus ?thesis using stk xcp stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1AAss3 e n e' xs stk loc pc xcp a i v1 v2)
   note IH3 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim3 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec (a\<lfloor>i\<rceil> := e) (stk @ [v2, v1]) STK loc (length (compE2 a) + length (compE2 i) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim3 have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     from exec have "exec_meth_d (compP2 P) (((compE2 a @ compE2 i) @ compE2 e) @ [AStore, Push Unit])
       ((compxE2 a 0 (length STK) @ compxE2 i (length (compE2 a)) (Suc (length STK))) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e 0 0))) t
       h (stk @ v2 # v1 # STK, loc, length (compE2 a @ compE2 i) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: shift_compxE2 stack_xlift_compxE2)
     hence exec': "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ compE2 e)
       ((compxE2 a 0 (length STK) @ compxE2 i (length (compE2 a)) (Suc (length STK))) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e 0 0))) t
       h (stk @ v2 # v1 # STK, loc, length (compE2 a @ compE2 i) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(simp add: True)
     hence "?exec e stk (v2 # v1 # STK) loc pc xcp stk' loc' (pc' - length (compE2 a @ compE2 i)) xcp'"
       by(rule exec_meth_drop_xt) auto
     from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v2 # v1 # STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 a @ compE2 i), xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 e) (stack_xlift (length [v2, v1]) (compxE2 e 0 0)) t h (stk @ [v2, v1], loc, pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', pc' - length (compE2 a @ compE2 i), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) ((compE2 a @ compE2 i) @ compE2 e) ((compxE2 a 0 0 @ compxE2 i (length (compE2 a)) (Suc 0)) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length [v2, v1]) (compxE2 e 0 0))) t
       h (stk @ [v2, v1], loc, length (compE2 a @ compE2 i) + pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 a @ compE2 i) + (pc' - length (compE2 a @ compE2 i)), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) (((compE2 a @ compE2 i) @ compE2 e) @ [AStore, Push Unit]) ((compxE2 a 0 0 @ compxE2 i (length (compE2 a)) (Suc 0)) @ shift (length (compE2 a @ compE2 i)) (stack_xlift (length [v2, v1]) (compxE2 e 0 0))) t
       h (stk @ [v2, v1], loc, length (compE2 a @ compE2 i) + pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 a @ compE2 i) + (pc' - length (compE2 a @ compE2 i)), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length (compE2 a @ compE2 i)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(simp add: stack_xlift_compxE2 shift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 e)" by simp
     with bisim3 obtain v3 where [simp]: "stk = [v3]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec pc show ?thesis apply(simp)
       by(erule exec_meth.cases)(auto intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case (bisim1AAssThrow1 A n a xs stk loc pc i e)
   note bisim1 = \<open>P,A,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (A\<lfloor>i\<rceil> := e) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 A)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 A @ (compE2 i @ compE2 e @ [AStore, Push Unit]))
      (stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0) @ compxE2 e (length (compE2 i)) (Suc (Suc 0))))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
   hence "?exec A stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'" by(rule exec_meth_take_xt)(rule pc)
   from IH1[OF this] show ?case by(auto)
 next
   case (bisim1AAssThrow2 i n a xs stk loc pc A e v1)
   note bisim2 = \<open>P,i,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec i stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl i stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (A\<lfloor>i\<rceil> := e) (stk @ [v1]) STK loc (length (compE2 A) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc < length (compE2 i)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ compE2 e @ [AStore, Push Unit])
      ((stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) @ (shift (length (compE2 A @ compE2 i)) (compxE2 e 0 (Suc (Suc (length STK)))))) t
      h (stk @ v1 # STK, loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   hence exec': "exec_meth_d (compP2 P) (compE2 A @ compE2 i)
      (stack_xlift (length STK) (compxE2 A 0 0) @ shift (length (compE2 A)) (stack_xlift (length STK) (compxE2 i 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take_xt)(simp add: pc)
   hence "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length STK) (compxE2 i 0 (Suc 0))) t
      h (stk @ v1 # STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc' - length (compE2 A), xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   hence "?exec i stk (v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 A)) xcp'"
     by(simp add: compxE2_stack_xlift_convs)
   from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 i) (compxE2 i 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 A), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 i) (stack_xlift (length [v1]) (compxE2 i 0 0)) t 
       h (stk @ [v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 A), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 A @ compE2 i) (compxE2 A 0 0 @ shift (length (compE2 A)) (stack_xlift (length [v1]) (compxE2 i 0 0))) t 
       h (stk @ [v1], loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 A) + (pc' - length (compE2 A)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ compE2 e @ [AStore, Push Unit]) ((compxE2 A 0 0 @ shift (length (compE2 A)) (stack_xlift (length [v1]) (compxE2 i 0 0))) @ (shift (length (compE2 A @ compE2 i)) (compxE2 e 0 (Suc (Suc 0))))) t
       h (stk @ [v1], loc, length (compE2 A) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 A) + (pc' - length (compE2 A)), xcp')"
     by(rule exec_meth_append_xt)
   moreover from exec' have pc': "pc' \<ge> length (compE2 A)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case (bisim1AAssThrow3 e n a xs stk loc pc A i v2 v1)
   note bisim3 = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH3 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (A\<lfloor>i\<rceil> := e) (stk @ [v2, v1]) STK loc (length (compE2 A) + length (compE2 i) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim3 have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (((compE2 A @ compE2 i) @ compE2 e) @ [AStore, Push Unit])
      ((stack_xlift (length STK) (compxE2 A 0 0 @ compxE2 i (length (compE2 A)) (Suc 0))) @ shift (length (compE2 A @ compE2 i)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e 0 0))) t
      h (stk @ v2 # v1 # STK, loc, length (compE2 A @ compE2 i) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   hence exec': "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ compE2 e)
      ((stack_xlift (length STK) (compxE2 A 0 0 @ compxE2 i (length (compE2 A)) (Suc 0))) @ shift (length (compE2 A @ compE2 i)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e 0 0))) t
      h (stk @ v2 # v1 # STK, loc, length (compE2 A @ compE2 i) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "?exec e stk (v2 # v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 A @ compE2 i)) xcp'"
     by(rule exec_meth_drop_xt) auto
   from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v2 # v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 A @ compE2 i), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 e) (stack_xlift (length [v2, v1]) (compxE2 e 0 0)) t h (stk @ [v2, v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', pc' - length (compE2 A @ compE2 i), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) ((compE2 A @ compE2 i) @ compE2 e) ((compxE2 A 0 0 @ compxE2 i (length (compE2 A)) (Suc 0)) @ shift (length (compE2 A @ compE2 i)) (stack_xlift (length [v2, v1]) (compxE2 e 0 0))) t h (stk @ [v2, v1], loc, length (compE2 A @ compE2 i) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 A @ compE2 i) + (pc' - length (compE2 A @ compE2 i)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) (((compE2 A @ compE2 i) @ compE2 e) @ [AStore, Push Unit]) ((compxE2 A 0 0 @ compxE2 i (length (compE2 A)) (Suc 0)) @ shift (length (compE2 A @ compE2 i)) (stack_xlift (length [v2, v1]) (compxE2 e 0 0))) t h (stk @ [v2, v1], loc, length (compE2 A @ compE2 i) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 A @ compE2 i) + (pc' - length (compE2 A @ compE2 i)), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have pc': "pc' \<ge> length (compE2 A @ compE2 i)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case bisim1AAssFail thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case bisim1AAss4 thus ?case
     by -(erule exec_meth.cases, auto intro!: exec_meth.exec_instr)
 next
   case (bisim1ALength a n a' xs stk loc pc xcp)
   note bisim = \<open>P,a,h \<turnstile> (a', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec a stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl a stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (a\<bullet>length) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 a)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 a)")
     case True
     with exec have "?exec a stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 a)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis apply(simp)
       by(erule exec_meth.cases)(auto intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case (bisim1ALengthThrow e n a xs stk loc pc)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e\<bullet>length) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case bisim1ALengthNull thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1FAcc e n e' xs stk loc pc xcp F D)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e\<bullet>F{D}) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     with bisim obtain v where [simp]: "stk = [v]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec show ?thesis apply(simp)
       by(erule exec_meth.cases)(fastforce intro!: exec_meth.intros simp add: is_Ref_def split: if_split_asm)+
   qed
 next
   case (bisim1FAccThrow e n a xs stk loc pc F D)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e\<bullet>F{D}) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp)(erule exec_meth_take[OF _ pc])
   from IH[OF this] show ?case by(auto)
 next
   case bisim1FAccNull thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1FAss1 e n e' xs stk loc pc xcp e2 F D)
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec e2 [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec (e\<bullet>F{D} := e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxE2_size_convs)(erule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 e)" by simp
     with exec have "pc' \<ge> length (compE2 e)"
       by(simp add: compxE2_size_convs stack_xlift_compxE2)(auto elim!: exec_meth_drop_xt_pc)
     then obtain PC where PC: "pc' = PC + length (compE2 e)"
       by -(rule_tac PC34="pc' - length (compE2 e)" in that, simp)
     from pc bisim1 obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec pc have "exec_meth_d (compP2 P) (compE2 e @ compE2 e2)
       (stack_xlift (length STK) (compxE2 e 0 0 @ compxE2 e2 (length (compE2 e)) (Suc 0))) t 
       h (stk @ STK, loc, length (compE2 e) + 0, xcp) ta h' (stk', loc', pc', xcp')"
       by-(rule exec_meth_take, auto)
     hence "?exec e2 [] (v # STK) loc 0 None stk' loc' (pc' - length (compE2 e)) xcp'"
       using \<open>stk = [v]\<close> \<open>xcp = None\<close>
       by -(rule exec_meth_drop_xt, auto simp add: stack_xlift_compxE2 shift_compxE2)
     from IH2[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')" by auto
     hence "exec_meth_d (compP2 P) ((compE2 e @ compE2 e2) @ [Putfield F D, Push Unit])
         (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v]) (compxE2 e2 0 0))) t h
         ([] @ [v], loc, length (compE2 e) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 e) + PC, xcp')"
       apply -
       apply(rule exec_meth_append)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by(auto)
     thus ?thesis using \<open>stk = [v]\<close> \<open>xcp = None\<close> stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1FAss2 e2 n e' xs stk loc pc xcp e F D v1)
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec (e\<bullet>F{D} := e2) (stk @ [v1]) STK loc (length (compE2 e) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case True
     from exec have "exec_meth_d (compP2 P) ((compE2 e @ compE2 e2) @ [Putfield F D, Push Unit])
       (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 e) + pc, xcp) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
     hence exec': "exec_meth_d (compP2 P) (compE2 e @ compE2 e2) (stack_xlift (length STK) (compxE2 e 0 0) @
       shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
       h (stk @ v1 # STK, loc, length (compE2 e) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(simp add: True)
     hence "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))) t
       h (stk @ v1 # STK, loc, pc, xcp) ta h' (stk', loc', pc' - length (compE2 e), xcp')"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     hence "?exec e2 stk (v1 # STK) loc pc xcp stk' loc' (pc' - length (compE2 e)) xcp'"
       by(simp add: compxE2_stack_xlift_convs)
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 e), xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length [v1]) (compxE2 e2 0 0)) t h (stk @ [v1], loc, pc, xcp)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 e), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) (compE2 e @ compE2 e2) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) ((compE2 e @ compE2 e2) @ [Putfield F D, Push Unit]) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e) + pc, xcp)
       ta h' (stk'' @ [v1], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length (compE2 e)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(simp add: stack_xlift_compxE2 shift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 e2)" by simp
     with bisim2 obtain v2 where [simp]: "stk = [v2]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec pc show ?thesis apply(simp)
       by(erule exec_meth.cases)(fastforce intro!: exec_meth.intros split: if_split_asm)+
   qed
 next
   case (bisim1FAssThrow1 e n a xs stk loc pc e2 F D)
   note bisim1 = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e\<bullet>F{D} := e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 e)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e @ (compE2 e2 @ [Putfield F D, Push Unit]))
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
   hence "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'" by(rule exec_meth_take_xt)(rule pc)
   from IH1[OF this] show ?case by(auto)
 next
   case (bisim1FAssThrow2 e2 n a xs stk loc pc e F D v1)
   note bisim2 = \<open>P,e2,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e\<bullet>F{D} := e2) (stk @ [v1]) STK loc (length (compE2 e) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc < length (compE2 e2)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 e @ compE2 e2) @ [Putfield F D, Push Unit])
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 e) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence exec': "exec_meth_d (compP2 P) (compE2 e @ compE2 e2)
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 e) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))) t
      h (stk @ v1 # STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc' - length (compE2 e), xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   hence "?exec e2 stk (v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 e)) xcp'"
     by(simp add: compxE2_stack_xlift_convs)
   from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 e), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length [v1]) (compxE2 e2 0 0)) t h (stk @ [v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 e), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 e @ compE2 e2) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) ((compE2 e @ compE2 e2) @ [Putfield F D, Push Unit]) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t h (stk @ [v1], loc, length (compE2 e) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have pc': "pc' \<ge> length (compE2 e)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case bisim1FAssNull thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case bisim1FAss3 thus ?case
     by -(erule exec_meth.cases, auto intro!: exec_meth.exec_instr)
 next
   case (bisim1CAS1 e1 n e1' xs stk loc pc xcp e2 e3 D F)
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec e2 [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim1 = \<open>P,e1,h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec _ stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
   from exec have exec': "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2 @ compE2 e3 @ [CAS F D]) (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0) @ compxE2 e3 (length (compE2 e2)) (Suc (Suc 0))))) t
     h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     with exec' have "?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'" by(rule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 e1)" by simp
     with exec' have "pc' \<ge> length (compE2 e1)" by -(erule exec_meth_drop_xt_pc, auto)
     then obtain PC where PC: "pc' = PC + length (compE2 e1)"
       by -(rule_tac PC34="pc' - length (compE2 e1)" in that, simp)
     from pc bisim1 obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec PC pc
     have "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3 @ [CAS F D]) (stack_xlift (length STK) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (compxE2 e2 0 (Suc 0))) @ shift (length (compE2 e1 @ compE2 e2)) (compxE2 e3 0 (length STK + Suc (Suc 0)))) t
     h (v # STK, loc, length (compE2 e1) + 0, None) ta h' (stk', loc', length (compE2 e1) + PC, xcp')" 
       by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
     hence "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2)
    (stack_xlift (length STK) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (compxE2 e2 0 (Suc 0)))) t h (v # STK, loc, length (compE2 e1) + 0, None) ta h' (stk', loc', length (compE2 e1) + PC, xcp')"
       by(rule exec_meth_take_xt) simp
     hence "?exec e2 [] (v # STK) loc 0 None stk' loc' ((length (compE2 e1) + PC) - length (compE2 e1)) xcp'"
       by -(rule exec_meth_drop_xt, auto simp add: stack_xlift_compxE2 shift_compxE2)
     from IH2[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')" by auto
     hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ (compE2 e3 @ [CAS F D]))
         ((compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v]) (compxE2 e2 0 0))) @
          shift (length (compE2 e1 @ compE2 e2)) (compxE2 e3 0 (Suc (Suc 0)))) t h
         ([] @ [v], loc, length (compE2 e1) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 e1) + PC, xcp')"
       apply -
       apply(rule exec_meth_append_xt)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by(auto)
     thus ?thesis using \<open>stk = [v]\<close> \<open>xcp = None\<close> stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1CAS2 e2 n e2' xs stk loc pc xcp e1 e3 D F v)
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH3 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?exec e3 [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e3 [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note bisim2 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note bisim3 = \<open>P,e3,h \<turnstile> (e3, loc) \<leftrightarrow> ([], loc, 0, None)\<close>
   note exec = \<open>?exec _ (stk @ [v]) STK loc (length (compE2 e1) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
   from exec have exec': "\<And>v'. exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3 @ [CAS F D]) ((compxE2 e1 0 (length STK) @ shift (length (compE2 e1)) (stack_xlift (length (v # STK)) (compxE2 e2 0 0))) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length (v' # v # STK)) (compxE2 e3 0 0))) t
     h (stk @ v # STK, loc, length (compE2 e1) + pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2)
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case True with exec'[of undefined]
     have exec'': "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2) (compxE2 e1 0 (length STK) @ shift (length (compE2 e1)) (stack_xlift (length (v # STK)) (compxE2 e2 0 0))) t h (stk @ v # STK, loc, length (compE2 e1) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by-(erule exec_meth_take_xt, simp)
     hence "?exec e2 stk (v # STK) loc pc xcp stk' loc' (pc' - length (compE2 e1)) xcp'"
       by(rule exec_meth_drop_xt) auto
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and exec''': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 e1), xcp')" by blast
     from exec''' have "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3 @ [CAS F D]) ((compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v]) (compxE2 e2 0 0))) @ shift (length (compE2 e1 @ compE2 e2)) (compxE2 e3 0 (Suc (Suc 0)))) t h (stk @ [v], loc, length (compE2 e1) + pc, xcp) ta h' (stk'' @ [v], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
       apply -
       apply(rule exec_meth_append_xt)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by auto
     moreover from exec'' have "pc' \<ge> length (compE2 e1)"
       by(rule exec_meth_drop_xt_pc) auto
     ultimately show ?thesis using stk' by(auto simp add: shift_compxE2 stack_xlift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 e2)" by simp
     with exec'[of undefined] have "pc' \<ge> length (compE2 e1 @ compE2 e2)"
       by-(erule exec_meth_drop_xt_pc, auto simp add: shift_compxE2 stack_xlift_compxE2)
     then obtain PC where PC: "pc' = PC + length (compE2 e1) + length (compE2 e2)"
       by -(rule_tac PC34="pc' - length (compE2 e1 @ compE2 e2)" in that, simp)
     from pc bisim2 obtain v' where stk: "stk = [v']" and xcp: "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     from exec'[of v'] 
     have "exec_meth_d (compP2 P) (compE2 e3 @ [CAS F D]) (stack_xlift (length (v' # v # STK)) (compxE2 e3 0 0)) t
                     h (v' # v # STK, loc, 0, xcp) ta h' (stk', loc', pc' - length (compE2 e1 @ compE2 e2), xcp')"
       unfolding stk pc append_Cons append_Nil
       by -(rule exec_meth_drop_xt, simp only: add_0_right length_append, auto simp add: shift_compxE2 stack_xlift_compxE2)
     with PC xcp have "?exec e3 [] (v' # v # STK) loc 0 None stk' loc' PC xcp'"
       by -(rule exec_meth_take,auto)
     from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v' # v # STK"
       and "exec_meth_d (compP2 P) (compE2 e3) (compxE2 e3 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')"  by auto
     hence "exec_meth_d (compP2 P) (((compE2 e1 @ compE2 e2) @ compE2 e3) @ [CAS F D]) ((compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0)) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length [v', v]) (compxE2 e3 0 0))) t h ([] @ [v', v], loc, length (compE2 e1 @ compE2 e2) + 0, None) ta h' (stk'' @ [v', v], loc', length (compE2 e1 @ compE2 e2) + PC, xcp')"
       apply -
       apply(rule exec_meth_append)
       apply(rule append_exec_meth_xt)
       apply(erule exec_meth_stk_offer)
       by auto
     thus ?thesis using stk xcp stk' pc PC
       by(clarsimp simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   qed
 next
   case (bisim1CAS3 e3 n e3' xs stk loc pc xcp e1 e2 D F v1 v2)
   note IH3 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e3 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e3 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim3 = \<open>P,e3,h \<turnstile> (e3', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec _ (stk @ [v2, v1]) STK loc (length (compE2 e1) + length (compE2 e2) + pc) xcp stk' loc' pc' xcp'\<close>
   from bisim3 have pc: "pc \<le> length (compE2 e3)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e3)")
     case True
     from exec have "exec_meth_d (compP2 P) (((compE2 e1 @ compE2 e2) @ compE2 e3) @ [CAS F D])
       ((compxE2 e1 0 (length STK) @ compxE2 e2 (length (compE2 e1)) (Suc (length STK))) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e3 0 0))) t
       h (stk @ v2 # v1 # STK, loc, length (compE2 e1 @ compE2 e2) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: shift_compxE2 stack_xlift_compxE2)
     hence exec': "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3)
       ((compxE2 e1 0 (length STK) @ compxE2 e2 (length (compE2 e1)) (Suc (length STK))) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e3 0 0))) t
       h (stk @ v2 # v1 # STK, loc, length (compE2 e1 @ compE2 e2) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(simp add: True)
     hence "?exec e3 stk (v2 # v1 # STK) loc pc xcp stk' loc' (pc' - length (compE2 e1 @ compE2 e2)) xcp'"
       by(rule exec_meth_drop_xt) auto
     from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v2 # v1 # STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e3) (compxE2 e3 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 e1 @ compE2 e2), xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 e3) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0)) t h (stk @ [v2, v1], loc, pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', pc' - length (compE2 e1 @ compE2 e2), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3) ((compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0)) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0))) t
       h (stk @ [v2, v1], loc, length (compE2 e1 @ compE2 e2) + pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 e1 @ compE2 e2) + (pc' - length (compE2 e1 @ compE2 e2)), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) (((compE2 e1 @ compE2 e2) @ compE2 e3) @ [CAS F D]) ((compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0)) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0))) t
       h (stk @ [v2, v1], loc, length (compE2 e1 @ compE2 e2) + pc, xcp)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 e1 @ compE2 e2) + (pc' - length (compE2 e1 @ compE2 e2)), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length (compE2 e1 @ compE2 e2)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(simp add: stack_xlift_compxE2 shift_compxE2)
   next
     case False
     with pc have pc: "pc = length (compE2 e3)" by simp
     with bisim3 obtain v3 where [simp]: "stk = [v3]" "xcp = None"
       by(auto dest: dest: bisim1_pc_length_compE2D)
     with exec pc show ?thesis apply(simp)
       by(erule exec_meth.cases)(fastforce intro!: exec_meth.intros split: if_split_asm)+
   qed
 next
   case (bisim1CASThrow1 e1 n a xs stk loc pc e2 e3 D F)
   note bisim1 = \<open>P,e1,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec _ stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 e1)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e1 @ (compE2 e2 @ compE2 e3 @ [CAS F D]))
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0) @ compxE2 e3 (length (compE2 e2)) (Suc (Suc 0))))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')" by(simp add: compxE2_size_convs)
   hence "?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'" by(rule exec_meth_take_xt)(rule pc)
   from IH1[OF this] show ?case by(auto)
 next
   case (bisim1CASThrow2 e2 n a xs stk loc pc e1 e3 D F v1)
   note bisim2 = \<open>P,e2,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH2 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec _ (stk @ [v1]) STK loc (length (compE2 e1) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc < length (compE2 e2)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3 @ [CAS F D])
      ((stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) @ (shift (length (compE2 e1 @ compE2 e2)) (compxE2 e3 0 (Suc (Suc (length STK)))))) t
      h (stk @ v1 # STK, loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   hence exec': "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2)
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0)))) t
      h (stk @ v1 # STK, loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take_xt)(simp add: pc)
   hence "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length STK) (compxE2 e2 0 (Suc 0))) t
      h (stk @ v1 # STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc' - length (compE2 e1), xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   hence "?exec e2 stk (v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 e1)) xcp'"
     by(simp add: compxE2_stack_xlift_convs)
   from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 e1), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 e2) (stack_xlift (length [v1]) (compxE2 e2 0 0)) t 
       h (stk @ [v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', pc' - length (compE2 e1), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 e1 @ compE2 e2) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) t 
       h (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3 @ [CAS F D]) ((compxE2 e1 0 0 @ shift (length (compE2 e1)) (stack_xlift (length [v1]) (compxE2 e2 0 0))) @ (shift (length (compE2 e1 @ compE2 e2)) (compxE2 e3 0 (Suc (Suc 0))))) t
       h (stk @ [v1], loc, length (compE2 e1) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v1], loc', length (compE2 e1) + (pc' - length (compE2 e1)), xcp')"
     by(rule exec_meth_append_xt)
   moreover from exec' have pc': "pc' \<ge> length (compE2 e1)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case (bisim1CASThrow3 e3 n a xs stk loc pc e1 e2 D F v2 v1)
   note bisim3 = \<open>P,e3,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH3 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e3 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e3 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec _ (stk @ [v2, v1]) STK loc (length (compE2 e1) + length (compE2 e2) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim3 have pc: "pc < length (compE2 e3)" and [simp]: "xs = loc"
     by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (((compE2 e1 @ compE2 e2) @ compE2 e3) @ [CAS F D])
      ((stack_xlift (length STK) (compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0))) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e3 0 0))) t
      h (stk @ v2 # v1 # STK, loc, length (compE2 e1 @ compE2 e2) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   hence exec': "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3)
      ((stack_xlift (length STK) (compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0))) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length (v2 # v1 # STK)) (compxE2 e3 0 0))) t
      h (stk @ v2 # v1 # STK, loc, length (compE2 e1 @ compE2 e2) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "?exec e3 stk (v2 # v1 # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 e1 @ compE2 e2)) xcp'"
     by(rule exec_meth_drop_xt) auto
   from IH3[OF this] obtain stk'' where stk': "stk' = stk'' @ v2 # v1 # STK" and
     exec'': "exec_meth_d (compP2 P) (compE2 e3) (compxE2 e3 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 e1 @ compE2 e2), xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (compE2 e3) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0)) t h (stk @ [v2, v1], loc, pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', pc' - length (compE2 e1 @ compE2 e2), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) ((compE2 e1 @ compE2 e2) @ compE2 e3) ((compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0)) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0))) t h (stk @ [v2, v1], loc, length (compE2 e1 @ compE2 e2) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 e1 @ compE2 e2) + (pc' - length (compE2 e1 @ compE2 e2)), xcp')"
     by(rule append_exec_meth_xt)(auto)
   hence "exec_meth_d (compP2 P) (((compE2 e1 @ compE2 e2) @ compE2 e3) @ [CAS F D]) ((compxE2 e1 0 0 @ compxE2 e2 (length (compE2 e1)) (Suc 0)) @ shift (length (compE2 e1 @ compE2 e2)) (stack_xlift (length [v2, v1]) (compxE2 e3 0 0))) t h (stk @ [v2, v1], loc, length (compE2 e1 @ compE2 e2) + pc, \<lfloor>a\<rfloor>)
       ta h' (stk'' @ [v2, v1], loc', length (compE2 e1 @ compE2 e2) + (pc' - length (compE2 e1 @ compE2 e2)), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have pc': "pc' \<ge> length (compE2 e1 @ compE2 e2)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: stack_xlift_compxE2 shift_compxE2)
 next
   case bisim1CASFail thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case (bisim1Call1 obj n obj' xs stk loc pc xcp ps M')
   note bisimObj = \<open>P,obj,h \<turnstile> (obj', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IHobj = \<open>\<And>stk' loc' pc' xcp' STK. ?exec obj stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl obj stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IHparams = \<open>\<And>xs stk' loc' pc' xcp' STK. ?execs ps [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concls ps [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (obj\<bullet>M'(ps)) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisimObj have pc: "pc \<le> length (compE2 obj)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 obj)")
     case True
     from exec have "?exec obj stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxEs2_size_convs)(erule exec_meth_take_xt[OF _ True])
     from IHobj[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 obj)" by simp
     with exec have "pc' \<ge> length (compE2 obj)"
       by(simp add: compxEs2_size_convs stack_xlift_compxE2)(auto elim!: exec_meth_drop_xt_pc)
     then obtain PC where PC: "pc' = PC + length (compE2 obj)"
       by -(rule_tac PC34="pc' - length (compE2 obj)" in that, simp)
     from pc bisimObj obtain v where [simp]: "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     show ?thesis
     proof(cases ps)
       case Cons
       with exec pc have "exec_meth_d (compP2 P) (compE2 obj @ compEs2 ps)
         (stack_xlift (length STK) (compxE2 obj 0 0 @ compxEs2 ps (length (compE2 obj)) (Suc 0))) t
         h (stk @ STK, loc, length (compE2 obj) + 0, xcp) ta h' (stk', loc', pc', xcp')"
         by -(rule exec_meth_take, auto)
       hence "?execs ps [] (v # STK) loc 0 None stk' loc' (pc' - length (compE2 obj)) xcp'"
         apply -
         apply(rule exec_meth_drop_xt)
         apply(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
         apply(auto simp add: stack_xlift_compxE2)
         done
       from IHparams[OF this] PC obtain stk'' where stk': "stk' = stk'' @ v # STK"
         and exec': "exec_meth_d (compP2 P) (compEs2 ps) (compxEs2 ps 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', PC, xcp')"
         by auto
       from exec' have "exec_meth_d (compP2 P) ((compE2 obj @ compEs2 ps) @ [Invoke M' (length ps)]) (compxE2 obj 0 0 @ shift (length (compE2 obj)) (stack_xlift (length [v]) (compxEs2 ps 0 0))) t h ([] @ [v], loc, length (compE2 obj) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 obj) + PC, xcp')"
         apply -
         apply(rule exec_meth_append)
         apply(rule append_exec_meth_xt)
         apply(erule exec_meth_stk_offer)
         by(auto)
       thus ?thesis using stk' PC by(clarsimp simp add: shift_compxEs2 stack_xlift_compxEs2 ac_simps)
     next
       case Nil
       with exec pc show ?thesis 
         apply(auto elim!: exec_meth.cases intro!: exec_meth.intros simp add: split_beta split: if_split_asm)
         apply(auto split: extCallRet.split_asm intro!: exec_meth.intros)
         apply(force intro!: exI)
         apply(force intro!: exI)
         apply(force intro!: exI)
         done
     qed
   qed
 next
   case (bisim1CallParams ps n ps' xs stk loc pc xcp obj M' v)
   note bisimParam = \<open>P,ps,h \<turnstile> (ps',xs) [\<leftrightarrow>] (stk,loc,pc,xcp)\<close>
   note IHparam = \<open>\<And>stk' loc' pc' xcp' STK. ?execs ps stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concls ps stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (obj\<bullet>M'(ps)) (stk @ [v]) STK loc (length (compE2 obj) + pc) xcp stk' loc' pc' xcp'\<close>
   show ?case
   proof(cases ps)
     case Nil
     with bisimParam have "pc = 0" "xcp = None" by(auto elim: bisims1.cases)
     with exec Nil show ?thesis 
       apply(auto elim!: exec_meth.cases intro!: exec_meth.intros simp add: split_beta extRet2JVM_def split: if_split_asm)
       apply(auto split: extCallRet.split_asm simp add: neq_Nil_conv)
       apply(force intro!: exec_meth.intros)+
       done
   next
     case Cons
     from bisimParam have pc: "pc \<le> length (compEs2 ps)" by(rule bisims1_pc_length_compEs2)
     show ?thesis
     proof(cases "pc < length (compEs2 ps)")
       case True
       from exec have "exec_meth_d (compP2 P) ((compE2 obj @ compEs2 ps) @ [Invoke M' (length ps)])
         (stack_xlift (length STK) (compxE2 obj 0 0) @ shift (length (compE2 obj)) (stack_xlift (length (v # STK)) (compxEs2 ps 0 0))) t
         h (stk @ v # STK, loc, length (compE2 obj) + pc, xcp) ta h' (stk', loc', pc', xcp')"
         by(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
       hence exec': "exec_meth_d (compP2 P) (compE2 obj @ compEs2 ps) (stack_xlift (length STK) (compxE2 obj 0 0) @
         shift (length (compE2 obj)) (stack_xlift (length (v # STK)) (compxEs2 ps 0 0))) t
         h (stk @ v # STK, loc, length (compE2 obj) + pc, xcp) ta h' (stk', loc', pc', xcp')"
         by(rule exec_meth_take)(simp add: True)
       hence "?execs ps stk (v # STK) loc pc xcp stk' loc' (pc' - length (compE2 obj)) xcp'"
         by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
       from IHparam[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
         and exec'': "exec_meth_d (compP2 P) (compEs2 ps) (compxEs2 ps 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 obj), xcp')" by blast
       from exec'' have "exec_meth_d (compP2 P) (compEs2 ps) (stack_xlift (length [v]) (compxEs2 ps 0 0)) t h (stk @ [v], loc, pc, xcp) ta h' (stk'' @ [v], loc', pc' - length (compE2 obj), xcp')"
         by(rule exec_meth_stk_offer)
       hence "exec_meth_d (compP2 P) (compE2 obj @ compEs2 ps) (compxE2 obj 0 0 @ shift (length (compE2 obj)) (stack_xlift (length [v]) (compxEs2 ps 0 0))) t
  h (stk @ [v], loc, length (compE2 obj) + pc, xcp) ta h' (stk'' @ [v], loc', length (compE2 obj) + (pc' - length (compE2 obj)), xcp')"
         by(rule append_exec_meth_xt) auto
       hence "exec_meth_d (compP2 P) ((compE2 obj @ compEs2 ps) @ [Invoke M' (length ps)])
      (compxE2 obj 0 0 @ shift (length (compE2 obj)) (stack_xlift (length [v]) (compxEs2 ps 0 0))) t
  h (stk @ [v], loc, length (compE2 obj) + pc, xcp) ta h' (stk'' @ [v], loc', length (compE2 obj) + (pc' - length (compE2 obj)), xcp')"
         by(rule exec_meth_append)
       moreover from exec' have "pc' \<ge> length (compE2 obj)"
         by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
       ultimately show ?thesis using stk'
         by(auto simp add: shift_compxEs2 stack_xlift_compxEs2)
     next
       case False
       with pc have pc: "pc = length (compEs2 ps)" by simp
       with bisimParam obtain vs where "stk = vs" "length vs = length ps" "xcp = None"
         by(auto dest: bisims1_pc_length_compEs2D)
       with exec pc Cons show ?thesis
         apply(auto elim!: exec_meth.cases intro!: exec_meth.intros simp add: split_beta extRet2JVM_def split: if_split_asm)
         apply(auto simp add: neq_Nil_conv split: extCallRet.split_asm)
         apply(force intro!: exec_meth.intros)+
         done
     qed
   qed
 next
   case (bisim1CallThrowObj obj n a xs stk loc pc ps M')
   note bisim = \<open>P,obj,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec obj stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl obj stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (obj\<bullet>M'(ps)) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have "pc < length (compE2 obj)" and [simp]: "xs = loc" by(auto dest: bisim1_ThrowD)
   with exec have "?exec obj stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)(erule exec_meth_take_xt)
   from IH[OF this] show ?case by auto
 next
   case (bisim1CallThrowParams ps n vs a ps' xs stk loc pc obj M' v)
   note bisim = \<open>P,ps,h \<turnstile> (map Val vs @ Throw a # ps',xs) [\<leftrightarrow>] (stk,loc,pc,\<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?execs ps stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concls ps stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (obj\<bullet>M'(ps)) (stk @ [v]) STK loc (length (compE2 obj) + pc) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compEs2 ps)" "loc = xs" by(auto dest: bisims1_ThrowD)
   from exec have "exec_meth_d (compP2 P) ((compE2 obj @ compEs2 ps) @ [Invoke M' (length ps)])
      (stack_xlift (length STK) (compxE2 obj 0 0) @ shift (length (compE2 obj)) (stack_xlift (length (v # STK)) (compxEs2 ps 0 0))) t
      h (stk @ v # STK, loc, length (compE2 obj) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
   hence exec': "exec_meth_d (compP2 P) (compE2 obj @ compEs2 ps) (stack_xlift (length STK) (compxE2 obj 0 0) @
       shift (length (compE2 obj)) (stack_xlift (length (v # STK)) (compxEs2 ps 0 0))) t
      h (stk @ v # STK, loc, length (compE2 obj) + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(simp add: pc)
   hence "?execs ps stk (v # STK) loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length (compE2 obj)) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
     and exec'': "exec_meth_d (compP2 P) (compEs2 ps) (compxEs2 ps 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length (compE2 obj), xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) ((compE2 obj @ compEs2 ps) @ [Invoke M' (length ps)])
      (compxE2 obj 0 0 @ shift (length (compE2 obj)) (stack_xlift (length [v]) (compxEs2 ps 0 0))) t
      h (stk @ [v], loc, length (compE2 obj) + pc, \<lfloor>a\<rfloor>) ta h' (stk'' @ [v], loc', length (compE2 obj) + (pc' - length (compE2 obj)), xcp')"
     apply - 
     apply(rule exec_meth_append)
     apply(rule append_exec_meth_xt)
     apply(erule exec_meth_stk_offer)
     apply auto
     done
   moreover from exec' have "pc' \<ge> length (compE2 obj)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
 next
   case bisim1CallThrow thus ?case
     by(auto elim!: exec_meth.cases dest: match_ex_table_pcsD simp add: stack_xlift_compxEs2 stack_xlift_compxE2)
 next
   case bisim1BlockSome1 thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case bisim1BlockSome2 thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1BlockSome4 e n e' xs stk loc pc xcp V T v)
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec {V:T=\<lfloor>v\<rfloor>; e} stk STK loc (Suc (Suc pc)) xcp stk' loc' pc' xcp'\<close>
   hence exec': "exec_meth_d (compP2 P) ([Push v, Store V] @ compE2 e)
      (shift (length [Push v, Store V]) (stack_xlift (length STK) (compxE2 e 0 0))) t h (stk @ STK, loc, length [Push v, Store V] + pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence "?exec e stk STK loc pc xcp stk' loc' (pc' - length [Push v, Store V]) xcp'"
     by(rule exec_meth_drop) auto
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, xcp) ta
       h' (stk'', loc', pc' - length [Push v, Store V], xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) ([Push v, Store V] @ compE2 e)
      (shift (length [Push v, Store V]) (compxE2 e 0 0)) t h (stk, loc, length [Push v, Store V] + pc, xcp) ta h' (stk'', loc', length [Push v, Store V] + (pc' - length [Push v, Store V]), xcp')"
     by(rule append_exec_meth) auto
   moreover from exec' have "pc' \<ge> length [Push v, Store V]"
     by(rule exec_meth_drop_pc)(auto simp add: stack_xlift_compxE2)
   hence "Suc (Suc (pc' - Suc (Suc 0))) = pc'" by(simp)
   ultimately show ?case using stk' by(auto simp add: compxE2_size_convs)
 next
   case (bisim1BlockThrowSome e n a xs stk loc pc V T v)
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec {V:T=\<lfloor>v\<rfloor>; e} stk STK loc (Suc (Suc pc)) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   hence exec': "exec_meth_d (compP2 P) ([Push v, Store V] @ compE2 e)
      (shift (length [Push v, Store V]) (stack_xlift (length STK) (compxE2 e 0 0))) t h (stk @ STK, loc, length [Push v, Store V] + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length [Push v, Store V]) xcp'"
     by(rule exec_meth_drop) auto
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta
       h' (stk'', loc', pc' - length [Push v, Store V], xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) ([Push v, Store V] @ compE2 e)
      (shift (length [Push v, Store V]) (compxE2 e 0 0)) t h (stk, loc, length [Push v, Store V] + pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', length [Push v, Store V] + (pc' - length [Push v, Store V]), xcp')"
     by(rule append_exec_meth) auto
   moreover from exec' have "pc' \<ge> length [Push v, Store V]"
     by(rule exec_meth_drop_pc)(auto simp add: stack_xlift_compxE2)
   hence "Suc (Suc (pc' - Suc (Suc 0))) = pc'" by(simp)
   ultimately show ?case using stk' by(auto simp add: compxE2_size_convs)
 next
   case bisim1BlockNone thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case bisim1BlockThrowNone thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1Sync1 e1 n e1' xs stk loc pc xcp e2 V)
   note bisim = \<open>P,e1,h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     from exec have "exec_meth_d (compP2 P)
       (compE2 e1 @ (Dup # Store V # MEnter # compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc]))
       (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 3 0) @
        stack_xlift (length STK) [(3, 3 + length (compE2 e2), None, 6 + length (compE2 e2), 0)])) t
       h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
     hence "?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'"
       by(rule exec_meth_take_xt)(rule True)
     from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
       and exec': "exec_meth_d (compP2 P) (compE2 e1) (compxE2 e1 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc', xcp')"
       by blast
     from exec' have "exec_meth_d (compP2 P) (compE2 e1 @ (Dup # Store V # MEnter # compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc]))
       (compxE2 e1 0 0 @ shift (length (compE2 e1)) (compxE2 e2 3 0 @ [(3, 3 + length (compE2 e2), None, 6 + length (compE2 e2), 0)])) t
       h (stk, loc, pc, xcp) ta h' (stk'', loc', pc', xcp')"
       by(rule exec_meth_append_xt)
     thus ?thesis using stk' by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   next
     case False
     with pc have [simp]: "pc = length (compE2 e1)" by simp
     with bisim obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     thus ?thesis using exec by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
   qed
 next
   case bisim1Sync2 thus ?case
     by(fastforce elim!: exec_meth.cases intro!: exec_meth.intros)
 next
   case bisim1Sync3 thus ?case
     by(fastforce elim!: exec_meth.cases intro!: exec_meth.intros split: if_split_asm)
 next
   case (bisim1Sync4 e2 n e2' xs stk loc pc xcp e1 V a)
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note bisim = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) stk STK loc (Suc (Suc (Suc (length (compE2 e1) + pc)))) xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case True
     let ?pre = "compE2 e1 @ [Dup, Store V, MEnter]"
     from exec have exec': "exec_meth_d (compP2 P) (?pre @ compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e2 0 0) @
       [(0, length (compE2 e2), None, 3 + length (compE2 e2), length STK)])) t
      h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: stack_xlift_compxE2 shift_compxE2 eval_nat_numeral ac_simps)
     hence exec'': "exec_meth_d (compP2 P) (compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
       (stack_xlift (length STK) (compxE2 e2 0 0) @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), length STK)]) t
      h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc' - length ?pre, xcp')"
       by(rule exec_meth_drop_xt[where n=1])(auto simp add: stack_xlift_compxE2)
     from exec' have pc': "pc' \<ge> length ?pre"
       by(rule exec_meth_drop_xt_pc[where n'=1])(auto simp add: stack_xlift_compxE2)
     hence pc'': "(Suc (Suc (Suc (pc' - Suc (Suc (Suc 0)))))) = pc'" by simp
     show ?thesis
     proof(cases xcp)
       case None
       from exec'' None True
       have "?exec e2 stk STK loc pc xcp stk' loc' (pc' - length ?pre) xcp'"
         apply -
         apply (erule exec_meth.cases)
         apply (cases "compE2 e2 ! pc")
                             apply (fastforce simp add: is_Ref_def intro: exec_meth.intros split: if_split_asm cong del: image_cong_simp)+
         done
       from IH[OF this] obtain stk'' where stk: "stk' = stk'' @ STK"
         and exec''': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp)
       ta h' (stk'', loc', pc' - length ?pre, xcp')" by blast
       from exec''' have "exec_meth_d (compP2 P) (compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
       (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)]) t
      h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length ?pre, xcp')"
         by(rule exec_meth_append_xt)
       hence "exec_meth_d (compP2 P) (?pre @ compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
       (compxE2 e1 0 0 @ shift (length ?pre) (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)])) t
      h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
         by(rule append_exec_meth_xt[where n=1]) auto
       thus ?thesis using stk pc' pc'' by(simp add: eval_nat_numeral shift_compxE2 ac_simps)
     next
       case (Some a)
       with exec'' have [simp]: "h' = h" "xcp' = None" "loc' = loc" "ta = \<epsilon>"
         by(auto elim!: exec_meth.cases simp add: match_ex_table_append
            split: if_split_asm dest!: match_ex_table_stack_xliftD)
       show ?thesis
       proof(cases "match_ex_table (compP2 P) (cname_of h a) pc (compxE2 e2 0 0)")
         case None
         with Some exec'' True have [simp]: "stk' = Addr a # STK"
           and pc': "pc' = length (compE2 e1) + length (compE2 e2) + 6"
           by(auto elim!: exec_meth.cases simp add: match_ex_table_append
                   split: if_split_asm dest!: match_ex_table_stack_xliftD)
         with exec'' Some None
         have "exec_meth_d (compP2 P) (compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
         (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)]) t
         h (stk, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - 0) stk, loc, pc' - length ?pre, None)"
           by -(rule exec_catch, auto elim!: exec_meth.cases simp add: match_ex_table_append matches_ex_entry_def
                                      split: if_split_asm dest!: match_ex_table_stack_xliftD)
         hence "exec_meth_d (compP2 P) (?pre @ compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
         (compxE2 e1 0 0 @ shift (length ?pre) (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)])) t
         h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - 0) stk, loc,
         length ?pre + (pc' - length ?pre), None)"
           by(rule append_exec_meth_xt[where n=1]) auto
         with pc' Some show ?thesis by(simp add: eval_nat_numeral shift_compxE2 ac_simps)
       next
         case (Some pcd)
         with \<open>xcp = \<lfloor>a\<rfloor>\<close> exec'' True
         have "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t
           h (stk, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - snd pcd) stk, loc, pc' - length ?pre, None)"
           apply -
           apply(rule exec_catch)
           apply(auto elim!: exec_meth.cases simp add: match_ex_table_append split: if_split_asm
                      dest!: match_ex_table_stack_xliftD)
           done
         hence "exec_meth_d (compP2 P) (compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc]) (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)]) t
    h (stk, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - snd pcd) stk, loc, pc' - length ?pre, None)"
           by(rule exec_meth_append_xt)
         hence "exec_meth_d (compP2 P) (?pre @ compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc]) 
               (compxE2 e1 0 0 @ shift (length ?pre) (compxE2 e2 0 0 @ [(0, length (compE2 e2), None, 3 + length (compE2 e2), 0)])) t
    h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - snd pcd) stk, loc, length ?pre + (pc' - length ?pre), None)"
           by(rule append_exec_meth_xt[where n=1])(auto)
         moreover from Some \<open>xcp = \<lfloor>a\<rfloor>\<close> exec'' True pc'
         have "pc' = length (compE2 e1) + 3 + fst pcd" "stk' = Addr a # drop (length stk - snd pcd) stk @ STK"
           by(auto elim!: exec_meth.cases dest!: match_ex_table_stack_xliftD simp: match_ex_table_append split: if_split_asm)
         ultimately show ?thesis using \<open>xcp = \<lfloor>a\<rfloor>\<close> by(auto simp add: eval_nat_numeral shift_compxE2 ac_simps)
       qed
     qed
   next
     case False
     with pc have [simp]: "pc = length (compE2 e2)" by simp
     with exec show ?thesis
       by(auto elim!: exec_meth.cases intro!: exec_meth.intros split: if_split_asm simp add: match_ex_table_append_not_pcs eval_nat_numeral)(simp_all add: matches_ex_entry_def)
   qed
 next
   case bisim1Sync5 thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros split: if_split_asm)
 next
   case bisim1Sync6 thus ?case  
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros split: if_split_asm)     
 next
   case bisim1Sync7 thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros split: if_split_asm)
 next
   case bisim1Sync8 thus ?case
     by(fastforce elim: exec_meth.cases intro: exec_meth.intros split: if_split_asm)
 next
   case (bisim1Sync9 e1 n e2 V a xs)
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) [Addr a] STK xs (8 + length (compE2 e1) + length (compE2 e2)) None stk' loc' pc' xcp'\<close>
   let ?pre = "compE2 e1 @ Dup # Store V # MEnter # compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit]"
   from exec have exec': "exec_meth_d (compP2 P) (?pre @ [ThrowExc]) (stack_xlift (length STK) (compxE2 (sync\<^bsub>V\<^esub> (e1) e2) 0 0) @ shift (length ?pre) []) t h (Addr a # STK, xs, length ?pre + 0, None) ta h' (stk', loc', pc', xcp')"
     by(simp add: eval_nat_numeral)
   hence "exec_meth_d (compP2 P) [ThrowExc] [] t h (Addr a # STK, xs, 0, None) ta h' (stk', loc', pc' - length ?pre, xcp')"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   moreover from exec' have "pc' = 8 + length (compE2 e1) + length (compE2 e2)" "stk' = Addr a # STK"
     by(auto elim!: exec_meth.cases)
   ultimately show ?case by(fastforce elim!: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1Sync10 e1 n e2 V a xs)
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) [Addr a] STK xs (8 + length (compE2 e1) + length (compE2 e2)) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   hence "match_ex_table (compP2 P) (cname_of h a) (8 + length (compE2 e1) + length (compE2 e2)) (stack_xlift (length STK) (compxE2 (sync\<^bsub>V\<^esub> (e1) e2) 0 0)) \<noteq> None"
     by(rule exec_meth.cases) auto
   hence False by(auto split: if_split_asm simp add: match_ex_table_append_not_pcs)(simp add: matches_ex_entry_def)
   thus ?case ..
 next
   case (bisim1Sync11 e1 n e2 V xs)
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) [Null] STK xs (Suc (Suc (length (compE2 e1)))) \<lfloor>addr_of_sys_xcpt NullPointer\<rfloor> stk' loc' pc' xcp'\<close>
   hence "match_ex_table (compP2 P) (cname_of h (addr_of_sys_xcpt NullPointer)) (2 + length (compE2 e1)) (stack_xlift (length STK) (compxE2 (sync\<^bsub>V\<^esub> (e1) e2) 0 0)) \<noteq> None"
     by(rule exec_meth.cases)(auto split: if_split_asm)
   hence False by(auto split: if_split_asm simp add: match_ex_table_append_not_pcs)(simp add: matches_ex_entry_def)
   thus ?case ..
 next
   case (bisim1SyncThrow e1 n a xs stk loc pc e2 V)
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note bisim = \<open>P,e1,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   from bisim have pc: "pc < length (compE2 e1)"
     and [simp]: "loc = xs" by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e1 @ Dup # Store V # MEnter # compE2 e2 @ [Load V, MExit, Goto 4, Load V, MExit, ThrowExc])
      (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 3 0) @
       [(3, 3 + length (compE2 e2), None, 6 + length (compE2 e2), length STK)])) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   hence "?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt)(rule pc)
   from IH[OF this] show ?case by auto
 next
   case (bisim1Seq1 e1 n e1' xs stk loc pc xcp e2)
   note bisim1 = \<open>P,e1,h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e1;;e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     from exec have "exec_meth_d (compP2 P) (compE2 e1 @ Pop # compE2 e2) (stack_xlift (length STK) (compxE2 e1 0 0) @
       shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 (Suc 0) 0))) t
      h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: shift_compxE2 stack_xlift_compxE2)
     hence "?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'"
       by(rule exec_meth_take_xt)(rule True)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e1)" by simp
     with bisim1 obtain v where "xcp = None" "stk = [v]" by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
   qed
 next
   case (bisim1SeqThrow1 e1 n a xs stk loc pc e2)
   note bisim1 = \<open>P,e1,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e1;;e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc < length (compE2 e1)" by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e1 @ Pop # compE2 e2) (stack_xlift (length STK) (compxE2 e1 0 0) @
       shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 (Suc 0) 0))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: shift_compxE2 stack_xlift_compxE2)
   hence "?exec e1 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt)(rule pc)
   from IH[OF this] show ?case by(fastforce elim: exec_meth.cases intro: exec_meth.intros)
 next
   case (bisim1Seq2 e2 n e2' xs stk loc pc xcp e1)
   note bisim2 = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (e1;;e2) stk STK loc (Suc (length (compE2 e1) + pc)) xcp stk' loc' pc' xcp'\<close>
   from bisim2 have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e2)")
     case False
     with pc have [simp]: "pc = length (compE2 e2)" by simp
     from bisim2 have "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec have False by(auto elim: exec_meth.cases)
     thus ?thesis ..
   next
     case True
     from exec have exec':
       "exec_meth_d (compP2 P) ((compE2 e1 @ [Pop]) @ compE2 e2) (stack_xlift (length STK) (compxE2 e1 0 0) @
       shift (length (compE2 e1 @ [Pop])) (stack_xlift (length STK) (compxE2 e2 0 0))) t
      h (stk @ STK, loc, length ((compE2 e1) @ [Pop]) + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: compxE2_size_convs)
     hence "?exec e2 stk STK loc pc xcp stk' loc' (pc' - length ((compE2 e1) @ [Pop])) xcp'"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp)
       ta h' (stk'', loc', pc' - length (compE2 e1 @ [Pop]), xcp')" by auto
     from exec'' have "exec_meth_d (compP2 P) ((compE2 e1 @ [Pop]) @ compE2 e2) (compxE2 e1 0 0 @ shift (length (compE2 e1 @ [Pop])) (compxE2 e2 0 0)) t
      h (stk, loc, length ((compE2 e1) @ [Pop]) + pc, xcp) ta h' (stk'', loc', length ((compE2 e1) @ [Pop]) + (pc' - length ((compE2 e1) @ [Pop])), xcp')"
       by(rule append_exec_meth_xt) auto
     moreover from exec' have "pc' \<ge> length ((compE2 e1) @ [Pop])"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk' by(auto simp add: shift_compxE2 stack_xlift_compxE2)
   qed
 next
   case (bisim1Cond1 e n e' xs stk loc pc xcp e1 e2)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (if (e) e1 else e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     from exec have "exec_meth_d (compP2 P) (compE2 e @ IfFalse (2 + int (length (compE2 e1))) # compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e1 (Suc 0) 0) @
       stack_xlift (length STK) (compxE2 e2 (Suc (Suc (length (compE2 e1)))) 0))) t
      h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: stack_xlift_compxE2 shift_compxE2 ac_simps)
     hence "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(rule exec_meth_take_xt)(rule True)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None"
       by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
   qed
 next
   case (bisim1CondThen e1 n e1' xs stk loc pc xcp e e2)
   note bisim = \<open>P,e1,h \<turnstile> (e1', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e1 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e1 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (if (e) e1 else e2) stk STK loc (Suc (length (compE2 e) + pc)) xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e1)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e1)")
     case True
     let ?pre = "compE2 e @ [IfFalse (2 + int (length (compE2 e1)))]"
     from exec have exec': "exec_meth_d (compP2 P) (?pre @ compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e1 0 0) @
       shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 (Suc 0) 0)))) t
      h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: stack_xlift_compxE2 shift_compxE2 ac_simps)
     hence "exec_meth_d (compP2 P) (compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
       (stack_xlift (length STK) (compxE2 e1 0 0) @ shift (length (compE2 e1)) (stack_xlift (length STK) (compxE2 e2 (Suc 0) 0))) t
      h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc' - length ?pre, xcp')"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     hence "?exec e1 stk STK loc pc xcp stk' loc' (pc' - length ?pre) xcp'"
       by(rule exec_meth_take_xt)(rule True)
     from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e1) (compxE2 e1 0 0) t h (stk, loc, pc, xcp)
       ta h' (stk'', loc', pc' - length ?pre, xcp')" by blast
     from exec'' have "exec_meth_d (compP2 P) (compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
       (compxE2 e1 0 0 @ shift (length (compE2 e1)) (compxE2 e2 (Suc 0) 0)) t
      h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length ?pre, xcp')"
       by(rule exec_meth_append_xt)
     hence "exec_meth_d (compP2 P) (?pre @ compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
       (compxE2 e 0 0 @ shift (length ?pre) (compxE2 e1 0 0 @ shift (length (compE2 e1)) (compxE2 e2 (Suc 0) 0))) t
      h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
       by(rule append_exec_meth_xt)(auto)
     moreover from exec' have "pc' \<ge> length ?pre"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using stk'
       by(auto simp add: shift_compxE2 stack_xlift_compxE2 ac_simps)
   next
     case False
     with pc have [simp]: "pc = length (compE2 e1)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None"
       by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
   qed
 next
   case (bisim1CondElse e2 n e2' xs stk loc pc xcp e e1)
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (if (e) e1 else e2) stk STK loc (Suc (Suc (length (compE2 e) + length (compE2 e1) + pc))) xcp stk' loc' pc' xcp'\<close>
   note bisim = \<open>P,e2,h \<turnstile> (e2', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   from bisim have pc: "pc \<le> length (compE2 e2)" by(rule bisim1_pc_length_compE2)
 
   let ?pre = "compE2 e @ IfFalse (2 + int (length (compE2 e1))) # compE2 e1 @ [Goto (1 + int (length (compE2 e2)))]"
   from exec have exec': "exec_meth_d (compP2 P) (?pre @ compE2 e2)
     (stack_xlift (length STK) (compxE2 e 0 0 @ compxE2 e1 (Suc (length (compE2 e))) 0) @
      shift (length ?pre) (stack_xlift (length STK) (compxE2 e2 0 0))) t
     h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: stack_xlift_compxE2 shift_compxE2 ac_simps)
   hence "?exec e2 stk STK loc pc xcp stk' loc' (pc' - length ?pre) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2 shift_compxEs2 ac_simps)
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp)
     ta h' (stk'', loc', pc' - length ?pre, xcp')" by blast
   from exec'' have "exec_meth_d (compP2 P) (?pre @ compE2 e2)
     ((compxE2 e 0 0 @ compxE2 e1 (Suc (length (compE2 e))) 0) @ shift (length ?pre) (compxE2 e2 0 0)) t
     h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule append_exec_meth_xt)(auto)
   moreover from exec' have "pc' \<ge> length ?pre"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   moreover hence "(Suc (Suc (pc' - Suc (Suc 0)))) = pc'" by simp
   ultimately show ?case using stk'
     by(auto simp add: shift_compxE2 stack_xlift_compxE2 ac_simps eval_nat_numeral)
 next
   case (bisim1CondThrow e n a xs stk loc pc e1 e2)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (if (e) e1 else e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 e @ IfFalse (2 + int (length (compE2 e1))) # compE2 e1 @ Goto (1 + int (length (compE2 e2))) # compE2 e2)
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e1 (Suc 0) 0) @
       stack_xlift (length STK) (compxE2 e2 (Suc (Suc (length (compE2 e1)))) 0))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: stack_xlift_compxE2 shift_compxE2 ac_simps)
   hence "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt)(rule pc)
   from IH[OF this] show ?case by auto
 next
   case (bisim1While1 c n e xs)
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec c [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concl c [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (while (c) e) [] STK xs 0 None stk' loc' pc' xcp'\<close>
   hence "exec_meth_d (compP2 P) (compE2 c @ IfFalse (int (length (compE2 e)) + 3) # compE2 e @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
      (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length (compE2 c)) (stack_xlift (length STK) (compxE2 e (Suc 0) 0))) t
      h ([] @ STK, xs, 0, None) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence "?exec c [] STK xs 0 None stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt) simp
   from IH[OF this] show ?case by auto
 next
   case (bisim1While3 c n c' xs stk loc pc xcp e)
   note bisim = \<open>P,c,h \<turnstile> (c', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec c stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl c stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (while (c) e) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 c)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 c)")
     case True
     from exec have "exec_meth_d (compP2 P) (compE2 c @ IfFalse (int (length (compE2 e)) + 3) # compE2 e @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
      (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length (compE2 c)) (stack_xlift (length STK) (compxE2 e (Suc 0) 0))) t
       h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: compxE2_size_convs)
     hence "?exec c stk STK loc pc xcp stk' loc' pc' xcp'"
       by(rule exec_meth_take_xt)(rule True)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 c)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
   qed
 next
   case (bisim1While4 e n e' xs stk loc pc xcp c)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (while (c) e) stk STK loc (Suc (length (compE2 c) + pc)) xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     let ?pre = "compE2 c @ [IfFalse (int (length (compE2 e)) + 3)]"
     from exec have "exec_meth_d (compP2 P) ((?pre @ compE2 e) @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
                    (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e 0 0))) t
                     h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: compxE2_size_convs)
     hence exec': "exec_meth_d (compP2 P) (?pre @ compE2 e) (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e 0 0))) t
                  h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(rule exec_meth_take)(auto intro: True)
     hence "?exec e stk STK loc pc xcp stk' loc' (pc' - length ?pre) xcp'"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)      
     from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
       and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length ?pre, xcp')" by auto
     from exec'' have "exec_meth_d (compP2 P) (?pre @ compE2 e) (compxE2 c 0 0 @ shift (length ?pre) (compxE2 e 0 0)) t
                      h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
       by(rule append_exec_meth_xt) auto
     hence "exec_meth_d (compP2 P) ((?pre @ compE2 e) @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
            (compxE2 c 0 0 @ shift (length ?pre) (compxE2 e 0 0)) t
            h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
       by(rule exec_meth_append)
     moreover from exec' have "pc' \<ge> length ?pre"
      by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
    moreover have "-2 + (- int (length (compE2 e)) - int (length (compE2 c))) = - int (length (compE2 c)) + (-2 - int (length (compE2 e)))" by simp
    ultimately show ?thesis using stk'
      by(auto simp add: shift_compxE2 stack_xlift_compxE2 algebra_simps uminus_minus_left_commute)
  next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros)
   qed
 next
   case (bisim1While6 c n e xs)
   note exec = \<open>?exec (while (c) e) [] STK xs (Suc (Suc (length (compE2 c) + length (compE2 e)))) None stk' loc' pc' xcp'\<close>
   thus ?case by(rule exec_meth.cases)(simp_all, auto intro!: exec_meth.intros)
 next
   case (bisim1While7 c n e xs)
   note exec = \<open>?exec (while (c) e) [] STK xs (Suc (Suc (Suc (length (compE2 c) + length (compE2 e))))) None stk' loc' pc' xcp'\<close>
   thus ?case by(rule exec_meth.cases)(simp_all, auto intro!: exec_meth.intros)
 next
   case (bisim1WhileThrow1 c n a xs stk loc pc e)
   note bisim = \<open>P,c,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec c stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl c stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (while (c) e) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 c)" by(auto dest: bisim1_ThrowD)
   from exec have "exec_meth_d (compP2 P) (compE2 c @ IfFalse (int (length (compE2 e)) + 3) # compE2 e @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
      (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length (compE2 c)) (stack_xlift (length STK) (compxE2 e (Suc 0) 0))) t
      h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence "?exec c stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(rule exec_meth_take_xt)(rule pc)
   from IH[OF this] show ?case by auto
 next
   case (bisim1WhileThrow2 e n a xs stk loc pc c)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (while (c) e) stk STK loc (Suc (length (compE2 c) + pc)) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" by(auto dest: bisim1_ThrowD)
   let ?pre = "compE2 c @ [IfFalse (int (length (compE2 e)) + 3)]"
   from exec have "exec_meth_d (compP2 P) ((?pre @ compE2 e) @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
      (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e 0 0))) t
     h (stk @ STK, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxE2_size_convs)
   hence exec': "exec_meth_d (compP2 P) (?pre @ compE2 e)
     (stack_xlift (length STK) (compxE2 c 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e 0 0))) t
     h (stk @ STK, loc, (length ?pre + pc), \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
     by(rule exec_meth_take)(auto intro: pc)
   hence "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length ?pre) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)      
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length ?pre, xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) (?pre @ compE2 e) (compxE2 c 0 0 @ shift (length ?pre) (compxE2 e 0 0)) t
     h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule append_exec_meth_xt) auto
   hence "exec_meth_d (compP2 P) ((?pre @ compE2 e) @ [Pop, Goto (-2 + (- int (length (compE2 e)) - int (length (compE2 c)))), Push Unit])
     (compxE2 c 0 0 @ shift (length ?pre) (compxE2 e 0 0)) t
     h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule exec_meth_append)
   moreover from exec' have "pc' \<ge> length ?pre"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   moreover have "-2 + (- int (length (compE2 e)) - int (length (compE2 c))) = - int (length (compE2 c)) + (-2 - int (length (compE2 e)))" by simp
   ultimately show ?case using stk'
     by(auto simp add: shift_compxE2 stack_xlift_compxE2 algebra_simps uminus_minus_left_commute)
 next
   case (bisim1Throw1 e n e' xs stk loc pc xcp)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (throw e) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'" by(auto elim: exec_meth_take)
     from IH[OF this] show ?thesis by auto
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case bisim1Throw2 thus ?case
     apply(auto elim!:exec_meth.cases intro: exec_meth.intros dest!: match_ex_table_stack_xliftD)
     apply(auto intro: exec_meth.intros dest!: match_ex_table_stack_xliftD intro!: exI)
     apply(auto simp add: le_Suc_eq)
     done
 next
   case bisim1ThrowNull thus ?case
     apply(auto elim!:exec_meth.cases intro: exec_meth.intros dest!: match_ex_table_stack_xliftD)
     apply(auto intro: exec_meth.intros dest!: match_ex_table_stack_xliftD intro!: exI)
     apply(auto simp add: le_Suc_eq)
     done
 next
   case (bisim1ThrowThrow e n a xs stk loc pc)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (throw e) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e)" by(auto dest: bisim1_ThrowD)
   with exec have "?exec e stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'"
     by(auto elim: exec_meth_take simp add: compxE2_size_convs)
   from IH[OF this] show ?case by auto
 next
   case (bisim1Try e n e' xs stk loc pc xcp e2 C' V)
   note bisim = \<open>P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (try e catch(C' V) e2) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     from exec have exec': "exec_meth_d (compP2 P) (compE2 e @ Goto (int (length (compE2 e2)) + 2) # Store V # compE2 e2)
       (stack_xlift (length STK) (compxE2 e 0 0) @  shift (length (compE2 e)) (stack_xlift (length STK) (compxE2 e2 (Suc (Suc 0)) 0)) @ [(0, length (compE2 e), \<lfloor>C'\<rfloor>, Suc (length (compE2 e)), length STK)]) t
       h (stk @ STK, loc, pc, xcp) ta h' (stk', loc', pc', xcp')"
       by(simp add: compxE2_size_convs)
     show ?thesis
     proof(cases xcp)
       case None
       with exec' True have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
         apply -
         apply (erule exec_meth.cases)
         apply (cases "compE2 e ! pc")
         apply (fastforce simp add: is_Ref_def intro: exec_meth.intros split: if_split_asm cong del: image_cong_simp)+
         done
       from IH[OF this] show ?thesis by auto
     next
       case (Some a)
       with exec' have [simp]: "h' = h" "loc' = loc" "xcp' = None" "ta = \<epsilon>"
         by(auto elim: exec_meth.cases)
       show ?thesis
       proof(cases "match_ex_table (compP2 P) (cname_of h a) pc (compxE2 e 0 0)")
         case (Some pcd)
         from exec \<open>xcp = \<lfloor>a\<rfloor>\<close> Some pc
         have stk': "stk' = Addr a # (drop (length stk - snd pcd) stk) @ STK"
           by(auto elim!: exec_meth.cases simp add: match_ex_table_append split: if_split_asm dest!: match_ex_table_stack_xliftD)
         from exec' \<open>xcp = \<lfloor>a\<rfloor>\<close> Some pc have "exec_meth_d (compP2 P)
           (compE2 e) (stack_xlift (length STK) (compxE2 e 0 0)) t h (stk @ STK, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # (drop (length (stk @ STK) - (snd pcd + length STK)) (stk @ STK)), loc, pc', None)"
           apply -
           apply(rule exec_meth.intros)
           apply(auto elim!: exec_meth.cases simp add: match_ex_table_append split: if_split_asm dest!: match_ex_table_shift_pcD match_ex_table_stack_xliftD)
           done
         from IH[unfolded \<open>ta = \<epsilon>\<close> \<open>xcp = \<lfloor>a\<rfloor>\<close> \<open>h' = h\<close>, OF this]
         have stk: "Addr a # drop (length stk - snd pcd) (stk @ STK) = Addr a # drop (length stk - snd pcd) stk @ STK"
           and exec'': "exec_meth_d (compP2 P) (compE2 e) (compxE2 e 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - snd pcd) stk, loc, pc', None)" by auto
         thus ?thesis using Some stk' \<open>xcp = \<lfloor>a\<rfloor>\<close> by(auto)
       next
         case None
         with Some exec pc have stk': "stk' = Addr a # STK"
           and pc': "pc' = Suc (length (compE2 e))"
           and subcls: "compP2 P \<turnstile> cname_of h a \<preceq>\<^sup>* C'"
           by(auto elim!: exec_meth.cases split: if_split_asm simp add: match_ex_table_append_not_pcs)(simp add: matches_ex_entry_def)
         moreover from Some True None pc' subcls
         have "exec_meth_d (compP2 P) (compE2 (try e catch(C' V) e2)) (compxE2 (try e catch(C' V) e2) 0 0) t h
           (stk, loc, pc, \<lfloor>a\<rfloor>) \<epsilon> h (Addr a # drop (length stk - 0) stk, loc, pc', None)"
           by -(rule exec_catch,auto simp add: match_ex_table_append_not_pcs matches_ex_entry_def)
         ultimately show ?thesis using Some by auto
       qed
     qed
   next
     case False
     with pc have [simp]: "pc = length (compE2 e)" by simp
     from bisim obtain v where "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec show ?thesis by(auto elim!: exec_meth.cases intro!: exec_meth.intros split: if_split_asm)
   qed
 next
   case bisim1TryCatch1 thus ?case
     by(auto elim!: exec_meth.cases intro!: exec_meth.intros split: if_split_asm)
 next
   case (bisim1TryCatch2 e2 n e' xs stk loc pc xcp e C' V)
   note bisim = \<open>P,e2,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (try e catch(C' V) e2) stk STK loc (Suc (Suc (length (compE2 e) + pc))) xcp stk' loc' pc' xcp'\<close>
   let ?pre = "compE2 e @ [Goto (int (length (compE2 e2)) + 2), Store V]"
   from exec have exec': "exec_meth_d (compP2 P) (?pre @ compE2 e2)
     (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length ?pre) (stack_xlift (length STK) (compxE2 e2 0 0))) t
     h (stk @ STK, loc, length ?pre + pc, xcp) ta h' (stk', loc', pc', xcp')"
   proof(cases)
     case (exec_catch xcp'' d)
     let ?stk = "stk @ STK" and ?PC = "Suc (Suc (length (compE2 e) + pc))"
     note s = \<open>stk' = Addr xcp'' # drop (length ?stk - d) ?stk\<close>
       \<open>ta = \<epsilon>\<close> \<open>h' = h\<close> \<open>xcp' = None\<close> \<open>xcp = \<lfloor>xcp''\<rfloor>\<close> \<open>loc' = loc\<close>
     from \<open>match_ex_table (compP2 P) (cname_of h xcp'') ?PC (stack_xlift (length STK) (compxE2 (try e catch(C' V) e2) 0 0)) = \<lfloor>(pc', d)\<rfloor>\<close> \<open>d \<le> length ?stk\<close>
     show ?thesis unfolding s
       by -(rule exec_meth.exec_catch, simp_all add: shift_compxE2 stack_xlift_compxE2, simp add: match_ex_table_append add: matches_ex_entry_def)
   qed(auto intro: exec_meth.intros simp add: shift_compxE2 stack_xlift_compxE2)
   hence "?exec e2 stk STK loc pc xcp stk' loc' (pc' - length ?pre) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length ?pre, xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) (?pre @ compE2 e2) (compxE2 e 0 0 @ shift (length ?pre) (compxE2 e2 0 0)) t h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule append_exec_meth_xt) auto
   hence "exec_meth_d (compP2 P) (?pre @ compE2 e2) (compxE2 e 0 0 @ shift (length ?pre) (compxE2 e2 0 0) @ [(0, length (compE2 e), \<lfloor>C'\<rfloor>, Suc (length (compE2 e)), 0)]) t h (stk, loc, length ?pre + pc, xcp) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule exec_meth.cases)(auto intro: exec_meth.intros simp add: match_ex_table_append_not_pcs)
   moreover from exec' have "pc' \<ge> length ?pre"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   moreover hence "(Suc (Suc (pc' - Suc (Suc 0)))) = pc'" by simp
   ultimately show ?case using stk' by(auto simp add: shift_compxE2 eval_nat_numeral)
 next
   case (bisim1TryFail e n a xs stk loc pc C' C'' e2 V)
   note bisim = \<open>P,e,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note exec = \<open>?exec (try e catch(C'' V) e2) stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note a = \<open>typeof_addr h a = \<lfloor>Class_type C'\<rfloor>\<close> \<open>\<not> P \<turnstile> C' \<preceq>\<^sup>* C''\<close>
   from bisim have "match_ex_table (compP2 P) (cname_of h a) (0 + pc) (compxE2 e 0 0) = None"
     unfolding compP2_def by(rule bisim1_xcp_Some_not_caught)
   moreover from bisim have "pc < length (compE2 e)" by(auto dest: bisim1_ThrowD)
   ultimately have False using exec a
     apply(auto elim!: exec_meth.cases simp add: outside_pcs_compxE2_not_matches_entry outside_pcs_not_matches_entry split: if_split_asm)
     apply(auto simp add: compP2_def match_ex_entry match_ex_table_append_not_pcs cname_of_def split: if_split_asm)
     done
   thus ?case ..
 next
   case (bisim1TryCatchThrow e2 n a xs stk loc pc e C' V)
   note bisim = \<open>P,e2,h \<turnstile> (Throw a, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'
              \<Longrightarrow> ?concl e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   note exec = \<open>?exec (try e catch(C' V) e2) stk STK loc (Suc (Suc (length (compE2 e) + pc))) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   from bisim have pc: "pc < length (compE2 e2)" by(auto dest: bisim1_ThrowD)
   let ?pre = "compE2 e @ [Goto (int (length (compE2 e2)) + 2), Store V]"
   from exec have exec': "exec_meth_d (compP2 P) (?pre @ compE2 e2) (stack_xlift (length STK) (compxE2 e 0 0) @
     shift (length ?pre) (stack_xlift (length STK)  (compxE2 e2 0 0))) t
     h (stk @ STK, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk', loc', pc', xcp')"
   proof(cases)
     case (exec_catch d)
     let ?stk = "stk @ STK" and ?PC = "Suc (Suc (length (compE2 e) + pc))"
     note s = \<open>stk' = Addr a # drop (length ?stk - d) ?stk\<close> \<open>loc' = loc\<close>
       \<open>ta = \<epsilon>\<close> \<open>h' = h\<close> \<open>xcp' = None\<close>
     from \<open>match_ex_table (compP2 P) (cname_of h a) ?PC (stack_xlift (length STK) (compxE2 (try e catch(C' V) e2) 0 0)) = \<lfloor>(pc', d)\<rfloor>\<close> \<open>d \<le> length ?stk\<close>
     show ?thesis unfolding s
       by -(rule exec_meth.exec_catch, simp_all add: shift_compxE2 stack_xlift_compxE2, simp add: match_ex_table_append add: matches_ex_entry_def)
   qed
   hence "?exec e2 stk STK loc pc \<lfloor>a\<rfloor> stk' loc' (pc' - length ?pre) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ STK"
     and exec'': "exec_meth_d (compP2 P) (compE2 e2) (compxE2 e2 0 0) t h (stk, loc, pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', pc' - length ?pre, xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) (?pre @ compE2 e2) (compxE2 e 0 0 @ shift (length ?pre) (compxE2 e2 0 0)) t h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule append_exec_meth_xt) auto
   hence "exec_meth_d (compP2 P) (?pre @ compE2 e2) (compxE2 e 0 0 @ shift (length ?pre) (compxE2 e2 0 0) @ [(0, length (compE2 e), \<lfloor>C'\<rfloor>, Suc (length (compE2 e)), 0)]) t h (stk, loc, length ?pre + pc, \<lfloor>a\<rfloor>) ta h' (stk'', loc', length ?pre + (pc' - length ?pre), xcp')"
     by(rule exec_meth.cases)(auto intro!: exec_meth.intros simp add: match_ex_table_append_not_pcs)
   moreover from exec' have "pc' \<ge> length ?pre"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   moreover hence "(Suc (Suc (pc' - Suc (Suc 0)))) = pc'" by simp
   ultimately show ?case using stk' by(auto simp add: shift_compxE2 eval_nat_numeral)
 next
   case bisims1Nil thus ?case by(auto elim: exec_meth.cases)
 next
   case (bisims1List1 e n e' xs stk loc pc xcp es)
   note bisim1 = \<open>P,e,h \<turnstile> (e', xs ) \<leftrightarrow> (stk, loc, pc, xcp)\<close>
   note IH1 = \<open>\<And>stk' loc' pc' xcp' STK. ?exec e stk STK loc pc xcp stk' loc' pc' xcp'
               \<Longrightarrow> ?concl e stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note IH2 = \<open>\<And>xs stk' loc' pc' xcp' STK. ?execs es [] STK xs 0 None stk' loc' pc' xcp'
              \<Longrightarrow> ?concls es [] STK xs 0 None stk' loc' pc' xcp'\<close>
   note exec = \<open>?execs (e # es) stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   from bisim1 have pc: "pc \<le> length (compE2 e)" by(rule bisim1_pc_length_compE2)
   show ?case
   proof(cases "pc < length (compE2 e)")
     case True
     with exec have "?exec e stk STK loc pc xcp stk' loc' pc' xcp'"
       by(simp add: compxEs2_size_convs)(erule exec_meth_take_xt)
     from IH1[OF this] show ?thesis by auto
   next
     case False
     with pc have pc: "pc = length (compE2 e)" by simp
     with bisim1 obtain v where s: "stk = [v]" "xcp = None" by(auto dest: bisim1_pc_length_compE2D)
     with exec pc have exec': "exec_meth_d (compP2 P) (compE2 e @ compEs2 es)
       (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length (v # STK)) (compxEs2 es 0 0))) t
       h ([] @ v # STK, loc, length (compE2 e) + 0, None) ta h' (stk', loc', pc', xcp')"
       by(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
     hence "?execs es [] (v # STK) loc 0 None stk' loc' (pc' - length (compE2 e)) xcp'"
       by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
     from IH2[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
       and exec'': "exec_meth_d (compP2 P) (compEs2 es) (compxEs2 es 0 0) t h ([], loc, 0, None) ta h' (stk'', loc', pc' - length (compE2 e), xcp')" by auto
     from exec'' have "exec_meth_d (compP2 P) (compEs2 es) (stack_xlift (length [v]) (compxEs2 es 0 0)) t h ([] @ [v], loc, 0, None) ta h' (stk'' @ [v], loc', pc' - length (compE2 e), xcp')"
       by(rule exec_meth_stk_offer)
     hence "exec_meth_d (compP2 P) (compE2 e @ compEs2 es) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v]) (compxEs2 es 0 0))) t h ([] @ [v], loc, length (compE2 e) + 0, None) ta h' (stk'' @ [v], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
       by(rule append_exec_meth_xt) auto
     moreover from exec' have "pc' \<ge> length (compE2 e)"
       by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
     ultimately show ?thesis using s pc stk' by(auto simp add: shift_compxEs2 stack_xlift_compxEs2)
   qed
 next
   case (bisims1List2 es n es' xs stk loc pc xcp e v)
   note bisim = \<open>P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc,xcp)\<close>
   note IH = \<open>\<And>stk' loc' pc' xcp' STK. ?execs es stk STK loc pc xcp stk' loc' pc' xcp'
              \<Longrightarrow> ?concls es stk STK loc pc xcp stk' loc' pc' xcp'\<close>
   note exec = \<open>?execs (e # es) (stk @ [v]) STK loc (length (compE2 e) + pc) xcp stk' loc' pc' xcp'\<close>
   from exec have exec': "exec_meth_d (compP2 P) (compE2 e @ compEs2 es)
      (stack_xlift (length STK) (compxE2 e 0 0) @ shift (length (compE2 e)) (stack_xlift (length (v # STK)) (compxEs2 es 0 0))) t
      h (stk @ v # STK, loc, length (compE2 e) + pc, xcp) ta h' (stk', loc', pc', xcp')"
     by(simp add: compxEs2_size_convs compxEs2_stack_xlift_convs)
   hence "?execs es stk (v # STK) loc pc xcp stk' loc' (pc' - length (compE2 e)) xcp'"
     by(rule exec_meth_drop_xt)(auto simp add: stack_xlift_compxE2)
   from IH[OF this] obtain stk'' where stk': "stk' = stk'' @ v # STK"
     and exec'': "exec_meth_d (compP2 P) (compEs2 es) (compxEs2 es 0 0) t h (stk, loc, pc, xcp) ta h' (stk'', loc', pc' - length (compE2 e), xcp')" by auto
   from exec'' have "exec_meth_d (compP2 P) (compEs2 es) (stack_xlift (length [v]) (compxEs2 es 0 0)) t h (stk @ [v], loc, pc, xcp) ta h' (stk'' @ [v], loc', pc' - length (compE2 e), xcp')"
     by(rule exec_meth_stk_offer)
   hence "exec_meth_d (compP2 P) (compE2 e @ compEs2 es) (compxE2 e 0 0 @ shift (length (compE2 e)) (stack_xlift (length [v]) (compxEs2 es 0 0))) t h (stk @ [v], loc, length (compE2 e) + pc, xcp) ta h' (stk'' @ [v], loc', length (compE2 e) + (pc' - length (compE2 e)), xcp')"
     by(rule append_exec_meth_xt) auto
   moreover from exec' have "pc' \<ge> length (compE2 e)"
     by(rule exec_meth_drop_xt_pc)(auto simp add: stack_xlift_compxE2)
   ultimately show ?case using stk' by(auto simp add: shift_compxEs2 stack_xlift_compxEs2)
 next
   case (bisim1Sync12 e1 n e2 V a xs v v')
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) [v, v'] STK xs (4 + length (compE2 e1) + length (compE2 e2)) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   thus ?case by(auto elim!: exec_meth.cases split: if_split_asm simp add: match_ex_table_append_not_pcs)(simp add: matches_ex_entry_def)
 next
   case (bisim1Sync14 e1 n e2 V a xs v a')
   note exec = \<open>?exec (sync\<^bsub>V\<^esub> (e1) e2) [v, Addr a'] STK xs (7 + length (compE2 e1) + length (compE2 e2)) \<lfloor>a\<rfloor> stk' loc' pc' xcp'\<close>
   thus ?case by(auto elim!: exec_meth.cases split: if_split_asm simp add: match_ex_table_append_not_pcs)(simp add: matches_ex_entry_def)
 qed
 
 lemma shows bisim1_callD:
   "\<lbrakk> P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, xcp); call1 e' = \<lfloor>(a, M, vs)\<rfloor>;
      compE2 e ! pc = Invoke M' n0 \<rbrakk>
     \<Longrightarrow> M = M'"
 
   and bisims1_callD:
   "\<lbrakk> P,es,h \<turnstile> (es',xs) [\<leftrightarrow>] (stk,loc,pc, xcp); calls1 es' = \<lfloor>(a, M, vs)\<rfloor>;
      compEs2 es ! pc = Invoke M' n0 \<rbrakk>
     \<Longrightarrow> M = M'"
 proof(induct e "n :: nat" e' xs stk loc pc xcp and es "n :: nat" es' xs stk loc pc xcp
     rule: bisim1_bisims1_inducts_split)
   case bisim1AAss1 thus ?case
     apply(simp (no_asm_use) split: if_split_asm add: is_val_iff)
     apply(fastforce dest: bisim_Val_pc_not_Invoke)
     apply(fastforce dest: bisim_Val_pc_not_Invoke)
     apply(fastforce dest: bisim_Val_pc_not_Invoke bisim1_pc_length_compE2)+
     done
 next
   case bisim1Call1 thus ?case
     apply(clarsimp split: if_split_asm simp add: is_vals_conv)
     apply(drule bisim_Val_pc_not_Invoke, simp, fastforce)
     apply(drule bisim_Val_pc_not_Invoke, simp, fastforce)
     apply(drule bisim1_pc_length_compE2, clarsimp simp add: neq_Nil_conv)
     apply(drule bisim1_pc_length_compE2, simp)
     apply(drule bisim1_pc_length_compE2, simp)
     apply(drule bisim1_pc_length_compE2, simp)
     apply(drule bisim1_call_pcD, simp, simp)
     apply(drule bisim1_call_pcD, simp, simp)
     done
 next
   case bisim1CallParams thus ?case
     apply(clarsimp split: if_split_asm simp add: is_vals_conv)
     apply(drule bisims_Val_pc_not_Invoke, simp, fastforce)
     apply(drule bisims1_pc_length_compEs2, simp)
     apply(drule bisims1_calls_pcD, simp, simp)
     done
 qed(fastforce split: if_split_asm dest: bisim1_pc_length_compE2 bisims1_pc_length_compEs2 bisim1_call_pcD bisims1_calls_pcD bisim1_call_xcpNone bisims1_calls_xcpNone bisim_Val_pc_not_Invoke bisims_Val_pc_not_Invoke)+
 
 lemma bisim1_xcpD: "P,e,h \<turnstile> (e', xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> pc < length (compE2 e)"
   and bisims1_xcpD: "P,es,h \<turnstile> (es', xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>) \<Longrightarrow> pc < length (compEs2 es)"
 by(induct "(e', xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)" and "(es', xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)"
   arbitrary: e' xs stk loc pc and es' xs stk loc pc rule: bisim1_bisims1.inducts)
   simp_all
 
 lemma bisim1_match_Some_stk_length:
   "\<lbrakk> P,E,h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, \<lfloor>a\<rfloor>);
      match_ex_table (compP2 P) (cname_of h a) pc (compxE2 E 0 0) = \<lfloor>(pc', d)\<rfloor> \<rbrakk>
   \<Longrightarrow> d \<le> length stk"
 
   and bisims1_match_Some_stk_length:
   "\<lbrakk> P,Es,h \<turnstile> (es, xs) [\<leftrightarrow>] (stk, loc, pc, \<lfloor>a\<rfloor>);
      match_ex_table (compP2 P) (cname_of h a) pc (compxEs2 Es 0 0) = \<lfloor>(pc', d)\<rfloor> \<rbrakk>
   \<Longrightarrow> d \<le> length stk"
 proof(induct "(e, xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)" and "(es, xs)" "(stk, loc, pc, \<lfloor>a :: 'addr\<rfloor>)"
   arbitrary: pc' d e xs stk loc pc and pc' d es xs stk loc pc rule: bisim1_bisims1.inducts)
   case bisim1Call1 thus ?case
     by(fastforce dest: bisim1_xcpD simp add: match_ex_table_append match_ex_table_not_pcs_None)
 next
   case bisim1CallThrowObj thus ?case
     by(fastforce dest: bisim1_xcpD simp add: match_ex_table_append match_ex_table_not_pcs_None)
 next
   case bisim1Sync4 thus ?case
     apply(clarsimp simp add: match_ex_table_not_pcs_None match_ex_table_append matches_ex_entry_def split: if_split_asm)
     apply(fastforce simp add: match_ex_table_compxE2_shift_conv dest: bisim1_xcpD)
     done
 next
   case bisim1Try thus ?case
     by(fastforce simp add: match_ex_table_append matches_ex_entry_def match_ex_table_not_pcs_None dest: bisim1_xcpD split: if_split_asm)
 next
   case bisim1TryCatch2 thus ?case
     apply(clarsimp simp add: match_ex_table_not_pcs_None match_ex_table_append matches_ex_entry_def split: if_split_asm)
     apply(fastforce simp add: match_ex_table_compxE2_shift_conv dest: bisim1_xcpD)
     done
 next
   case bisim1TryFail thus ?case
     by(fastforce simp add: match_ex_table_append matches_ex_entry_def match_ex_table_not_pcs_None dest: bisim1_xcpD split: if_split_asm)
 next
   case bisim1TryCatchThrow thus ?case
     apply(clarsimp simp add: match_ex_table_not_pcs_None match_ex_table_append matches_ex_entry_def split: if_split_asm)
     apply(fastforce simp add: match_ex_table_compxE2_shift_conv dest: bisim1_xcpD)
     done
 next
   case bisims1List1 thus ?case
     by(fastforce simp add: match_ex_table_append split: if_split_asm dest: bisim1_xcpD match_ex_table_pcsD)
 qed(fastforce simp add: match_ex_table_not_pcs_None match_ex_table_append match_ex_table_compxE2_shift_conv match_ex_table_compxEs2_shift_conv match_ex_table_compxE2_stack_conv match_ex_table_compxEs2_stack_conv matches_ex_entry_def dest: bisim1_xcpD)+
 
 end
 
 locale J1_JVM_heap_conf_base =
   J1_JVM_heap_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
   +
   J1_heap_conf_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     hconf P 
   +
   JVM_heap_conf_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     hconf "compP2 P"
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and P :: "'addr J1_prog"
 begin
 
 inductive bisim1_list1 :: 
   "'thread_id \<Rightarrow> 'heap \<Rightarrow> 'addr expr1 \<times> 'addr locals1 \<Rightarrow> ('addr expr1 \<times> 'addr locals1) list
   \<Rightarrow> 'addr option \<Rightarrow> 'addr frame list \<Rightarrow> bool"
 for t :: 'thread_id and h :: 'heap
 where
   bl1_Normal:
   "\<lbrakk> compTP P \<turnstile> t:(xcp, h, (stk, loc, C, M, pc) # frs) \<surd>;
      P \<turnstile> C sees M : Ts\<rightarrow>T = \<lfloor>body\<rfloor> in D;
      P,blocks1 0 (Class D#Ts) body, h \<turnstile> (e, xs) \<leftrightarrow> (stk, loc, pc, xcp); max_vars e \<le> length xs;
      list_all2 (bisim1_fr P h) exs frs \<rbrakk>
   \<Longrightarrow> bisim1_list1 t h (e, xs) exs xcp ((stk, loc, C, M, pc) # frs)"
 
 | bl1_finalVal:
   "\<lbrakk> hconf h; preallocated h \<rbrakk> \<Longrightarrow> bisim1_list1 t h (Val v, xs) [] None []"
 
 | bl1_finalThrow:
   "\<lbrakk> hconf h; preallocated h \<rbrakk> \<Longrightarrow> bisim1_list1 t h (Throw a, xs) [] \<lfloor>a\<rfloor> []"
 
 fun wbisim1 :: 
   "'thread_id
   \<Rightarrow> ((('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list) \<times> 'heap, 
       ('addr option \<times> 'addr frame list) \<times> 'heap) bisim"
 where "wbisim1 t ((ex, exs), h) ((xcp, frs), h') \<longleftrightarrow> h = h' \<and> bisim1_list1 t h ex exs xcp frs"
 
 lemma new_thread_conf_compTP:
   assumes hconf: "hconf h" "preallocated h"
   and ha: "typeof_addr h a = \<lfloor>Class_type C\<rfloor>"
   and sub: "typeof_addr h (thread_id2addr t) = \<lfloor>Class_type C'\<rfloor>" "P \<turnstile> C' \<preceq>\<^sup>* Thread"
   and sees: "P \<turnstile> C sees M: []\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
   shows "compTP P \<turnstile> t:(None, h, [([], Addr a # replicate (max_vars meth) undefined_value, D, M, 0)]) \<surd>"
 proof -
   from ha sees_method_decl_above[OF sees]
   have "P,h \<turnstile> Addr a :\<le> Class D" by(simp add: conf_def)
   moreover
   hence "compP2 P,h \<turnstile> Addr a :\<le> Class D" by(simp add: compP2_def)
   hence "compP2 P,h \<turnstile> Addr a # replicate (max_vars meth) undefined_value [:\<le>\<^sub>\<top>] map (\<lambda>i. if i = 0 then OK ([Class D] ! i) else Err) [0..<max_vars meth] @ [Err]"
     by -(rule list_all2_all_nthI, simp_all)
   hence "conf_f (compP2 P) h ([], map (\<lambda>i. if i = 0 then OK ([Class D] ! i) else Err) [0..<max_vars meth] @ [Err])
                 (compE2 meth @ [Return]) ([], Addr a # replicate (max_vars meth) undefined_value, D, M, 0)"
     unfolding conf_f_def2 by(simp add: compP2_def)
   ultimately have "conf_f (compP2 P) h ([], TC0.ty\<^sub>l (Suc (max_vars meth)) [Class D] {0}) (compE2 meth @ [Return])
                        ([], Addr a # replicate (max_vars meth) undefined_value, D, M, 0)"
     by(simp add: TC0.ty\<^sub>l_def conf_f_def2 compP2_def)
   with hconf ha sub sees_method_compP[OF sees, where f="\<lambda>C M Ts T. compMb2"] sees_method_idemp[OF sees]
   show ?thesis
     by(auto simp add: TC0.ty\<^sub>i'_def correct_state_def compTP_def tconf_def)(fastforce simp add: compP2_def compMb2_def tconf_def intro: sees_method_idemp)+
 qed
 
 lemma ta_bisim12_extTA2J1_extTA2JVM:
   assumes nt: "\<And>n T C M a h. \<lbrakk> n < length \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>; \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n = NewThread T (C, M, a) h \<rbrakk> 
            \<Longrightarrow> typeof_addr h a = \<lfloor>Class_type C\<rfloor> \<and> (\<exists>C'. typeof_addr h (thread_id2addr T) = \<lfloor>Class_type C'\<rfloor> \<and> P \<turnstile> C' \<preceq>\<^sup>* Thread) \<and>
               (\<exists>T meth D. P \<turnstile> C sees M:[]\<rightarrow>T =\<lfloor>meth\<rfloor> in D) \<and> hconf h \<and> preallocated h"
   shows "ta_bisim wbisim1 (extTA2J1 P ta) (extTA2JVM (compP2 P) ta)"
 proof -
   { fix n t C M a m
     assume "n < length \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>" and "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n = NewThread t (C, M, a) m"
     from nt[OF this] obtain T meth D C'
       where ma: "typeof_addr m a = \<lfloor>Class_type C\<rfloor>"
       and sees: "P \<turnstile> C sees M: []\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
       and sub: "typeof_addr m (thread_id2addr t) = \<lfloor>Class_type C'\<rfloor>" "P \<turnstile> C' \<preceq>\<^sup>* Thread"
       and mconf: "hconf m" "preallocated m" by fastforce
     from sees_method_compP[OF sees, where f="\<lambda>C M Ts T. compMb2"]
     have sees': "compP2 P \<turnstile> C sees M: []\<rightarrow>T = \<lfloor>(max_stack meth, max_vars meth, compE2 meth @ [Return], compxE2 meth 0 0)\<rfloor> in D"
       by(simp add: compMb2_def compP2_def)
     have "bisim1_list1 t m ({0:Class D=None; meth}, Addr a # replicate (max_vars meth) undefined_value) ([]) None [([], Addr a # replicate (max_vars meth) undefined_value, D, M, 0)]"
     proof
       from mconf ma sub sees
       show "compTP P \<turnstile> t:(None, m, [([], Addr a # replicate (max_vars meth) undefined_value, D, M, 0)]) \<surd>"
         by(rule new_thread_conf_compTP)
 
       from sees show "P \<turnstile> D sees M: []\<rightarrow>T = \<lfloor>meth\<rfloor> in D" by(rule sees_method_idemp)
       show "list_all2 (bisim1_fr P m) [] []" by simp
       show "P,blocks1 0 [Class D] meth,m \<turnstile> ({0:Class D=None; meth}, Addr a # replicate (max_vars meth) undefined_value) \<leftrightarrow>
                                                 ([], Addr a # replicate (max_vars meth) undefined_value, 0, None)"
         by simp(rule bisim1_refl)
     qed simp
     with sees sees' have "bisim1_list1 t m ({0:Class (fst (method P C M))=None; the (snd (snd (snd (method P C M))))}, Addr a # replicate (max_vars (the (snd (snd (snd (method P C M)))))) undefined_value) [] None [([], Addr a # replicate (fst (snd (the (snd (snd (snd (method (compP2 P) C M))))))) undefined_value, fst (method (compP2 P) C M), M, 0)]" by simp }
   thus ?thesis
     apply(auto simp add: ta_bisim_def intro!: list_all2_all_nthI)
     apply(case_tac "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n", auto simp add: extNTA2JVM_def)
     done
 qed
 
 end
 
 definition no_call2 :: "'addr expr1 \<Rightarrow> pc \<Rightarrow> bool"
 where "no_call2 e pc \<longleftrightarrow> (pc \<le> length (compE2 e)) \<and> (pc < length (compE2 e) \<longrightarrow> (\<forall>M n. compE2 e ! pc \<noteq> Invoke M n))"
 
 definition no_calls2 :: "'addr expr1 list \<Rightarrow> pc \<Rightarrow> bool"
 where "no_calls2 es pc \<longleftrightarrow> (pc \<le> length (compEs2 es)) \<and> (pc < length (compEs2 es) \<longrightarrow> (\<forall>M n. compEs2 es ! pc \<noteq> Invoke M n))"
 
 locale J1_JVM_conf_read =
   J1_JVM_heap_conf_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     hconf P 
   +
   JVM_conf_read
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     hconf "compP2 P"
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and P :: "'addr J1_prog"
 
 locale J1_JVM_heap_conf =
   J1_JVM_heap_conf_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     hconf P 
   +
   JVM_heap_conf
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     hconf "compP2 P"
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and P :: "'addr J1_prog"
 begin
 
 lemma red_external_ta_bisim21: 
   "\<lbrakk> wf_prog wf_md P; P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; hconf h'; preallocated h' \<rbrakk>
   \<Longrightarrow> ta_bisim wbisim1 (extTA2J1 P ta) (extTA2JVM (compP2 P) ta)"
 apply(rule ta_bisim12_extTA2J1_extTA2JVM)
 apply(frule (1) red_external_new_thread_sees)
  apply(fastforce simp add: in_set_conv_nth)
 apply(frule red_ext_new_thread_heap)
  apply(fastforce simp add: in_set_conv_nth)
 apply(frule red_external_new_thread_exists_thread_object[unfolded compP2_def, simplified])
  apply(fastforce simp add: in_set_conv_nth)
 apply simp
 done
 
 lemma ta_bisim_red_extTA2J1_extTA2JVM:
   assumes wf: "wf_prog wf_md P"
   and red: "uf,P,t' \<turnstile>1 \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>"
   and hconf: "hconf (hp s')" "preallocated (hp s')"
   shows "ta_bisim wbisim1 (extTA2J1 P ta) (extTA2JVM (compP2 P) ta)"
 proof -
   { fix n t C M a H
     assume len: "n < length \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>" and tan: "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n = NewThread t (C, M, a) H"
     hence nt: "NewThread t (C, M, a) H \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>" unfolding set_conv_nth by(auto intro!: exI)
     from red1_new_threadD[OF red nt] obtain ad M' vs va T C' Ts' Tr' D'
       where rede: "P,t' \<turnstile> \<langle>ad\<bullet>M'(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,hp s'\<rangle>"
       and ad: "typeof_addr (hp s) ad = \<lfloor>T\<rfloor>" by blast
     from red_ext_new_thread_heap[OF rede nt] have [simp]: "hp s' = H" by simp
     from red_external_new_thread_sees[OF wf rede nt] 
     obtain T body D where Ha: "typeof_addr H a = \<lfloor>Class_type C\<rfloor>"
       and sees: "P \<turnstile> C sees M:[]\<rightarrow>T=\<lfloor>body\<rfloor> in D" by auto
     have sees': "compP2 P \<turnstile> C sees M:[]\<rightarrow>T=\<lfloor>(max_stack body, max_vars body, compE2 body @ [Return], compxE2 body 0 0)\<rfloor> in D"
       using sees unfolding compP2_def compMb2_def Let_def by(auto dest: sees_method_compP)
     from red_external_new_thread_exists_thread_object[unfolded compP2_def, simplified, OF rede nt] hconf Ha sees
     have "compTP P \<turnstile> t:(None, H, [([], Addr a # replicate (max_vars body) undefined_value, D, M, 0)]) \<surd>"
       by(auto intro: new_thread_conf_compTP)
     hence "bisim1_list1 t H ({0:Class D=None; body}, Addr a # replicate (max_vars body) undefined_value) [] None [([], Addr a # replicate (max_vars body) undefined_value, D, M, 0)]"
     proof
       from sees show "P \<turnstile> D sees M:[]\<rightarrow>T=\<lfloor>body\<rfloor> in D" by(rule sees_method_idemp)
 
       show "P,blocks1 0 [Class D] body,H \<turnstile> ({0:Class D=None; body}, Addr a # replicate (max_vars body) undefined_value) \<leftrightarrow>
                                                 ([], Addr a # replicate (max_vars body) undefined_value, 0, None)"
         by(auto intro: bisim1_refl)
     qed simp_all
     hence "bisim1_list1 t H ({0:Class (fst (method P C M))=None; the (snd (snd (snd (method P C M))))},
                                Addr a # replicate (max_vars (the (snd (snd (snd (method P C M)))))) undefined_value)
                               []
                               None [([], Addr a # replicate (fst (snd (the (snd (snd (snd (method (compP2 P) C M))))))) undefined_value,
                                     fst (method (compP2 P) C M), M, 0)]"
       using sees sees' by simp }
   thus ?thesis
     apply(auto simp add: ta_bisim_def intro!: list_all2_all_nthI)
     apply(case_tac "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n")
     apply(auto simp add: extNTA2JVM_def extNTA2J1_def)
     done
 qed
 
 end
 
 sublocale J1_JVM_conf_read < heap_conf?: J1_JVM_heap_conf
 by(unfold_locales)
 
 sublocale J1_JVM_conf_read < heap?: J1_heap
 apply(rule J1_heap.intro)
 apply(subst compP_heap[symmetric, where f="\<lambda>_ _ _ _. compMb2", folded compP2_def])
 apply(unfold_locales)
 done
 
 end
diff --git a/thys/JinjaThreads/J/Annotate.thy b/thys/JinjaThreads/J/Annotate.thy
--- a/thys/JinjaThreads/J/Annotate.thy
+++ b/thys/JinjaThreads/J/Annotate.thy
@@ -1,358 +1,358 @@
 (*  Title:      Jinja/J/Annotate.thy
     Author:     Tobias Nipkow, Andreas Lochbihler
 *)
 
 section \<open>Program annotation\<close>
 
 theory Annotate
 imports
   WellType
 begin
 
 abbreviation (output)
   unanFAcc :: "'addr expr \<Rightarrow> vname \<Rightarrow> 'addr expr" ("(_\<bullet>_)" [10,10] 90)
 where
   "unanFAcc e F \<equiv> FAcc e F (STR '''')"
 
 abbreviation (output)
   unanFAss :: "'addr expr \<Rightarrow> vname \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr" ("(_\<bullet>_ := _)" [10,0,90] 90)
 where
   "unanFAss e F e' \<equiv> FAss e F (STR '''') e'"
 
 definition array_length_field_name :: vname
 where "array_length_field_name = STR ''length''"
 
 notation (output) array_length_field_name ("length")
 
 definition super :: vname
 where "super = STR ''super''"
 
 lemma super_neq_this [simp]: "super \<noteq> this" "this \<noteq> super"
 by(simp_all add: this_def super_def)
 
 inductive Anno :: "(ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool) \<Rightarrow> 'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr \<Rightarrow> bool" 
   ("_,_,_ \<turnstile> _ \<leadsto> _"   [51,51,0,0,51]50)
   and Annos :: "(ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool) \<Rightarrow> 'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr list \<Rightarrow> bool"
   ("_,_,_ \<turnstile> _ [\<leadsto>] _" [51,51,0,0,51]50)
 for is_lub :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" and P :: "'addr J_prog"
 where
   AnnoNew: "is_lub,P,E \<turnstile> new C \<leadsto> new C"
 | AnnoNewArray: "is_lub,P,E \<turnstile> i \<leadsto> i' \<Longrightarrow> is_lub,P,E \<turnstile> newA T\<lfloor>i\<rceil> \<leadsto> newA T\<lfloor>i'\<rceil>"
 | AnnoCast: "is_lub,P,E \<turnstile> e \<leadsto> e' \<Longrightarrow> is_lub,P,E \<turnstile> Cast C e \<leadsto> Cast C e'"
 | AnnoInstanceOf: "is_lub,P,E \<turnstile> e \<leadsto> e' \<Longrightarrow> is_lub,P,E \<turnstile> e instanceof T \<leadsto> e' instanceof T"
 | AnnoVal: "is_lub,P,E \<turnstile> Val v \<leadsto> Val v"
 | AnnoVarVar: "\<lbrakk> E V = \<lfloor>T\<rfloor>; V \<noteq> super \<rbrakk> \<Longrightarrow> is_lub,P,E \<turnstile> Var V \<leadsto> Var V"
 | AnnoVarField:
   \<comment> \<open>There is no need to handle access of array fields explicitly,
     because arrays do not implement methods, i.e. @{term "this"} is
     always of a @{term "Class"} type.\<close>
   "\<lbrakk> E V = None; V \<noteq> super; E this = \<lfloor>Class C\<rfloor>; P \<turnstile> C sees V:T (fm) in D \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> Var V \<leadsto> Var this\<bullet>V{D}"
 | AnnoBinOp:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1';  is_lub,P,E \<turnstile> e2 \<leadsto> e2' \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> e1 \<guillemotleft>bop\<guillemotright> e2 \<leadsto> e1' \<guillemotleft>bop\<guillemotright> e2'"
 | AnnoLAssVar:
   "\<lbrakk> E V = \<lfloor>T\<rfloor>; V \<noteq> super; is_lub,P,E \<turnstile> e \<leadsto> e' \<rbrakk> \<Longrightarrow> is_lub,P,E \<turnstile> V:=e \<leadsto> V:=e'"
 | AnnoLAssField:
   "\<lbrakk> E V = None; V \<noteq> super; E this = \<lfloor>Class C\<rfloor>; P \<turnstile> C sees V:T (fm) in D; is_lub,P,E \<turnstile> e \<leadsto> e' \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> V:=e \<leadsto> Var this\<bullet>V{D} := e'"
 | AnnoAAcc:
   "\<lbrakk> is_lub,P,E \<turnstile> a \<leadsto> a'; is_lub,P,E \<turnstile> i \<leadsto> i' \<rbrakk> \<Longrightarrow> is_lub,P,E \<turnstile> a\<lfloor>i\<rceil> \<leadsto> a'\<lfloor>i'\<rceil>"
 | AnnoAAss:
   "\<lbrakk> is_lub,P,E \<turnstile> a \<leadsto> a'; is_lub,P,E \<turnstile> i \<leadsto> i'; is_lub,P,E \<turnstile> e \<leadsto> e' \<rbrakk> \<Longrightarrow> is_lub,P,E \<turnstile> a\<lfloor>i\<rceil> := e \<leadsto> a'\<lfloor>i'\<rceil> := e'"
 | AnnoALength:
   "is_lub,P,E \<turnstile> a \<leadsto> a' \<Longrightarrow> is_lub,P,E \<turnstile> a\<bullet>length \<leadsto> a'\<bullet>length"
 | \<comment> \<open>All arrays implicitly declare a final field called @{term "array_length_field_name"} to
     store the array length, which hides a potential field of the same name in @{term "Object"} (cf. JLS 6.4.5).
     The last premise implements the hiding because field lookup does does not model the implicit declaration.\<close>
   AnnoFAcc:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e';  is_lub,P,E \<turnstile> e' :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees F:T (fm) in D; 
      is_Array U \<longrightarrow> F \<noteq> array_length_field_name \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> e\<bullet>F{STR ''''} \<leadsto> e'\<bullet>F{D}"
 | AnnoFAccALength:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e'; is_lub,P,E \<turnstile> e' :: T\<lfloor>\<rceil> \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e\<bullet>array_length_field_name{STR ''''} \<leadsto> e'\<bullet>length"
 | AnnoFAccSuper:
   \<comment> \<open>In class C with super class D, "super" is syntactic sugar for "((D) this)" (cf. JLS, 15.11.2)\<close>
   "\<lbrakk> E this = \<lfloor>Class C\<rfloor>; C \<noteq> Object; class P C = \<lfloor>(D, fs, ms)\<rfloor>; 
      P \<turnstile> D sees F:T (fm) in D' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> Var super\<bullet>F{STR ''''} \<leadsto> (Cast (Class D) (Var this))\<bullet>F{D'}"
 |  AnnoFAss:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1';  is_lub,P,E \<turnstile> e2 \<leadsto> e2';
      is_lub,P,E \<turnstile> e1' :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees F:T (fm) in D;
      is_Array U \<longrightarrow> F \<noteq> array_length_field_name \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e1\<bullet>F{STR ''''} := e2 \<leadsto> e1'\<bullet>F{D} := e2'"
 | AnnoFAssSuper:
   "\<lbrakk> E this = \<lfloor>Class C\<rfloor>; C \<noteq> Object; class P C = \<lfloor>(D, fs, ms)\<rfloor>;
      P \<turnstile> D sees F:T (fm) in D'; is_lub,P,E \<turnstile> e \<leadsto> e' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> Var super\<bullet>F{STR ''''} := e \<leadsto> (Cast (Class D) (Var this))\<bullet>F{D'} := e'"
 | AnnoCAS:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1'; is_lub,P,E \<turnstile> e2 \<leadsto> e2'; is_lub,P,E \<turnstile> e3 \<leadsto> e3' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3) \<leadsto> e1'\<bullet>compareAndSwap(D\<bullet>F, e2', e3')"
 | AnnoCall:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e';  is_lub,P,E \<turnstile> es [\<leadsto>] es' \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> Call e M es \<leadsto> Call e' M es'"
 | AnnoBlock:
   "is_lub,P,E(V \<mapsto> T) \<turnstile> e \<leadsto> e'  \<Longrightarrow>  is_lub,P,E \<turnstile> {V:T=vo; e} \<leadsto> {V:T=vo; e'}"
 | AnnoSync:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1'; is_lub,P,E \<turnstile> e2 \<leadsto> e2' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> sync(e1) e2 \<leadsto> sync(e1') e2'"
 | AnnoComp:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1';  is_lub,P,E \<turnstile> e2 \<leadsto> e2' \<rbrakk>
   \<Longrightarrow>  is_lub,P,E \<turnstile> e1;;e2 \<leadsto> e1';;e2'"
 | AnnoCond:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e'; is_lub,P,E \<turnstile> e1 \<leadsto> e1';  is_lub,P,E \<turnstile> e2 \<leadsto> e2' \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> if (e) e1 else e2 \<leadsto> if (e') e1' else e2'"
 | AnnoLoop:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e';  is_lub,P,E \<turnstile> c \<leadsto> c' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> while (e) c \<leadsto> while (e') c'"
 | AnnoThrow:
   "is_lub,P,E \<turnstile> e \<leadsto> e' \<Longrightarrow> is_lub,P,E \<turnstile> throw e \<leadsto> throw e'"
 | AnnoTry:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 \<leadsto> e1';  is_lub,P,E(V \<mapsto> Class C) \<turnstile> e2 \<leadsto> e2' \<rbrakk>
    \<Longrightarrow> is_lub,P,E \<turnstile> try e1 catch(C V) e2 \<leadsto> try e1' catch(C V) e2'"
 
 | AnnoNil:
   "is_lub,P,E \<turnstile> [] [\<leadsto>] []"
 | AnnoCons:
   "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e';  is_lub,P,E \<turnstile> es [\<leadsto>] es' \<rbrakk> \<Longrightarrow>  is_lub,P,E \<turnstile> e#es [\<leadsto>] e'#es'"
 
 inductive_cases Anno_cases [elim!]:
   "is_lub',P,E \<turnstile> new C \<leadsto> e"
   "is_lub',P,E \<turnstile> newA T\<lfloor>e\<rceil> \<leadsto> e'"
   "is_lub',P,E \<turnstile> Cast T e \<leadsto> e'"
   "is_lub',P,E \<turnstile> e instanceof T \<leadsto> e'"
   "is_lub',P,E \<turnstile> Val v \<leadsto> e'"
   "is_lub',P,E \<turnstile> Var V \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1 \<guillemotleft>bop\<guillemotright> e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> V := e \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1\<lfloor>e2\<rceil> \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1\<lfloor>e2\<rceil> := e3 \<leadsto> e'"
   "is_lub',P,E \<turnstile> e\<bullet>length \<leadsto> e'"
   "is_lub',P,E \<turnstile> e\<bullet>F{D} \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1\<bullet>F{D} := e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3) \<leadsto> e'"
   "is_lub',P,E \<turnstile> e\<bullet>M(es) \<leadsto> e'"
   "is_lub',P,E \<turnstile> {V:T=vo; e} \<leadsto> e'"
   "is_lub',P,E \<turnstile> sync(e1) e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> insync(a) e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> e1;; e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> if (e) e1 else e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> while(e1) e2 \<leadsto> e'"
   "is_lub',P,E \<turnstile> throw e \<leadsto> e'"
   "is_lub',P,E \<turnstile> try e1 catch(C V) e2 \<leadsto> e'"
 
 inductive_cases Annos_cases [elim!]:
   "is_lub',P,E \<turnstile> [] [\<leadsto>] es'"
   "is_lub',P,E \<turnstile> e # es [\<leadsto>] es'"
 
 abbreviation Anno' :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr \<Rightarrow> bool"  ("_,_ \<turnstile> _ \<leadsto> _"   [51,0,0,51]50)
 where "Anno' P \<equiv> Anno (TypeRel.is_lub P) P"
 
 abbreviation Annos' :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr list \<Rightarrow> bool"  ("_,_ \<turnstile> _ [\<leadsto>] _" [51,0,0,51]50)
 where "Annos' P \<equiv> Annos (TypeRel.is_lub P) P"
 
 definition annotate :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr"
 where "annotate P E e = THE_default e (\<lambda>e'. P,E \<turnstile> e \<leadsto> e')"
 
 lemma fixes is_lub :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile> lub'((_,/ _)') = _" [51,51,51] 50)
   assumes is_lub_unique: "\<And>T1 T2 T3 T4. \<lbrakk> \<turnstile> lub(T1, T2) = T3; \<turnstile> lub(T1, T2) = T4 \<rbrakk> \<Longrightarrow> T3 = T4"
   shows Anno_fun: "\<lbrakk> is_lub,P,E \<turnstile> e \<leadsto> e'; is_lub,P,E \<turnstile> e \<leadsto> e'' \<rbrakk> \<Longrightarrow> e' = e''"
   and Annos_fun: "\<lbrakk> is_lub,P,E \<turnstile> es [\<leadsto>] es'; is_lub,P,E \<turnstile> es [\<leadsto>] es'' \<rbrakk> \<Longrightarrow> es' = es''"
 proof(induct arbitrary: e'' and es'' rule: Anno_Annos.inducts)
   case (AnnoFAcc E e e' U C F T fm D)
   from \<open>is_lub,P,E \<turnstile> e\<bullet>F{STR ''''} \<leadsto> e''\<close> show ?case
   proof(rule Anno_cases)
     fix e''' U' C' T' fm' D'
     assume "is_lub,P,E \<turnstile> e \<leadsto> e'''" "is_lub,P,E \<turnstile> e''' :: U'"
       and "class_type_of' U' = \<lfloor>C'\<rfloor>"
       and "P \<turnstile> C' sees F:T' (fm') in D'" "e'' = e'''\<bullet>F{D'}"
     from \<open>is_lub,P,E \<turnstile> e \<leadsto> e'''\<close> have "e' = e'''" by(rule AnnoFAcc)
     with \<open>is_lub,P,E \<turnstile> e' :: U\<close> \<open>is_lub,P,E \<turnstile> e''' :: U'\<close>
     have "U = U'" by(auto intro: WT_unique is_lub_unique)
     with \<open>class_type_of' U = \<lfloor>C\<rfloor>\<close> \<open>class_type_of' U' = \<lfloor>C'\<rfloor>\<close>
     have "C = C'" by(auto)
     with \<open>P \<turnstile> C' sees F:T' (fm') in D'\<close> \<open>P \<turnstile> C sees F:T (fm) in D\<close>
     have "D' = D" by(auto dest: sees_field_fun)
     with \<open>e'' = e'''\<bullet>F{D'}\<close> \<open>e' = e'''\<close> show ?thesis by simp
   next
     fix e''' T
     assume "e'' = e'''\<bullet>length"
       and "is_lub,P,E \<turnstile> e''' :: T\<lfloor>\<rceil>"
       and "is_lub,P,E \<turnstile> e \<leadsto> e'''"
       and "F = array_length_field_name"
     from \<open>is_lub,P,E \<turnstile> e \<leadsto> e'''\<close> have "e' = e'''" by(rule AnnoFAcc)
     with \<open>is_lub,P,E \<turnstile> e' :: U\<close> \<open>is_lub,P,E \<turnstile> e''' :: T\<lfloor>\<rceil>\<close> have "U = T\<lfloor>\<rceil>" by(auto intro: WT_unique is_lub_unique)
     with \<open>class_type_of' U = \<lfloor>C\<rfloor>\<close> \<open>is_Array U \<longrightarrow> F \<noteq> array_length_field_name\<close>
     show ?thesis using \<open>F = array_length_field_name\<close> by simp
   next
     fix C' D' fs ms T D''
     assume "E this = \<lfloor>Class C'\<rfloor>"
       and "class P C' = \<lfloor>(D', fs, ms)\<rfloor>"
       and "e = Var super"
       and "e'' = Cast (Class D') (Var this)\<bullet>F{D''}"
     with \<open>is_lub,P,E \<turnstile> e \<leadsto> e'\<close> have False by(auto)
     thus ?thesis ..
   qed
 next
   case AnnoFAccALength thus ?case by(fastforce intro: WT_unique[OF is_lub_unique])
 next
   case (AnnoFAss E e1 e1' e2 e2' U C F T fm D)
   from \<open>is_lub,P,E \<turnstile> e1\<bullet>F{STR ''''} := e2 \<leadsto> e''\<close> 
   show ?case
   proof(rule Anno_cases)
     fix e1'' e2'' U' C' T' fm' D'
     assume "is_lub,P,E \<turnstile> e1 \<leadsto> e1''" "is_lub,P,E \<turnstile> e2 \<leadsto> e2''"
       and "is_lub,P,E \<turnstile> e1'' :: U'" and "class_type_of' U' = \<lfloor>C'\<rfloor>"
       and "P \<turnstile> C' sees F:T' (fm') in D'"
       and "e'' = e1''\<bullet>F{D'} := e2''"
     from \<open>is_lub,P,E \<turnstile> e1 \<leadsto> e1''\<close> have "e1' = e1''" by(rule AnnoFAss)
     moreover with \<open>is_lub,P,E \<turnstile> e1' :: U\<close> \<open>is_lub,P,E \<turnstile> e1'' :: U'\<close>
     have "U = U'" by(auto intro: WT_unique is_lub_unique)
     with \<open>class_type_of' U = \<lfloor>C\<rfloor>\<close> \<open>class_type_of' U' = \<lfloor>C'\<rfloor>\<close>
     have "C = C'" by(auto)
     with \<open>P \<turnstile> C' sees F:T' (fm') in D'\<close> \<open>P \<turnstile> C sees F:T (fm) in D\<close>
     have "D' = D" by(auto dest: sees_field_fun)
     moreover from \<open>is_lub,P,E \<turnstile> e2 \<leadsto> e2''\<close> have "e2' = e2''" by(rule AnnoFAss)
     ultimately show ?thesis using \<open>e'' = e1''\<bullet>F{D'} := e2''\<close> by simp
   next
     fix C' D' fs ms T' fm' D'' e'''
     assume "e'' = Cast (Class D') (Var this)\<bullet>F{D''} := e'''"
       and "E this = \<lfloor>Class C'\<rfloor>"
       and "class P C' = \<lfloor>(D', fs, ms)\<rfloor>"
       and "P \<turnstile> D' sees F:T' (fm') in D''"
       and "is_lub,P,E \<turnstile> e2 \<leadsto> e'''"
       and "e1 = Var super"
     with \<open>is_lub,P,E \<turnstile> e1 \<leadsto> e1'\<close> have False by(auto elim: Anno_cases)
     thus ?thesis ..
   qed
 qed(fastforce dest: sees_field_fun)+
 
 subsection \<open>Code generation\<close>
 
-definition Anno_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr \<Rightarrow> bool" ("_,_ \<turnstile> _ \<leadsto>' _"   [51,0,0,51]50)
+definition Anno_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr \<Rightarrow> bool" ("_,_ \<turnstile> _ \<leadsto>'' _"   [51,0,0,51]50)
 where "Anno_code P = Anno (is_lub_sup P) P"
 
 definition Annos_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr list \<Rightarrow> bool" ("_,_ \<turnstile> _ [\<leadsto>''] _" [51,0,0,51]50)
 where "Annos_code P = Annos (is_lub_sup P) P"
 
 primrec block_types :: "('a, 'b, 'addr) exp \<Rightarrow> ty list" 
   and blocks_types :: "('a, 'b, 'addr) exp list \<Rightarrow> ty list"
 where 
   "block_types (new C) = []"
 | "block_types (newA T\<lfloor>e\<rceil>) = block_types e"
 | "block_types (Cast U e) = block_types e"
 | "block_types (e instanceof U) = block_types e"
 | "block_types (e1\<guillemotleft>bop\<guillemotright>e2) = block_types e1 @ block_types e2"
 | "block_types (Val v) = []"
 | "block_types (Var V) = []"
 | "block_types (V := e) = block_types e"
 | "block_types (a\<lfloor>i\<rceil>) = block_types a @ block_types i"
 | "block_types (a\<lfloor>i\<rceil> := e) = block_types a @ block_types i @ block_types e"
 | "block_types (a\<bullet>length) = block_types a"
 | "block_types (e\<bullet>F{D}) = block_types e"
 | "block_types (e\<bullet>F{D} := e') = block_types e @ block_types e'"
 | "block_types (e\<bullet>compareAndSwap(D\<bullet>F, e', e'')) = block_types e @ block_types e' @ block_types e''"
 | "block_types (e\<bullet>M(es)) = block_types e @ blocks_types es"
 | "block_types {V:T=vo; e} = T # block_types e"
 | "block_types (sync\<^bsub>V\<^esub>(e) e') = block_types e @ block_types e'"
 | "block_types (insync\<^bsub>V\<^esub>(a) e) = block_types e"
 | "block_types (e;;e') = block_types e @ block_types e'"
 | "block_types (if (e) e1 else e2) = block_types e @ block_types e1 @ block_types e2"
 | "block_types (while (b) c) = block_types b @ block_types c"
 | "block_types (throw e) = block_types e"
 | "block_types (try e catch(C V) e') = block_types e @ Class C # block_types e'"
 
 | "blocks_types [] = []"
 | "blocks_types (e#es) = block_types e @ blocks_types es"
 
 lemma fixes is_lub1 :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile>1 lub'((_,/ _)') = _" [51,51,51] 50)
   and is_lub2 :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile>2 lub'((_,/ _)') = _" [51,51,51] 50)
   assumes wf: "wf_prog wf_md P"
   and is_lub1_into_is_lub2: "\<And>T1 T2 T3. \<lbrakk> \<turnstile>1 lub(T1, T2) = T3; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> \<turnstile>2 lub(T1, T2) = T3"
   and is_lub2_is_type: "\<And>T1 T2 T3. \<lbrakk> \<turnstile>2 lub(T1, T2) = T3; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T3"
   shows Anno_change_is_lub:
   "\<lbrakk> is_lub1,P,E \<turnstile> e \<leadsto> e'; ran E \<union> set (block_types e) \<subseteq> types P \<rbrakk> \<Longrightarrow> is_lub2,P,E \<turnstile> e \<leadsto> e'"
   and Annos_change_is_lub:
   "\<lbrakk> is_lub1,P,E \<turnstile> es [\<leadsto>] es'; ran E \<union> set (blocks_types es) \<subseteq> types P \<rbrakk> \<Longrightarrow> is_lub2,P,E \<turnstile> es [\<leadsto>] es'"
 proof(induct rule: Anno_Annos.inducts)
   case (AnnoBlock E V T e e' vo)
   from \<open>ran E \<union> set (block_types {V:T=vo; e}) \<subseteq> types P\<close>
   have "ran (E(V \<mapsto> T)) \<union> set (block_types e) \<subseteq> types P"
     by(auto simp add: ran_def)
   thus ?case using AnnoBlock by(blast intro: Anno_Annos.intros)
 next
   case (AnnoTry E e1 e1' V C e2 e2')
   from \<open>ran E \<union> set (block_types (try e1 catch(C V) e2)) \<subseteq> types P\<close>
   have "ran (E(V \<mapsto> Class C)) \<union> set (block_types e2) \<subseteq> types P"
     by(auto simp add: ran_def)
   thus ?case using AnnoTry by(simp del: fun_upd_apply)(blast intro: Anno_Annos.intros)
 qed(simp_all del: is_Array.simps is_Array_conv, (blast intro: Anno_Annos.intros WT_change_is_lub[OF wf, where ?is_lub1.0=is_lub1 and ?is_lub2.0=is_lub2] is_lub1_into_is_lub2 is_lub2_is_type)+)
 
 lemma assumes wf: "wf_prog wf_md P"
   shows Anno_into_Anno_code: "\<lbrakk> P,E \<turnstile> e \<leadsto> e'; ran E \<union> set (block_types e) \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> e \<leadsto>' e'"
   and Annos_into_Annos_code: "\<lbrakk> P,E \<turnstile> es [\<leadsto>] es'; ran E \<union> set (blocks_types es) \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> es [\<leadsto>'] es'"
 proof -
   assume anno: "P,E \<turnstile> e \<leadsto> e'" 
     and ran: "ran E \<union> set (block_types e) \<subseteq> types P"
   show "P,E \<turnstile> e \<leadsto>' e'" unfolding Anno_code_def
     by(rule Anno_change_is_lub[OF wf _ _ anno ran])(blast intro!: is_lub_sup.intros intro: is_lub_subD[OF wf] sup_is_type[OF wf] elim!: is_lub_sup.cases)+ 
 next
   assume annos: "P,E \<turnstile> es [\<leadsto>] es'"
     and ran: "ran E \<union> set (blocks_types es) \<subseteq> types P"
   show "P,E \<turnstile> es [\<leadsto>'] es'" unfolding Annos_code_def
     by(rule Annos_change_is_lub[OF wf _ _ annos ran])(blast intro!: is_lub_sup.intros intro: is_lub_subD[OF wf] sup_is_type[OF wf] elim!: is_lub_sup.cases)+
 qed 
 
 lemma assumes wf: "wf_prog wf_md P"
   shows Anno_code_into_Anno: "\<lbrakk> P,E \<turnstile> e \<leadsto>' e'; ran E \<union> set (block_types e) \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> e \<leadsto> e'"
   and Annos_code_into_Annos: "\<lbrakk> P,E \<turnstile> es [\<leadsto>'] es'; ran E \<union> set (blocks_types es) \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> es [\<leadsto>] es'"
 proof -
   assume anno: "P,E \<turnstile> e \<leadsto>' e'" 
     and ran: "ran E \<union> set (block_types e) \<subseteq> types P"
   show "P,E \<turnstile> e \<leadsto> e'"
     by(rule Anno_change_is_lub[OF wf _ _ anno[unfolded Anno_code_def] ran])(blast elim!: is_lub_sup.cases intro: sup_is_lubI[OF wf] is_lub_is_type[OF wf])+
 next
   assume annos: "P,E \<turnstile> es [\<leadsto>'] es'"
     and ran: "ran E \<union> set (blocks_types es) \<subseteq> types P"
   show "P,E \<turnstile> es [\<leadsto>] es'"
     by(rule Annos_change_is_lub[OF wf _ _ annos[unfolded Annos_code_def] ran])(blast elim!: is_lub_sup.cases intro: sup_is_lubI[OF wf] is_lub_is_type[OF wf])+
 qed
 
 lemma fixes is_lub
   assumes wf: "wf_prog wf_md P"
   shows WT_block_types_is_type: "is_lub,P,E \<turnstile> e :: T \<Longrightarrow> set (block_types e) \<subseteq> types P"
   and WTs_blocks_types_is_type: "is_lub,P,E \<turnstile> es [::] Ts \<Longrightarrow> set (blocks_types es) \<subseteq> types P"
 apply(induct rule: WT_WTs.inducts)
 apply(auto intro: is_class_sub_Throwable[OF wf])
 done
 
 lemma fixes is_lub
   shows Anno_block_types: "is_lub,P,E \<turnstile> e \<leadsto> e' \<Longrightarrow> block_types e = block_types e'"
   and Annos_blocks_types: "is_lub,P,E \<turnstile> es [\<leadsto>] es' \<Longrightarrow> blocks_types es = blocks_types es'"
 by(induct rule: Anno_Annos.inducts) auto
 
 code_pred 
   (modes: (i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   [detect_switches, skip_proof]
   Anno
 .
 
 definition annotate_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr"
 where "annotate_code P E e = THE_default e (\<lambda>e'. P,E \<turnstile> e \<leadsto>' e')"
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   [inductify]
   Anno_code 
 .
 
 lemma eval_Anno_i_i_i_o_conv:
   "Predicate.eval (Anno_code_i_i_i_o P E e) = (\<lambda>e'. P,E \<turnstile> e \<leadsto>' e')"
 by(auto intro!: ext intro: Anno_code_i_i_i_oI elim: Anno_code_i_i_i_oE)
  
 lemma annotate_code [code]:
   "annotate_code P E e = Predicate.singleton (\<lambda>_. Code.abort (STR ''annotate'') (\<lambda>_. e)) (Anno_code_i_i_i_o P E e)"
 by(simp add: THE_default_def Predicate.singleton_def annotate_code_def eval_Anno_i_i_i_o_conv)
 
 end
diff --git a/thys/JinjaThreads/J/WellType.thy b/thys/JinjaThreads/J/WellType.thy
--- a/thys/JinjaThreads/J/WellType.thy
+++ b/thys/JinjaThreads/J/WellType.thy
@@ -1,419 +1,419 @@
 (*  Title:      JinjaThreads/J/WellType.thy
     Author:     Tobias Nipkow, Andreas Lochbihler
 *)
 
 section \<open>Well-typedness of Jinja expressions\<close>
 
 theory WellType
 imports
   Expr
   State
   "../Common/ExternalCallWF"
   "../Common/WellForm"
   "../Common/SemiType"
 begin
 
 declare Listn.lesub_list_impl_same_size[simp del]
 declare listE_length [simp del]
 
 type_synonym 
   env  = "vname \<rightharpoonup> ty"
 
 inductive
   WT :: "(ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool) \<Rightarrow> 'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> ty \<Rightarrow> bool" ("_,_,_ \<turnstile> _ :: _"   [51,51,51,51]50)
   and WTs :: "(ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool) \<Rightarrow> 'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> ty list \<Rightarrow> bool" 
     ("_,_,_ \<turnstile> _ [::] _"   [51,51,51,51]50)
   for is_lub :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile> lub'((_,/ _)') = _" [51,51,51] 50)
   and P :: "'addr J_prog"
 where
 
   WTNew:
   "is_class P C  \<Longrightarrow>
   is_lub,P,E \<turnstile> new C :: Class C"
 
 | WTNewArray:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: Integer; is_type P (T\<lfloor>\<rceil>) \<rbrakk> \<Longrightarrow>
   is_lub,P,E \<turnstile> newA T\<lfloor>e\<rceil> :: T\<lfloor>\<rceil>"
 
 | WTCast:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: T; P \<turnstile> U \<le> T \<or> P \<turnstile> T \<le> U; is_type P U \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> Cast U e :: U"
 
 | WTInstanceOf:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: T; P \<turnstile> U \<le> T \<or> P \<turnstile> T \<le> U; is_type P U; is_refT U \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e instanceof U :: Boolean"
 
 | WTVal:
   "typeof v = Some T \<Longrightarrow>
   is_lub,P,E \<turnstile> Val v :: T"
 
 | WTVar:
   "E V = Some T \<Longrightarrow>
   is_lub,P,E \<turnstile> Var V :: T"
 
 | WTBinOp:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 :: T1; is_lub,P,E \<turnstile> e2 :: T2; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e1\<guillemotleft>bop\<guillemotright>e2 :: T"
 
 | WTLAss:
   "\<lbrakk> E V = Some T;  is_lub,P,E \<turnstile> e :: T';  P \<turnstile> T' \<le> T;  V \<noteq> this \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> V:=e :: Void"
 
 | WTAAcc:
   "\<lbrakk> is_lub,P,E \<turnstile> a :: T\<lfloor>\<rceil>; is_lub,P,E \<turnstile> i :: Integer \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> a\<lfloor>i\<rceil> :: T"
 
 | WTAAss:
   "\<lbrakk> is_lub,P,E \<turnstile> a :: T\<lfloor>\<rceil>; is_lub,P,E \<turnstile> i :: Integer; is_lub,P,E \<turnstile> e :: T'; P \<turnstile> T' \<le> T \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> a\<lfloor>i\<rceil> := e :: Void"
 
 | WTALength:
   "is_lub,P,E \<turnstile> a :: T\<lfloor>\<rceil> \<Longrightarrow> is_lub,P,E \<turnstile> a\<bullet>length :: Integer"
 
 | WTFAcc:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees F:T (fm) in D \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e\<bullet>F{D} :: T"
 
 | WTFAss:
   "\<lbrakk> is_lub,P,E \<turnstile> e\<^sub>1 :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees F:T (fm) in D; is_lub,P,E \<turnstile> e\<^sub>2 :: T'; P \<turnstile> T' \<le> T \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e\<^sub>1\<bullet>F{D}:=e\<^sub>2 :: Void"
 
 | WTCAS:
   "\<lbrakk> is_lub,P,E \<turnstile> e1 :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees F:T (fm) in D; volatile fm; 
      is_lub,P,E \<turnstile> e2 :: T'; P \<turnstile> T' \<le> T; is_lub,P,E \<turnstile> e3 :: T''; P \<turnstile> T'' \<le> T \<rbrakk>
   \<Longrightarrow>  is_lub,P,E \<turnstile> e1\<bullet>compareAndSwap(D\<bullet>F, e2, e3) :: Boolean"
 
 | WTCall:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: U; class_type_of' U = \<lfloor>C\<rfloor>; P \<turnstile> C sees M:Ts \<rightarrow> T = meth in D;
      is_lub,P,E \<turnstile> es [::] Ts'; P \<turnstile> Ts' [\<le>] Ts \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> e\<bullet>M(es) :: T"
 
 | WTBlock:
   "\<lbrakk> is_type P T;  is_lub,P,E(V \<mapsto> T) \<turnstile> e :: T'; case vo of None \<Rightarrow> True | \<lfloor>v\<rfloor> \<Rightarrow> \<exists>T'. typeof v = \<lfloor>T'\<rfloor> \<and> P \<turnstile> T' \<le> T \<rbrakk>
   \<Longrightarrow>  is_lub,P,E \<turnstile> {V:T=vo; e} :: T'"
 
 | WTSynchronized:
   "\<lbrakk> is_lub,P,E \<turnstile> o' :: T; is_refT T; T \<noteq> NT; is_lub,P,E \<turnstile> e :: T' \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> sync(o') e :: T'"
 
 \<comment> \<open>Note that insync is not statically typable.\<close>
 
 | WTSeq:
   "\<lbrakk> is_lub,P,E \<turnstile> e\<^sub>1::T\<^sub>1;  is_lub,P,E \<turnstile> e\<^sub>2::T\<^sub>2 \<rbrakk>
   \<Longrightarrow>  is_lub,P,E \<turnstile> e\<^sub>1;;e\<^sub>2 :: T\<^sub>2"
 
 | WTCond:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: Boolean;  is_lub,P,E \<turnstile> e\<^sub>1::T\<^sub>1;  is_lub,P,E \<turnstile> e\<^sub>2::T\<^sub>2; \<turnstile> lub(T\<^sub>1, T\<^sub>2) = T \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :: T"
 
 | WTWhile:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: Boolean;  is_lub,P,E \<turnstile> c::T \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> while (e) c :: Void"
 
 | WTThrow:
   "\<lbrakk> is_lub,P,E \<turnstile> e :: Class C; P \<turnstile> C \<preceq>\<^sup>* Throwable \<rbrakk> \<Longrightarrow> 
   is_lub,P,E \<turnstile> throw e :: Void"
 
 | WTTry:
   "\<lbrakk> is_lub,P,E \<turnstile> e\<^sub>1 :: T;  is_lub,P,E(V \<mapsto> Class C) \<turnstile> e\<^sub>2 :: T; P \<turnstile> C \<preceq>\<^sup>* Throwable \<rbrakk>
   \<Longrightarrow> is_lub,P,E \<turnstile> try e\<^sub>1 catch(C V) e\<^sub>2 :: T"
 
 | WTNil: "is_lub,P,E \<turnstile> [] [::] []"
 
 | WTCons: "\<lbrakk> is_lub,P,E \<turnstile> e :: T; is_lub,P,E \<turnstile> es [::] Ts \<rbrakk> \<Longrightarrow> is_lub,P,E \<turnstile> e#es [::] T#Ts"
 
 abbreviation WT' :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> ty \<Rightarrow> bool" ("_,_ \<turnstile> _ :: _" [51,51,51] 50)
 where "WT' P \<equiv> WT (TypeRel.is_lub P) P"
 
 abbreviation WTs' :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> ty list \<Rightarrow> bool" ("_,_ \<turnstile> _ [::] _" [51,51,51] 50)
 where "WTs' P \<equiv> WTs (TypeRel.is_lub P) P"
 
 declare WT_WTs.intros[intro!]
 
 inductive_simps WTs_iffs [iff]:
   "is_lub',P,E \<turnstile> [] [::] Ts"
   "is_lub',P,E \<turnstile> e#es [::] T#Ts"
   "is_lub',P,E \<turnstile> e#es [::] Ts"
 
 lemma WTs_conv_list_all2: 
   fixes is_lub 
   shows "is_lub,P,E \<turnstile> es [::] Ts = list_all2 (WT is_lub P E) es Ts"
 by(induct es arbitrary: Ts)(auto simp add: list_all2_Cons1 elim: WTs.cases)
 
 lemma WTs_append [iff]: "\<And>is_lub Ts. (is_lub,P,E \<turnstile> es\<^sub>1 @ es\<^sub>2 [::] Ts) =
   (\<exists>Ts\<^sub>1 Ts\<^sub>2. Ts = Ts\<^sub>1 @ Ts\<^sub>2 \<and> is_lub,P,E \<turnstile> es\<^sub>1 [::] Ts\<^sub>1 \<and> is_lub,P,E \<turnstile> es\<^sub>2[::]Ts\<^sub>2)"
 by(auto simp add: WTs_conv_list_all2 list_all2_append1 dest: list_all2_lengthD[symmetric])
 
 inductive_simps WT_iffs [iff]:
   "is_lub',P,E \<turnstile> Val v :: T"
   "is_lub',P,E \<turnstile> Var V :: T"
   "is_lub',P,E \<turnstile> e\<^sub>1;;e\<^sub>2 :: T\<^sub>2"
   "is_lub',P,E \<turnstile> {V:T=vo; e} :: T'"
 
 inductive_cases WT_elim_cases[elim!]:
   "is_lub',P,E \<turnstile> V :=e :: T"
   "is_lub',P,E \<turnstile> sync(o') e :: T"
   "is_lub',P,E \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :: T"
   "is_lub',P,E \<turnstile> while (e) c :: T"
   "is_lub',P,E \<turnstile> throw e :: T"
   "is_lub',P,E \<turnstile> try e\<^sub>1 catch(C V) e\<^sub>2 :: T"
   "is_lub',P,E \<turnstile> Cast D e :: T"
   "is_lub',P,E \<turnstile> e instanceof U :: T"
   "is_lub',P,E \<turnstile> a\<bullet>F{D} :: T"
   "is_lub',P,E \<turnstile> a\<bullet>F{D} := v :: T"
   "is_lub',P,E \<turnstile> e\<bullet>compareAndSwap(D\<bullet>F, e', e'') :: T"
   "is_lub',P,E \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 :: T"
   "is_lub',P,E \<turnstile> new C :: T"
   "is_lub',P,E \<turnstile> newA T\<lfloor>e\<rceil> :: T'"
   "is_lub',P,E \<turnstile> a\<lfloor>i\<rceil> := e :: T"
   "is_lub',P,E \<turnstile> a\<lfloor>i\<rceil> :: T"
   "is_lub',P,E \<turnstile> a\<bullet>length :: T"
   "is_lub',P,E \<turnstile> e\<bullet>M(ps) :: T"
   "is_lub',P,E \<turnstile> sync(o') e :: T"
   "is_lub',P,E \<turnstile> insync(a) e :: T"
 
 lemma fixes is_lub :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile> lub'((_,/ _)') = _" [51,51,51] 50)
   assumes is_lub_unique: "\<And>T1 T2 T3 T4. \<lbrakk> \<turnstile> lub(T1, T2) = T3; \<turnstile> lub(T1, T2) = T4 \<rbrakk> \<Longrightarrow> T3 = T4"
   shows WT_unique: "\<lbrakk> is_lub,P,E \<turnstile> e :: T; is_lub,P,E \<turnstile> e :: T' \<rbrakk> \<Longrightarrow> T = T'"
   and WTs_unique: "\<lbrakk> is_lub,P,E \<turnstile> es [::] Ts; is_lub,P,E \<turnstile> es [::] Ts' \<rbrakk> \<Longrightarrow> Ts = Ts'"
 apply(induct arbitrary: T' and Ts' rule: WT_WTs.inducts)
 apply blast
 apply blast
 apply blast
 apply blast
 apply fastforce
 apply fastforce
 apply(fastforce dest: WT_binop_fun)
 apply fastforce
 apply fastforce
 apply fastforce
 apply fastforce
 apply(fastforce dest: sees_field_fun)
 apply(fastforce dest: sees_field_fun)
 apply blast
 apply(fastforce dest: sees_method_fun)
 apply fastforce
 apply fastforce
 apply fastforce
 apply(blast dest: is_lub_unique)
 apply fastforce
 apply fastforce
 apply blast
 apply fastforce
 apply fastforce
 done
 
 lemma fixes is_lub
   shows wt_env_mono: "is_lub,P,E \<turnstile> e :: T \<Longrightarrow> (\<And>E'. E \<subseteq>\<^sub>m E' \<Longrightarrow> is_lub,P,E' \<turnstile> e :: T)"
   and wts_env_mono: "is_lub,P,E \<turnstile> es [::] Ts \<Longrightarrow> (\<And>E'. E \<subseteq>\<^sub>m E' \<Longrightarrow> is_lub,P,E' \<turnstile> es [::] Ts)"
 apply(induct rule: WT_WTs.inducts)
 apply(simp add: WTNew)
 apply(simp add: WTNewArray)
 apply(fastforce simp: WTCast)
 apply(fastforce simp: WTInstanceOf)
 apply(fastforce simp: WTVal)
 apply(simp add: WTVar map_le_def dom_def)
 apply(fastforce simp: WTBinOp)
 apply(force simp:map_le_def)
 apply(simp add: WTAAcc)
 apply(simp add: WTAAss, fastforce)
 apply(simp add: WTALength, fastforce)
 apply(fastforce simp: WTFAcc)
 apply(fastforce simp: WTFAss del:WT_WTs.intros WT_elim_cases)
 apply blast
 apply(fastforce)
 apply(fastforce simp: map_le_def WTBlock)
 apply(fastforce simp: WTSynchronized)
 apply(fastforce simp: WTSeq)
 apply(fastforce simp: WTCond)
 apply(fastforce simp: WTWhile)
 apply(fastforce simp: WTThrow)
 apply(fastforce simp: WTTry map_le_def dom_def)
 apply(fastforce)+
 done
 
 lemma fixes is_lub
   shows WT_fv: "is_lub,P,E \<turnstile> e :: T \<Longrightarrow> fv e \<subseteq> dom E"
   and WT_fvs: "is_lub,P,E \<turnstile> es [::] Ts \<Longrightarrow> fvs es \<subseteq> dom E"
 apply(induct rule:WT_WTs.inducts)
 apply(simp_all del: fun_upd_apply)
 apply fast+
 done
 
 lemma fixes is_lub
   shows WT_expr_locks: "is_lub,P,E \<turnstile> e :: T \<Longrightarrow> expr_locks e = (\<lambda>ad. 0)"
   and WTs_expr_lockss: "is_lub,P,E \<turnstile> es [::] Ts \<Longrightarrow> expr_lockss es = (\<lambda>ad. 0)"
 by(induct rule: WT_WTs.inducts)(auto)
 
 lemma
   fixes is_lub :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile> lub'((_,/ _)') = _" [51,51,51] 50)
   assumes is_lub_is_type: "\<And>T1 T2 T3. \<lbrakk> \<turnstile> lub(T1, T2) = T3; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T3"
   and wf: "wf_prog wf_md P"
   shows WT_is_type: "\<lbrakk> is_lub,P,E \<turnstile> e :: T; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> is_type P T"
   and WTs_is_type: "\<lbrakk> is_lub,P,E \<turnstile> es [::] Ts; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> set Ts \<subseteq> types P"
 apply(induct rule: WT_WTs.inducts)
 apply simp
 apply simp
 apply simp
 apply simp
 apply (simp add:typeof_lit_is_type)
 apply (fastforce intro:nth_mem simp add: ran_def)
 apply(simp add: WT_binop_is_type)
 apply(simp)
 apply(simp del: is_type_array add: is_type_ArrayD)
 apply(simp)
 apply(simp)
 apply(simp add:sees_field_is_type[OF _ wf])
 apply(simp)
 apply simp
 apply(fastforce dest: sees_wf_mdecl[OF wf] simp:wf_mdecl_def)
 apply(fastforce simp add: ran_def split: if_split_asm)
 apply(simp add: is_class_Object[OF wf])
 apply(simp)
 apply(simp)
 apply(fastforce intro: is_lub_is_type)
 apply(simp)
 apply(simp)
 apply simp
 apply simp
 apply simp
 done
 
 lemma
   fixes is_lub1 :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile>1 lub'((_,/ _)') = _" [51,51,51] 50)
   and is_lub2 :: "ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("\<turnstile>2 lub'((_,/ _)') = _" [51,51,51] 50)
   assumes wf: "wf_prog wf_md P"
   and is_lub1_into_is_lub2: "\<And>T1 T2 T3. \<lbrakk> \<turnstile>1 lub(T1, T2) = T3; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> \<turnstile>2 lub(T1, T2) = T3"
   and is_lub2_is_type: "\<And>T1 T2 T3. \<lbrakk> \<turnstile>2 lub(T1, T2) = T3; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T3"
   shows WT_change_is_lub: "\<lbrakk> is_lub1,P,E \<turnstile> e :: T; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> is_lub2,P,E \<turnstile> e :: T"
   and WTs_change_is_lub: "\<lbrakk> is_lub1,P,E \<turnstile> es [::] Ts; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> is_lub2,P,E \<turnstile> es [::] Ts"
 proof(induct rule: WT_WTs.inducts)
   case (WTBlock U E V e' T vo)
   from \<open>is_type P U\<close> \<open>ran E \<subseteq> types P\<close>
   have "ran (E(V \<mapsto> U)) \<subseteq> types P" by(auto simp add: ran_def)
   hence "is_lub2,P,E(V \<mapsto> U) \<turnstile> e' :: T" by(rule WTBlock)
   with \<open>is_type P U\<close> show ?case
     using \<open>case vo of None \<Rightarrow> True | \<lfloor>v\<rfloor> \<Rightarrow> \<exists>T'. typeof v = \<lfloor>T'\<rfloor> \<and> P \<turnstile> T' \<le> U\<close> by auto
 next
   case (WTCond E e e1 T1 e2 T2 T)
   from \<open>ran E \<subseteq> types P\<close> have "is_lub2,P,E \<turnstile> e :: Boolean" "is_lub2,P,E \<turnstile> e1 :: T1" "is_lub2,P,E \<turnstile> e2 :: T2"
     by(rule WTCond)+
   moreover from is_lub2_is_type wf \<open>is_lub2,P,E \<turnstile> e1 :: T1\<close> \<open>ran E \<subseteq> types P\<close>
   have "is_type P T1" by(rule WT_is_type)
   from is_lub2_is_type wf \<open>is_lub2,P,E \<turnstile> e2 :: T2\<close> \<open>ran E \<subseteq> types P\<close>
   have "is_type P T2" by(rule WT_is_type)
   with \<open>\<turnstile>1 lub(T1, T2) = T\<close> \<open>is_type P T1\<close>
   have "\<turnstile>2 lub(T1, T2) = T" by(rule is_lub1_into_is_lub2)
   ultimately show ?case ..
 next
   case (WTTry E e1 T V C e2)
   from \<open>ran E \<subseteq> types P\<close> have "is_lub2,P,E \<turnstile> e1 :: T" by(rule WTTry)
   moreover from \<open>P \<turnstile> C \<preceq>\<^sup>* Throwable\<close> have "is_class P C"
     by(rule is_class_sub_Throwable[OF wf])
   with \<open>ran E \<subseteq> types P\<close> have "ran (E(V \<mapsto> Class C)) \<subseteq> types P"
     by(auto simp add: ran_def)
   hence "is_lub2,P,E(V \<mapsto> Class C) \<turnstile> e2 :: T" by(rule WTTry)
   ultimately show ?case using \<open>P \<turnstile> C \<preceq>\<^sup>* Throwable\<close> ..
 qed auto
 
 subsection \<open>Code generator setup\<close>
 
 lemma WTBlock_code:
   "\<And>is_lub. \<lbrakk> is_type P T; is_lub,P,E(V \<mapsto> T) \<turnstile> e :: T'; 
      case vo of None \<Rightarrow> True | \<lfloor>v\<rfloor> \<Rightarrow> case typeof v of None \<Rightarrow> False | Some T' \<Rightarrow> P \<turnstile> T' \<le> T \<rbrakk>
   \<Longrightarrow>  is_lub,P,E \<turnstile> {V:T=vo; e} :: T'"
 by(auto)
 
 lemmas [code_pred_intro] =
   WTNew WTNewArray WTCast WTInstanceOf WTVal WTVar WTBinOp WTLAss WTAAcc WTAAss WTALength WTFAcc WTFAss WTCAS WTCall 
 declare 
   WTBlock_code [code_pred_intro WTBlock']
 lemmas [code_pred_intro] =
   WTSynchronized WTSeq WTCond WTWhile WTThrow WTTry
   WTNil WTCons
 
 code_pred
   (modes:
     (i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, 
     (i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   [detect_switches, skip_proof]
   WT
 proof -
   case WT
   from WT.prems show thesis
   proof cases
     case (WTBlock T V e vo)
     thus thesis using WT.WTBlock'[OF refl refl refl, of V T vo e] by(auto)
   qed(assumption|erule WT.that[OF refl refl refl]|rule refl)+
 next
   case WTs
   from WTs.prems WTs.that show thesis by cases blast+
 qed
 
 inductive is_lub_sup :: "'m prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"
 for P T1 T2 T3
 where
   "sup P T1 T2 = OK T3 \<Longrightarrow> is_lub_sup P T1 T2 T3"
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   is_lub_sup
 .
 
-definition WT_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> ty \<Rightarrow> bool" ("_,_ \<turnstile> _ ::' _" [51,51,51] 50)
+definition WT_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr \<Rightarrow> ty \<Rightarrow> bool" ("_,_ \<turnstile> _ ::'' _" [51,51,51] 50)
 where "WT_code P \<equiv> WT (is_lub_sup P) P"
 
 definition WTs_code :: "'addr J_prog \<Rightarrow> env \<Rightarrow> 'addr expr list \<Rightarrow> ty list \<Rightarrow> bool" ("_,_ \<turnstile> _ [::''] _" [51,51,51] 50)
 where "WTs_code P \<equiv> WTs (is_lub_sup P) P"
 
 lemma assumes wf: "wf_prog wf_md P"
   shows WT_code_into_WT: 
   "\<lbrakk> P,E \<turnstile> e ::' T; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> e :: T"
 
   and WTs_code_into_WTs:
   "\<lbrakk> P,E \<turnstile> es [::'] Ts; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> es [::] Ts"
 proof -
   assume ran: "ran E \<subseteq> types P"
   { assume wt: "P,E \<turnstile> e ::' T"
     show "P,E \<turnstile> e :: T"
       by(rule WT_change_is_lub[OF wf _ _ wt[unfolded WT_code_def] ran])(blast elim!: is_lub_sup.cases intro: sup_is_lubI[OF wf] is_lub_is_type[OF wf])+ }
   { assume wts: "P,E \<turnstile> es [::'] Ts"
     show "P,E \<turnstile> es [::] Ts"
       by(rule WTs_change_is_lub[OF wf _ _ wts[unfolded WTs_code_def] ran])(blast elim!: is_lub_sup.cases intro: sup_is_lubI[OF wf] is_lub_is_type[OF wf])+ }
 qed
 
 lemma assumes wf: "wf_prog wf_md P"
   shows WT_into_WT_code: 
   "\<lbrakk> P,E \<turnstile> e :: T; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> e ::' T"
 
   and WT_into_WTs_code_OK:
   "\<lbrakk> P,E \<turnstile> es [::] Ts; ran E \<subseteq> types P \<rbrakk> \<Longrightarrow> P,E \<turnstile> es [::'] Ts"
 proof -
   assume ran: "ran E \<subseteq> types P"
   { assume wt: "P,E \<turnstile> e :: T"
     show "P,E \<turnstile> e ::' T" unfolding WT_code_def
       by(rule WT_change_is_lub[OF wf _ _ wt ran])(blast intro!: is_lub_sup.intros intro: is_lub_subD[OF wf] sup_is_type[OF wf] elim!: is_lub_sup.cases)+ }
   { assume wts: "P,E \<turnstile> es [::] Ts"
     show "P,E \<turnstile> es [::'] Ts" unfolding WTs_code_def
       by(rule WTs_change_is_lub[OF wf _ _ wts ran])(blast intro!: is_lub_sup.intros intro: is_lub_subD[OF wf] sup_is_type[OF wf] elim!: is_lub_sup.cases)+ }
 qed
 
 theorem WT_eq_WT_code:
   assumes "wf_prog wf_md P"
   and "ran E \<subseteq> types P"
   shows "P,E \<turnstile> e :: T \<longleftrightarrow> P,E \<turnstile> e ::' T"
 using assms by(blast intro: WT_code_into_WT WT_into_WT_code)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   [inductify]
   WT_code 
 .
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   [inductify]
   WTs_code 
 .
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Type.thy b/thys/JinjaThreads/MM/JMM_Type.thy
--- a/thys/JinjaThreads/MM/JMM_Type.thy
+++ b/thys/JinjaThreads/MM/JMM_Type.thy
@@ -1,352 +1,352 @@
 (*  Title:      JinjaThreads/MM/JMM_Type.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>JMM heap implementation 1\<close>
 
 theory JMM_Type
 imports 
   "../Common/ExternalCallWF"
   "../Common/ConformThreaded"
   JMM_Heap
 begin
 
 subsection \<open>Definitions\<close>
 
 text \<open>
   The JMM heap only stores type information.
 \<close>
 
 type_synonym 'addr JMM_heap = "'addr \<rightharpoonup> htype"
 
 translations (type) "'addr JMM_heap" <= (type) "'addr \<Rightarrow> htype option"
 
 abbreviation jmm_empty :: "'addr JMM_heap" where "jmm_empty == Map.empty"
 
 definition jmm_allocate :: "'addr JMM_heap \<Rightarrow> htype \<Rightarrow> ('addr JMM_heap \<times> 'addr) set"
 where "jmm_allocate h hT = (\<lambda>a. (h(a \<mapsto> hT), a)) ` {a. h a = None}"
 
 definition jmm_typeof_addr :: "'addr JMM_heap \<Rightarrow> 'addr \<rightharpoonup> htype"
 where "jmm_typeof_addr h = h"
 
 definition jmm_heap_read :: "'addr JMM_heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
 where "jmm_heap_read h a ad v = True"
 
 context
   notes [[inductive_internals]]
 begin
 
 inductive jmm_heap_write :: "'addr JMM_heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool"
 where "jmm_heap_write h a ad v h"
 
 end
 
 definition jmm_hconf :: "'m prog \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool" ("_ \<turnstile>jmm _ \<surd>" [51,51] 50)
 where "P \<turnstile>jmm h \<surd> \<longleftrightarrow> ty_of_htype ` ran h \<subseteq> {T. is_type P T}"
 
 definition jmm_allocated :: "'addr JMM_heap \<Rightarrow> 'addr set"
 where "jmm_allocated h = dom (jmm_typeof_addr h)"
 
 definition jmm_spurious_wakeups :: bool
 where "jmm_spurious_wakeups = True"
 
 lemmas jmm_heap_ops_defs =
   jmm_allocate_def jmm_typeof_addr_def 
   jmm_heap_read_def jmm_heap_write_def
   jmm_allocated_def jmm_spurious_wakeups_def
 
 type_synonym 'addr thread_id = "'addr"
 
 abbreviation (input) addr2thread_id :: "'addr \<Rightarrow> 'addr thread_id"
 where "addr2thread_id \<equiv> \<lambda>x. x"
 
 abbreviation (input) thread_id2addr :: "'addr thread_id \<Rightarrow> 'addr"
 where "thread_id2addr \<equiv> \<lambda>x. x"
 
 interpretation jmm: heap_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write 
 .
 
 notation jmm.hext  ("_ \<unlhd>jmm _" [51,51] 50)
 notation jmm.conf ("_,_ \<turnstile>jmm _ :\<le> _"  [51,51,51,51] 50)
 notation jmm.addr_loc_type ("_,_ \<turnstile>jmm _@_ : _" [50, 50, 50, 50, 50] 51)
 notation jmm.confs ("_,_ \<turnstile>jmm _ [:\<le>] _"  [51,51,51,51] 50)
 notation jmm.tconf ("_,_ \<turnstile>jmm _ \<surd>t" [51,51,51] 50)
 
 text \<open>Now a variation of the JMM with a different read operation that permits to read only type-conformant values\<close>
 
 interpretation jmm': heap_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write
   for P .
 
-notation jmm'.hext ("_ \<unlhd>jmm' _" [51,51] 50)
-notation jmm'.conf ("_,_ \<turnstile>jmm' _ :\<le> _"  [51,51,51,51] 50)
-notation jmm'.addr_loc_type ("_,_ \<turnstile>jmm' _@_ : _" [50, 50, 50, 50, 50] 51)
-notation jmm'.confs ("_,_ \<turnstile>jmm' _ [:\<le>] _"  [51,51,51,51] 50)
-notation jmm'.tconf ("_,_ \<turnstile>jmm' _ \<surd>t" [51,51,51] 50)
+notation jmm'.hext ("_ \<unlhd>jmm'' _" [51,51] 50)
+notation jmm'.conf ("_,_ \<turnstile>jmm'' _ :\<le> _"  [51,51,51,51] 50)
+notation jmm'.addr_loc_type ("_,_ \<turnstile>jmm'' _@_ : _" [50, 50, 50, 50, 50] 51)
+notation jmm'.confs ("_,_ \<turnstile>jmm'' _ [:\<le>] _"  [51,51,51,51] 50)
+notation jmm'.tconf ("_,_ \<turnstile>jmm'' _ \<surd>t" [51,51,51] 50)
 
 subsection \<open>Heap locale interpretations\<close>
 
 subsection \<open>Locale \<open>heap\<close>\<close>
 
 lemma jmm_heap: "heap addr2thread_id thread_id2addr jmm_allocate jmm_typeof_addr jmm_heap_write P"
 proof
   fix h' a h hT
   assume "(h', a) \<in> jmm_allocate h hT"
   thus "jmm_typeof_addr h' a = \<lfloor>hT\<rfloor>"
     by(auto simp add: jmm_heap_ops_defs)
 next
   fix h' :: "('addr :: addr) JMM_heap" and h hT a
   assume "(h', a) \<in> jmm_allocate h hT"
   thus "h \<unlhd>jmm h'"
     by(fastforce simp add: jmm_heap_ops_defs intro: jmm.hextI)
 next
   fix h a al v and h' :: "('addr :: addr) JMM_heap"
   assume "jmm_heap_write h a al v h'"
   thus "h \<unlhd>jmm h'" by cases auto
 qed simp
 
 interpretation jmm: heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write
   P
   for P
 by(rule jmm_heap)
 
 declare jmm.typeof_addr_thread_id2_addr_addr2thread_id [simp del]
 
 lemmas jmm'_heap = jmm_heap
 
 interpretation jmm': heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write
   P
   for P
 by(rule jmm'_heap)
 
 declare jmm'.typeof_addr_thread_id2_addr_addr2thread_id [simp del]
 
 subsection \<open>Locale \<open>heap_conf\<close>\<close>
 
 interpretation jmm: heap_conf_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write "jmm_hconf P"
   P
   for P .
 
-abbreviation (input) jmm'_hconf :: "'m prog \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool" ("_ \<turnstile>jmm' _ \<surd>" [51,51] 50)
+abbreviation (input) jmm'_hconf :: "'m prog \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool" ("_ \<turnstile>jmm'' _ \<surd>" [51,51] 50)
 where "jmm'_hconf == jmm_hconf"
 
 interpretation jmm': heap_conf_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write "jmm'_hconf P"
   P
   for P .
 
 abbreviation jmm_heap_read_typeable :: "('addr :: addr) itself \<Rightarrow> 'm prog \<Rightarrow> bool"
 where "jmm_heap_read_typeable tytok P \<equiv> jmm.heap_read_typeable (jmm_hconf P :: 'addr JMM_heap \<Rightarrow> bool) P"
 
 abbreviation jmm'_heap_read_typeable :: "('addr :: addr) itself \<Rightarrow> 'm prog \<Rightarrow> bool"
 where "jmm'_heap_read_typeable tytok P \<equiv> jmm'.heap_read_typeable TYPE('m) P (jmm_hconf P :: 'addr JMM_heap \<Rightarrow> bool) P"
 
 lemma jmm_heap_read_typeable: "jmm_heap_read_typeable tytok P"
 by(rule jmm.heap_read_typeableI)(simp add: jmm_heap_read_def)
 
 lemma jmm'_heap_read_typeable: "jmm'_heap_read_typeable tytok P"
 by(rule jmm'.heap_read_typeableI)(auto simp add: jmm.heap_read_typed_def jmm_heap_read_def dest: jmm'.addr_loc_type_fun)
 
 lemma jmm_heap_conf:
   "heap_conf addr2thread_id thread_id2addr jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_write (jmm_hconf P) P"
 proof
   show "P \<turnstile>jmm jmm_empty \<surd>"
     by(simp add: jmm_hconf_def)
 next
   fix h a hT
   assume "jmm_typeof_addr h a = \<lfloor>hT\<rfloor>" "P \<turnstile>jmm h \<surd>"
   thus "is_htype P hT" by(auto simp add: jmm_hconf_def jmm_heap_ops_defs intro: ranI)
 next
   fix h' h hT a
   assume "(h', a) \<in> jmm_allocate h hT" "P \<turnstile>jmm h \<surd>" "is_htype P hT"
   thus "P \<turnstile>jmm h' \<surd>"
     by(fastforce simp add: jmm_hconf_def jmm_heap_ops_defs ran_def split: if_split_asm)
 next
   fix h a al v h' T
   assume "jmm_heap_write h a al v h'" "P \<turnstile>jmm h \<surd>"
     and "jmm.addr_loc_type P h a al T" and "P,h \<turnstile>jmm v :\<le> T"
   thus "P \<turnstile>jmm h' \<surd>" by(cases) simp
 qed
 
 interpretation jmm: heap_conf
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write "jmm_hconf P"
   P
   for P
 by(rule jmm_heap_conf)
 
 lemmas jmm'_heap_conf = jmm_heap_conf
 
 interpretation jmm': heap_conf
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write "jmm'_hconf P"
   P
   for P
 by(rule jmm'_heap_conf)
 
 subsection \<open>Locale \<open>heap_progress\<close>\<close>
 
 lemma jmm_heap_progress:
   "heap_progress addr2thread_id thread_id2addr jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write (jmm_hconf P) P"
 proof
   fix h a al T
   assume "P \<turnstile>jmm h \<surd>"
     and al: "jmm.addr_loc_type P h a al T"
   show "\<exists>v. jmm_heap_read h a al v \<and> P,h \<turnstile>jmm v :\<le> T"
     using jmm.defval_conf[of P h T] unfolding jmm_heap_ops_defs by blast
 next
   fix h a al T v
   assume "jmm.addr_loc_type P h a al T"
   show "\<exists>h'. jmm_heap_write h a al v h'"
     by(auto intro: jmm_heap_write.intros)
 qed
 
 interpretation jmm: heap_progress
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write "jmm_hconf P"
   P
   for P
 by(rule jmm_heap_progress)
 
 lemma jmm'_heap_progress:
   "heap_progress addr2thread_id thread_id2addr jmm_empty jmm_allocate jmm_typeof_addr (jmm.heap_read_typed P) jmm_heap_write (jmm'_hconf P) P"
 proof
   fix h a al T
   assume "P \<turnstile>jmm' h \<surd>"
     and al: "jmm'.addr_loc_type P h a al T"
   thus "\<exists>v. jmm.heap_read_typed P h a al v \<and> P,h \<turnstile>jmm' v :\<le> T"
     unfolding jmm.heap_read_typed_def jmm_heap_read_def
     by(auto dest: jmm'.addr_loc_type_fun intro: jmm'.defval_conf)
 next
   fix h a al T v
   assume "jmm'.addr_loc_type P h a al T"
     and "P,h \<turnstile>jmm' v :\<le> T"
   thus "\<exists>h'. jmm_heap_write h a al v h'"
     by(auto intro: jmm_heap_write.intros)
 qed
 
 interpretation jmm': heap_progress
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write "jmm'_hconf P"
   P
   for P
 by(rule jmm'_heap_progress)
 
 subsection \<open>Locale \<open>heap_conf_read\<close>\<close>
 
 lemma jmm'_heap_conf_read:
   "heap_conf_read addr2thread_id thread_id2addr jmm_empty jmm_allocate jmm_typeof_addr (jmm.heap_read_typed P) jmm_heap_write (jmm'_hconf P) P"
 by(rule jmm.heap_conf_read_heap_read_typed)
 
 interpretation jmm': heap_conf_read
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write "jmm'_hconf P"
   P
   for P
 by(rule jmm'_heap_conf_read)
 
 interpretation jmm': heap_typesafe
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write "jmm'_hconf P"
   P
   for P
 ..
 
 subsection \<open>Locale \<open>allocated_heap\<close>\<close>
 
 lemma jmm_allocated_heap: 
   "allocated_heap addr2thread_id thread_id2addr jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_write jmm_allocated P"
 proof
   show "jmm_allocated jmm_empty = {}" by(auto simp add: jmm_heap_ops_defs)
 next
   fix h' a h hT
   assume "(h', a) \<in> jmm_allocate h hT"
   thus "jmm_allocated h' = insert a (jmm_allocated h) \<and> a \<notin> jmm_allocated h"
     by(auto simp add: jmm_heap_ops_defs split: if_split_asm)
 next
   fix h a al v h'
   assume "jmm_heap_write h a al v h'"
   thus "jmm_allocated h' = jmm_allocated h" by cases simp
 qed
 
 interpretation jmm: allocated_heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr jmm_heap_read jmm_heap_write
   jmm_allocated
   P
   for P
 by(rule jmm_allocated_heap)
 
 lemmas jmm'_allocated_heap = jmm_allocated_heap
 
 interpretation jmm': allocated_heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate jmm_typeof_addr "jmm.heap_read_typed P" jmm_heap_write
   jmm_allocated
   P
   for P
 by(rule jmm'_allocated_heap)
 
 subsection \<open>Syntax translations\<close>
 
-notation jmm'.external_WT' ("_,_ \<turnstile>jmm' (_\<bullet>_'(_')) : _" [50,0,0,0,50] 60)
+notation jmm'.external_WT' ("_,_ \<turnstile>jmm'' (_\<bullet>_'(_')) : _" [50,0,0,0,50] 60)
 
 abbreviation jmm'_red_external :: 
   "'m prog \<Rightarrow> 'addr thread_id \<Rightarrow> 'addr JMM_heap \<Rightarrow> 'addr \<Rightarrow> mname \<Rightarrow> 'addr val list
   \<Rightarrow> ('addr :: addr, 'addr thread_id, 'addr JMM_heap) external_thread_action 
   \<Rightarrow> 'addr extCallRet \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool"
 where "jmm'_red_external P \<equiv> jmm'.red_external (TYPE('m)) P P"
 
 abbreviation jmm'_red_external_syntax :: 
   "'m prog \<Rightarrow> 'addr thread_id \<Rightarrow> 'addr \<Rightarrow> mname \<Rightarrow> 'addr val list \<Rightarrow> 'addr JMM_heap
   \<Rightarrow> ('addr :: addr, 'addr thread_id, 'addr JMM_heap) external_thread_action 
   \<Rightarrow> 'addr extCallRet \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool"
-  ("_,_ \<turnstile>jmm' (\<langle>(_\<bullet>_'(_')),/_\<rangle>) -_\<rightarrow>ext (\<langle>(_),/(_)\<rangle>)" [50, 0, 0, 0, 0, 0, 0, 0, 0] 51)
+  ("_,_ \<turnstile>jmm'' (\<langle>(_\<bullet>_'(_')),/_\<rangle>) -_\<rightarrow>ext (\<langle>(_),/(_)\<rangle>)" [50, 0, 0, 0, 0, 0, 0, 0, 0] 51)
 where
   "P,t \<turnstile>jmm' \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle> \<equiv> jmm'_red_external P t h a M vs ta va h'"
 
 abbreviation jmm'_red_external_aggr :: 
   "'m prog \<Rightarrow> 'addr thread_id \<Rightarrow> 'addr \<Rightarrow> mname \<Rightarrow> 'addr val list \<Rightarrow> 'addr JMM_heap 
     \<Rightarrow> (('addr :: addr, 'addr thread_id, 'addr JMM_heap) external_thread_action \<times> 'addr extCallRet \<times> 'addr JMM_heap) set"
 where "jmm'_red_external_aggr P \<equiv> jmm'.red_external_aggr TYPE('m) P P"
 
 abbreviation jmm'_heap_copy_loc :: 
   "'m prog \<Rightarrow> 'addr \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr JMM_heap
   \<Rightarrow> ('addr :: addr, 'addr thread_id) obs_event list \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool"
 where "jmm'_heap_copy_loc \<equiv> jmm'.heap_copy_loc TYPE('m)"
 
 abbreviation jmm'_heap_copies :: 
   "'m prog \<Rightarrow> 'addr \<Rightarrow> 'addr \<Rightarrow> addr_loc list \<Rightarrow> 'addr JMM_heap
   \<Rightarrow> ('addr :: addr, 'addr thread_id) obs_event list \<Rightarrow> 'addr JMM_heap \<Rightarrow> bool"
 where "jmm'_heap_copies \<equiv> jmm'.heap_copies TYPE('m)"
 
 abbreviation jmm'_heap_clone ::
   "'m prog \<Rightarrow> 'addr JMM_heap \<Rightarrow> 'addr \<Rightarrow> 'addr JMM_heap
   \<Rightarrow> (('addr :: addr, 'addr thread_id) obs_event list \<times> 'addr) option \<Rightarrow> bool"
 where "jmm'_heap_clone P \<equiv> jmm'.heap_clone TYPE('m) P P"
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Type2.thy b/thys/JinjaThreads/MM/JMM_Type2.thy
--- a/thys/JinjaThreads/MM/JMM_Type2.thy
+++ b/thys/JinjaThreads/MM/JMM_Type2.thy
@@ -1,425 +1,425 @@
 (*  Title:      JinjaThreads/MM/JMM_Type2.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>JMM heap implementation 2\<close>
 
 theory JMM_Type2
 imports 
   "../Common/ExternalCallWF"
   "../Common/ConformThreaded"
   JMM_Heap
 begin
 
 subsection \<open>Definitions\<close>
 
 datatype addr = Address htype nat   \<comment> \<open>heap type and sequence number\<close>
 
 lemma rec_addr_conv_case_addr [simp]: "rec_addr = case_addr"
 by(auto intro!: ext split: addr.split)
 
 instantiation addr :: addr begin
 definition "hash_addr (a :: addr) = (case a of Address ht n \<Rightarrow> int n)"
 definition "monitor_finfun_to_list (ls :: addr \<Rightarrow>f nat) = (SOME xs. set xs = {x. finfun_dom ls $ x })"
 instance
 proof
   fix ls :: "addr \<Rightarrow>f nat"
   show "set (monitor_finfun_to_list ls) = Collect (($) (finfun_dom ls))"
     unfolding monitor_finfun_to_list_addr_def
     using finite_list[OF finite_finfun_dom, where ?f.1 = "ls"]
     by(rule someI_ex)
 qed
 end
 
 primrec the_Address :: "addr \<Rightarrow> htype \<times> nat"
 where "the_Address (Address hT n) = (hT, n)"
 
 text \<open>
   The JMM heap only stores which sequence numbers of a given @{typ "htype"} have already been allocated.
 \<close>
 
 type_synonym JMM_heap = "htype \<Rightarrow> nat set"
 
 translations (type) "JMM_heap" <= (type) "htype \<Rightarrow> nat set"
 
 definition jmm_allocate :: "JMM_heap \<Rightarrow> htype \<Rightarrow> (JMM_heap \<times> addr) set"
 where "jmm_allocate h hT = (let hhT = h hT in (\<lambda>n. (h(hT := insert n hhT), Address hT n)) ` (- hhT))"
 
 abbreviation jmm_empty :: "JMM_heap" where "jmm_empty == (\<lambda>_. {})"
 
 definition jmm_typeof_addr :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<rightharpoonup> htype"
 where "jmm_typeof_addr P h = (\<lambda>hT. if is_htype P hT then Some hT else None) \<circ> fst \<circ> the_Address"
 
 definition jmm_typeof_addr' :: "'m prog \<Rightarrow> addr \<rightharpoonup> htype"
 where "jmm_typeof_addr' P = (\<lambda>hT. if is_htype P hT then Some hT else None) \<circ> fst \<circ> the_Address"
 
 lemma jmm_typeof_addr'_conv_jmm_type_addr: "jmm_typeof_addr' P = jmm_typeof_addr P h"
 by(simp add: jmm_typeof_addr_def jmm_typeof_addr'_def)
 
 lemma jmm_typeof_addr'_conv_jmm_typeof_addr: "(\<lambda>_. jmm_typeof_addr' P) = jmm_typeof_addr P"
 by(simp add: jmm_typeof_addr_def jmm_typeof_addr'_def fun_eq_iff)
 
 lemma jmm_typeof_addr_conv_jmm_typeof_addr': "jmm_typeof_addr = (\<lambda>P _. jmm_typeof_addr' P)"
 by(simp add: jmm_typeof_addr'_conv_jmm_typeof_addr)
 
 definition jmm_heap_read :: "JMM_heap \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> addr val \<Rightarrow> bool"
 where "jmm_heap_read h a ad v = True"
 
 context
   notes [[inductive_internals]]
 begin
 
 inductive jmm_heap_write :: "JMM_heap \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> addr val \<Rightarrow> JMM_heap \<Rightarrow> bool"
 where "jmm_heap_write h a ad v h"
 
 end
 
 definition jmm_hconf :: "JMM_heap \<Rightarrow> bool"
 where "jmm_hconf h \<longleftrightarrow> True"
 
 definition jmm_allocated :: "JMM_heap \<Rightarrow> addr set"
 where "jmm_allocated h = {Address CTn n|CTn n. n \<in> h CTn}"
 
 definition jmm_spurious_wakeups :: "bool"
 where "jmm_spurious_wakeups = True"
 
 lemmas jmm_heap_ops_defs =
   jmm_allocate_def jmm_typeof_addr_def 
   jmm_heap_read_def jmm_heap_write_def
   jmm_allocated_def jmm_spurious_wakeups_def
 
 type_synonym thread_id = "addr"
 
 abbreviation (input) addr2thread_id :: "addr \<Rightarrow> thread_id"
 where "addr2thread_id \<equiv> \<lambda>x. x"
 
 abbreviation (input) thread_id2addr :: "thread_id \<Rightarrow> addr"
 where "thread_id2addr \<equiv> \<lambda>x. x"
 
 interpretation jmm: heap_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write
   for P
 .
 
 abbreviation jmm_hext :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> JMM_heap \<Rightarrow> bool" ("_ \<turnstile> _ \<unlhd>jmm _" [51,51,51] 50)
 where "jmm_hext \<equiv> jmm.hext TYPE('m)"
 
 abbreviation jmm_conf :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr val \<Rightarrow> ty \<Rightarrow> bool" 
   ("_,_ \<turnstile>jmm _ :\<le> _"  [51,51,51,51] 50)
 where "jmm_conf P \<equiv> jmm.conf TYPE('m) P P"
 
 abbreviation jmm_addr_loc_type :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> ty \<Rightarrow> bool" 
   ("_,_ \<turnstile>jmm _@_ : _" [50, 50, 50, 50, 50] 51)
 where "jmm_addr_loc_type P \<equiv> jmm.addr_loc_type TYPE('m) P P"
 
 abbreviation jmm_confs :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr val list \<Rightarrow> ty list \<Rightarrow> bool"
   ("_,_ \<turnstile>jmm _ [:\<le>] _"  [51,51,51,51] 50)
 where "jmm_confs P \<equiv> jmm.confs TYPE('m) P P"
 
 abbreviation jmm_tconf :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> bool" ("_,_ \<turnstile>jmm _ \<surd>t" [51,51,51] 50)
 where "jmm_tconf P \<equiv> jmm.tconf TYPE('m) P P"
 
 interpretation jmm: allocated_heap_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write
   jmm_allocated
   for P
 .
 
 text \<open>Now a variation of the JMM with a different read operation that permits to read only type-conformant values\<close>
 
 abbreviation jmm_heap_read_typed :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> addr val \<Rightarrow> bool"
 where "jmm_heap_read_typed P \<equiv> jmm.heap_read_typed TYPE('m) P P"
 
 interpretation jmm': heap_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write
   for P .
 
-abbreviation jmm'_hext :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> JMM_heap \<Rightarrow> bool" ("_ \<turnstile> _ \<unlhd>jmm' _" [51,51,51] 50)
+abbreviation jmm'_hext :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> JMM_heap \<Rightarrow> bool" ("_ \<turnstile> _ \<unlhd>jmm'' _" [51,51,51] 50)
 where "jmm'_hext \<equiv> jmm'.hext TYPE('m)"
 
 abbreviation jmm'_conf :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr val \<Rightarrow> ty \<Rightarrow> bool" 
-  ("_,_ \<turnstile>jmm' _ :\<le> _"  [51,51,51,51] 50)
+  ("_,_ \<turnstile>jmm'' _ :\<le> _"  [51,51,51,51] 50)
 where "jmm'_conf P \<equiv> jmm'.conf TYPE('m) P P"
 
 abbreviation jmm'_addr_loc_type :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> ty \<Rightarrow> bool" 
-  ("_,_ \<turnstile>jmm' _@_ : _" [50, 50, 50, 50, 50] 51)
+  ("_,_ \<turnstile>jmm'' _@_ : _" [50, 50, 50, 50, 50] 51)
 where "jmm'_addr_loc_type P \<equiv> jmm'.addr_loc_type TYPE('m) P P"
 
 abbreviation jmm'_confs :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr val list \<Rightarrow> ty list \<Rightarrow> bool"
-  ("_,_ \<turnstile>jmm' _ [:\<le>] _"  [51,51,51,51] 50)
+  ("_,_ \<turnstile>jmm'' _ [:\<le>] _"  [51,51,51,51] 50)
 where "jmm'_confs P \<equiv> jmm'.confs TYPE('m) P P"
 
-abbreviation jmm'_tconf :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> bool" ("_,_ \<turnstile>jmm' _ \<surd>t" [51,51,51] 50)
+abbreviation jmm'_tconf :: "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> bool" ("_,_ \<turnstile>jmm'' _ \<surd>t" [51,51,51] 50)
 where "jmm'_tconf P \<equiv> jmm'.tconf TYPE('m) P P"
 
 subsection \<open>Heap locale interpretations\<close>
 
 subsection \<open>Locale \<open>heap\<close>\<close>
 
 lemma jmm_heap: "heap addr2thread_id thread_id2addr jmm_allocate (jmm_typeof_addr P) jmm_heap_write P"
 proof
   fix h' a h hT
   assume "(h', a) \<in> jmm_allocate h hT" "is_htype P hT"
   thus "jmm_typeof_addr P h' a = \<lfloor>hT\<rfloor>"
     by(auto simp add: jmm_heap_ops_defs)
 next
   fix h hT h' a
   assume "(h', a) \<in> jmm_allocate h hT"
   thus "P \<turnstile> h \<unlhd>jmm h'" by(auto simp add: jmm_heap_ops_defs intro: jmm.hextI)
 next
   fix h a al v h'
   assume "jmm_heap_write h a al v h'"
   thus "P \<turnstile> h \<unlhd>jmm h'" by cases auto
 qed simp
 
 interpretation jmm: heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write
   P
   for P
 by(rule jmm_heap)
 
 declare jmm.typeof_addr_thread_id2_addr_addr2thread_id [simp del]
 
 lemmas jmm'_heap = jmm_heap
 
 interpretation jmm': heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write
   P
   for P
 by(rule jmm'_heap)
 
 declare jmm'.typeof_addr_thread_id2_addr_addr2thread_id [simp del]
 
 lemma jmm_heap_read_typed_default_val:
   "heap_base.heap_read_typed typeof_addr jmm_heap_read P h a al
    (default_val (THE T. heap_base.addr_loc_type typeof_addr P h a al T))"
 by(rule heap_base.heap_read_typedI)(simp_all add: heap_base.THE_addr_loc_type jmm_heap_read_def heap_base.defval_conf)
 
 lemma jmm_allocate_Eps:
   "(SOME ha. ha \<in> jmm_allocate h hT) = (h', a')
   \<Longrightarrow> jmm_allocate h hT \<noteq> {} \<longrightarrow> (h', a') \<in> jmm_allocate h hT"
 by(auto dest: jmm.allocate_Eps)
 
 lemma jmm_allocate_eq_empty: "jmm_allocate h hT = {} \<longleftrightarrow> h hT = UNIV"
 by(auto simp add: jmm_allocate_def)
 
 lemma jmm_allocate_otherD:
   "(h', a) \<in> jmm_allocate h hT \<Longrightarrow> \<forall>hT'. hT' \<noteq> hT \<longrightarrow> h' hT' = h hT'"
 by(auto simp add: jmm_allocate_def)
 
 lemma jmm_start_heap_ok: "jmm.start_heap_ok"
 apply(simp add: jmm.start_heap_ok_def jmm.start_heap_data_def initialization_list_def sys_xcpts_list_def jmm.create_initial_object_simps)
 apply(split prod.split, clarify, clarsimp simp add: jmm.create_initial_object_simps jmm_allocate_eq_empty Thread_neq_sys_xcpts sys_xcpts_neqs dest!: jmm_allocate_Eps jmm_allocate_otherD)+
 done
 
 subsection \<open>Locale \<open>heap_conf\<close>\<close>
 
 interpretation jmm: heap_conf_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write jmm_hconf
   P
   for P .
 
 abbreviation (input) jmm'_hconf :: "JMM_heap \<Rightarrow> bool"
 where "jmm'_hconf == jmm_hconf"
 
 interpretation jmm': heap_conf_base
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write jmm'_hconf
   P
   for P .
 
 abbreviation jmm_heap_read_typeable :: "'m prog \<Rightarrow> bool"
 where "jmm_heap_read_typeable P \<equiv> jmm.heap_read_typeable TYPE('m) P jmm_hconf P"
 
 abbreviation jmm'_heap_read_typeable :: "'m prog \<Rightarrow> bool"
 where "jmm'_heap_read_typeable P \<equiv> jmm'.heap_read_typeable TYPE('m) P jmm_hconf P"
 
 lemma jmm_heap_read_typeable: "jmm_heap_read_typeable P"
 by(rule jmm.heap_read_typeableI)(simp add: jmm_heap_read_def)
 
 lemma jmm'_heap_read_typeable: "jmm'_heap_read_typeable P"
 by(rule jmm'.heap_read_typeableI)(auto simp add: jmm_heap_read_def jmm.heap_read_typed_def dest: jmm'.addr_loc_type_fun)
 
 lemma jmm_heap_conf:
   "heap_conf addr2thread_id thread_id2addr jmm_empty jmm_allocate (jmm_typeof_addr P) jmm_heap_write jmm_hconf P"
 by(unfold_locales)(simp_all add: jmm_hconf_def jmm_heap_ops_defs split: if_split_asm)
 
 interpretation jmm: heap_conf
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write jmm_hconf
   P
   for P
 by(rule jmm_heap_conf)
 
 lemmas jmm'_heap_conf = jmm_heap_conf
 
 interpretation jmm': heap_conf
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write jmm'_hconf
   P
   for P
 by(rule jmm'_heap_conf)
 
 subsection \<open>Locale \<open>heap_progress\<close>\<close>
 
 lemma jmm_heap_progress:
   "heap_progress addr2thread_id thread_id2addr jmm_empty jmm_allocate (jmm_typeof_addr P) jmm_heap_read jmm_heap_write jmm_hconf P"
 proof
   fix h a al T
   assume "jmm_hconf h"
     and al: "P,h \<turnstile>jmm a@al : T"
   show "\<exists>v. jmm_heap_read h a al v \<and> P,h \<turnstile>jmm v :\<le> T"
     using jmm.defval_conf[of P P h T] unfolding jmm_heap_ops_defs by blast
 next
   fix h a al T v
   assume "P,h \<turnstile>jmm a@al : T"
   show "\<exists>h'. jmm_heap_write h a al v h'"
     by(auto intro: jmm_heap_write.intros)
 qed
 
 interpretation jmm: heap_progress
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write jmm_hconf
   P
   for P
 by(rule jmm_heap_progress)
 
 lemma jmm'_heap_progress:
   "heap_progress addr2thread_id thread_id2addr jmm_empty jmm_allocate (jmm_typeof_addr P) (jmm_heap_read_typed P) jmm_heap_write jmm'_hconf P"
 proof
   fix h a al T
   assume "jmm'_hconf h"
     and al: "P,h \<turnstile>jmm' a@al : T"
   thus "\<exists>v. jmm_heap_read_typed P h a al v \<and> P,h \<turnstile>jmm' v :\<le> T"
     unfolding jmm_heap_read_def jmm.heap_read_typed_def
     by(blast dest: jmm'.addr_loc_type_fun intro: jmm'.defval_conf)+
 next
   fix h a al T v
   assume "P,h \<turnstile>jmm' a@al : T"
     and "P,h \<turnstile>jmm' v :\<le> T"
   thus "\<exists>h'. jmm_heap_write h a al v h'"
     by(auto intro: jmm_heap_write.intros)
 qed
 
 interpretation jmm': heap_progress
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write jmm'_hconf
   P
   for P
 by(rule jmm'_heap_progress)
 
 subsection \<open>Locale \<open>heap_conf_read\<close>\<close>
 
 lemma jmm'_heap_conf_read:
   "heap_conf_read addr2thread_id thread_id2addr jmm_empty jmm_allocate (jmm_typeof_addr P) (jmm_heap_read_typed P) jmm_heap_write jmm'_hconf P"
 by(rule jmm.heap_conf_read_heap_read_typed)
 
 interpretation jmm': heap_conf_read
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write jmm'_hconf
   P
   for P
 by(rule jmm'_heap_conf_read)
 
 interpretation jmm': heap_typesafe
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write jmm'_hconf
   P
   for P
 ..
 
 subsection \<open>Locale \<open>allocated_heap\<close>\<close>
 
 lemma jmm_allocated_heap:
   "allocated_heap addr2thread_id thread_id2addr jmm_empty jmm_allocate (jmm_typeof_addr P) jmm_heap_write jmm_allocated P"
 proof
   show "jmm_allocated jmm_empty = {}" by(simp add: jmm_allocated_def)
 next
   fix h' a h hT
   assume "(h', a) \<in> jmm_allocate h hT"
   thus "jmm_allocated h' = insert a (jmm_allocated h) \<and> a \<notin> jmm_allocated h"
     by(auto simp add: jmm_heap_ops_defs split: if_split_asm)
 next
   fix h a al v h'
   assume "jmm_heap_write h a al v h'"
   thus "jmm_allocated h' = jmm_allocated h" by cases simp
 qed
 
 interpretation jmm: allocated_heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" jmm_heap_read jmm_heap_write
   jmm_allocated
   P
   for P
 by(rule jmm_allocated_heap)
 
 lemmas jmm'_allocated_heap = jmm_allocated_heap
 
 interpretation jmm': allocated_heap
   addr2thread_id thread_id2addr
   jmm_spurious_wakeups
   jmm_empty jmm_allocate "jmm_typeof_addr P" "jmm_heap_read_typed P" jmm_heap_write
   jmm_allocated
   P
   for P
 by(rule jmm'_allocated_heap)
 
 subsection \<open>Syntax translations\<close>
 
-notation jmm'.external_WT' ("_,_ \<turnstile>jmm' (_\<bullet>_'(_')) : _" [50,0,0,0,50] 60)
+notation jmm'.external_WT' ("_,_ \<turnstile>jmm'' (_\<bullet>_'(_')) : _" [50,0,0,0,50] 60)
 
 abbreviation jmm'_red_external :: 
   "'m prog \<Rightarrow> thread_id \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> mname \<Rightarrow> addr val list
   \<Rightarrow> (addr, thread_id, JMM_heap) external_thread_action 
   \<Rightarrow> addr extCallRet \<Rightarrow> JMM_heap \<Rightarrow> bool"
 where "jmm'_red_external P \<equiv> jmm'.red_external (TYPE('m)) P P"
 
 abbreviation jmm'_red_external_syntax :: 
   "'m prog \<Rightarrow> thread_id \<Rightarrow> addr \<Rightarrow> mname \<Rightarrow> addr val list \<Rightarrow> JMM_heap
   \<Rightarrow> (addr, thread_id, JMM_heap) external_thread_action 
   \<Rightarrow> addr extCallRet \<Rightarrow> JMM_heap \<Rightarrow> bool"
-  ("_,_ \<turnstile>jmm' (\<langle>(_\<bullet>_'(_')),/_\<rangle>) -_\<rightarrow>ext (\<langle>(_),/(_)\<rangle>)" [50, 0, 0, 0, 0, 0, 0, 0, 0] 51)
+  ("_,_ \<turnstile>jmm'' (\<langle>(_\<bullet>_'(_')),/_\<rangle>) -_\<rightarrow>ext (\<langle>(_),/(_)\<rangle>)" [50, 0, 0, 0, 0, 0, 0, 0, 0] 51)
 where
   "P,t \<turnstile>jmm' \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle> \<equiv> jmm'_red_external P t h a M vs ta va h'"
 
 abbreviation jmm'_red_external_aggr :: 
   "'m prog \<Rightarrow> thread_id \<Rightarrow> addr \<Rightarrow> mname \<Rightarrow> addr val list \<Rightarrow> JMM_heap 
     \<Rightarrow> ((addr, thread_id, JMM_heap) external_thread_action \<times> addr extCallRet \<times> JMM_heap) set"
 where "jmm'_red_external_aggr P \<equiv> jmm'.red_external_aggr TYPE('m) P P"
 
 abbreviation jmm'_heap_copy_loc :: 
   "'m prog \<Rightarrow> addr \<Rightarrow> addr \<Rightarrow> addr_loc \<Rightarrow> JMM_heap
   \<Rightarrow> (addr, thread_id) obs_event list \<Rightarrow> JMM_heap \<Rightarrow> bool"
 where "jmm'_heap_copy_loc \<equiv> jmm'.heap_copy_loc TYPE('m)"
 
 abbreviation jmm'_heap_copies :: 
   "'m prog \<Rightarrow> addr \<Rightarrow> addr \<Rightarrow> addr_loc list \<Rightarrow> JMM_heap
   \<Rightarrow> (addr, thread_id) obs_event list \<Rightarrow> JMM_heap \<Rightarrow> bool"
 where "jmm'_heap_copies \<equiv> jmm'.heap_copies TYPE('m)"
 
 abbreviation jmm'_heap_clone ::
   "'m prog \<Rightarrow> JMM_heap \<Rightarrow> addr \<Rightarrow> JMM_heap
   \<Rightarrow> ((addr, thread_id) obs_event list \<times> addr) option \<Rightarrow> bool"
 where "jmm'_heap_clone P \<equiv> jmm'.heap_clone TYPE('m) P P"
 
 end
diff --git a/thys/LTL/Rewriting.thy b/thys/LTL/Rewriting.thy
--- a/thys/LTL/Rewriting.thy
+++ b/thys/LTL/Rewriting.thy
@@ -1,1052 +1,1052 @@
 (*
     Author:   Salomon Sickert
     Author:   Benedikt Seidl
     Author:   Alexander Schimpf (original entry: CAVA/LTL_Rewrite.thy)
     License:  BSD
 *)
 
 section \<open>Rewrite Rules for LTL Simplification\<close>
 
 theory Rewriting
 imports
   LTL "HOL-Library.Extended_Nat"
 begin
 
 text \<open>This theory provides rewrite rules for the simplification of LTL formulas. It supports:
   \begin{itemize}
     \item Constants Removal
     \item @{const Next_ltln}-Normalisation
     \item Modal Simplification (based on pure eventual, pure universal, or suspendable formulas)
     \item Syntactic Implication Checking
   \end{itemize}
   It reuses parts of LTL\_Rewrite.thy (CAVA, LTL\_TO\_GBA). Furthermore, some rules were taken from
   \cite{DBLP:conf/cav/SomenziB00} and \cite{DBLP:conf/tacas/BabiakKRS12}. All functions are defined for @{type ltln}.\<close>
 
 
 
 subsection \<open>Constant Eliminating Constructors\<close>
 
 definition mk_and
 where
   "mk_and x y \<equiv> case x of false\<^sub>n \<Rightarrow> false\<^sub>n | true\<^sub>n \<Rightarrow> y | _ \<Rightarrow> (case y of false\<^sub>n \<Rightarrow> false\<^sub>n | true\<^sub>n \<Rightarrow> x | _ \<Rightarrow> x and\<^sub>n y)"
 
 definition mk_or
 where
   "mk_or x y \<equiv> case x of false\<^sub>n \<Rightarrow> y | true\<^sub>n \<Rightarrow> true\<^sub>n | _ \<Rightarrow> (case y of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> x | _ \<Rightarrow> x or\<^sub>n y)"
 
 fun remove_strong_ops
 where
   "remove_strong_ops (x U\<^sub>n y) = remove_strong_ops y"
 | "remove_strong_ops (x M\<^sub>n y) = x and\<^sub>n y"
 | "remove_strong_ops (x or\<^sub>n y) = remove_strong_ops x or\<^sub>n remove_strong_ops y"
 | "remove_strong_ops x = x"
 
 fun remove_weak_ops
 where
   "remove_weak_ops (x R\<^sub>n y) = remove_weak_ops y"
 | "remove_weak_ops (x W\<^sub>n y) = x or\<^sub>n y"
 | "remove_weak_ops (x and\<^sub>n y) = remove_weak_ops x and\<^sub>n remove_weak_ops y"
 | "remove_weak_ops x = x"
 
 definition mk_finally
 where
   "mk_finally x \<equiv> case x of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> F\<^sub>n (remove_strong_ops x)"
 
 definition mk_globally
 where
   "mk_globally x \<equiv> case x of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> G\<^sub>n (remove_weak_ops x)"
 
 definition mk_until
 where
   "mk_until x y \<equiv> case x of false\<^sub>n \<Rightarrow> y
     | true\<^sub>n \<Rightarrow> mk_finally y
     | _ \<Rightarrow> (case y of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> x U\<^sub>n y)"
 
 definition mk_release
 where
   "mk_release x y \<equiv> case x of true\<^sub>n \<Rightarrow> y
     | false\<^sub>n \<Rightarrow> mk_globally y
     | _ \<Rightarrow> (case y of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> x R\<^sub>n y)"
 
 definition mk_weak_until
 where
   "mk_weak_until x y \<equiv> case y of true\<^sub>n \<Rightarrow> true\<^sub>n
     | false\<^sub>n \<Rightarrow> mk_globally x
     | _ \<Rightarrow> (case x of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> y | _ \<Rightarrow> x W\<^sub>n y)"
 
 definition mk_strong_release
 where
   "mk_strong_release x y \<equiv> case y of false\<^sub>n \<Rightarrow> false\<^sub>n
     | true\<^sub>n \<Rightarrow> mk_finally x
     | _ \<Rightarrow> (case x of true\<^sub>n \<Rightarrow> y | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> x M\<^sub>n y)"
 
 definition mk_next
 where
   "mk_next x \<equiv> case x of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> X\<^sub>n x"
 
-definition mk_next_pow ("X\<^sub>n'")
+definition mk_next_pow ("X\<^sub>n''")
 where
   "mk_next_pow n x \<equiv> case x of true\<^sub>n \<Rightarrow> true\<^sub>n | false\<^sub>n \<Rightarrow> false\<^sub>n | _ \<Rightarrow> (Next_ltln ^^ n) x"
 
 
 
 lemma mk_and_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_and x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x and\<^sub>n y"
   unfolding mk_and_def by (cases x; cases y; simp)
 
 lemma mk_or_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_or x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x or\<^sub>n y"
   unfolding mk_or_def by (cases x; cases y; simp)
 
 lemma remove_strong_ops_sound [simp]:
   "w \<Turnstile>\<^sub>n F\<^sub>n (remove_strong_ops y) \<longleftrightarrow> w \<Turnstile>\<^sub>n F\<^sub>n y"
   by (induction y arbitrary: w) (auto; force)+
 
 lemma remove_weak_ops_sound [simp]:
   "w \<Turnstile>\<^sub>n G\<^sub>n (remove_weak_ops y) \<longleftrightarrow> w \<Turnstile>\<^sub>n G\<^sub>n y"
   by (induction y arbitrary: w) (auto; force)+
 
 lemma mk_finally_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_finally x \<longleftrightarrow> w \<Turnstile>\<^sub>n F\<^sub>n x"
   by (simp add: mk_finally_def del: semantics_ltln.simps(8,9) remove_strong_ops.simps split: ltln.splits)
 
 lemma mk_globally_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_globally x \<longleftrightarrow> w \<Turnstile>\<^sub>n G\<^sub>n x"
   by (simp add: mk_globally_def del: semantics_ltln.simps(8,9) remove_weak_ops.simps split: ltln.splits)
 
 lemma mk_until_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_until x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x U\<^sub>n y"
 proof (cases x)
   case (True_ltln)
     show ?thesis
       unfolding True_ltln mk_until_def
       by (cases y) auto
 next
   case (False_ltln)
     thus ?thesis
       by (force simp: mk_until_def)
 qed (cases y; force simp: mk_until_def)+
 
 lemma mk_release_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_release x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x R\<^sub>n y"
 proof (cases x)
   case (False_ltln)
     thus ?thesis
       unfolding False_ltln mk_release_def
       by (cases y) auto
 next
   case (True_ltln)
     thus ?thesis
       by (force simp: mk_release_def)
 qed (cases y; force simp: mk_release_def)+
 
 lemma mk_weak_until_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_weak_until x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x W\<^sub>n y"
 proof (cases y)
   case (False_ltln)
     thus ?thesis
       unfolding False_ltln mk_weak_until_def
       by (cases x) auto
 next
   case (True_ltln)
     thus ?thesis
       by (force simp: mk_weak_until_def)
 qed (cases x; force simp: mk_weak_until_def)+
 
 lemma mk_strong_release_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_strong_release x y \<longleftrightarrow> w \<Turnstile>\<^sub>n x M\<^sub>n y"
 proof (cases y)
   case (True_ltln)
     show ?thesis
       unfolding True_ltln mk_strong_release_def
       by (cases x) auto
 next
   case (False_ltln)
     thus ?thesis
       by (force simp: mk_strong_release_def)
 qed (cases x; force simp: mk_strong_release_def)+
 
 lemma mk_next_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_next x \<longleftrightarrow> w \<Turnstile>\<^sub>n X\<^sub>n x"
   unfolding mk_next_def by (cases x; auto)
 
 lemma mk_next_pow_semantics [simp]:
   "w \<Turnstile>\<^sub>n mk_next_pow i x \<longleftrightarrow> suffix i w \<Turnstile>\<^sub>n x"
   by (induction i arbitrary: w; cases x)
      (auto simp: mk_next_pow_def)
 
 lemma mk_next_pow_simp [simp, code_unfold]:
   "mk_next_pow 0 x = x"
   "mk_next_pow 1 x = mk_next x"
   by (cases x; simp add: mk_next_pow_def mk_next_def)+
 
 
 
 subsection \<open>Constant Propagation\<close>
 
 fun is_constant :: "'a ltln \<Rightarrow> bool"
 where
   "is_constant true\<^sub>n = True"
 | "is_constant false\<^sub>n = True"
 | "is_constant _ = False"
 
 lemma is_constant_constructorsI:
   "is_constant x \<Longrightarrow> is_constant y \<Longrightarrow> is_constant (mk_and x y)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant y \<Longrightarrow> \<not>is_constant (mk_and x y)"
   "is_constant x \<Longrightarrow> is_constant y \<Longrightarrow> is_constant (mk_or x y)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant y \<Longrightarrow> \<not>is_constant (mk_or x y)"
   "is_constant x \<Longrightarrow>  is_constant (mk_finally x)"
   "\<not>is_constant x \<Longrightarrow>  \<not>is_constant (mk_finally x)"
   "is_constant x \<Longrightarrow> is_constant (mk_globally x)"
   "\<not>is_constant x \<Longrightarrow>  \<not>is_constant (mk_globally x)"
   "is_constant x \<Longrightarrow> is_constant (mk_until y x)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant (mk_until y x)"
   "is_constant x \<Longrightarrow> is_constant (mk_release y x)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant (mk_release y x)"
   "is_constant x \<Longrightarrow> is_constant y \<Longrightarrow> is_constant (mk_weak_until x y)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant y \<Longrightarrow> \<not>is_constant (mk_weak_until x y)"
   "is_constant x \<Longrightarrow> is_constant y \<Longrightarrow> is_constant (mk_strong_release x y)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant y \<Longrightarrow> \<not>is_constant (mk_strong_release x y)"
   "is_constant x \<Longrightarrow> is_constant (mk_next x)"
   "\<not>is_constant x \<Longrightarrow> \<not>is_constant (mk_next x)"
   "is_constant x \<Longrightarrow> is_constant (mk_next_pow n x)"
   by (cases x; cases y; simp add: mk_and_def mk_or_def mk_finally_def mk_globally_def mk_until_def mk_release_def mk_weak_until_def mk_strong_release_def mk_next_def mk_next_pow_def)+
 
 lemma is_constant_constructors_simps:
   "mk_next_pow n x = false\<^sub>n \<longleftrightarrow> x = false\<^sub>n"
   "mk_next_pow n x = true\<^sub>n \<longleftrightarrow> x = true\<^sub>n"
   "is_constant (mk_next_pow n x) \<longleftrightarrow> is_constant x"
   by (induction n) (cases x; simp add: mk_next_pow_def)+
 
 lemma is_constant_constructors_simps2:
   "is_constant (mk_and x y) \<longleftrightarrow> (x = true\<^sub>n \<and> y = true\<^sub>n \<or> x = false\<^sub>n \<or> y = false\<^sub>n)"
   "is_constant (mk_or x y) \<longleftrightarrow> (x = false\<^sub>n \<and> y = false\<^sub>n \<or> x = true\<^sub>n \<or> y = true\<^sub>n)"
   "is_constant (mk_finally x) \<longleftrightarrow> is_constant x"
   "is_constant (mk_globally x) \<longleftrightarrow> is_constant x"
   "is_constant (mk_until y x) \<longleftrightarrow> is_constant x"
   "is_constant (mk_release y x) \<longleftrightarrow> is_constant x"
   "is_constant (mk_next x) \<longleftrightarrow> is_constant x"
   by ((cases x; cases y; simp add: mk_and_def),
       (cases x; cases y; simp add: mk_or_def),
       (meson is_constant_constructorsI)+)
 
 lemma is_constant_constructors_simps3:
   "is_constant (mk_weak_until x y) \<longleftrightarrow> (x = false\<^sub>n \<and> y = false\<^sub>n \<or> x = true\<^sub>n \<or> y = true\<^sub>n)"
   "is_constant (mk_strong_release x y) \<longleftrightarrow> (x = true\<^sub>n \<and> y = true\<^sub>n \<or> x = false\<^sub>n \<or> y = false\<^sub>n)"
   by (cases x; cases y; simp add: mk_weak_until_def mk_strong_release_def is_constant_constructors_simps2)+
 
 lemma is_constant_semantics:
   "is_constant \<phi> \<Longrightarrow> ((\<forall>w. w \<Turnstile>\<^sub>n \<phi>) \<or> \<not>(\<exists>w. w \<Turnstile>\<^sub>n \<phi>))"
   by (cases \<phi>) auto
 
 lemma until_constant_simp:
   "is_constant \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<psi>"
   by (cases \<psi>) auto
 
 lemma release_constant_simp:
   "is_constant \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<phi> R\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<psi>"
   by (cases \<psi>) auto
 
 lemma mk_next_pow_dist:
   "mk_next_pow (i + j) \<phi> = mk_next_pow i (mk_next_pow j \<phi>)"
   by (cases j; simp) (cases \<phi>; simp add: mk_next_pow_def funpow_add; simp add: funpow_swap1)
 
 lemma mk_next_pow_until:
   "suffix (min i j) w \<Turnstile>\<^sub>n (mk_next_pow (i - j) \<phi>) U\<^sub>n (mk_next_pow (j - i) \<psi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n (mk_next_pow i \<phi>) U\<^sub>n (mk_next_pow j \<psi>)"
   by (simp add: mk_next_pow_dist min_def add.commute)
 
 lemma mk_next_pow_release:
   "suffix (min i j) w \<Turnstile>\<^sub>n (mk_next_pow (i - j) \<phi>) R\<^sub>n (mk_next_pow (j - i) \<psi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n (mk_next_pow i \<phi>) R\<^sub>n (mk_next_pow j \<psi>)"
   by (simp add: mk_next_pow_dist min_def add.commute)
 
 subsection \<open>X-Normalisation\<close>
 
 text \<open>The following rewrite functions pulls the X-operator up in the syntax tree. This preprocessing
   step enables the removal of X-operators in front of suspendable formulas. Furthermore constants are
   removed as far as possible.\<close>
 
 fun the_enat_0 :: "enat \<Rightarrow> nat"
 where
   "the_enat_0 i = i"
 | "the_enat_0 \<infinity> = 0"
 
 lemma the_enat_0_simp [simp]:
   "the_enat_0 0 = 0"
   "the_enat_0 1 = 1"
   by (simp add: zero_enat_def one_enat_def)+
 
 fun combine :: "('a ltln \<Rightarrow> 'a ltln \<Rightarrow> 'a ltln) \<Rightarrow> ('a ltln * enat) \<Rightarrow> ('a ltln * enat) \<Rightarrow> ('a ltln * enat)"
 where
   "combine binop (\<phi>, i) (\<psi>, j) = (
     let
       \<chi> = binop (mk_next_pow (the_enat_0 (i - j)) \<phi>) (mk_next_pow (the_enat_0 (j - i)) \<psi>)
     in
       (\<chi>, if is_constant \<chi> then \<infinity> else min i j))"
 
 lemma fst_combine:
   "fst (combine binop (\<phi>, i) (\<psi>, j)) = binop (mk_next_pow (the_enat_0 (i - j)) \<phi>) (mk_next_pow (the_enat_0 (j - i)) \<psi>)"
   unfolding combine.simps by (meson fstI)
 
 abbreviation to_ltln :: "('a ltln * enat) \<Rightarrow> 'a ltln"
 where
   "to_ltln x \<equiv> mk_next_pow (the_enat_0 (snd x)) (fst x)"
 
 fun rewrite_X_enat :: "'a ltln \<Rightarrow> ('a ltln * enat)"
 where
   "rewrite_X_enat true\<^sub>n = (true\<^sub>n, \<infinity>)"
 | "rewrite_X_enat false\<^sub>n = (false\<^sub>n, \<infinity>)"
 | "rewrite_X_enat prop\<^sub>n(a) = (prop\<^sub>n(a), 0)"
 | "rewrite_X_enat nprop\<^sub>n(a) = (nprop\<^sub>n(a), 0)"
 | "rewrite_X_enat (\<phi> and\<^sub>n \<psi>) = combine mk_and (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (\<phi> or\<^sub>n \<psi>) = combine mk_or (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (\<phi> U\<^sub>n \<psi>) = combine mk_until (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (\<phi> R\<^sub>n \<psi>) = combine mk_release (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (\<phi> W\<^sub>n \<psi>) = combine mk_weak_until (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (\<phi> M\<^sub>n \<psi>) = combine mk_strong_release (rewrite_X_enat \<phi>) (rewrite_X_enat \<psi>)"
 | "rewrite_X_enat (X\<^sub>n \<phi>) = (\<lambda>(\<phi>, n). (\<phi>, eSuc n)) (rewrite_X_enat \<phi>)"
 
 definition
   "rewrite_X \<phi> = to_ltln (rewrite_X_enat \<phi>)"
 
 lemma combine_infinity_invariant:
   assumes "i = \<infinity> \<longleftrightarrow> is_constant x"
   assumes "j = \<infinity> \<longleftrightarrow> is_constant y"
   shows "combine mk_and (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
     and "combine mk_or (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
     and "combine mk_until (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
     and "combine mk_release (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
     and "combine mk_weak_until (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
     and "combine mk_strong_release (x, i) (y, j) = (z, k) \<Longrightarrow> (k = \<infinity> \<longleftrightarrow> is_constant z)"
   by (cases i; cases j; simp add: assms Let_def; force intro: is_constant_constructorsI)+
 
 lemma combine_and_or_semantics:
   assumes "i = \<infinity> \<longleftrightarrow> is_constant \<phi>"
   assumes "j = \<infinity> \<longleftrightarrow> is_constant \<psi>"
   shows "w \<Turnstile>\<^sub>n to_ltln (combine mk_and (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) and\<^sub>n to_ltln (\<psi>, j)"
     and "w \<Turnstile>\<^sub>n to_ltln (combine mk_or (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) or\<^sub>n to_ltln (\<psi>, j)"
   by ((cases i; cases j; simp add: min_def is_constant_constructors_simps is_constant_constructors_simps2 assms),
       (cases \<psi>; insert assms; auto),
       (cases \<phi>; insert assms; auto),
       (blast elim!: is_constant.elims))+
 
 lemma combine_until_release_semantics:
   assumes "i = \<infinity> \<longleftrightarrow> is_constant \<phi>"
   assumes "j = \<infinity> \<longleftrightarrow> is_constant \<psi>"
   shows "w \<Turnstile>\<^sub>n to_ltln (combine mk_until (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) U\<^sub>n to_ltln (\<psi>, j)"
     and "w \<Turnstile>\<^sub>n to_ltln (combine mk_release (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) R\<^sub>n to_ltln (\<psi>, j)"
   by ((cases i; cases j; simp add: is_constant_constructors_simps is_constant_constructors_simps2
        until_constant_simp release_constant_simp mk_next_pow_until mk_next_pow_release del: semantics_ltln.simps),
       (blast dest: is_constant_semantics),
       (cases \<psi>; simp add: assms),
       (cases \<phi>; insert assms; auto simp: add.commute))+
 
 (* TODO this proof is a bit slow and could be optimized *)
 lemma combine_weak_until_strong_release_semantics:
   assumes "i = \<infinity> \<longleftrightarrow> is_constant \<phi>"
   assumes "j = \<infinity> \<longleftrightarrow> is_constant \<psi>"
   shows "w \<Turnstile>\<^sub>n to_ltln (combine mk_weak_until (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) W\<^sub>n to_ltln (\<psi>, j)"
     and "w \<Turnstile>\<^sub>n to_ltln (combine mk_strong_release (\<phi>, i) (\<psi>, j)) \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (\<phi>, i) M\<^sub>n to_ltln (\<psi>, j)"
   by ((cases i; cases j; simp add: min_def is_constant_constructors_simps is_constant_constructors_simps3 del: semantics_ltln.simps),
       (cases \<phi>; simp add: assms),
       (cases \<psi>; insert assms; auto simp: add.commute))+
 
 
 
 lemma rewrite_X_enat_infinity_invariant:
   "snd (rewrite_X_enat \<phi>) = \<infinity> \<longleftrightarrow> is_constant (fst (rewrite_X_enat \<phi>))"
 proof (induction \<phi>)
   case (And_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF And_ltln(1,2), unfolded prod.collapse])
 next
   case (Or_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF Or_ltln(1,2), unfolded prod.collapse])
 next
   case (Until_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF Until_ltln(1,2), unfolded prod.collapse])
 next
   case (Release_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF Release_ltln(1,2), unfolded prod.collapse])
 next
   case (WeakUntil_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF WeakUntil_ltln(1,2), unfolded prod.collapse])
 next
   case (StrongRelease_ltln \<phi> \<psi>)
     thus ?case
       by (simp add: combine_infinity_invariant[OF StrongRelease_ltln(1,2), unfolded prod.collapse])
 next
   case (Next_ltln \<phi>)
     thus ?case
       by (simp add: split_def) (metis eSuc_infinity eSuc_inject)
 qed auto
 
 lemma rewrite_X_enat_correct:
   "w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n to_ltln (rewrite_X_enat \<phi>)"
 proof (induction \<phi> arbitrary: w)
   case (And_ltln \<phi> \<psi>)
     thus ?case
       using combine_and_or_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant] by fastforce
 next
   case (Or_ltln \<phi> \<psi>)
     thus ?case
       using combine_and_or_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant] by fastforce
 next
   case (Until_ltln \<phi> \<psi>)
     thus ?case
       unfolding rewrite_X_enat.simps combine_until_release_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant, unfolded prod.collapse] by fastforce
 next
   case (Release_ltln \<phi> \<psi>)
     thus ?case
       unfolding rewrite_X_enat.simps combine_until_release_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant, unfolded prod.collapse] by fastforce
 next
   case (WeakUntil_ltln \<phi> \<psi>)
     thus ?case
       unfolding rewrite_X_enat.simps combine_weak_until_strong_release_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant, unfolded prod.collapse] by fastforce
 next
   case (StrongRelease_ltln \<phi> \<psi>)
     thus ?case
       unfolding rewrite_X_enat.simps combine_weak_until_strong_release_semantics[OF rewrite_X_enat_infinity_invariant rewrite_X_enat_infinity_invariant, unfolded prod.collapse] by fastforce
 next
   case (Next_ltln \<phi>)
   moreover
     have " w \<Turnstile>\<^sub>n to_ltln (rewrite_X_enat (X\<^sub>n \<phi>)) \<longleftrightarrow> suffix 1 w \<Turnstile>\<^sub>n to_ltln (rewrite_X_enat \<phi>)"
       by (simp add: split_def; cases "snd (rewrite_X_enat \<phi>) \<noteq> \<infinity>")
          (auto simp: eSuc_def, auto simp: rewrite_X_enat_infinity_invariant eSuc_def dest: is_constant_semantics)
     ultimately
     show ?case
        using semantics_ltln.simps(7) by blast
 qed auto
 
 lemma rewrite_X_sound [simp]:
   "w \<Turnstile>\<^sub>n rewrite_X \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   using rewrite_X_enat_correct unfolding rewrite_X_def Let_def by auto
 
 subsection \<open>Pure Eventual, Pure Universal, and Suspendable Formulas\<close>
 
 fun pure_eventual :: "'a ltln \<Rightarrow> bool"
 where
   "pure_eventual true\<^sub>n = True"
 | "pure_eventual false\<^sub>n = True"
 | "pure_eventual (\<mu> and\<^sub>n \<mu>') = (pure_eventual \<mu> \<and> pure_eventual \<mu>')"
 | "pure_eventual (\<mu> or\<^sub>n \<mu>') = (pure_eventual \<mu> \<and> pure_eventual \<mu>')"
 | "pure_eventual (\<mu> U\<^sub>n \<mu>') = (\<mu> = true\<^sub>n \<or> pure_eventual \<mu>')"
 | "pure_eventual (\<mu> R\<^sub>n \<mu>') = (pure_eventual \<mu> \<and> pure_eventual \<mu>')"
 | "pure_eventual (\<mu> W\<^sub>n \<mu>') = (pure_eventual \<mu> \<and> pure_eventual \<mu>')"
 | "pure_eventual (\<mu> M\<^sub>n \<mu>') = (pure_eventual \<mu> \<and> pure_eventual \<mu>' \<or> \<mu>' = true\<^sub>n)"
 | "pure_eventual (X\<^sub>n \<mu>) = pure_eventual \<mu>"
 | "pure_eventual _ = False"
 
 fun pure_universal :: "'a ltln \<Rightarrow> bool"
 where
   "pure_universal true\<^sub>n = True"
 | "pure_universal false\<^sub>n = True"
 | "pure_universal (\<nu> and\<^sub>n \<nu>') = (pure_universal \<nu> \<and> pure_universal \<nu>')"
 | "pure_universal (\<nu> or\<^sub>n \<nu>') = (pure_universal \<nu> \<and> pure_universal \<nu>')"
 | "pure_universal (\<nu> U\<^sub>n \<nu>') = (pure_universal \<nu> \<and> pure_universal \<nu>')"
 | "pure_universal (\<nu> R\<^sub>n \<nu>') = (\<nu> = false\<^sub>n \<or> pure_universal \<nu>')"
 | "pure_universal (\<nu> W\<^sub>n \<nu>') = (pure_universal \<nu> \<and> pure_universal \<nu>' \<or> \<nu>' = false\<^sub>n)"
 | "pure_universal (\<nu> M\<^sub>n \<nu>') = (pure_universal \<nu> \<and> pure_universal \<nu>')"
 | "pure_universal (X\<^sub>n \<nu>) = pure_universal \<nu>"
 | "pure_universal _ = False"
 
 fun suspendable :: "'a ltln \<Rightarrow> bool"
 where
   "suspendable true\<^sub>n = True"
 | "suspendable false\<^sub>n = True"
 | "suspendable (\<xi> and\<^sub>n \<xi>') = (suspendable \<xi> \<and> suspendable \<xi>')"
 | "suspendable (\<xi> or\<^sub>n \<xi>') = (suspendable \<xi> \<and> suspendable \<xi>')"
 | "suspendable (\<phi> U\<^sub>n \<xi>) = (\<phi> = true\<^sub>n \<and> pure_universal \<xi> \<or> suspendable \<xi>)"
 | "suspendable (\<phi> R\<^sub>n \<xi>) = (\<phi> = false\<^sub>n \<and> pure_eventual \<xi> \<or> suspendable \<xi>)"
 | "suspendable (\<phi> W\<^sub>n \<xi>) = (suspendable \<phi> \<and> suspendable \<xi> \<or> pure_eventual \<phi> \<and> \<xi> = false\<^sub>n)"
 | "suspendable (\<phi> M\<^sub>n \<xi>) = (suspendable \<phi> \<and> suspendable \<xi> \<or> pure_universal \<phi> \<and> \<xi> = true\<^sub>n)"
 | "suspendable (X\<^sub>n \<xi>) = suspendable \<xi>"
 | "suspendable _ = False"
 
 lemma pure_eventual_left_append:
   "pure_eventual \<mu> \<Longrightarrow> w \<Turnstile>\<^sub>n \<mu> \<Longrightarrow> (u \<frown> w) \<Turnstile>\<^sub>n \<mu>"
 proof (induction \<mu> arbitrary: u w)
   case (Until_ltln \<mu> \<mu>')
     moreover
     then obtain i where "suffix i w \<Turnstile>\<^sub>n \<mu>'"
       by auto
     hence "\<mu> = true\<^sub>n \<Longrightarrow> ?case"
       by simp (metis suffix_conc_length suffix_suffix)
     moreover
     have "pure_eventual \<mu>' \<Longrightarrow> (u \<frown> w) \<Turnstile>\<^sub>n \<mu>'"
       by (metis \<open>suffix i w \<Turnstile>\<^sub>n \<mu>'\<close> Until_ltln(2) prefix_suffix)
     hence "pure_eventual \<mu>' \<Longrightarrow> ?case"
       by force
     ultimately
     show ?case
       by fastforce
 next
   case (Release_ltln \<mu> \<mu>')
     thus ?case
       by (cases "\<forall>i. suffix i w \<Turnstile>\<^sub>n \<mu>'"; simp_all)
          (metis linear suffix_conc_snd gr0I not_less0 prefix_suffix suffix_0)+
 next
   case (WeakUntil_ltln \<mu> \<mu>')
     thus ?case
       by (cases "\<forall>i. suffix i w \<Turnstile>\<^sub>n \<mu>'"; simp_all)
          (metis zero_le le0 nat_le_linear prefix_suffix suffix_0 suffix_conc_length suffix_conc_snd suffix_subseq_join)+
 next
   case (StrongRelease_ltln \<mu> \<mu>')
     moreover
     then obtain i where "suffix i w \<Turnstile>\<^sub>n \<mu> and\<^sub>n \<mu>'"
       by auto
     hence "\<mu>' = true\<^sub>n \<Longrightarrow> ?case"
       by simp (metis suffix_conc_length suffix_suffix)
     moreover
     have "pure_eventual \<mu> \<Longrightarrow> pure_eventual \<mu>' \<Longrightarrow> (u \<frown> w) \<Turnstile>\<^sub>n \<mu> and\<^sub>n \<mu>'"
       by (metis \<open>suffix i w \<Turnstile>\<^sub>n \<mu> and\<^sub>n \<mu>'\<close> calculation(1) calculation(2) prefix_suffix semantics_ltln.simps(5))
     hence "pure_eventual \<mu> \<Longrightarrow> pure_eventual \<mu>' \<Longrightarrow> ?case"
       by force
     ultimately
     show ?case
       by fastforce
 qed (auto, metis diff_zero le_0_eq not_less_eq_eq suffix_conc_length suffix_conc_snd word_split)
 
 lemma pure_universal_suffix_closed:
   "pure_universal \<nu> \<Longrightarrow> (u \<frown> w) \<Turnstile>\<^sub>n \<nu> \<Longrightarrow> w \<Turnstile>\<^sub>n \<nu>"
 proof (induction \<nu> arbitrary: u w)
   case (Until_ltln \<nu> \<nu>')
     hence "\<exists>i. suffix i (u \<frown> w) \<Turnstile>\<^sub>n \<nu>' \<and> (\<forall>j<i. suffix j (u \<frown> w) \<Turnstile>\<^sub>n \<nu>)"
       using semantics_ltln.simps(8) by blast
     thus ?case
       by simp (metis Until_ltln(1-3) le_0_eq le_eq_less_or_eq le_less_linear prefix_suffix pure_universal.simps(5) suffix_conc_fst suffix_conc_snd)
 next
   case (Release_ltln \<nu> \<nu>')
     moreover
     hence "\<forall>i. suffix i (u \<frown> w) \<Turnstile>\<^sub>n \<nu>' \<or> (\<exists>j<i. suffix j (u \<frown> w) \<Turnstile>\<^sub>n \<nu>)"
       by simp
     ultimately
     show ?case
       by simp (metis semantics_ltln.simps(2) not_less0 prefix_suffix suffix_0 suffix_conc_length suffix_suffix)
 next
   case (WeakUntil_ltln \<nu> \<nu>')
     moreover
     hence "\<forall>i. suffix i (u \<frown> w) \<Turnstile>\<^sub>n \<nu> \<or> (\<exists>j\<le>i. suffix j (u \<frown> w) \<Turnstile>\<^sub>n \<nu>')"
       by simp
     ultimately
     show ?case
       by simp (metis (full_types) le_antisym prefix_suffix semantics_ltln.simps(2) suffix_0 suffix_conc_length suffix_suffix zero_le)
 next
   case (StrongRelease_ltln \<nu> \<nu>')
     hence "\<exists>i. suffix i (u \<frown> w) \<Turnstile>\<^sub>n \<nu> \<and> (\<forall>j\<le>i. suffix j (u \<frown> w) \<Turnstile>\<^sub>n \<nu>')"
       using semantics_ltln.simps(11) by blast
     thus ?case
       by simp (metis StrongRelease_ltln(1-3) diff_is_0_eq nat_le_linear prefix_conc_length prefix_suffix pure_universal.simps(8) subsequence_length suffix_conc_snd suffix_subseq_join)
 next
   case (Next_ltln \<mu>)
     thus ?case
       by (metis prefix_suffix pure_universal.simps(9) semantics_ltln.simps(7) semiring_normalization_rules(24) suffix_conc_length suffix_suffix)
 qed auto
 
 lemma suspendable_prefix_invariant:
   "suspendable \<xi> \<Longrightarrow> (u \<frown> w) \<Turnstile>\<^sub>n \<xi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<xi>"
 proof (induction \<xi> arbitrary: u w)
   case (Until_ltln \<xi> \<xi>')
     show ?case
     proof (cases "suspendable \<xi>'")
       case False
         hence "\<xi> = true\<^sub>n" and "pure_universal \<xi>'"
           using Until_ltln by simp+
         thus ?thesis
           by (simp; metis (no_types) linear pure_universal_suffix_closed suffix_conc_fst suffix_conc_length suffix_conc_snd suffix_suffix)
     qed (simp; metis Until_ltln(2) not_less0 prefix_suffix)
 next
   case (Release_ltln \<xi> \<xi>')
     show ?case
     proof (cases "suspendable \<xi>'")
       case False
         hence "\<xi> = false\<^sub>n" and "pure_eventual \<xi>'"
           using Release_ltln by simp+
         thus ?thesis
           by (simp; metis (no_types) le_iff_add add_diff_cancel_left' linear pure_eventual_left_append suffix_0 suffix_conc_fst suffix_conc_snd)
     qed (simp; metis Release_ltln(2) not_less0 prefix_suffix)
 next
   case (WeakUntil_ltln \<xi> \<xi>')
     show ?case
     proof (cases "suspendable \<xi> \<and> suspendable \<xi>'")
       case False
         hence "\<xi>' = false\<^sub>n" and "pure_eventual \<xi>"
           using WeakUntil_ltln by simp+
         thus ?thesis
           by (simp; metis (no_types) le_iff_add add_diff_cancel_left' linear pure_eventual_left_append suffix_0 suffix_conc_fst suffix_conc_snd)
       qed (simp; metis (full_types) WeakUntil_ltln.IH prefix_suffix)
 next
   case (StrongRelease_ltln \<xi> \<xi>')
     show ?case
     proof (cases "suspendable \<xi> \<and> suspendable \<xi>'")
       case False
         hence "\<xi>' = true\<^sub>n" and "pure_universal \<xi>"
           using StrongRelease_ltln by simp+
         thus ?thesis
           by (simp; metis (no_types) linear pure_universal_suffix_closed suffix_conc_fst suffix_conc_length suffix_conc_snd suffix_suffix)
     qed (simp; metis (full_types) StrongRelease_ltln.IH(1) StrongRelease_ltln.IH(2) prefix_suffix)
 qed (simp_all, metis prefix_suffix)
 
 theorem pure_eventual_until_simp:
   assumes "pure_eventual \<mu>"
   shows "w \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<mu> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<mu>"
 proof -
   have "\<And>i. suffix i w \<Turnstile>\<^sub>n \<mu> \<Longrightarrow> w \<Turnstile>\<^sub>n \<mu>"
     using pure_eventual_left_append[OF assms] prefix_suffix by metis
   thus ?thesis
     by force
 qed
 
 theorem pure_universal_release_simp:
   assumes "pure_universal \<nu>"
   shows "w \<Turnstile>\<^sub>n \<phi> R\<^sub>n \<nu> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<nu>"
 proof -
   have "\<And>i. w \<Turnstile>\<^sub>n \<nu> \<Longrightarrow> suffix i w \<Turnstile>\<^sub>n \<nu>"
     using pure_universal_suffix_closed[OF assms] prefix_suffix by metis
   thus ?thesis
     by force
 qed
 
 theorem pure_universal_weak_until_simp:
   assumes "pure_universal \<phi>" and "pure_universal \<psi>"
   shows "w \<Turnstile>\<^sub>n \<phi> W\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi>"
 proof -
   have "\<And>i. w \<Turnstile>\<^sub>n \<phi> \<Longrightarrow> suffix i w \<Turnstile>\<^sub>n \<phi>" and "\<And>i. w \<Turnstile>\<^sub>n \<psi> \<Longrightarrow> suffix i w \<Turnstile>\<^sub>n \<psi>"
     using assms pure_universal_suffix_closed prefix_suffix by metis+
   thus ?thesis
     by force
 qed
 
 theorem pure_eventual_strong_release_simp:
   assumes "pure_eventual \<phi>" and "pure_eventual \<psi>"
   shows "w \<Turnstile>\<^sub>n \<phi> M\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi>"
 proof -
   have "\<And>i. suffix i w \<Turnstile>\<^sub>n \<phi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<phi>" and "\<And>i. suffix i w \<Turnstile>\<^sub>n \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<psi>"
     using assms pure_eventual_left_append prefix_suffix by metis+
   thus ?thesis
     by force
 qed
 
 
 theorem suspendable_formula_simp:
   assumes "suspendable \<xi>"
   shows "w \<Turnstile>\<^sub>n X\<^sub>n \<xi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<xi>" (is ?t1)
     and "w \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<xi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<xi>" (is ?t2)
     and "w \<Turnstile>\<^sub>n \<phi> R\<^sub>n \<xi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<xi>" (is ?t3)
 proof -
   have "\<And>i. suffix i w \<Turnstile>\<^sub>n \<xi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<xi>"
     using suspendable_prefix_invariant[OF assms] prefix_suffix by metis
   thus ?t1 ?t2 ?t3
     by force+
 qed
 
 theorem suspendable_formula_simp2:
   assumes "suspendable \<phi>" and "suspendable \<psi>"
   shows "w \<Turnstile>\<^sub>n \<phi> W\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi>" (is ?t1)
     and "w \<Turnstile>\<^sub>n \<phi> M\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi>" (is ?t2)
 proof -
   have "\<And>i. suffix i w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>" and "\<And>i. suffix i w \<Turnstile>\<^sub>n \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<psi>"
     using assms suspendable_prefix_invariant prefix_suffix by metis+
   thus ?t1 ?t2
     by force+
 qed
 
 fun rewrite_modal :: "'a ltln \<Rightarrow> 'a ltln"
 where
   "rewrite_modal true\<^sub>n = true\<^sub>n"
 | "rewrite_modal false\<^sub>n = false\<^sub>n"
 | "rewrite_modal (\<phi> and\<^sub>n \<psi>) = (rewrite_modal \<phi> and\<^sub>n rewrite_modal \<psi>)"
 | "rewrite_modal (\<phi> or\<^sub>n \<psi>) = (rewrite_modal \<phi> or\<^sub>n rewrite_modal \<psi>)"
 | "rewrite_modal (\<phi> U\<^sub>n \<psi>) = (if pure_eventual \<psi> \<or> suspendable \<psi> then rewrite_modal \<psi> else (rewrite_modal \<phi> U\<^sub>n rewrite_modal \<psi>))"
 | "rewrite_modal (\<phi> R\<^sub>n \<psi>) = (if pure_universal \<psi> \<or> suspendable \<psi> then rewrite_modal \<psi> else (rewrite_modal \<phi> R\<^sub>n rewrite_modal \<psi>))"
 | "rewrite_modal (\<phi> W\<^sub>n \<psi>) = (if pure_universal \<phi> \<and> pure_universal \<psi> \<or> suspendable \<phi> \<and> suspendable \<psi> then (rewrite_modal \<phi> or\<^sub>n rewrite_modal \<psi>) else (rewrite_modal \<phi> W\<^sub>n rewrite_modal \<psi>))"
 | "rewrite_modal (\<phi> M\<^sub>n \<psi>) = (if pure_eventual \<phi> \<and> pure_eventual \<psi> \<or> suspendable \<phi> \<and> suspendable \<psi> then (rewrite_modal \<phi> and\<^sub>n rewrite_modal \<psi>) else (rewrite_modal \<phi> M\<^sub>n rewrite_modal \<psi>))"
 | "rewrite_modal (X\<^sub>n \<phi>) = (if suspendable \<phi> then rewrite_modal \<phi> else X\<^sub>n (rewrite_modal \<phi>))"
 | "rewrite_modal \<phi> = \<phi>"
 
 lemma rewrite_modal_sound [simp]:
   "w \<Turnstile>\<^sub>n rewrite_modal \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
 proof (induction \<phi> arbitrary: w)
   case (Until_ltln \<phi> \<psi>)
     thus ?case
       apply (cases "pure_eventual \<psi> \<or> suspendable \<psi>")
       apply (insert pure_eventual_until_simp[of \<psi>] suspendable_formula_simp[of \<psi>])
       apply fastforce+
       done
 next
   case (Release_ltln \<phi> \<psi>)
     thus ?case
       apply (cases "pure_universal \<psi> \<or> suspendable \<psi>")
       apply (insert pure_universal_release_simp[of \<psi>] suspendable_formula_simp[of \<psi>])
       apply fastforce+
       done
 next
   case (WeakUntil_ltln \<phi> \<psi>)
     thus ?case
       apply (cases "pure_universal \<phi> \<and> pure_universal \<psi> \<or> suspendable \<phi> \<and> suspendable \<psi>")
       apply (insert pure_universal_weak_until_simp[of \<phi> \<psi>] suspendable_formula_simp2[of \<phi> \<psi>])
       apply fastforce+
       done
 next
   case (StrongRelease_ltln \<phi> \<psi>)
     thus ?case
       apply (cases "pure_eventual \<phi> \<and> pure_eventual \<psi> \<or> suspendable \<phi> \<and> suspendable \<psi>")
       apply (insert pure_eventual_strong_release_simp[of \<phi> \<psi>] suspendable_formula_simp2[of \<phi> \<psi>])
       apply fastforce+
       done
 next
   case (Next_ltln \<phi>)
     thus ?case
       apply (cases "suspendable \<phi>")
       apply (insert suspendable_formula_simp[of \<phi>])
       apply fastforce+
       done
 qed auto
 
 lemma rewrite_modal_size:
   "size (rewrite_modal \<phi>) \<le> size \<phi>"
   by (induction \<phi>) auto
 
 subsection \<open>Syntactical Implication Based Simplification\<close>
 
 inductive syntactical_implies :: "'a ltln \<Rightarrow> 'a ltln \<Rightarrow> bool" ("_ \<turnstile>\<^sub>s _" [80, 80])
 where
   "_ \<turnstile>\<^sub>s true\<^sub>n"
 | "false\<^sub>n \<turnstile>\<^sub>s _"
 | "\<phi> = \<phi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s \<phi>"
 
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> (\<phi> and\<^sub>n \<psi>) \<turnstile>\<^sub>s \<chi>"
 | "\<psi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> (\<phi> and\<^sub>n \<psi>) \<turnstile>\<^sub>s \<chi>"
 | "\<phi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s (\<psi> and\<^sub>n \<chi>)"
 
 | "\<phi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s (\<psi> or\<^sub>n \<chi>)"
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s (\<psi> or\<^sub>n \<chi>)"
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<psi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> (\<phi> or\<^sub>n \<psi>) \<turnstile>\<^sub>s \<chi>"
 
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<phi> \<turnstile>\<^sub>s (\<psi> U\<^sub>n \<chi>)"
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<psi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> (\<phi> U\<^sub>n \<psi>) \<turnstile>\<^sub>s \<chi>"
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<psi> \<turnstile>\<^sub>s \<nu> \<Longrightarrow> (\<phi> U\<^sub>n \<psi>) \<turnstile>\<^sub>s (\<chi> U\<^sub>n \<nu>)"
 
 | "\<chi> \<turnstile>\<^sub>s \<phi> \<Longrightarrow> (\<psi> R\<^sub>n \<chi>) \<turnstile>\<^sub>s \<phi>"
 | "\<chi> \<turnstile>\<^sub>s \<phi> \<Longrightarrow> \<chi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> \<chi> \<turnstile>\<^sub>s (\<phi> R\<^sub>n \<psi>)"
 | "\<phi> \<turnstile>\<^sub>s \<chi> \<Longrightarrow> \<psi> \<turnstile>\<^sub>s \<nu> \<Longrightarrow> (\<phi> R\<^sub>n \<psi>) \<turnstile>\<^sub>s (\<chi> R\<^sub>n \<nu>)"
 
 | "(false\<^sub>n R\<^sub>n \<phi>) \<turnstile>\<^sub>s \<psi> \<Longrightarrow> (false\<^sub>n R\<^sub>n \<phi>) \<turnstile>\<^sub>s X\<^sub>n \<psi>"
 | "\<phi> \<turnstile>\<^sub>s (true\<^sub>n U\<^sub>n \<psi>) \<Longrightarrow> (X\<^sub>n \<phi>) \<turnstile>\<^sub>s (true\<^sub>n U\<^sub>n \<psi>)"
 | "\<phi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> (X\<^sub>n \<phi>) \<turnstile>\<^sub>s (X\<^sub>n \<psi>)"
 
 lemma syntactical_implies_correct:
   "\<phi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<phi> \<Longrightarrow> w \<Turnstile>\<^sub>n \<psi>"
   by (induction arbitrary: w rule: syntactical_implies.induct; auto; force)
 
 fun rewrite_syn_imp
 where
   "rewrite_syn_imp (\<phi> and\<^sub>n \<psi>) = (
     if \<phi> \<turnstile>\<^sub>s \<psi> then
       rewrite_syn_imp \<phi>
     else if \<psi> \<turnstile>\<^sub>s \<phi> then
       rewrite_syn_imp \<psi>
     else if \<phi> \<turnstile>\<^sub>s (not\<^sub>n \<psi>) \<or> \<psi> \<turnstile>\<^sub>s (not\<^sub>n \<phi>) then
       false\<^sub>n
     else
       mk_and (rewrite_syn_imp \<phi>) (rewrite_syn_imp \<psi>))"
 | "rewrite_syn_imp (\<phi> or\<^sub>n \<psi>) = (
     if \<phi> \<turnstile>\<^sub>s \<psi> then
       rewrite_syn_imp \<psi>
     else if \<psi> \<turnstile>\<^sub>s \<phi> then
       rewrite_syn_imp \<phi>
     else if (not\<^sub>n \<phi>) \<turnstile>\<^sub>s \<psi> \<or> (not\<^sub>n \<psi>) \<turnstile>\<^sub>s \<phi> then
       true\<^sub>n
     else
       mk_or (rewrite_syn_imp \<phi>) (rewrite_syn_imp \<psi>))"
 | "rewrite_syn_imp (\<phi> U\<^sub>n \<psi>) = (
     if \<phi> \<turnstile>\<^sub>s \<psi> then
       rewrite_syn_imp \<psi>
     else if (not\<^sub>n \<phi>) \<turnstile>\<^sub>s \<psi> then
       mk_finally (rewrite_syn_imp \<psi>)
     else
       mk_until (rewrite_syn_imp \<phi>) (rewrite_syn_imp \<psi>))"
 | "rewrite_syn_imp (\<phi> R\<^sub>n \<psi>) = (
     if \<psi> \<turnstile>\<^sub>s \<phi> then
       rewrite_syn_imp \<psi>
     else if \<psi> \<turnstile>\<^sub>s (not\<^sub>n \<phi>) then
       mk_globally (rewrite_syn_imp \<psi>)
     else
       mk_release (rewrite_syn_imp \<phi>) (rewrite_syn_imp \<psi>))"
 | "rewrite_syn_imp (X\<^sub>n \<phi>) = mk_next (rewrite_syn_imp \<phi>)"
 | "rewrite_syn_imp \<phi> = \<phi>"
 
 lemma rewrite_syn_imp_sound:
   "w \<Turnstile>\<^sub>n rewrite_syn_imp \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
 proof (induction \<phi> arbitrary: w)
   case And_ltln
     thus ?case
       by (simp add: Let_def; metis syntactical_implies_correct not\<^sub>n_semantics)
 next
   case (Or_ltln \<phi> \<psi>)
     moreover
     have "(not\<^sub>n \<phi>) \<turnstile>\<^sub>s \<psi> \<Longrightarrow> \<forall>w. w \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi>"
       by (auto intro: syntactical_implies_correct[of "not\<^sub>n \<phi>"])
     moreover
     have "(not\<^sub>n \<psi>) \<turnstile>\<^sub>s \<phi> \<Longrightarrow> \<forall>w. w \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi>"
       by (auto intro: syntactical_implies_correct[of "not\<^sub>n \<psi>"])
     ultimately
     show ?case
       by (auto intro: syntactical_implies_correct)
 next
   case (Until_ltln \<phi> \<psi>)
     moreover
     have "\<phi> \<turnstile>\<^sub>s \<psi> \<Longrightarrow> ?case"
       by (force simp add: Until_ltln dest: syntactical_implies_correct)
     moreover
     {
       assume A: "(not\<^sub>n \<phi>) \<turnstile>\<^sub>s \<psi>" and B: "\<not> \<phi> \<turnstile>\<^sub>s \<psi>"
       hence [simp]: "rewrite_syn_imp (\<phi> U\<^sub>n \<psi>) = mk_finally (rewrite_syn_imp \<psi>)"
         by simp
       {
         assume "\<exists>i. suffix i w \<Turnstile>\<^sub>n \<psi>"
         moreover
         define i where "i \<equiv> LEAST i. suffix i w \<Turnstile>\<^sub>n \<psi>"
         ultimately
         have "\<forall>j < i. \<not>suffix j w \<Turnstile>\<^sub>n \<psi>" and "suffix i w \<Turnstile>\<^sub>n \<psi>"
           by (blast dest: not_less_Least , metis LeastI \<open>\<exists>i. suffix i w \<Turnstile>\<^sub>n \<psi>\<close> i_def)
         hence "\<forall>j < i. suffix j w \<Turnstile>\<^sub>n \<phi>" and "suffix i w \<Turnstile>\<^sub>n \<psi>"
           using syntactical_implies_correct[OF A] by auto
       }
       hence ?case
         by (simp del: rewrite_syn_imp.simps; unfold Until_ltln(2)) blast
     }
     ultimately
     show ?case
       by fastforce
 next
   case (Release_ltln \<phi> \<psi>)
     moreover
     have "\<psi> \<turnstile>\<^sub>s \<phi> \<Longrightarrow> ?case"
       by (force simp add: Release_ltln dest: syntactical_implies_correct)
     moreover
     {
       assume A: "\<psi> \<turnstile>\<^sub>s (not\<^sub>n \<phi>)" and B: "\<not> \<psi> \<turnstile>\<^sub>s \<phi>"
       hence [simp]: "rewrite_syn_imp (\<phi> R\<^sub>n \<psi>) = mk_globally (rewrite_syn_imp \<psi>)"
         by simp
       {
         assume "\<exists>i. \<not>suffix i w \<Turnstile>\<^sub>n \<psi>"
         moreover
         define i where "i \<equiv> LEAST i. \<not>suffix i w \<Turnstile>\<^sub>n \<psi>"
         ultimately
         have "\<forall>j < i. suffix j w \<Turnstile>\<^sub>n \<psi>" and "\<not> suffix i w \<Turnstile>\<^sub>n \<psi>"
           by (blast dest: not_less_Least , metis LeastI \<open>\<exists>i. \<not>suffix i w \<Turnstile>\<^sub>n \<psi>\<close> i_def)
         hence "\<forall>j < i. \<not>suffix j w \<Turnstile>\<^sub>n \<phi>" and "\<not> suffix i w \<Turnstile>\<^sub>n \<psi>"
           using syntactical_implies_correct[OF A] by auto
       }
       hence ?case
         by (simp del: rewrite_syn_imp.simps; unfold Release_ltln(2)) blast
     }
     ultimately
     show ?case
       by fastforce
 qed auto
 
 subsection \<open>Iterated Rewriting\<close>
 
 fun iterate
 where
   "iterate f x 0 = x"
 | "iterate f x (Suc n) = (let x' = f x in if x = x' then x else iterate f x' n)"
 
 definition
   "rewrite_iter_fast \<phi> \<equiv> iterate (rewrite_modal o rewrite_X) \<phi> (size \<phi>)"
 
 definition
   "rewrite_iter_slow \<phi> \<equiv> iterate (rewrite_syn_imp o rewrite_modal o rewrite_X) \<phi> (size \<phi>)"
 
 text \<open>The rewriting functions defined in the previous subsections can be used as-is. However, in the
   most cases one wants to iterate these rules until the formula cannot be simplified further.
   @{const rewrite_iter_fast} pulls X operators up in the syntax tree and the uses the
   "modal" simplification rules. @{const rewrite_iter_slow} additionally tries to simplify the
   formula using syntactic implication checking.\<close>
 
 lemma iterate_sound:
   assumes "\<And>\<phi>. w \<Turnstile>\<^sub>n f \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   shows "w \<Turnstile>\<^sub>n iterate f \<phi> n \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   by (induction n arbitrary: \<phi>; simp add: assms Let_def)
 
 theorem rewrite_iter_fast_sound [simp]:
   "w \<Turnstile>\<^sub>n rewrite_iter_fast \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   using iterate_sound[of _ "rewrite_modal o rewrite_X"]
   unfolding comp_def rewrite_modal_sound rewrite_X_sound rewrite_iter_fast_def
   by blast
 
 theorem rewrite_iter_slow_sound [simp]:
   "w \<Turnstile>\<^sub>n rewrite_iter_slow \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   using iterate_sound[of _ "rewrite_syn_imp o rewrite_modal o rewrite_X"]
   unfolding comp_def rewrite_modal_sound rewrite_X_sound rewrite_syn_imp_sound rewrite_iter_slow_def
   by blast
 
 subsection \<open>Preservation of atoms\<close>
 
 lemma iterate_atoms:
   assumes
     "\<And>\<phi>. atoms_ltln (f \<phi>) \<subseteq> atoms_ltln \<phi>"
   shows
     "atoms_ltln (iterate f \<phi> n) \<subseteq> atoms_ltln \<phi>"
   by (induction n arbitrary: \<phi>) (auto, metis (mono_tags, lifting) assms in_mono)
 
 lemma rewrite_modal_atoms:
   "atoms_ltln (rewrite_modal \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (induction \<phi>) auto
 
 lemma mk_and_atoms:
   "atoms_ltln (mk_and \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_and_def split: ltln.splits)
 
 lemma mk_or_atoms:
   "atoms_ltln (mk_or \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_or_def split: ltln.splits)
 
 lemma remove_strong_ops_atoms:
   "atoms_ltln (remove_strong_ops \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (induction \<phi>) auto
 
 lemma remove_weak_ops_atoms:
   "atoms_ltln (remove_weak_ops \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (induction \<phi>) auto
 
 lemma mk_finally_atoms:
   "atoms_ltln (mk_finally \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (auto simp: mk_finally_def split: ltln.splits) (insert remove_strong_ops_atoms, fast+)
 
 lemma mk_globally_atoms:
   "atoms_ltln (mk_globally \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (auto simp: mk_globally_def split: ltln.splits) (insert remove_weak_ops_atoms, fast+)
 
 lemma mk_until_atoms:
   "atoms_ltln (mk_until \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_until_def split: ltln.splits) (insert mk_finally_atoms, fastforce+)
 
 lemma mk_release_atoms:
   "atoms_ltln (mk_release \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_release_def split: ltln.splits) (insert mk_globally_atoms, fastforce+)
 
 lemma mk_weak_until_atoms:
   "atoms_ltln (mk_weak_until \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_weak_until_def split: ltln.splits) (insert mk_globally_atoms, fastforce+)
 
 lemma mk_strong_release_atoms:
   "atoms_ltln (mk_strong_release \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   by (auto simp: mk_strong_release_def split: ltln.splits) (insert mk_finally_atoms, fastforce+)
 
 lemma mk_next_atoms:
   "atoms_ltln (mk_next \<phi>) = atoms_ltln \<phi>"
   by (auto simp: mk_next_def split: ltln.splits)
 
 lemma mk_next_pow_atoms:
   "atoms_ltln (mk_next_pow n \<phi>) = atoms_ltln \<phi>"
   by (induction n) (auto simp: mk_next_pow_def split: ltln.splits)
 
 lemma combine_atoms:
   assumes
     "\<And>\<phi> \<psi>. atoms_ltln (f \<phi> \<psi>) \<subseteq> atoms_ltln \<phi> \<union> atoms_ltln \<psi>"
   shows
     "atoms_ltln (fst (combine f x y)) \<subseteq> atoms_ltln (fst x) \<union> atoms_ltln (fst y)"
   by (metis assms fst_combine mk_next_pow_atoms prod.collapse)
 
 lemmas combine_mk_atoms =
   combine_atoms[OF mk_and_atoms]
   combine_atoms[OF mk_or_atoms]
   combine_atoms[OF mk_until_atoms]
   combine_atoms[OF mk_release_atoms]
   combine_atoms[OF mk_weak_until_atoms]
   combine_atoms[OF mk_strong_release_atoms]
 
 lemma rewrite_X_enat_atoms:
   "atoms_ltln (fst (rewrite_X_enat \<phi>)) \<subseteq> atoms_ltln \<phi>"
   by (induction \<phi>) (simp_all add: case_prod_beta, insert combine_mk_atoms, fast+)
 
 lemma rewrite_X_atoms:
   "atoms_ltln (rewrite_X \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (induction \<phi>) (simp_all add: rewrite_X_def mk_next_pow_atoms case_prod_beta, insert combine_mk_atoms, fast+)
 
 lemma rewrite_syn_imp_atoms:
   "atoms_ltln (rewrite_syn_imp \<phi>) \<subseteq> atoms_ltln \<phi>"
 proof (induction \<phi>)
   case (And_ltln \<phi>1 \<phi>2)
   then show ?case
     using mk_and_atoms by simp fast
 next
   case (Or_ltln \<phi>1 \<phi>2)
   then show ?case
     using mk_or_atoms by simp fast
 next
   case (Next_ltln \<phi>)
   then show ?case
     using mk_next_atoms by simp fast
 next
   case (Until_ltln \<phi>1 \<phi>2)
   then show ?case
     using mk_finally_atoms mk_until_atoms by simp fast
 next
   case (Release_ltln \<phi>1 \<phi>2)
   then show ?case
     using mk_globally_atoms mk_release_atoms by simp fast
 qed simp_all
 
 lemma rewrite_iter_fast_atoms:
   "atoms_ltln (rewrite_iter_fast \<phi>) \<subseteq> atoms_ltln \<phi>"
 proof -
   have 1: "\<And>\<phi>. atoms_ltln (rewrite_modal (rewrite_X \<phi>)) \<subseteq> atoms_ltln \<phi>"
     using rewrite_modal_atoms rewrite_X_atoms by force
 
   show ?thesis
     by (simp add: rewrite_iter_fast_def 1 iterate_atoms)
 qed
 
 lemma rewrite_iter_slow_atoms:
   "atoms_ltln (rewrite_iter_slow \<phi>) \<subseteq> atoms_ltln \<phi>"
 proof -
   have 1: "\<And>\<phi>. atoms_ltln (rewrite_syn_imp (rewrite_modal (rewrite_X \<phi>))) \<subseteq> atoms_ltln \<phi>"
     using rewrite_syn_imp_atoms rewrite_modal_atoms rewrite_X_atoms by force
 
   show ?thesis
     by (simp add: rewrite_iter_slow_def 1 iterate_atoms)
 qed
 
 subsection \<open>Simplifier\<close>
 
 text \<open>We now define a convenience wrapper for the rewriting engine\<close>
 
 datatype mode = Nop | Fast | Slow
 
 fun simplify :: "mode \<Rightarrow> 'a ltln \<Rightarrow> 'a ltln"
 where
   "simplify Nop = id"
 | "simplify Fast = rewrite_iter_fast"
 | "simplify Slow = rewrite_iter_slow"
 
 theorem simplify_correct:
   "w \<Turnstile>\<^sub>n simplify m \<phi> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
   by (cases m) simp+
 
 lemma simplify_atoms:
   "atoms_ltln (simplify m \<phi>) \<subseteq> atoms_ltln \<phi>"
   by (cases m) (insert rewrite_iter_fast_atoms rewrite_iter_slow_atoms, fastforce+)
 
 subsection \<open>Code Generation\<close>
 
 code_pred syntactical_implies .
 
 export_code simplify checking
 
 lemma "rewrite_iter_fast (F\<^sub>n (G\<^sub>n (X\<^sub>n prop\<^sub>n(''a'')))) = (F\<^sub>n (G\<^sub>n prop\<^sub>n(''a'')))"
   by eval
 
 lemma "rewrite_iter_fast (X\<^sub>n prop\<^sub>n(''a'') U\<^sub>n (X\<^sub>n nprop\<^sub>n(''a''))) = X\<^sub>n (prop\<^sub>n(''a'') U\<^sub>n nprop\<^sub>n(''a''))"
   by eval
 
 lemma "rewrite_iter_slow (X\<^sub>n prop\<^sub>n(''a'') U\<^sub>n (X\<^sub>n nprop\<^sub>n(''a''))) = X\<^sub>n (F\<^sub>n nprop\<^sub>n(''a''))"
   by eval
 
 end
diff --git a/thys/Psi_Calculi/Semantics.thy b/thys/Psi_Calculi/Semantics.thy
--- a/thys/Psi_Calculi/Semantics.thy
+++ b/thys/Psi_Calculi/Semantics.thy
@@ -1,9323 +1,9323 @@
 (* 
    Title: Psi-calculi   
    Author/Maintainer: Jesper Bengtson (jebe@itu.dk), 2012
 *)
 theory Semantics
   imports Frame
 begin
 
 nominal_datatype ('a, 'b, 'c) boundOutput = 
-  BOut "'a::fs_name" "('a, 'b::fs_name, 'c::fs_name) psi" ("_ \<prec>' _" [110, 110] 110)
+  BOut "'a::fs_name" "('a, 'b::fs_name, 'c::fs_name) psi" ("_ \<prec>'' _" [110, 110] 110)
 | BStep "\<guillemotleft>name\<guillemotright> ('a, 'b, 'c) boundOutput"                ("\<lparr>\<nu>_\<rparr>_" [110, 110] 110)
 
 primrec BOresChain :: "name list \<Rightarrow> ('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput \<Rightarrow> 
                       ('a, 'b, 'c) boundOutput" where
   Base: "BOresChain [] B = B"
 | Step: "BOresChain (x#xs) B = \<lparr>\<nu>x\<rparr>(BOresChain xs B)"
 
 abbreviation
   BOresChainJudge ("\<lparr>\<nu>*_\<rparr>_" [80, 80] 80) where "\<lparr>\<nu>*xvec\<rparr>B \<equiv> BOresChain xvec B"
 
 lemma BOresChainEqvt[eqvt]:
   fixes perm :: "name prm"
   and   lst  :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   
   shows "perm \<bullet> (\<lparr>\<nu>*xvec\<rparr>B) = \<lparr>\<nu>*(perm \<bullet> xvec)\<rparr>(perm \<bullet> B)"
 by(induct_tac xvec, auto)
 
 lemma BOresChainSimps[simp]:
   fixes xvec :: "name list"
   and   N    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   N'   :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   B'    :: "('a, 'b, 'c) boundOutput"
 
   shows "(\<lparr>\<nu>*xvec\<rparr>N \<prec>' P = N' \<prec>' P') = (xvec = [] \<and> N = N' \<and> P = P')"
   and   "(N' \<prec>' P' = \<lparr>\<nu>*xvec\<rparr>N \<prec>' P) = (xvec = [] \<and> N = N' \<and> P = P')"
   and   "(N' \<prec>' P' = N \<prec>' P) = (N = N' \<and> P = P')"
   and   "(\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*xvec\<rparr>B') = (B = B')"
 by(induct xvec) (auto simp add: boundOutput.inject alpha)
 
 lemma outputFresh[simp]:
   fixes Xs   :: "name set"
   and   xvec :: "name list"
   and   N    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "(Xs \<sharp>* (N \<prec>' P)) = ((Xs \<sharp>* N) \<and> (Xs \<sharp>* P))"
   and   "(xvec \<sharp>* (N \<prec>' P)) = ((xvec \<sharp>* N) \<and> (xvec \<sharp>* P))"
 by(auto simp add: fresh_star_def)
 
 lemma boundOutputFresh: 
   fixes x    :: name
   and   xvec :: "name list"
   and   B   :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
 
   shows "(x \<sharp> (\<lparr>\<nu>*xvec\<rparr>B)) = (x \<in> set xvec \<or> x \<sharp> B)"
 by (induct xvec) (simp_all add: abs_fresh)
 
 lemma boundOutputFreshSet: 
   fixes Xs   :: "name set"
   and   xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
   and   x    :: name
 
   shows "Xs \<sharp>* (\<lparr>\<nu>*xvec\<rparr>B) = (\<forall>x\<in>Xs. x \<in> set xvec \<or> x \<sharp> B)"
   and   "yvec \<sharp>* (\<lparr>\<nu>*xvec\<rparr>B) = (\<forall>x\<in>(set yvec). x \<in> set xvec \<or> x \<sharp> B)"
   and   "Xs \<sharp>* (\<lparr>\<nu>x\<rparr>B) = Xs \<sharp>* [x].B"
   and   "xvec \<sharp>* (\<lparr>\<nu>x\<rparr>B) = xvec \<sharp>* [x].B"
 by(simp add: fresh_star_def boundOutputFresh)+
 
 lemma BOresChainSupp:
   fixes xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
 
   shows "(supp(\<lparr>\<nu>*xvec\<rparr>B)::name set) = (supp B) - (supp xvec)" 
 by(induct xvec)
   (auto simp add: boundOutput.supp supp_list_nil supp_list_cons abs_supp supp_atm)
 
 lemma boundOutputFreshSimps[simp]:
   fixes Xs   :: "name set"
   and   xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
   and   x    :: name
 
   shows "Xs \<sharp>* xvec \<Longrightarrow> (Xs \<sharp>* (\<lparr>\<nu>*xvec\<rparr>B)) = (Xs \<sharp>* B)"
   and   "yvec \<sharp>* xvec \<Longrightarrow> yvec \<sharp>* (\<lparr>\<nu>*xvec\<rparr>B) = yvec \<sharp>* B"
   and   "xvec \<sharp>* (\<lparr>\<nu>*xvec\<rparr>B)"
   and   "x \<sharp> xvec \<Longrightarrow> x \<sharp> \<lparr>\<nu>*xvec\<rparr>B = x \<sharp> B"
 apply(simp add: boundOutputFreshSet) apply(force simp add: fresh_star_def name_list_supp fresh_def)
 apply(simp add: boundOutputFreshSet) apply(force simp add: fresh_star_def name_list_supp fresh_def)
 apply(simp add: boundOutputFreshSet)  
 by(simp add: BOresChainSupp fresh_def)
 
 lemma boundOutputChainAlpha:
   fixes p    :: "name prm"
   and   xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
 
   assumes xvecFreshB: "(p \<bullet> xvec) \<sharp>* B"
   and     S: "set p \<subseteq> set xvec \<times> set (p \<bullet> xvec)"
   and     "(set xvec) \<subseteq> (set yvec)"
 
   shows "(\<lparr>\<nu>*yvec\<rparr>B) = (\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>(p \<bullet> B))"
 proof -
   note pt_name_inst at_name_inst S
   moreover from \<open>(set xvec) \<subseteq> (set yvec)\<close> have "set xvec \<sharp>* (\<lparr>\<nu>*yvec\<rparr>B)"
     by(force simp add: boundOutputFreshSet)
   moreover from xvecFreshB \<open>(set xvec) \<subseteq> (set yvec)\<close> have "set (p \<bullet> xvec) \<sharp>* (\<lparr>\<nu>*yvec\<rparr>B)"
     by (simp add: boundOutputFreshSet) (simp add: fresh_star_def)
   ultimately have "(\<lparr>\<nu>*yvec\<rparr>B) = p \<bullet> (\<lparr>\<nu>*yvec\<rparr>B)"
     by (rule_tac pt_freshs_freshs [symmetric])
   then show ?thesis by(simp add: eqvts)
 qed
 
 lemma boundOutputChainAlpha':
   fixes p    :: "name prm"
   and   xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
   and   zvec :: "name list"
 
   assumes xvecFreshB: "xvec \<sharp>* B"
   and     S: "set p \<subseteq> set xvec \<times> set yvec"
   and     "yvec \<sharp>* (\<lparr>\<nu>*zvec\<rparr>B)"
 
   shows "(\<lparr>\<nu>*zvec\<rparr>B) = (\<lparr>\<nu>*(p \<bullet> zvec)\<rparr>(p \<bullet> B))"
 proof -
   note pt_name_inst at_name_inst S \<open>yvec \<sharp>* (\<lparr>\<nu>*zvec\<rparr>B)\<close>
   moreover from xvecFreshB have "set (xvec) \<sharp>* (\<lparr>\<nu>*zvec\<rparr>B)"
     by (simp add: boundOutputFreshSet) (simp add: fresh_star_def)
   ultimately have "(\<lparr>\<nu>*zvec\<rparr>B) = p \<bullet> (\<lparr>\<nu>*zvec\<rparr>B)"
     by (rule_tac pt_freshs_freshs [symmetric]) auto
   then show ?thesis by(simp add: eqvts)
 qed
 
 lemma boundOutputChainAlpha'':
   fixes p    :: "name prm"
   and   xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
 
   assumes "(p \<bullet> xvec) \<sharp>* M"
   and     "(p \<bullet> xvec) \<sharp>* P"
   and      "set p \<subseteq> set xvec \<times> set (p \<bullet> xvec)"
   and     "(set xvec) \<subseteq> (set yvec)"
 
   shows "(\<lparr>\<nu>*yvec\<rparr>M \<prec>' P) = (\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>(p \<bullet> M) \<prec>' (p \<bullet> P))"
 using assms
 by(subst boundOutputChainAlpha) auto
 
 lemma boundOutputChainSwap:
   fixes x    :: name
   and   y    :: name
   and   N    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   xvec :: "name list"
 
   assumes "y \<sharp> N"
   and     "y \<sharp> P"
   and     "x \<in> (set xvec)"
 
   shows "\<lparr>\<nu>*xvec\<rparr>N \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> xvec)\<rparr>([(x ,y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> P)"
 proof(case_tac "x=y")
   assume "x=y"
   thus ?thesis by simp
 next
   assume "x \<noteq> y"
   with assms show ?thesis
     by(rule_tac xvec="[x]" in boundOutputChainAlpha'') (auto simp add: calc_atm)
 qed
 
 lemma alphaBoundOutput:
   fixes x  :: name
   and   y  :: name
   and   B  :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
 
   assumes "y \<sharp> B"
 
   shows "\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> B)"
 using assms
 by(auto simp add: boundOutput.inject alpha fresh_left calc_atm)
 
 lemma boundOutputEqFresh:
   fixes B :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   C :: "('a, 'b, 'c) boundOutput"
   and   x :: name
   and   y :: name
 
   assumes "\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>y\<rparr>C"
   and     "x \<sharp> B"
   
   shows "y \<sharp> C"
 using assms
 by(auto simp add: boundOutput.inject alpha fresh_left calc_atm)  
 
 lemma boundOutputEqSupp:
   fixes B :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   C :: "('a, 'b, 'c) boundOutput"
   and   x :: name
   and   y :: name
 
   assumes "\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>y\<rparr>C"
   and     "x \<in> supp B"
   
   shows "y \<in> supp C"
 using assms
 apply(auto simp add: boundOutput.inject alpha fresh_left calc_atm)
 apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
 by(simp add: eqvts calc_atm)
 
 lemma boundOutputChainEq:
   fixes xvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
   and   B'   :: "('a, 'b, 'c) boundOutput"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*yvec\<rparr>B'"
   and     "xvec \<sharp>* yvec"
   and     "length xvec = length yvec"
 
   shows "\<exists>p. (set p) \<subseteq> (set xvec) \<times> set (yvec) \<and> distinctPerm p \<and>  B = p \<bullet> B' \<and> (set (map fst p)) \<subseteq> (supp B) \<and> xvec \<sharp>* B' \<and> yvec \<sharp>* B"
 proof -
   obtain n where "n = length xvec" by auto
   with assms show ?thesis
   proof(induct n arbitrary: xvec yvec B B')
     case(0 xvec yvec B B')
     have Eq: "\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*yvec\<rparr>B'" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with \<open>length xvec = length yvec\<close> have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec B B')
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*yvec\<rparr>B'\<close> \<open>xvec = x # xvec'\<close> \<open>length xvec = length yvec\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>B = \<lparr>\<nu>*(y#yvec')\<rparr>B'"
       and "yvec = y#yvec'" and "length xvec' = length yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>B) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>B')"
       by simp
     from \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>xvec \<sharp>* yvec\<close>
     have "x \<noteq> y" and "xvec' \<sharp>* yvec'" and "x \<sharp> yvec'" and "y \<sharp> xvec'"
       by auto
     have IH: "\<And>xvec yvec B B'. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>(B::('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput) = \<lparr>\<nu>*yvec\<rparr>B'; xvec \<sharp>* yvec; length xvec = length yvec; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>p. (set p) \<subseteq> (set xvec) \<times> (set yvec) \<and> distinctPerm p \<and>  B = p \<bullet> B' \<and> set(map fst p) \<subseteq> supp B \<and> xvec \<sharp>* B' \<and> yvec \<sharp>* B"
       by fact
     from EQ \<open>x \<noteq> y\<close> have EQ': "\<lparr>\<nu>*xvec'\<rparr>B = ([(x, y)] \<bullet> (\<lparr>\<nu>*yvec'\<rparr>B'))" 
                      and xFreshB': "x \<sharp> (\<lparr>\<nu>*yvec'\<rparr>B')"
                      and yFreshB: "y \<sharp> (\<lparr>\<nu>*xvec'\<rparr>B)"
       by(metis boundOutput.inject alpha)+
     from xFreshB' \<open>x \<sharp> yvec'\<close> have "x \<sharp> B'"
       by(auto simp add: boundOutputFresh) (simp add: fresh_def name_list_supp)+
     from yFreshB \<open>y \<sharp> xvec'\<close> have "y \<sharp> B"
       by(auto simp add: boundOutputFresh) (simp add: fresh_def name_list_supp)+
     show ?case
     proof(case_tac "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>B")
       assume xFreshB: "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>B"
       with EQ have yFreshB': "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>B'"
         by(rule boundOutputEqFresh)
       with xFreshB' EQ' have "\<lparr>\<nu>*xvec'\<rparr>B = \<lparr>\<nu>*yvec'\<rparr>B'" 
         by(simp)
       with \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = length yvec'\<close> \<open>length xvec' = n\<close> IH
       obtain p where S: "(set p) \<subseteq> (set xvec') \<times> (set yvec')" and "distinctPerm p" and "B = p \<bullet> B'"
                  and "set(map fst p) \<subseteq> supp B" and "xvec' \<sharp>* B'"  and "yvec' \<sharp>* B"
         by blast
       from S have "(set p) \<subseteq> set(x#xvec') \<times> set(y#yvec')" by auto
       moreover note \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>distinctPerm p\<close> \<open>B = p \<bullet> B'\<close>
                     \<open>xvec' \<sharp>* B'\<close> \<open>x \<sharp> B'\<close> \<open>x \<sharp> B'\<close> \<open>yvec' \<sharp>* B\<close> \<open>y \<sharp> B\<close> \<open>set(map fst p) \<subseteq> supp B\<close>
 
       ultimately show ?case by auto
     next
       assume "\<not>(x \<sharp> \<lparr>\<nu>*xvec'\<rparr>B)"
       hence xSuppB: "x \<in> supp(\<lparr>\<nu>*xvec'\<rparr>B)"
         by(simp add: fresh_def)
       with EQ have ySuppB': "y \<in> supp (\<lparr>\<nu>*yvec'\<rparr>B')"
         by(rule boundOutputEqSupp)
       hence "y \<sharp> yvec'"
         by(induct yvec') (auto simp add: boundOutput.supp abs_supp)      
       with \<open>x \<sharp> yvec'\<close> EQ' have "\<lparr>\<nu>*xvec'\<rparr>B = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> B')"
         by(simp add: eqvts)
       with  \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = length yvec'\<close> \<open>length xvec' = n\<close> IH
       obtain p where S: "(set p) \<subseteq> (set xvec') \<times> (set yvec')" and "distinctPerm p" and "B = p \<bullet> [(x, y)] \<bullet> B'"
                  and "set(map fst p) \<subseteq> supp B" and "xvec' \<sharp>* ([(x, y)] \<bullet> B')" and "yvec' \<sharp>* B" 
         by blast
 
       from xSuppB have "x \<sharp> xvec'"
         by(induct xvec') (auto simp add: boundOutput.supp abs_supp)      
       with \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> xvec'\<close> \<open>y \<sharp> yvec'\<close> S have "x \<sharp> p" and "y \<sharp> p"
         apply(induct p)
         by(auto simp add: name_list_supp) (auto simp add: fresh_def) 
       from S have "(set ((x, y)#p)) \<subseteq> (set(x#xvec')) \<times> (set(y#yvec'))"
         by force
       moreover from \<open>x \<noteq> y\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> S \<open>distinctPerm p\<close>
       have "distinctPerm((x,y)#p)" by simp
       moreover from \<open>B = p \<bullet> [(x, y)] \<bullet> B'\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> have "B = [(x, y)] \<bullet> p \<bullet> B'"
         by(subst perm_compose) simp
       hence "B = ((x, y)#p) \<bullet> B'" by simp
       moreover from \<open>xvec' \<sharp>* ([(x, y)] \<bullet> B')\<close> have "([(x, y)] \<bullet> xvec') \<sharp>* ([(x, y)] \<bullet> [(x, y)] \<bullet> B')"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> xvec'\<close> \<open>y \<sharp> xvec'\<close> \<open>x \<sharp> B'\<close> have "(x#xvec') \<sharp>* B'" by simp
       moreover from \<open>y \<sharp> B\<close> \<open>yvec' \<sharp>* B\<close> have "(y#yvec') \<sharp>* B" by simp
       moreover from \<open>set(map fst p) \<subseteq> supp B\<close> xSuppB \<open>x \<sharp> xvec'\<close>
       have "set(map fst ((x, y)#p)) \<subseteq> supp B"
         by(simp add: BOresChainSupp)
       ultimately show ?case using \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close>
         by metis
     qed
   qed
 qed
 
 lemma boundOutputChainEqLength:
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: "'a::fs_name"
   and   Q    :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
 
   shows "length xvec = length yvec"
 proof -
   obtain n where "n = length xvec" by auto
   with assms show ?thesis
   proof(induct n arbitrary: xvec yvec M P N Q)
     case(0 xvec yvec M P N Q)
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<close> have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case by simp
   next
     case(Suc n xvec yvec M P N Q)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' Q"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)"
       by simp
     have IH: "\<And>xvec yvec M P N Q. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q::('a, 'b, 'c) psi); n = length xvec\<rbrakk> \<Longrightarrow> length xvec = length yvec"
       by fact
     show ?case
     proof(case_tac "x = y")
       assume "x = y"
       with EQ have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P  = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(simp add: alpha boundOutput.inject)
       with IH \<open>length xvec' = n\<close> have "length xvec' = length yvec'"
         by blast
       with \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close>
       show ?case by simp
     next
       assume "x \<noteq> y"
       with EQ have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = [(x, y)] \<bullet> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(simp add: alpha boundOutput.inject)
       hence "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
         by(simp add: eqvts)
       with IH \<open>length xvec' = n\<close> have "length xvec' = length ([(x, y)] \<bullet> yvec')"
         by blast
       hence "length xvec' = length yvec'"
         by simp
       with \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close>
       show ?case by simp
     qed
   qed
 qed
 
 lemma boundOutputChainEq':
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   and     "xvec \<sharp>* yvec"
 
   shows "\<exists>p. (set p) \<subseteq> (set xvec) \<times> set (yvec) \<and> distinctPerm p \<and>  M = p \<bullet> N \<and>  P = p \<bullet> Q \<and> xvec \<sharp>* N \<and> xvec \<sharp>* Q \<and> yvec \<sharp>* M \<and> yvec \<sharp>* P"
 using assms
 apply(frule_tac boundOutputChainEqLength)
 apply(drule_tac boundOutputChainEq)
 by(auto simp add: boundOutput.inject)
 
 lemma boundOutputChainEq'':
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   and     "xvec \<sharp>* yvec"
   and     "distinct xvec"
   and     "distinct yvec"
 
   obtains p where "(set p) \<subseteq> (set xvec) \<times> set (p \<bullet> xvec)" and "distinctPerm p" and "yvec = p \<bullet> xvec" and "N = p \<bullet> M" and "Q = p \<bullet> P" and "xvec \<sharp>* N" and "xvec \<sharp>* Q" and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* P"
 proof -
 
   assume "\<And>p. \<lbrakk>set p \<subseteq> set xvec \<times> set (p \<bullet> xvec); distinctPerm p; yvec = p \<bullet> xvec; N = p \<bullet> M; Q = p \<bullet> P; xvec \<sharp>* N; xvec \<sharp>* Q; (p \<bullet> xvec) \<sharp>* M; (p \<bullet> xvec) \<sharp>* P\<rbrakk> \<Longrightarrow> thesis"
 
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>p. (set p) \<subseteq> (set xvec) \<times> set (yvec) \<and> distinctPerm p \<and>  yvec = p \<bullet> xvec \<and> N = p \<bullet> M \<and> Q = p \<bullet> P \<and> xvec \<sharp>* N \<and> xvec \<sharp>* Q \<and> (p \<bullet> xvec) \<sharp>* M \<and> (p \<bullet> xvec) \<sharp>* P"
   proof(induct n arbitrary: xvec yvec M P N Q)
     case(0 xvec yvec M P N Q)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M P N Q)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' Q"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)"
       by simp
     from \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>xvec \<sharp>* yvec\<close>
     have "x \<noteq> y" and "xvec' \<sharp>* yvec'" and "x \<sharp> yvec'" and "y \<sharp> xvec'"
       by auto
     from \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> have "x \<sharp> xvec'" and "y \<sharp> yvec'" and "distinct xvec'" and "distinct yvec'"
       by simp+
     have IH: "\<And>xvec yvec M P N Q. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>(M::'a) \<prec>' (P::('a, 'b, 'c) psi) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q; xvec \<sharp>* yvec; distinct xvec; distinct yvec; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>p. (set p) \<subseteq> (set xvec) \<times> (set yvec) \<and> distinctPerm p \<and>  yvec = p \<bullet> xvec \<and> N = p \<bullet> M \<and> Q = p \<bullet> P \<and> xvec \<sharp>* N \<and> xvec \<sharp>* Q \<and> (p \<bullet> xvec) \<sharp>* M \<and> (p \<bullet> xvec) \<sharp>* P"
       by fact 
     from EQ \<open>x \<noteq> y\<close>  \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> yvec'\<close> \<open>y \<sharp> xvec'\<close> \<open>x \<sharp> xvec'\<close> have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)" and "x \<sharp> N" and "x \<sharp> Q" and "y \<sharp> M" and "y \<sharp> P"
       apply -
       apply(simp add: boundOutput.inject alpha eqvts)
       apply(simp add: boundOutput.inject alpha eqvts)
       apply(simp add: boundOutput.inject alpha eqvts)
       by(simp add: boundOutput.inject alpha' eqvts)+
     with \<open>xvec' \<sharp>* yvec'\<close> \<open>distinct xvec'\<close> \<open>distinct yvec'\<close> \<open>length xvec' = n\<close> IH
     obtain p where S: "(set p) \<subseteq> (set xvec') \<times> (set yvec')" and "distinctPerm p" and "yvec' = p \<bullet> xvec'" and "([(x, y)] \<bullet> N) = p \<bullet> M" and "([(x, y)] \<bullet> Q) = p \<bullet> P" and "xvec' \<sharp>* ([(x, y)] \<bullet> N)" and "xvec' \<sharp>* ([(x, y)] \<bullet> Q)" and "yvec' \<sharp>* M" and "yvec' \<sharp>* P"
       by metis
     from S have "set((x, y)#p) \<subseteq> set(x#xvec') \<times> set(y#yvec')" by auto
     moreover from \<open>x \<sharp> xvec'\<close> \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> xvec'\<close> \<open>y \<sharp> yvec'\<close> S have "x \<sharp> p" and "y \<sharp> p"
       apply(induct p)
       by(auto simp add: fresh_prod name_list_supp) (auto simp add: fresh_def) 
 
     with S \<open>distinctPerm p\<close> \<open>x \<noteq> y\<close> have "distinctPerm((x, y)#p)" by auto
     moreover from \<open>yvec' = p \<bullet> xvec'\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> xvec'\<close> \<open>y \<sharp> xvec'\<close> have "(y#yvec') = ((x, y)#p) \<bullet> (x#xvec')"
       by(simp add: eqvts calc_atm perm_compose freshChainSimps)
     moreover from \<open>([(x, y)] \<bullet> N) = p \<bullet> M\<close>
     have "([(x, y)] \<bullet> [(x, y)] \<bullet> N) = [(x, y)] \<bullet> p \<bullet> M"
       by(simp add: pt_bij)
     hence "N = ((x, y)#p) \<bullet> M" by simp
     moreover from \<open>([(x, y)] \<bullet> Q) = p \<bullet> P\<close>
     have "([(x, y)] \<bullet> [(x, y)] \<bullet> Q) = [(x, y)] \<bullet> p \<bullet> P"
       by(simp add: pt_bij)
     hence "Q = ((x, y)#p) \<bullet> P" by simp
     moreover from \<open>xvec' \<sharp>* ([(x, y)] \<bullet> N)\<close> have "([(x, y)] \<bullet> xvec') \<sharp>* ([(x, y)] \<bullet> [(x, y)] \<bullet> N)"
       by(subst fresh_star_bij)
     with \<open>x \<sharp> xvec'\<close> \<open>y \<sharp> xvec'\<close> have "xvec' \<sharp>* N" by simp
     with \<open>x \<sharp> N\<close> have "(x#xvec') \<sharp>* N" by simp
     moreover from \<open>xvec' \<sharp>* ([(x, y)] \<bullet> Q)\<close> have "([(x, y)] \<bullet> xvec') \<sharp>* ([(x, y)] \<bullet> [(x, y)] \<bullet> Q)"
       by(subst fresh_star_bij)
     with \<open>x \<sharp> xvec'\<close> \<open>y \<sharp> xvec'\<close> have "xvec' \<sharp>* Q" by simp
     with \<open>x \<sharp> Q\<close> have "(x#xvec') \<sharp>* Q" by simp
     moreover from \<open>y \<sharp> M\<close> \<open>yvec' \<sharp>* M\<close> have "(y#yvec') \<sharp>* M" by simp
     moreover from \<open>y \<sharp> P\<close> \<open>yvec' \<sharp>* P\<close> have "(y#yvec') \<sharp>* P" by simp
     ultimately show ?case using \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close>
       by metis
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma boundOutputEqSupp':
   fixes x    :: name
   and   xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   y    :: name
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
 
   assumes Eq: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec\<rparr>N \<prec>' Q)"
   and     "x \<noteq> y"
   and     "x \<sharp> yvec"
   and     "x \<sharp> xvec"
   and     "y \<sharp> xvec"
   and     "y \<sharp> yvec"
   and     "xvec \<sharp>* yvec"
   and     "x \<in> supp M"
   
   shows "y \<in> supp N"
 proof -
   from Eq \<open>x \<noteq> y\<close> \<open>x \<sharp> yvec\<close> \<open>y \<sharp> yvec\<close> have "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
     by(simp add: boundOutput.inject alpha eqvts)
   then obtain p where S: "set p \<subseteq> set xvec \<times> set yvec" and "M = p \<bullet> [(x, y)] \<bullet> N" and "distinctPerm p" using \<open>xvec \<sharp>* yvec\<close>
     by(blast dest: boundOutputChainEq')
   with \<open>x \<in> supp M\<close> have "x \<in> supp(p \<bullet> [(x, y)] \<bullet> N)" by simp
   hence "(p \<bullet> x) \<in> p \<bullet> supp(p \<bullet> [(x, y)] \<bullet> N)"
     by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> S \<open>distinctPerm p\<close> have "x \<in> supp([(x, y)] \<bullet> N)"
     by(simp add: eqvts)
   hence "([(x, y)] \<bullet> x) \<in> ([(x, y)] \<bullet> (supp([(x, y)] \<bullet> N)))"
     by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>x \<noteq> y\<close> show ?thesis by(simp add: calc_atm eqvts)
 qed
 
 lemma boundOutputChainOpenIH:
   fixes xvec :: "name list"
   and   x    :: name
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
   and   yvec :: "name list"
   and   y    :: name
   and   B'   :: "('a, 'b, 'c) boundOutput"
 
   assumes Eq: "\<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>x\<rparr>B) = \<lparr>\<nu>*yvec\<rparr>(\<lparr>\<nu>y\<rparr>B')"
   and     L: "length xvec = length yvec"
   and     xFreshB': "x \<sharp> B'"
   and     xFreshxvec: "x \<sharp> xvec"
   and     xFreshyvec: "x \<sharp> yvec"
 
   shows "\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*yvec\<rparr>([(x, y)] \<bullet> B')"
 using assms
 proof(induct n=="length xvec" arbitrary: xvec yvec y B' rule: nat.induct)
   case(zero xvec yvec y B')
   have "0 = length xvec" and "length xvec = length yvec" by fact+
   moreover have "\<lparr>\<nu>*xvec\<rparr>\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>*yvec\<rparr>\<lparr>\<nu>y\<rparr>B'" by fact
   ultimately show ?case by(auto simp add: boundOutput.inject alpha)
 next
   case(Suc n xvec yvec y B')
   have L: "length xvec = length yvec" and "Suc n = length xvec" by fact+
   then obtain x' xvec' y' yvec' where xEq: "xvec = x'#xvec'" and yEq: "yvec = y'#yvec'"
                                   and L': "length xvec' = length yvec'"
     by(cases xvec, auto, cases yvec, auto)
   have xFreshB': "x \<sharp> B'" by fact
   have "x \<sharp> xvec" and "x \<sharp> yvec" by fact+
   with xEq yEq have xineqx': "x \<noteq> x'" and xFreshxvec': "x \<sharp> xvec'"
                 and xineqy': "x \<noteq> y'" and xFreshyvec': "x \<sharp> yvec'"
     by simp+
   have "\<lparr>\<nu>*xvec\<rparr>\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>*yvec\<rparr>\<lparr>\<nu>y\<rparr>B'" by fact
   with xEq yEq have Eq: "\<lparr>\<nu>x'\<rparr>(\<lparr>\<nu>*xvec'\<rparr>\<lparr>\<nu>x\<rparr>B) = \<lparr>\<nu>y'\<rparr>(\<lparr>\<nu>*yvec'\<rparr>\<lparr>\<nu>y\<rparr>B')" by simp
   have "Suc n = length xvec" by fact
   with xEq have L'': "n = length xvec'" by simp
   have "\<lparr>\<nu>x'\<rparr>(\<lparr>\<nu>*xvec'\<rparr>B) = \<lparr>\<nu>y'\<rparr>(\<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> B'))"
   proof(case_tac "x'=y'")
     assume x'eqy': "x' = y'"
     with Eq have "\<lparr>\<nu>*xvec'\<rparr>\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>*yvec'\<rparr>\<lparr>\<nu>y\<rparr>B'" by(simp add: boundOutput.inject alpha)
     hence "\<lparr>\<nu>*xvec'\<rparr>B = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> B')" using L' xFreshB' xFreshxvec' xFreshyvec' L'' 
       by(rule_tac Suc)
     with x'eqy' show ?thesis by(simp add: boundOutput.inject alpha)
   next
     assume x'ineqy': "x' \<noteq> y'"
     with Eq have Eq': "\<lparr>\<nu>*xvec'\<rparr>\<lparr>\<nu>x\<rparr>B = \<lparr>\<nu>*([(x', y')] \<bullet> yvec')\<rparr>\<lparr>\<nu>([(x', y')] \<bullet> y)\<rparr>([(x', y')] \<bullet> B')"
              and x'FreshB': "x' \<sharp> \<lparr>\<nu>*yvec'\<rparr>\<lparr>\<nu>y\<rparr>B'"
       by(simp add: boundOutput.inject alpha eqvts)+
     from L' have "length xvec' = length ([(x', y')] \<bullet> yvec')" by simp
     moreover from xineqx' xineqy' xFreshB' have "x \<sharp> [(x', y')] \<bullet> B'" by(simp add: fresh_left calc_atm)
     moreover from xineqx' xineqy' xFreshyvec' have "x \<sharp> [(x', y')] \<bullet> yvec'" by(simp add: fresh_left calc_atm)
     ultimately have "\<lparr>\<nu>*xvec'\<rparr>B = \<lparr>\<nu>*([(x', y')] \<bullet> yvec')\<rparr>([(x, ([(x', y')] \<bullet> y))] \<bullet> [(x', y')] \<bullet> B')" using Eq' xFreshxvec' L''
       by(rule_tac Suc)
     moreover from x'FreshB' have "x' \<sharp> \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> B')"
     proof(case_tac "x' \<sharp> yvec'")
       assume "x' \<sharp> yvec'"
       with x'FreshB' have x'FreshB': "x' \<sharp> \<lparr>\<nu>y\<rparr>B'"
         by(simp add: fresh_def BOresChainSupp)
       show ?thesis
       proof(case_tac "x'=y")
         assume x'eqy: "x' = y"
         show ?thesis
         proof(case_tac "x=y")
           assume "x=y"
           with xFreshB' x'eqy show ?thesis by(simp add: BOresChainSupp fresh_def)
         next
           assume "x \<noteq> y"
           with \<open>x \<sharp> B'\<close> have "y \<sharp> [(x, y)] \<bullet> B'" by(simp add: fresh_left calc_atm)
           with x'eqy show ?thesis by(simp add: BOresChainSupp fresh_def)
         qed
       next
         assume x'ineqy: "x' \<noteq> y"
         with x'FreshB' have "x' \<sharp> B'" by(simp add: abs_fresh)
         with xineqx' x'ineqy have "x' \<sharp> ([(x, y)] \<bullet> B')" by(simp add: fresh_left calc_atm)
         thus ?thesis by(simp add: BOresChainSupp fresh_def)
       qed
     next
       assume "\<not>x' \<sharp> yvec'"
       thus ?thesis by(simp add: BOresChainSupp fresh_def)
     qed
     ultimately show ?thesis using x'ineqy' xineqx' xineqy'
       apply(simp add: boundOutput.inject alpha eqvts)
       apply(subst perm_compose[of "[(x', y')]"])
       by(simp add: calc_atm)
   qed
   with xEq yEq show ?case by simp
 qed
 
 lemma boundOutputPar1Dest:
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
   and   R    :: "('a, 'b, 'c) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)"
   and     "xvec \<sharp>* R"
   and     "yvec \<sharp>* R"
 
   obtains T where "P = T \<parallel> R" and "\<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
 proof -
   assume "\<And>T. \<lbrakk>P = T \<parallel> R; \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>T. P = T \<parallel> R \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   proof(induct n arbitrary: xvec yvec M N P Q R)
     case(0 xvec yvec M N P Q R)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M N P Q R)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' (Q \<parallel> R)"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
       by simp
     from \<open>xvec \<sharp>* R\<close> \<open>yvec \<sharp>* R\<close> \<open>xvec = x#xvec'\<close> \<open>yvec = y#yvec'\<close>
     have "x \<sharp> R" and "xvec' \<sharp>* R" and "y \<sharp> R" and "yvec' \<sharp>* R" by auto
     show ?case
     proof(case_tac "x = y")
       assume "x = y"
       with EQ have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(simp add: boundOutput.inject alpha)
       with \<open>xvec' \<sharp>* R\<close> \<open>yvec' \<sharp>* R\<close> \<open>length xvec' = n\<close>
       obtain T where "P = T \<parallel> R" and "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(drule_tac Suc) auto
       with \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>x=y\<close> show ?case
         by(force simp add: boundOutput.inject alpha)
     next
       assume "x \<noteq> y"
       with EQ \<open>x \<sharp> R\<close> \<open>y \<sharp> R\<close>
       have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' (([(x, y)] \<bullet> Q) \<parallel> R)"
        and xFreshQR: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(simp add: boundOutput.inject alpha eqvts)+
       moreover from \<open>yvec' \<sharp>* R\<close> have "([(x, y)] \<bullet> yvec') \<sharp>* ([(x, y)] \<bullet> R)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> R\<close> \<open>y \<sharp> R\<close> have "([(x, y)] \<bullet> yvec') \<sharp>* R" by simp
       moreover note \<open>xvec' \<sharp>* R\<close> \<open>length xvec' = n\<close>
       ultimately obtain T where "P = T \<parallel> R" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
         by(drule_tac Suc) auto
 
       from A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q))"
         by(simp add: boundOutput.inject alpha)
       moreover from xFreshQR have "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(force simp add: boundOutputFresh)
       ultimately show ?thesis using \<open>P = T \<parallel> R\<close> \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> xFreshQR
         by(force simp add: alphaBoundOutput name_swap eqvts)
     qed
   qed
   ultimately show ?thesis
     by blast
 qed
 
 lemma boundOutputPar1Dest':
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
   and   R    :: "('a, 'b, 'c) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)"
   and     "xvec \<sharp>* yvec"
 
   obtains T p where "set p \<subseteq> set xvec \<times> set yvec" and "P = T \<parallel> (p \<bullet> R)" and "\<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
 proof -
   assume "\<And>p T. \<lbrakk>set p \<subseteq> set xvec \<times> set yvec; P = T \<parallel> (p \<bullet> R); \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>p T. set p \<subseteq> set xvec \<times> set yvec \<and> P = T \<parallel> (p \<bullet> R) \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   proof(induct n arbitrary: xvec yvec M N P Q R)
     case(0 xvec yvec M N P Q R)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M N P Q R)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' (Q \<parallel> R)"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence Eq: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
       by simp
     from \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>xvec \<sharp>* yvec\<close> have "x \<noteq> y" and "x \<sharp> yvec'" and "y \<sharp> xvec'" and "xvec' \<sharp>* yvec'"
       by auto
     from Eq \<open>x \<noteq> y\<close> have Eq': "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = [(x, y)] \<bullet> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
                      and xFreshQR: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
       by(simp add: boundOutput.inject alpha)+
     have IH: "\<And>xvec yvec M N P Q R. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>M \<prec>' (P::('a, 'b, 'c) psi) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R);  xvec \<sharp>* yvec; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>p T. set p \<subseteq> set xvec \<times> set yvec \<and> P = T \<parallel> (p \<bullet> R) \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
       by fact
     show ?case
     proof(case_tac "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P")
       assume "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P"
       with Eq have yFreshQR: "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(rule boundOutputEqFresh)
       with Eq' xFreshQR have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by simp
       with \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = n\<close>
       obtain p T where S: "set p \<subseteq> set xvec' \<times> set yvec'" and "P = T \<parallel> (p \<bullet> R)" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(drule_tac IH) auto
       from yFreshQR xFreshQR have yFreshQ: "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q" and xFreshQ: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q" 
         by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
       hence "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)" by (subst alphaBoundOutput) simp+
       with A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)" by simp
       with \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> S \<open>P = T \<parallel> (p \<bullet> R)\<close> show ?case
         by auto
     next
       assume "\<not>(x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P)"
       hence "x \<in> supp(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P)" by(simp add: fresh_def)
       with Eq have "y \<in> supp(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
         by(rule boundOutputEqSupp)
       hence "y \<sharp> yvec'" by(simp add: BOresChainSupp fresh_def)
       with Eq' \<open>x \<sharp> yvec'\<close> have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' (([(x, y)] \<bullet> Q) \<parallel> ([(x, y)] \<bullet> R))"
         by(simp add: eqvts)
       moreover note \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = n\<close>
       ultimately obtain p T where S: "set p \<subseteq> set xvec' \<times> set yvec'" and "P = T \<parallel> (p \<bullet> [(x, y)] \<bullet> R)" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
         by(drule_tac IH) auto
 
       from S have "set(p@[(x, y)]) \<subseteq> set(x#xvec') \<times> set(y#yvec')" by auto
       moreover from \<open>P = T \<parallel> (p \<bullet> [(x, y)] \<bullet> R)\<close>  have "P = T \<parallel> ((p @ [(x, y)]) \<bullet> R)"
         by(simp add: pt2[OF pt_name_inst])
       moreover from xFreshQR have xFreshQ: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q" 
         by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
       with \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> yvec'\<close> \<open>x \<noteq> y\<close> have "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
         by(simp add: fresh_left calc_atm)
       with \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> yvec'\<close> have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)"
         by(subst alphaBoundOutput) (assumption | simp add: eqvts)+
       with  A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q)" by simp
       ultimately show ?thesis using \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close>
         by(rule_tac x="p@[(x, y)]" in exI) force
     qed
   qed
   ultimately show ?thesis
     by blast
 qed
 
 lemma boundOutputPar2Dest:
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
   and   R    :: "('a, 'b, 'c) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)"
   and     "xvec \<sharp>* Q"
   and     "yvec \<sharp>* Q"
 
   obtains T where "P = Q \<parallel> T" and "\<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
 proof -
   assume "\<And>T. \<lbrakk>P = Q \<parallel> T; \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>T. P = Q \<parallel> T \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
   proof(induct n arbitrary: xvec yvec M N P Q R)
     case(0 xvec yvec M N P Q R)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M N P Q R)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' (Q \<parallel> R)"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
       by simp
     from \<open>xvec \<sharp>* Q\<close> \<open>yvec \<sharp>* Q\<close> \<open>xvec = x#xvec'\<close> \<open>yvec = y#yvec'\<close>
     have "x \<sharp> Q" and "xvec' \<sharp>* Q" and "y \<sharp> Q" and "yvec' \<sharp>* Q" by auto
     have IH: "\<And>xvec yvec M N P Q R. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>M \<prec>' (P::('a, 'b, 'c) psi) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R); xvec \<sharp>* Q; yvec \<sharp>* Q; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>T. P = Q \<parallel> T \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
       by fact
     show ?case
     proof(case_tac "x = y")
       assume "x = y"
       with EQ have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(simp add: boundOutput.inject alpha)
       with \<open>xvec' \<sharp>* Q\<close> \<open>yvec' \<sharp>* Q\<close> \<open>length xvec' = n\<close>
       obtain T where "P = Q \<parallel> T" and "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R"
         by(drule_tac IH) auto
       with \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>x=y\<close> show ?case
         by(force simp add: boundOutput.inject alpha)
     next
       assume "x \<noteq> y"
       with EQ \<open>x \<sharp> Q\<close> \<open>y \<sharp> Q\<close>
       have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' (Q \<parallel> ([(x, y)] \<bullet> R))"
        and xFreshQR: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(simp add: boundOutput.inject alpha eqvts)+
       moreover from \<open>yvec' \<sharp>* Q\<close> have "([(x, y)] \<bullet> yvec') \<sharp>* ([(x, y)] \<bullet> Q)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> Q\<close> \<open>y \<sharp> Q\<close> have "([(x, y)] \<bullet> yvec') \<sharp>* Q" by simp
       moreover note \<open>xvec' \<sharp>* Q\<close> \<open>length xvec' = n\<close>
       ultimately obtain T where "P = Q \<parallel> T" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> R)"
         by(drule_tac IH) auto
 
       from A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> R))"
         by(simp add: boundOutput.inject alpha)
       moreover from xFreshQR have "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R"
         by(force simp add: boundOutputFresh)
       ultimately show ?thesis using \<open>P = Q \<parallel> T\<close> \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> xFreshQR
         by(force simp add: alphaBoundOutput name_swap eqvts)
     qed
   qed
   ultimately show ?thesis
     by blast
 qed
 
 lemma boundOutputPar2Dest':
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
   and   R    :: "('a, 'b, 'c) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)"
   and     "xvec \<sharp>* yvec"
 
   obtains T p where "set p \<subseteq> set xvec \<times> set yvec" and "P = (p \<bullet> Q) \<parallel> T" and "\<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
 proof -
   assume "\<And>p T. \<lbrakk>set p \<subseteq> set xvec \<times> set yvec; P = (p \<bullet> Q) \<parallel> T; \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>p T. set p \<subseteq> set xvec \<times> set yvec \<and> P = (p \<bullet> Q) \<parallel> T \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
   proof(induct n arbitrary: xvec yvec M N P Q R)
     case(0 xvec yvec M N P Q R)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M N P Q R)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R)\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' (Q \<parallel> R)"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence Eq: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
       by simp
     from \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>xvec \<sharp>* yvec\<close> have "x \<noteq> y" and "x \<sharp> yvec'" and "y \<sharp> xvec'" and "xvec' \<sharp>* yvec'"
       by auto
     from Eq \<open>x \<noteq> y\<close> have Eq': "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = [(x, y)] \<bullet> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
                      and xFreshQR: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
       by(simp add: boundOutput.inject alpha)+
     have IH: "\<And>xvec yvec M N P Q R. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>M \<prec>' (P::('a, 'b, 'c) psi) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (Q \<parallel> R);  xvec \<sharp>* yvec; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>p T. set p \<subseteq> set xvec \<times> set yvec \<and> P = (p \<bullet> Q) \<parallel> T \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R"
       by fact
     show ?case
     proof(case_tac "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P")
       assume "x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P"
       with Eq have yFreshQR: "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by(rule boundOutputEqFresh)
       with Eq' xFreshQR have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R)"
         by simp
       with \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = n\<close>
       obtain p T where S: "set p \<subseteq> set xvec' \<times> set yvec'" and "P = (p \<bullet> Q) \<parallel> T" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R"
         by(drule_tac IH) auto
       from yFreshQR xFreshQR have yFreshR: "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R" and xFreshQ: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R" 
         by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
       hence "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' R) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' R)" by (subst alphaBoundOutput) simp+
       with A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' R)" by simp
       with \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> S \<open>P = (p \<bullet> Q) \<parallel> T\<close> show ?case
         by auto
     next
       assume "\<not>(x \<sharp> \<lparr>\<nu>*xvec'\<rparr>M \<prec>' P)"
       hence "x \<in> supp(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P)" by(simp add: fresh_def)
       with Eq have "y \<in> supp(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' (Q \<parallel> R))"
         by(rule boundOutputEqSupp)
       hence "y \<sharp> yvec'" by(simp add: BOresChainSupp fresh_def)
       with Eq' \<open>x \<sharp> yvec'\<close> have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' (([(x, y)] \<bullet> Q) \<parallel> ([(x, y)] \<bullet> R))"
         by(simp add: eqvts)
       moreover note \<open>xvec' \<sharp>* yvec'\<close> \<open>length xvec' = n\<close>
       ultimately obtain p T where S: "set p \<subseteq> set xvec' \<times> set yvec'" and "P = (p \<bullet> [(x, y)] \<bullet> Q) \<parallel> T" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T = \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> R)"
         by(drule_tac IH) auto
 
       from S have "set(p@[(x, y)]) \<subseteq> set(x#xvec') \<times> set(y#yvec')" by auto
       moreover from \<open>P = (p \<bullet> [(x, y)] \<bullet> Q) \<parallel> T\<close>  have "P = ((p @ [(x, y)]) \<bullet> Q) \<parallel> T"
         by(simp add: pt2[OF pt_name_inst])
       moreover from xFreshQR have xFreshR: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' R" 
         by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
       with \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> yvec'\<close> \<open>x \<noteq> y\<close> have "y \<sharp> \<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> R)"
         by(simp add: fresh_left calc_atm)
       with \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> yvec'\<close> have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*yvec'\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> R)) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' R)"
         by(subst alphaBoundOutput) (assumption | simp add: eqvts)+
       with  A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' T) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' R)" by simp
       ultimately show ?thesis using \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close>
         by(rule_tac x="p@[(x, y)]" in exI) force
     qed
   qed
   ultimately show ?thesis
     by blast
 qed
 
 lemma boundOutputApp:
   fixes xvec :: "name list"
   and   yvec :: "name list"
   and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
 
   shows "\<lparr>\<nu>*(xvec@yvec)\<rparr>B = \<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>*yvec\<rparr>B)"
 by(induct xvec) auto
   
 lemma openInjectAuxAuxAux:
   fixes x    :: name
   and   xvec :: "name list"
 
   shows "\<exists>y yvec. x # xvec = yvec @ [y] \<and> length xvec = length yvec"
 apply(induct xvec arbitrary: x)
 apply auto
 apply(subgoal_tac "\<exists>y yvec. a # xvec = yvec @ [y] \<and> length xvec = length yvec")
 apply(clarify)
 apply(rule_tac x=y in exI)
 by auto
 
 lemma openInjectAuxAux:
   fixes xvec1 :: "name list"
   and   xvec2 :: "name list"
   and   yvec  :: "name list"
 
   assumes "length(xvec1@xvec2) = length yvec"
 
   shows "\<exists>yvec1 yvec2. yvec = yvec1@yvec2 \<and> length xvec1 = length yvec1 \<and> length xvec2 = length yvec2"
 using assms
 apply(induct yvec arbitrary: xvec1)
 apply simp
 apply simp
 apply(case_tac xvec1)
 apply simp
 apply simp
 apply(subgoal_tac "\<exists>yvec1 yvec2.
                    yvec = yvec1 @ yvec2 \<and> length list = length yvec1 \<and> length xvec2 = length yvec2")
 apply(clarify)
 apply(rule_tac x="a#yvec1" in exI)
 apply(rule_tac x=yvec2 in exI)
 by auto
 
 lemma openInjectAux:
   fixes xvec1 :: "name list"
   and   x     :: name
   and   xvec2 :: "name list"
   and   yvec  :: "name list"
 
   assumes "length(xvec1@x#xvec2) = length yvec"
 
   shows "\<exists>yvec1 y yvec2. yvec = yvec1@y#yvec2 \<and> length xvec1 = length yvec1 \<and> length xvec2 = length yvec2"
 using assms
 apply(case_tac yvec)
 apply simp
 apply simp
 apply(subgoal_tac "\<exists>(yvec1::name list) (yvec2::name list). yvec1@yvec2 = list \<and> length xvec1 = length yvec1 \<and> length xvec2 = length yvec2")
 apply(clarify)
 apply hypsubst_thin
 apply simp
 apply(subgoal_tac "\<exists>y (yvec::name list). a # yvec1 = yvec @ [y] \<and> length yvec1 = length yvec")
 apply(clarify)
 apply(rule_tac x=yvec in exI)
 apply(rule_tac x=y in exI)
 apply simp
 apply(rule_tac x=yvec2 in exI)
 apply simp
 apply(rule openInjectAuxAuxAux)
 apply(insert openInjectAuxAux)
 apply simp
 by blast
 
 lemma boundOutputOpenDest:
   fixes yvec  :: "name list"
   and   M     :: "'a::fs_name"
   and   P     :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   xvec1 :: "name list"
   and   x     :: name
   and   xvec2 :: "name list"
   and   N     :: 'a
   and   Q     :: "('a, 'b, 'c) psi"
 
   assumes Eq: "\<lparr>\<nu>*(xvec1@x#xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   and     "x \<sharp> xvec1"
   and     "x \<sharp> yvec"
   and     "x \<sharp> N"
   and     "x \<sharp> Q"
   and     "distinct yvec"
   
 
   obtains yvec1 y yvec2 where "yvec=yvec1@y#yvec2" and "length xvec1 = length yvec1" and "length xvec2 = length yvec2" 
                           and "\<lparr>\<nu>*(xvec1@xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1@yvec2)\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
 proof -
   assume Ass: "\<And>yvec1 y yvec2.
         \<lbrakk>yvec = yvec1 @ y # yvec2; length xvec1 = length yvec1; length xvec2 = length yvec2;
          \<lparr>\<nu>*(xvec1 @ xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1 @ yvec2)\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)\<rbrakk>
         \<Longrightarrow> thesis"
   from Eq have "length(xvec1@x#xvec2) = length yvec" by(rule boundOutputChainEqLength)
   then obtain yvec1 y yvec2 where A: "yvec = yvec1@y#yvec2" and "length xvec1 = length yvec1"
           and "length xvec2 = length yvec2"
     by(metis openInjectAux sym)
 
   from \<open>distinct yvec\<close> A have "y \<sharp> yvec2" by simp
   from A \<open>x \<sharp> yvec\<close> have "x \<sharp> yvec2" and "x \<sharp> yvec1"  by simp+
   with Eq \<open>length xvec1 = length yvec1\<close> \<open>x \<sharp> N\<close> \<open>x \<sharp> Q\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> xvec1\<close> A
   have "\<lparr>\<nu>*(xvec1@xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1@yvec2)\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
     by(force dest: boundOutputChainOpenIH simp add: boundOutputApp BOresChainSupp fresh_def boundOutput.supp eqvts)
   with \<open>length xvec1 = length yvec1\<close> \<open>length xvec2 = length yvec2\<close> A Ass show ?thesis
     by blast
 qed
 
 lemma boundOutputOpenDest':
   fixes yvec  :: "name list"
   and   M     :: "'a::fs_name"
   and   P     :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   xvec1 :: "name list"
   and   x     :: name
   and   xvec2 :: "name list"
   and   N     :: 'a
   and   Q     :: "('a, 'b, 'c) psi"
 
   assumes Eq: "\<lparr>\<nu>*(xvec1@x#xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   and     "x \<sharp> xvec1"
   and     "x \<sharp> yvec"
   and     "x \<sharp> N"
   and     "x \<sharp> Q"
   
 
   obtains yvec1 y yvec2 where "yvec=yvec1@y#yvec2" and "length xvec1 = length yvec1" and "length xvec2 = length yvec2" 
                           and "\<lparr>\<nu>*(xvec1@xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1@[(x, y)] \<bullet> yvec2)\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
 proof -
   assume Ass: "\<And>yvec1 y yvec2.
         \<lbrakk>yvec = yvec1 @ y # yvec2; length xvec1 = length yvec1; length xvec2 = length yvec2;
          \<lparr>\<nu>*(xvec1 @ xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1 @ ([(x, y)] \<bullet> yvec2))\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)\<rbrakk>
         \<Longrightarrow> thesis"
   from Eq have "length(xvec1@x#xvec2) = length yvec" by(rule boundOutputChainEqLength)
   then obtain yvec1 y yvec2 where A: "yvec = yvec1@y#yvec2" and "length xvec1 = length yvec1"
           and "length xvec2 = length yvec2"
     by(metis openInjectAux sym)
 
   from A \<open>x \<sharp> yvec\<close> have "x \<sharp> yvec2" and "x \<sharp> yvec1"  by simp+
   with Eq \<open>length xvec1 = length yvec1\<close> \<open>x \<sharp> N\<close> \<open>x \<sharp> Q\<close> \<open>x \<sharp> xvec1\<close> A
   have "\<lparr>\<nu>*(xvec1@xvec2)\<rparr>M \<prec>' P = \<lparr>\<nu>*(yvec1@([(x, y)] \<bullet> yvec2))\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
     by(force dest: boundOutputChainOpenIH simp add: boundOutputApp BOresChainSupp fresh_def boundOutput.supp eqvts)
   with \<open>length xvec1 = length yvec1\<close> \<open>length xvec2 = length yvec2\<close> A Ass show ?thesis
     by blast
 qed
 
 lemma boundOutputScopeDest:
   fixes xvec :: "name list"
   and   M    :: "'a::fs_name"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   yvec :: "name list"
   and   N    :: 'a
   and   x    :: name
   and   Q    :: "('a, 'b, 'c) psi"
 
   assumes "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q"
   and     "z \<sharp> xvec"
   and     "z \<sharp> yvec"
 
   obtains R where "P = \<lparr>\<nu>z\<rparr>R" and "\<lparr>\<nu>*xvec\<rparr>M \<prec>' R = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
 proof -
   assume "\<And>R. \<lbrakk>P = \<lparr>\<nu>z\<rparr>R; \<lparr>\<nu>*xvec\<rparr>M \<prec>' R = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>R. P = \<lparr>\<nu>z\<rparr>R \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' R = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
   proof(induct n arbitrary: xvec yvec M N P Q z)
     case(0 xvec yvec M N P Q z)
     have Eq: "\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q" by fact
     from \<open>0 = length xvec\<close> have "xvec = []" by auto
     moreover with Eq have "yvec = []"
       by(case_tac yvec) auto
     ultimately show ?case using Eq
       by(simp add: boundOutput.inject)
   next
     case(Suc n xvec yvec M N P Q z)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>\<lparr>\<nu>*xvec\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec\<rparr>N \<prec>' (\<lparr>\<nu>z\<rparr>Q)\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "\<lparr>\<nu>*(x#xvec')\<rparr>M \<prec>' P = \<lparr>\<nu>*(y#yvec')\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q"
       and "yvec = y#yvec'"
       by(case_tac yvec) auto
     hence EQ: "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P) = \<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*yvec'\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q)"
       by simp
     from \<open>z \<sharp> xvec\<close> \<open>z \<sharp> yvec\<close> \<open>xvec = x#xvec'\<close> \<open>yvec = y#yvec'\<close>
     have "z \<noteq> x" and "z \<noteq> y" and "z \<sharp> xvec'" and "z \<sharp> yvec'"
       by simp+
     have IH: "\<And>xvec yvec M N P Q z. \<lbrakk>\<lparr>\<nu>*xvec\<rparr>M \<prec>' (P::('a, 'b, 'c) psi) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q; z \<sharp> xvec; z \<sharp> yvec; n = length xvec\<rbrakk> \<Longrightarrow> \<exists>R. P = \<lparr>\<nu>z\<rparr>R \<and> \<lparr>\<nu>*xvec\<rparr>M \<prec>' R = \<lparr>\<nu>*yvec\<rparr>N \<prec>' Q"
       by fact
     show ?case
     proof(case_tac "x = y")
       assume "x = y"
       with EQ have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q"
         by(simp add: boundOutput.inject alpha)
       with \<open>z \<sharp> xvec'\<close> \<open>z \<sharp> yvec'\<close> \<open>length xvec' = n\<close>
       obtain R where "P = \<lparr>\<nu>z\<rparr>R" and "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' R = \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(drule_tac IH) auto
       with \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>x=y\<close> show ?case
         by(force simp add: boundOutput.inject alpha)
     next
       assume "x \<noteq> y"
       with EQ \<open>z \<noteq> x\<close> \<open>z \<noteq> y\<close>
       have "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' \<lparr>\<nu>z\<rparr>([(x, y)] \<bullet> Q)"
        and xFreshzQ: "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' \<lparr>\<nu>z\<rparr>Q"
         by(simp add: boundOutput.inject alpha eqvts)+
       moreover from \<open>z \<noteq> x\<close> \<open>z \<noteq> y\<close> \<open>z \<sharp> yvec'\<close> \<open>x \<noteq> y\<close> have "z \<sharp> ([(x, y)] \<bullet> yvec')"
         by(simp add: fresh_left calc_atm)
       moreover note \<open>z \<sharp> xvec'\<close> \<open>length xvec' = n\<close>
       ultimately obtain R where "P = \<lparr>\<nu>z\<rparr>R" and A: "\<lparr>\<nu>*xvec'\<rparr>M \<prec>' R = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q)"
         by(drule_tac IH) auto
 
       from A have "\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*xvec'\<rparr>M \<prec>' R) = \<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> N) \<prec>' ([(x, y)] \<bullet> Q))"
         by(simp add: boundOutput.inject alpha)
       moreover from xFreshzQ \<open>z \<noteq> x\<close> have "x \<sharp> \<lparr>\<nu>*yvec'\<rparr>N \<prec>' Q"
         by(simp add: boundOutputFresh abs_fresh)
       ultimately show ?thesis using \<open>P = \<lparr>\<nu>z\<rparr>R\<close> \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> xFreshzQ
         by(force simp add: alphaBoundOutput name_swap eqvts)
     qed
   qed
   ultimately show ?thesis
     by blast
 qed
 
 nominal_datatype ('a, 'b, 'c) residual = 
   RIn "'a::fs_name" 'a "('a, 'b::fs_name, 'c::fs_name) psi" 
 | ROut 'a "('a, 'b, 'c) boundOutput"
 | RTau "('a, 'b, 'c) psi"
 
 nominal_datatype 'a action = In "'a::fs_name" 'a      ("_\<lparr>_\<rparr>" [90, 90] 90)
                    | Out "'a::fs_name" "name list" 'a ("_\<lparr>\<nu>*_\<rparr>\<langle>_\<rangle>" [90, 90, 90] 90)
                    | Tau                              ("\<tau>" 90)
 
 nominal_primrec bn :: "('a::fs_name) action \<Rightarrow> name list"
   where
   "bn (M\<lparr>N\<rparr>) = []"
 | "bn (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) = xvec"
 | "bn (\<tau>) = []"
 by(rule TrueI)+
 
 lemma bnEqvt[eqvt]:
   fixes p :: "name prm"
   and   \<alpha> :: "('a::fs_name) action"
 
   shows "(p \<bullet> bn \<alpha>) = bn(p \<bullet> \<alpha>)"
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
 
 nominal_primrec create_residual :: "('a::fs_name) action \<Rightarrow> ('a, 'b::fs_name, 'c::fs_name) psi \<Rightarrow> ('a, 'b, 'c) residual" ("_ \<prec> _" [80, 80] 80)
 where 
   "(M\<lparr>N\<rparr>) \<prec> P = RIn M N P"
 | "M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P = ROut M (\<lparr>\<nu>*xvec\<rparr>(N \<prec>' P))"
 | "\<tau> \<prec> P = (RTau P)"
 by(rule TrueI)+
 
 nominal_primrec subject :: "('a::fs_name) action \<Rightarrow> 'a option" 
   where 
   "subject (M\<lparr>N\<rparr>) = Some M"
 | "subject (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) = Some M"
 | "subject (\<tau>) = None"
 by(rule TrueI)+
 
 nominal_primrec object :: "('a::fs_name) action \<Rightarrow> 'a option" 
   where 
   "object (M\<lparr>N\<rparr>) = Some N"
 | "object (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) = Some N"
 | "object (\<tau>) = None"
 by(rule TrueI)+
 
 lemma optionFreshChain[simp]:
   fixes xvec :: "name list"
   and   X    :: "name set"
 
   shows "xvec \<sharp>* (Some x) = xvec \<sharp>* x"
   and   "X \<sharp>* (Some x) = X \<sharp>* x"
   and   "xvec \<sharp>* None"
   and   "X \<sharp>* None"
 by(auto simp add: fresh_star_def fresh_some fresh_none)
 
 lemmas [simp] = fresh_some fresh_none
   
 lemma actionFresh[simp]:
   fixes x :: name
   and   \<alpha> :: "('a::fs_name) action"
 
   shows "(x \<sharp> \<alpha>)  = (x \<sharp> (subject \<alpha>) \<and> x \<sharp> (bn \<alpha>) \<and> x \<sharp> (object \<alpha>))"
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
   
 lemma actionFreshChain[simp]:
   fixes X    :: "name set"
   and   \<alpha>    :: "('a::fs_name) action"
   and   xvec :: "name list"
 
   shows "(X \<sharp>* \<alpha>) = (X \<sharp>* (subject \<alpha>) \<and> X \<sharp>* (bn \<alpha>) \<and> X \<sharp>* (object \<alpha>))"
   and   "(xvec \<sharp>* \<alpha>) = (xvec \<sharp>* (subject \<alpha>) \<and> xvec \<sharp>* (bn \<alpha>) \<and> xvec \<sharp>* (object \<alpha>))"
 by(auto simp add: fresh_star_def)
 
 lemma subjectEqvt[eqvt]:
   fixes p :: "name prm"
   and   \<alpha> :: "('a::fs_name) action"
 
   shows "(p \<bullet> subject \<alpha>) = subject(p \<bullet> \<alpha>)"
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
 
 lemma okjectEqvt[eqvt]:
   fixes p :: "name prm"
   and   \<alpha> :: "('a::fs_name) action"
 
   shows "(p \<bullet> object \<alpha>) = object(p \<bullet> \<alpha>)"
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
 
 lemma create_residualEqvt[eqvt]:
   fixes p :: "name prm"
   and   \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "(p \<bullet> (\<alpha> \<prec> P)) = (p \<bullet> \<alpha>) \<prec> (p \<bullet> P)"
 by(nominal_induct \<alpha> rule: action.strong_induct)
   (auto simp add: eqvts)
 
 lemma residualFresh:
   fixes x :: name
   and   \<alpha> :: "'a::fs_name action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "(x \<sharp> (\<alpha> \<prec> P)) = (x \<sharp> (subject \<alpha>) \<and> (x \<in> (set(bn(\<alpha>))) \<or> (x \<sharp> object(\<alpha>) \<and> x \<sharp> P)))"
 by(nominal_induct \<alpha> rule: action.strong_induct)
   (auto simp add: fresh_some fresh_none boundOutputFresh)
 
 lemma residualFresh2[simp]:
   fixes x :: name
   and   \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   assumes "x \<sharp> \<alpha>"
   and     "x \<sharp> P"
 
   shows "x \<sharp> \<alpha> \<prec> P"
 using assms
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
 
 lemma residualFreshChain2[simp]:
   fixes xvec :: "name list"
   and   X    :: "name set"
   and   \<alpha>    :: "('a::fs_name) action"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "\<lbrakk>xvec \<sharp>* \<alpha>; xvec \<sharp>* P\<rbrakk> \<Longrightarrow> xvec \<sharp>* (\<alpha> \<prec> P)"
   and   "\<lbrakk>X \<sharp>* \<alpha>; X \<sharp>* P\<rbrakk> \<Longrightarrow> X \<sharp>* (\<alpha> \<prec> P)"
 by(auto simp add: fresh_star_def)
 
 lemma residualFreshSimp[simp]:
   fixes x :: name
   and   M :: "'a::fs_name"
   and   N :: 'a
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   
 
   shows "x \<sharp> (M\<lparr>N\<rparr> \<prec> P) = (x \<sharp> M \<and> x \<sharp> N \<and> x \<sharp> P)"
   and   "x \<sharp> (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P) = (x \<sharp> M \<and> x \<sharp> (\<lparr>\<nu>*xvec\<rparr>(N \<prec>' P)))"
   and   "x \<sharp> (\<tau> \<prec> P) = (x \<sharp> P)"
 by(auto simp add: residualFresh)
 
 lemma residualInject':
 
   shows "(\<alpha> \<prec> P = RIn M N Q) = (P = Q \<and> \<alpha> = M\<lparr>N\<rparr>)"
   and   "(\<alpha> \<prec> P = ROut M B) = (\<exists>xvec N. \<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<and> B = \<lparr>\<nu>*xvec\<rparr>(N \<prec>' P))"
   and   "(\<alpha> \<prec> P = RTau Q) = (\<alpha> = \<tau> \<and> P = Q)"
   and   "(RIn M N Q = \<alpha> \<prec> P) = (P = Q \<and> \<alpha> = M\<lparr>N\<rparr>)"
   and   "(ROut M B = \<alpha> \<prec> P) = (\<exists>xvec N. \<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<and> B = \<lparr>\<nu>*xvec\<rparr>(N \<prec>' P))"
   and   "(RTau Q = \<alpha> \<prec> P) = (\<alpha> = \<tau> \<and> P = Q)"
 proof -
   show "(\<alpha> \<prec> P = RIn M N Q) = (P = Q \<and> \<alpha> = M\<lparr>N\<rparr>)"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 next
   show "(\<alpha> \<prec> P = ROut M B) = (\<exists>xvec N. \<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<and> B = \<lparr>\<nu>*xvec\<rparr>(N \<prec>' P))"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 next
   show  "(\<alpha> \<prec> P = RTau Q) = (\<alpha> = \<tau> \<and> P = Q)"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 next
   show "(RIn M N Q = \<alpha> \<prec> P) = (P = Q \<and> \<alpha> = M\<lparr>N\<rparr>)"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 next
   show "(ROut M B = \<alpha> \<prec> P) = (\<exists>xvec N. \<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<and> B = \<lparr>\<nu>*xvec\<rparr>(N \<prec>' P))"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 next
   show  "(RTau Q = \<alpha> \<prec> P) = (\<alpha> = \<tau> \<and> P = Q)"
     by(nominal_induct \<alpha> rule: action.strong_induct)
       (auto simp add: residual.inject action.inject)
 qed
 
 lemma residualFreshChainSimp[simp]:
   fixes xvec :: "name list"
   and   X    :: "name set"
   and   M    :: "'a::fs_name"
   and   N    :: 'a
   and   yvec :: "name list"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "xvec \<sharp>* (M\<lparr>N\<rparr> \<prec> P) = (xvec \<sharp>* M \<and> xvec \<sharp>* N \<and> xvec \<sharp>* P)"
   and   "xvec \<sharp>* (M\<lparr>\<nu>*yvec\<rparr>\<langle>N\<rangle> \<prec> P) = (xvec \<sharp>* M \<and> xvec \<sharp>* (\<lparr>\<nu>*yvec\<rparr>(N \<prec>' P)))"
   and   "xvec \<sharp>* (\<tau> \<prec> P) = (xvec \<sharp>* P)"
   and   "X \<sharp>* (M\<lparr>N\<rparr> \<prec> P) = (X \<sharp>* M \<and> X \<sharp>* N \<and> X \<sharp>* P)"
   and   "X \<sharp>* (M\<lparr>\<nu>*yvec\<rparr>\<langle>N\<rangle> \<prec> P) = (X \<sharp>* M \<and> X \<sharp>* (\<lparr>\<nu>*yvec\<rparr>(N \<prec>' P)))"
   and   "X \<sharp>* (\<tau> \<prec> P) = (X \<sharp>* P)"
 by(auto simp add: fresh_star_def)
 
 lemma residualFreshChainSimp2[simp]:
   fixes xvec :: "name list"
   and   X    :: "name set"
   and   M    :: "'a::fs_name"
   and   N    :: 'a
   and   yvec :: "name list"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
 
   shows "xvec \<sharp>* (RIn M N P) = (xvec \<sharp>* M \<and> xvec \<sharp>* N \<and> xvec \<sharp>* P)"
   and   "xvec \<sharp>* (ROut M B) = (xvec \<sharp>* M \<and> xvec \<sharp>* B)"
   and   "xvec \<sharp>* (RTau P) = (xvec \<sharp>* P)"
   and   "X \<sharp>* (RIn M N P) = (X \<sharp>* M \<and> X \<sharp>* N \<and> X \<sharp>* P)"
   and   "X \<sharp>* (ROut M B) = (X \<sharp>* M \<and> X \<sharp>* B)"
   and   "X \<sharp>* (RTau P) = (X \<sharp>* P)"
 by(auto simp add: fresh_star_def)
 
 lemma freshResidual3[dest]:
   fixes x :: name
   and   \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   
   assumes "x \<sharp> bn \<alpha>"
   and     "x \<sharp> \<alpha> \<prec> P"
 
   shows "x \<sharp> \<alpha>" and "x \<sharp> P"
 using assms
 by(nominal_induct rule: action.strong_induct) auto
 
 lemma freshResidualChain3[dest]:
   fixes xvec :: "name list"
   and   \<alpha>    :: "('a::fs_name) action"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   
   assumes "xvec \<sharp>* (\<alpha> \<prec> P)"
   and     "xvec \<sharp>* bn \<alpha>"
 
   shows "xvec \<sharp>* \<alpha>" and "xvec \<sharp>* P"
 using assms
 by(nominal_induct rule: action.strong_induct) auto
 
 lemma freshResidual4[dest]:
   fixes x :: name
   and   \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   
   assumes "x \<sharp> \<alpha> \<prec> P"
 
   shows "x \<sharp> subject \<alpha>"
 using assms
 by(nominal_induct rule: action.strong_induct) auto
 
 lemma freshResidualChain4[dest]:
   fixes xvec :: "name list"
   and   \<alpha>    :: "('a::fs_name) action"
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   
   assumes "xvec \<sharp>* (\<alpha> \<prec> P)"
 
   shows "xvec \<sharp>* subject \<alpha>"
 using assms
 by(nominal_induct rule: action.strong_induct) auto
 
 lemma alphaOutputResidual:
   fixes M    :: "'a::fs_name"
   and   xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   p    :: "name prm"
 
   assumes "(p \<bullet> xvec) \<sharp>* N"
   and     "(p \<bullet> xvec) \<sharp>* P"
   and     "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
   and     "set xvec \<subseteq> set yvec"
 
   shows "M\<lparr>\<nu>*yvec\<rparr>\<langle>N\<rangle> \<prec> P = M\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> P)"
 using assms
 by(simp add: boundOutputChainAlpha'')
 
 lemmas[simp del] =  create_residual.simps
 
 lemma residualInject'':
 
   assumes "bn \<alpha> = bn \<beta>"
 
   shows "(\<alpha> \<prec> P = \<beta> \<prec> Q) = (\<alpha> = \<beta> \<and> P = Q)"
 using assms
 apply(nominal_induct \<alpha> rule: action.strong_induct)
 apply(auto simp add: residual.inject create_residual.simps residualInject' action.inject boundOutput.inject)
 by(rule_tac x="bn \<beta>" in exI) auto
 
 lemmas residualInject = residual.inject create_residual.simps residualInject' residualInject''
 
 lemma bnFreshResidual[simp]:
   fixes \<alpha> :: "('a::fs_name) action"
 
   shows "(bn \<alpha>) \<sharp>* (\<alpha> \<prec> P) = bn \<alpha> \<sharp>* (subject \<alpha>)"
 by(nominal_induct \<alpha> rule: action.strong_induct)
   (auto simp add: residualFresh fresh_some fresh_star_def)
 
 lemma actionCases[case_names cInput cOutput cTau]:
   fixes \<alpha> :: "('a::fs_name) action"
 
   assumes "\<And>M N. \<alpha> = M\<lparr>N\<rparr> \<Longrightarrow> Prop"
   and     "\<And>M xvec N. \<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<Longrightarrow> Prop"
   and     "\<alpha> = \<tau> \<Longrightarrow> Prop"
 
   shows Prop
 using assms
 by(nominal_induct \<alpha> rule: action.strong_induct) auto
 
 lemma actionPar1Dest:
   fixes \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   \<beta> :: "('a::fs_name) action"
   and   Q :: "('a, 'b, 'c) psi"
   and   R :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> (Q \<parallel> R)"
   and     "bn \<alpha> \<sharp>* bn \<beta>"
 
   obtains T p where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn \<beta>)" and "P = T \<parallel> (p \<bullet> R)" and "\<alpha> \<prec> T = \<beta> \<prec> Q"
 using assms
 apply(cases rule: actionCases[where \<alpha>=\<alpha>])
 apply(auto simp add: residualInject)
 by(drule_tac boundOutputPar1Dest') auto
 
 lemma actionPar2Dest:
   fixes \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   \<beta> :: "('a::fs_name) action"
   and   Q :: "('a, 'b, 'c) psi"
   and   R :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> (Q \<parallel> R)"
   and     "bn \<alpha> \<sharp>* bn \<beta>"
 
   obtains T p where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn \<beta>)" and "P = (p \<bullet> Q) \<parallel> T" and "\<alpha> \<prec> T = \<beta> \<prec> R"
 using assms
 apply(cases rule: actionCases[where \<alpha>=\<alpha>])
 apply(auto simp add: residualInject)
 by(drule_tac boundOutputPar2Dest') auto
 
 lemma actionScopeDest:
   fixes \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   fixes \<beta> :: "('a::fs_name) action"
   and   x :: name
   and   Q :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> \<lparr>\<nu>x\<rparr>Q"
   and     "x \<sharp> bn \<alpha>"
   and     "x \<sharp> bn \<beta>"
 
   obtains R where "P = \<lparr>\<nu>x\<rparr>R" and "\<alpha> \<prec> R = \<beta> \<prec> Q"
 using assms
 apply(cases rule: actionCases[where \<alpha>=\<alpha>])
 apply(auto simp add: residualInject)
 by(drule_tac boundOutputScopeDest) auto
 
 abbreviation
   outputJudge ("_\<langle>_\<rangle>" [110, 110] 110) where "M\<langle>N\<rangle> \<equiv> M\<lparr>\<nu>*([])\<rparr>\<langle>N\<rangle>"
 
 declare [[unify_trace_bound=100]]
 
 locale env = substPsi substTerm substAssert substCond + 
              assertion SCompose' SImp' SBottom' SChanEq'
   for substTerm :: "('a::fs_name) \<Rightarrow> name list \<Rightarrow> 'a::fs_name list \<Rightarrow> 'a"
   and substAssert :: "('b::fs_name) \<Rightarrow> name list \<Rightarrow> 'a::fs_name list \<Rightarrow> 'b"
   and substCond :: "('c::fs_name) \<Rightarrow> name list \<Rightarrow> 'a::fs_name list \<Rightarrow> 'c"
   and SCompose'  :: "'b \<Rightarrow> 'b \<Rightarrow> 'b"
   and SImp'      :: "'b \<Rightarrow> 'c \<Rightarrow> bool"
   and SBottom'   :: 'b
   and SChanEq'   :: "'a \<Rightarrow> 'a \<Rightarrow> 'c"
 begin
 notation SCompose' (infixr "\<otimes>" 90)
 notation SImp' ("_ \<turnstile> _" [85, 85] 85)
 notation FrameImp ("_ \<turnstile>\<^sub>F _" [85, 85] 85) 
 abbreviation
   FBottomJudge ("\<bottom>\<^sub>F" 90) where "\<bottom>\<^sub>F \<equiv> (FAssert SBottom')"
 notation SChanEq' ("_ \<leftrightarrow> _" [90, 90] 90)
 notation substTerm ("_[_::=_]" [100, 100, 100] 100)
 notation subs ("_[_::=_]" [100, 100, 100] 100)
 notation AssertionStatEq ("_ \<simeq> _" [80, 80] 80)
 notation FrameStatEq ("_ \<simeq>\<^sub>F _" [80, 80] 80)
 notation SBottom' ("\<one>" 190)
 abbreviation insertAssertion' ("insertAssertion") where "insertAssertion' \<equiv> assertionAux.insertAssertion (\<otimes>)"
 
 inductive semantics :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) residual \<Rightarrow> bool"
                        ("_ \<rhd> _ \<longmapsto> _" [50, 50, 50] 50)
 where
   cInput:  "\<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N; xvec \<sharp>* Tvec;
             length xvec = length Tvec;
             xvec \<sharp>* \<Psi>; xvec \<sharp>* M; xvec \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto> K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> P[xvec::=Tvec]"
 | Output: "\<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto> K\<langle>N\<rangle> \<prec> P"
 | Case:   "\<lbrakk>\<Psi> \<rhd> P \<longmapsto> Rs; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> Cases Cs \<longmapsto> Rs"
 
 | cPar1:   "\<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>\<alpha> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
              A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* P'; distinct(bn \<alpha>); 
              bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* (subject \<alpha>)\<rbrakk> \<Longrightarrow>
              \<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P' \<parallel> Q)"
 | cPar2:   "\<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
              A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* Q'; distinct(bn \<alpha>); 
              bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* (subject \<alpha>)\<rbrakk> \<Longrightarrow>
              \<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P \<parallel> Q')"
 | cComm1:   "\<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto> M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
              \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
              \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; 
              A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
              A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; 
              A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P';
              A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec; distinct xvec;
              xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M;
              xvec \<sharp>* Q; xvec \<sharp>* K\<rbrakk> \<Longrightarrow>
              \<Psi> \<rhd> P \<parallel> Q \<longmapsto> \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
 | cComm2:   "\<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto> M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
              \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
              \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; 
              A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
              A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; 
              A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P';
              A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec; distinct xvec;
              xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M;
              xvec \<sharp>* Q; xvec \<sharp>* K\<rbrakk> \<Longrightarrow>
              \<Psi> \<rhd> P \<parallel> Q \<longmapsto> \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
 | cOpen:    "\<lbrakk>\<Psi> \<rhd> P \<longmapsto> M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; x \<in> supp N; x \<sharp> xvec; x \<sharp> yvec; x \<sharp> M; x \<sharp> \<Psi>;
               distinct xvec; distinct yvec;
               xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* yvec; yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M\<rbrakk> \<Longrightarrow>
               \<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto> M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'"
 | cScope:  "\<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; x \<sharp> \<Psi>; x \<sharp> \<alpha>; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* (subject \<alpha>); distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P')"
 | Bang:    "\<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs; guarded P\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> !P \<longmapsto> Rs"
 
 abbreviation
   semanticsBottomJudge ("_ \<longmapsto> _" [50, 50] 50) where "P \<longmapsto> Rs \<equiv> \<one> \<rhd> P \<longmapsto> Rs"
 
 equivariance env.semantics
 
 nominal_inductive2 env.semantics
   avoids cInput: "set xvec"
        | cPar1: "set A\<^sub>Q \<union> set(bn \<alpha>)"
        | cPar2: "set A\<^sub>P \<union> set(bn \<alpha>)"
        | cComm1: "set A\<^sub>P \<union> set A\<^sub>Q \<union> set xvec"
        | cComm2: "set A\<^sub>P \<union> set A\<^sub>Q \<union> set xvec"
        | cOpen:  "{x} \<union> set xvec \<union> set yvec"
        | cScope: "{x} \<union> set(bn \<alpha>)"
 apply(auto intro: substTerm.subst4Chain subst4Chain simp add: abs_fresh residualFresh)
 apply(force simp add: fresh_star_def abs_fresh)
 apply(simp add: boundOutputFresh)
 apply(simp add: boundOutputFreshSet)
 apply(simp add: boundOutputFreshSet)
 by(simp add: fresh_star_def abs_fresh)
 
 lemma nilTrans[dest]:
   fixes \<Psi>   :: 'b
   and   Rs   :: "('a, 'b, 'c) residual"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b, 'c) psi"
   and   K    :: 'a
   and   yvec :: "name list"
   and   N'   :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   CsP  :: "('c \<times>  ('a, 'b, 'c) psi) list"
   and   \<Psi>'   :: 'b
 
   shows "\<Psi> \<rhd> \<zero> \<longmapsto> Rs \<Longrightarrow> False"
   and   "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>K\<lparr>\<nu>*yvec\<rparr>\<langle>N'\<rangle> \<prec> P' \<Longrightarrow> False"
   and   "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<tau> \<prec> P' \<Longrightarrow> False"
   and   "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>K\<lparr>N'\<rparr> \<prec> P' \<Longrightarrow> False"
   and   "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>\<tau> \<prec> P' \<Longrightarrow> False"
   and   "\<Psi> \<rhd> \<lbrace>\<Psi>'\<rbrace> \<longmapsto> Rs \<Longrightarrow> False"
 apply(cases rule: semantics.cases) apply auto
 apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
 apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
 apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
 apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
 by(cases rule: semantics.cases) (auto simp add: residualInject)
   
 lemma residualEq:
   fixes \<alpha> :: "'a action"
   and   P :: "('a, 'b, 'c) psi"
   and   \<beta> :: "'a action"
   and   Q :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> Q"
   and     "bn \<alpha> \<sharp>* (bn \<beta>)"
   and     "distinct(bn \<alpha>)"
   and     "distinct(bn \<beta>)"
   and     "bn \<alpha> \<sharp>* (\<alpha> \<prec> P)"
   and     "bn \<beta> \<sharp>* (\<beta> \<prec> Q)"
 
   obtains p where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "\<beta> = p \<bullet> \<alpha>" and "Q = p \<bullet> P" and "bn \<alpha> \<sharp>* \<beta>" and "bn \<alpha> \<sharp>* Q" and "bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>" and "bn(p \<bullet> \<alpha>) \<sharp>* P"
 using assms
 proof(nominal_induct \<alpha> rule: action.strong_induct)
   case(In M N)
   thus ?case by(simp add: residualInject)
 next
   case(Out M xvec N)
   thus ?case 
     by(auto simp add: residualInject)
       (drule_tac boundOutputChainEq'', auto) 
 next
   case Tau
   thus ?case by(simp add: residualInject)
 qed
 
 lemma semanticsInduct[consumes 3, case_names cAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                 'a action \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "bn \<alpha> \<sharp>* (subject \<alpha>)"
   and     "distinct(bn \<alpha>)"
   and     rAlpha: "\<And>\<Psi> P \<alpha> P' p C. \<lbrakk>bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* (subject \<alpha>); 
                                     bn \<alpha> \<sharp>* C; bn \<alpha> \<sharp>* (bn(p \<bullet> \<alpha>)); 
                                     set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>)); distinctPerm p;
                                     (bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>; (bn(p \<bullet> \<alpha>)) \<sharp>* P'; Prop C \<Psi> P \<alpha> P'\<rbrakk> \<Longrightarrow>
                                      Prop C \<Psi> P (p \<bullet> \<alpha>) (p \<bullet> P')"
   and     rInput: "\<And>\<Psi> M K xvec N Tvec P C.
                    \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N;
                     length xvec = length Tvec; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (M\<lparr>\<lambda>*xvec N\<rparr>.P)
                               (K\<lparr>(N[xvec::=Tvec])\<rparr>) (P[xvec::=Tvec])"
   and     rOutput: "\<And>\<Psi> M K N P C. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) (K\<langle>N\<rangle>) P"
   and     rCase: "\<And>\<Psi> P \<alpha> P' \<phi> Cs C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; \<And>C. Prop C \<Psi> P \<alpha> P'; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow>
                                       Prop C \<Psi> (Cases Cs) \<alpha> P'"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P \<alpha> P';
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C; distinct(bn \<alpha>); bn \<alpha> \<sharp>* Q;
                     bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) \<alpha> (P' \<parallel> Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q \<alpha> Q';
                     A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C; distinct(bn \<alpha>); bn \<alpha> \<sharp>* Q;
                     bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) \<alpha> (P \<parallel> Q')"
   and     rComm1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>N\<rparr>) P'; 
                     extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) Q'; 
                     extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q'; distinct xvec;
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rComm2: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) P'; 
                     extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; 
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>N\<rparr>) Q'; 
                     extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q'; distinct xvec;
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rOpen:  "\<And>\<Psi> P M xvec yvec N P' x C.
                    \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; x \<in> supp N; \<And>C. Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle>) P';
                     x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> yvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M;  distinct xvec; distinct yvec;
                     yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; yvec \<sharp>* C; x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow> 
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) P'"
   and     rScope: "\<And>\<Psi> P \<alpha> P' x C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; \<And>C. Prop C \<Psi> P \<alpha> P';
                     x \<sharp> \<Psi>; x \<sharp> \<alpha>; bn \<alpha> \<sharp>* \<Psi>;
                     bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* (subject \<alpha>); x \<sharp> C; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) \<alpha> (\<lparr>\<nu>x\<rparr>P')"
   and     rBang:    "\<And>\<Psi> P \<alpha> P' C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<alpha> \<prec> P'; guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) \<alpha> P'\<rbrakk> \<Longrightarrow>
                       Prop C \<Psi> (!P) \<alpha> P'"
 
   shows "Prop C \<Psi> P \<alpha> P'"
 using \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* (subject \<alpha>)\<close> \<open>distinct(bn \<alpha>)\<close>
 proof(nominal_induct x3=="\<alpha> \<prec> P'" avoiding: \<alpha> C arbitrary: P' rule: semantics.strong_induct)
   case(cInput \<Psi> M K xvec N Tvec P \<alpha> C P')
   thus ?case by(force intro: rInput simp add: residualInject)
 next
   case(Output \<Psi> M K N P \<alpha> C P')
   thus ?case by(force intro: rOutput simp add: residualInject)
 next
   case(Case \<Psi> P Rs \<phi> Cs \<alpha> C)
   thus ?case by(auto intro: rCase)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q \<alpha>' C P'')
   note \<open>\<alpha> \<prec> (P' \<parallel> Q) = \<alpha>' \<prec> P''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P' \<parallel> Q)" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and P'eq: "P'' = p \<bullet> (P' \<parallel> Q)" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (P' \<parallel> Q)"
     by(rule residualEq)
     
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P \<alpha> P'" by(rule_tac cPar1) auto
   moreover note \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
                 \<open>bn \<alpha> \<sharp>* Q\<close> \<open>distinct(bn \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) \<alpha> (P' \<parallel> Q)"
     by(rule_tac rPar1)
 
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* bn \<alpha>'\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P' \<parallel> Q)\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
   have "Prop C \<Psi> (P \<parallel> Q) (p \<bullet> \<alpha>) (p \<bullet> (P' \<parallel> Q))"
     by(rule_tac rAlpha) auto
   with \<alpha>Eq P'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P \<alpha>' C Q'')
   note \<open>\<alpha> \<prec> (P \<parallel> Q') = \<alpha>' \<prec> Q''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P \<parallel> Q')" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> Q'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and Q'eq: "Q'' = p \<bullet> (P \<parallel> Q')" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (P \<parallel> Q')"
     by(rule residualEq)
     
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q \<alpha> Q'" by(rule_tac cPar2) auto
 
   moreover note \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* C\<close>
                 \<open>bn \<alpha> \<sharp>* Q\<close> \<open>distinct(bn \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) \<alpha> (P \<parallel> Q')"
     by(rule_tac rPar2)
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* (bn \<alpha>')\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P \<parallel> Q')\<close>
   have "Prop C \<Psi> (P \<parallel> Q) (p \<bullet> \<alpha>) (p \<bullet> (P \<parallel> Q'))"
     by(rule_tac rAlpha) auto
   with \<alpha>Eq Q'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q \<alpha> C P'')
   hence "Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
     by(rule_tac rComm1) (assumption | simp)+
   thus ?case using \<open>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q') = \<alpha> \<prec> P''\<close>
     by(simp add: residualInject)
 next
   case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q \<alpha> C P'')
   hence "Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
     by(rule_tac rComm2) (assumption | simp)+
   thus ?case using \<open>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q') = \<alpha> \<prec> P''\<close>
     by(simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec yvec N P' x \<alpha> C P'')
   note \<open>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close>
   moreover from \<open>xvec \<sharp>* \<alpha>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>yvec \<sharp>* \<alpha>\<close> have "(xvec@x#yvec) \<sharp>* (bn \<alpha>)"
     by auto
   moreover from \<open>xvec \<sharp>* yvec\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
   have "distinct(xvec@x#yvec)"
     by(auto simp add: fresh_star_def) (simp add: fresh_def name_list_supp)
   moreover note \<open>distinct(bn \<alpha>)\<close>
   moreover from \<open>xvec \<sharp>* M\<close> \<open>x \<sharp> M\<close> \<open>yvec \<sharp>* M\<close> have "(xvec@x#yvec) \<sharp>* M" by auto
   hence "(xvec@x#yvec) \<sharp>* (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P')" by auto
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P'')" by simp
   ultimately obtain p where S: "(set p) \<subseteq> (set(xvec@x#yvec)) \<times> (set(p \<bullet> (xvec@x#yvec)))" and "distinctPerm p"
              and \<alpha>eq: "\<alpha> = (p \<bullet> M)\<lparr>\<nu>*(p \<bullet> (xvec@x#yvec))\<rparr>\<langle>(p \<bullet> N)\<rangle>" and P'eq: "P'' = (p \<bullet> P')"
              and A: "(xvec@x#yvec) \<sharp>* ((p \<bullet> M)\<lparr>\<nu>*(p \<bullet> (xvec@x#yvec))\<rparr>\<langle>(p \<bullet> N)\<rangle>)"
              and B: "(p \<bullet> (xvec@x#yvec)) \<sharp>* (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>)"
              and C: "(p \<bullet> (xvec@x#yvec)) \<sharp>* P'"
     by(rule_tac residualEq) (assumption | simp)+
     
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>x \<in> (supp N)\<close>
 
   moreover {
     fix C
     from \<open>xvec \<sharp>* M\<close> \<open>yvec \<sharp>* M\<close> have "(xvec@yvec) \<sharp>* M" by simp
     moreover from \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>xvec \<sharp>* yvec\<close> have "distinct(xvec@yvec)"
       by auto (simp add: fresh_star_def name_list_supp fresh_def)
     ultimately have "Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle>) P'" by(rule_tac cOpen) auto
   }
 
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* M\<close>
                  \<open>yvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* P\<close> \<open>yvec \<sharp>* M\<close> \<open>yvec \<sharp>* C\<close> \<open>x \<sharp> C\<close> \<open>xvec \<sharp>* C\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) P'"
     by(rule_tac rOpen) 
 
   with \<open>xvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>yvec \<sharp>* P\<close> \<open>xvec \<sharp>* M\<close> \<open>yvec \<sharp>* M\<close> 
        \<open>yvec \<sharp>* C\<close>  S \<open>distinctPerm p\<close> \<open>x \<sharp> C\<close> \<open>xvec \<sharp>* C\<close>
        \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> A B C
   have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (p \<bullet> (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>)) (p \<bullet> P')"
     apply(rule_tac \<alpha>="M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>" in rAlpha)
     apply(assumption | simp)+
     apply(fastforce simp add: fresh_star_def abs_fresh)
     by(assumption | simp)+
   with \<alpha>eq P'eq show ?case by simp
 next
   case(cScope \<Psi> P \<alpha> P' x \<alpha>' C P'')
   note \<open>\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P') = \<alpha>' \<prec> P''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> \<lparr>\<nu>x\<rparr>P')" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and P'eq: "P'' = p \<bullet> (\<lparr>\<nu>x\<rparr>P')" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (\<lparr>\<nu>x\<rparr>P')"
     by(rule residualEq)
     
   note \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close>
   have "\<And>C. Prop C \<Psi> P \<alpha> P'" by(rule_tac cScope) auto
 
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>
                 \<open>x \<sharp> C\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>distinct(bn \<alpha>)\<close>
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) \<alpha> (\<lparr>\<nu>x\<rparr>P')"
     by(rule rScope) 
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>x \<sharp> \<alpha>\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* (bn \<alpha>')\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (\<lparr>\<nu>x\<rparr>P')\<close>
   have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (p \<bullet> \<alpha>) (p \<bullet> (\<lparr>\<nu>x\<rparr>P'))"
     by(rule_tac rAlpha) simp+
   with \<alpha>Eq P'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(Bang \<Psi> P Rs \<alpha> C)
   thus ?case by(rule_tac rBang) auto
 qed
 
 lemma outputInduct[consumes 1, case_names cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  'a \<Rightarrow> ('a, 'b, 'c) boundOutput \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>ROut M B"
   and     rOutput: "\<And>\<Psi> M K N P C. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) K (N \<prec>' P)"
   and     rCase: "\<And>\<Psi> P M B \<phi> Cs C.  
                   \<lbrakk>\<Psi> \<rhd> P \<longmapsto>(ROut M B); \<And>C. Prop C \<Psi> P M B; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> 
                    Prop C \<Psi> (Cases Cs) M B"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N  P' A\<^sub>Q Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P');
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; 
                     A\<^sub>Q \<sharp>* xvec; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C; xvec \<sharp>* Q;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P' \<parallel> Q))"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q M xvec N  Q' A\<^sub>P P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' Q');
                     A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; 
                     A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C; xvec \<sharp>* P;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* Q; xvec \<sharp>* M; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P \<parallel> Q'))"
   and     rOpen:  "\<And>\<Psi> P M xvec yvec N P' x C.
                    \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; x \<in> supp N; \<And>C. Prop C \<Psi> P M (\<lparr>\<nu>*(xvec@yvec)\<rparr>N \<prec>' P');
                     x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> yvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* yvec; yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; yvec \<sharp>* C; x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M (\<lparr>\<nu>*(xvec@x#yvec)\<rparr>N \<prec>' P')"
   and     rScope: "\<And>\<Psi> P M xvec N P' x C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<And>C. Prop C \<Psi> P M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P');
                     x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> N; xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M;
                     x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' \<lparr>\<nu>x\<rparr>P')"
   and     rBang:    "\<And>\<Psi> P M B C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>(ROut M B); guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) M B\<rbrakk> \<Longrightarrow>
                       Prop C \<Psi> (!P) M B"
   shows "Prop C \<Psi> P M B"
 using \<open>\<Psi> \<rhd> P \<longmapsto>(ROut M B)\<close>
 proof(nominal_induct \<Psi> P Rs=="(ROut M B)" avoiding: C arbitrary: B rule: semantics.strong_induct)
   case(cInput \<Psi> M K xvec N Tvec P C)
   thus ?case by(simp add: residualInject)
 next
   case(Output \<Psi> M K N P C)
   thus ?case by(force simp add: residualInject intro: rOutput)
 next
   case(Case \<Psi> P Rs \<phi> Cs C)
   thus ?case by(force intro: rCase) 
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q C)
   thus ?case by(force intro: rPar1 simp add: residualInject)
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P C)
   thus ?case by(force intro: rPar2 simp add: residualInject)
 next
   case cComm1
   thus ?case by(simp add: residualInject)
 next
   case cComm2
   thus ?case by(simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec yvec N P' x C B)
   thus ?case by(force intro: rOpen simp add: residualInject)
 next
   case(cScope \<Psi> P M \<alpha> P' x C)
   thus ?case by(force intro: rScope simp add: residualInject)
 next
   case(Bang  \<Psi> P Rs C)
   thus ?case by(force intro: rBang)
 qed
 
 lemma boundOutputBindObject:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   yvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   y    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     "y \<in> set(bn \<alpha>)"
 
   shows "y \<in> supp(object \<alpha>)"
 using assms
 proof(nominal_induct avoiding: P' arbitrary: y rule: semanticsInduct)
   case(cAlpha \<Psi> P \<alpha> P' p P'' y)
   from \<open>y \<in> set(bn(p \<bullet> \<alpha>))\<close> have "(p \<bullet> y) \<in> (p \<bullet> set(bn(p \<bullet> \<alpha>)))"
     by(rule pt_set_bij2[OF pt_name_inst, OF at_name_inst])
   hence "(p \<bullet> y) \<in> set(bn \<alpha>)" using \<open>distinctPerm p\<close>
     by(simp add: eqvts)
   hence "(p \<bullet> y) \<in> supp(object \<alpha>)" by(rule cAlpha)
   hence "(p \<bullet> p \<bullet> y) \<in> (p \<bullet> supp(object \<alpha>))"
     by(rule pt_set_bij2[OF pt_name_inst, OF at_name_inst])
   thus ?case using \<open>distinctPerm p\<close>
     by(simp add: eqvts)
 next
   case cInput 
   thus ?case by(simp add: supp_list_nil)
 next
   case cOutput
   thus ?case by(simp add: supp_list_nil)
 next
   case cCase
   thus ?case by simp
 next
   case cPar1
   thus ?case by simp
 next
   case cPar2
   thus ?case by simp
 next
   case cComm1
   thus ?case by(simp add: supp_list_nil)
 next
   case cComm2
   thus ?case by(simp add: supp_list_nil)
 next
   case cOpen
   thus ?case by(auto simp add: supp_list_cons supp_list_append supp_atm supp_some)
 next
   case cScope
   thus ?case by simp
 next
   case cBang
   thus ?case by simp
 qed
 
 lemma alphaBoundOutputChain':
   fixes yvec :: "name list"
   and   xvec :: "name list"
   and   B    :: "('a, 'b, 'c) boundOutput"
 
   assumes "length xvec = length yvec"
   and     "yvec \<sharp>* B"
   and     "yvec \<sharp>* xvec"
   and     "distinct yvec"
 
   shows "\<lparr>\<nu>*xvec\<rparr>B = \<lparr>\<nu>*yvec\<rparr>([xvec yvec] \<bullet>\<^sub>v B)"
 using assms
 proof(induct rule: composePermInduct)
   case cBase
   show ?case by simp
 next
   case(cStep x xvec y yvec)
   thus ?case
     apply auto
     by(subst alphaBoundOutput[of y]) (auto simp add: eqvts)
 qed
 
 lemma alphaBoundOutputChain'':
   fixes yvec :: "name list"
   and   xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b, 'c) psi"
 
   assumes "length xvec = length yvec"
   and     "yvec \<sharp>* N"
   and     "yvec \<sharp>* P"
   and     "yvec \<sharp>* xvec"
   and     "distinct yvec"
 
   shows "\<lparr>\<nu>*xvec\<rparr>(N \<prec>' P) = \<lparr>\<nu>*yvec\<rparr>(([xvec yvec] \<bullet>\<^sub>v N) \<prec>' ([xvec yvec] \<bullet>\<^sub>v P))"
 proof -
   from assms have "\<lparr>\<nu>*xvec\<rparr>(N \<prec>' P) = \<lparr>\<nu>*yvec\<rparr>([xvec yvec] \<bullet>\<^sub>v (N \<prec>' P))"
     by(simp add: alphaBoundOutputChain')
   thus ?thesis by simp
 qed
 
 lemma alphaDistinct:
   fixes xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b, 'c) psi"
   and   yvec :: "name list"
   and   M    :: 'a
   and   Q    :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> Q"
   and     "distinct(bn \<alpha>)"
   and     "\<And>x. x \<in> set(bn \<alpha>) \<Longrightarrow> x \<in> supp(object \<alpha>)"
   and     "bn \<alpha> \<sharp>* bn \<beta>"
   and     "bn \<alpha> \<sharp>* (object \<beta>)"
   and     "bn \<alpha> \<sharp>* Q"
 
   shows "distinct(bn \<beta>)"
 using assms
 proof(rule_tac actionCases[where \<alpha>=\<alpha>], auto simp add: residualInject supp_some)
   fix xvec M yvec N
   assume Eq: "\<lparr>\<nu>*xvec\<rparr>N \<prec>' P = \<lparr>\<nu>*yvec\<rparr>M \<prec>' Q" 
   assume "distinct xvec" and "xvec \<sharp>* M" and "xvec \<sharp>* yvec" and "xvec \<sharp>* Q" 
   assume Mem: "\<And>x. x \<in> set xvec \<Longrightarrow> x \<in> (supp N)"
   show "distinct yvec"
 proof -
   from Eq have "length xvec = length yvec"
     by(rule boundOutputChainEqLength)
   with Eq \<open>distinct xvec\<close> \<open>xvec \<sharp>* yvec\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* Q\<close> Mem show ?thesis
   proof(induct n=="length xvec" arbitrary: xvec yvec M Q rule: nat.induct)
     case(zero xvec yvec M Q)
     thus ?case by simp
   next
     case(Suc n xvec yvec M Q)
     have L: "length xvec = length yvec" and "Suc n = length xvec" by fact+
     then obtain x xvec' y yvec' where xEq: "xvec = x#xvec'" and yEq: "yvec = y#yvec'"
                                   and L': "length xvec' = length yvec'"
       by(cases xvec, auto, cases yvec, auto)
     have xvecFreshyvec: "xvec \<sharp>* yvec" and xvecDist: "distinct xvec" by fact+
     with xEq yEq have xineqy: "x \<noteq> y" and xvec'Freshyvec': "xvec' \<sharp>* yvec'"
                   and xvec'Dist: "distinct xvec'" and xFreshxvec': "x \<sharp> xvec'"
                   and xFreshyvec': "x \<sharp> yvec'" and yFreshxvec': "y \<sharp> xvec'"
       by auto
     have Eq: "\<lparr>\<nu>*xvec\<rparr>N \<prec>' P = \<lparr>\<nu>*yvec\<rparr>M \<prec>' Q" by fact
     with xEq yEq xineqy have Eq': "\<lparr>\<nu>*xvec'\<rparr>N \<prec>' P = \<lparr>\<nu>*([(x, y)] \<bullet> yvec')\<rparr>([(x, y)] \<bullet> M) \<prec>' ([(x, y)] \<bullet> Q)"
       by(simp add: boundOutput.inject alpha eqvts) 
     moreover have Mem:"\<And>x. x \<in> set xvec \<Longrightarrow> x \<in> supp N" by fact
     with xEq have "\<And>x. x \<in> set xvec' \<Longrightarrow> x \<in> supp N" by simp
     moreover have "xvec \<sharp>* M" by fact
     with xEq xFreshxvec' yFreshxvec' have "xvec' \<sharp>* ([(x, y)] \<bullet> M)" by simp
     moreover have xvecFreshQ: "xvec \<sharp>* Q" by fact
     with xEq xFreshxvec' yFreshxvec' have "xvec' \<sharp>* ([(x, y)] \<bullet> Q)" by simp
     moreover have "Suc n = length xvec" by fact
     with xEq have "n = length xvec'" by simp
     moreover from xvec'Freshyvec' xFreshxvec' yFreshxvec' have "xvec' \<sharp>* ([(x, y)] \<bullet> yvec')"
       by simp
     moreover from L' have "length xvec' = length([(x, y)] \<bullet> yvec')" by simp
     ultimately have "distinct([(x, y)] \<bullet> yvec')" using xvec'Dist
       by(rule_tac Suc) (assumption | simp)+
     hence "distinct yvec'" by simp
     from Mem xEq have xSuppN: "x \<in> supp N" by simp
     from L \<open>distinct xvec\<close> \<open>xvec \<sharp>* yvec\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* Q\<close> 
     have "\<lparr>\<nu>*yvec\<rparr>M \<prec>' Q = \<lparr>\<nu>*xvec\<rparr>([yvec xvec] \<bullet>\<^sub>v M) \<prec>' ([yvec xvec] \<bullet>\<^sub>v Q)"
       by(simp add: alphaBoundOutputChain'')
     with Eq have "N = [yvec xvec] \<bullet>\<^sub>v M" by simp
     with xEq yEq have "N = [(y, x)] \<bullet> [yvec' xvec'] \<bullet>\<^sub>v M"
       by simp
     with xSuppN have ySuppM: "y \<in> supp([yvec' xvec'] \<bullet>\<^sub>v M)"
       by(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
         (simp add: calc_atm eqvts name_swap)
     have "y \<sharp> yvec'"
     proof(simp add: fresh_def, rule notI)
       assume "y \<in> supp yvec'"
       hence "y mem yvec'"
         by(induct yvec') (auto simp add: supp_list_nil supp_list_cons supp_atm)
       moreover from \<open>xvec \<sharp>* M\<close> xEq xFreshxvec' have "xvec' \<sharp>* M" by simp
       ultimately have "y \<sharp> [yvec' xvec'] \<bullet>\<^sub>v  M" using L' xvec'Freshyvec' xvec'Dist
         by(force intro: freshChainPerm)
       with ySuppM show "False" by(simp add: fresh_def)
     qed
     with \<open>distinct yvec'\<close>  yEq show ?case by simp
   qed
 qed
 qed
 
 lemma boundOutputDistinct:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
 
   shows "distinct(bn \<alpha>)"
 using assms
 proof(nominal_induct \<Psi> P x3=="\<alpha> \<prec> P'" avoiding: \<alpha> P' rule: semantics.strong_induct)
   case cInput
   thus ?case by(simp add: residualInject)
 next
   case Output
   thus ?case by(simp add: residualInject)
 next
   case Case
   thus ?case by(simp add: residualInject)
 next
   case cPar1
   thus ?case by(force intro: alphaDistinct boundOutputBindObject)
 next
   case cPar2
   thus ?case by(force intro: alphaDistinct boundOutputBindObject)
 next 
   case cComm1
   thus ?case by(simp add: residualInject)
 next
   case cComm2
   thus ?case by(simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec yvec N P' x \<alpha> P'')
   note \<open>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close>
   moreover from \<open>xvec \<sharp>* yvec\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
   have "distinct(bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>))"
     by auto (simp add: fresh_star_def fresh_def name_list_supp)
   moreover {
     fix y
     from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>x \<in> supp N\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> \<Psi>\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* yvec\<close> \<open>yvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* P\<close> \<open>yvec \<sharp>* M\<close>
     have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'" by(rule semantics.cOpen)
     moreover moreover from \<open>xvec \<sharp>* M\<close> \<open>x \<sharp> M\<close> \<open>yvec \<sharp>* M\<close> 
     have "bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) \<sharp>* (subject(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>))"
       by simp
     moreover note \<open>distinct(bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>))\<close>
     moreover assume "y \<in> set(bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>))"
 
     ultimately have "y \<in> supp(object(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>))"
       by(rule_tac boundOutputBindObject)
   }
   moreover from \<open>xvec \<sharp>* \<alpha>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>yvec \<sharp>* \<alpha>\<close>
   have "bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) \<sharp>* bn \<alpha>" and "bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) \<sharp>* object \<alpha>" by simp+
   moreover from \<open>xvec \<sharp>* P''\<close> \<open>x \<sharp> P''\<close> \<open>yvec \<sharp>* P''\<close>
   have "bn(M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>) \<sharp>* P''" by simp
   ultimately show ?case by(rule alphaDistinct)
 next
   case cScope
   thus ?case
     by(rule_tac alphaDistinct, auto) (rule_tac boundOutputBindObject, auto)
 next
   case Bang
   thus ?case by simp
 qed
 
 lemma inputDistinct:
   fixes \<Psi>   :: 'b
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b, 'c) psi"
   and   Rs   :: "('a, 'b, 'c) residual"
 
   assumes "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto> Rs"
 
   shows "distinct xvec"
 using assms
 by(nominal_induct \<Psi> P=="M\<lparr>\<lambda>*xvec N\<rparr>.P" Rs avoiding: xvec N P rule: semantics.strong_induct)
   (auto simp add: psi.inject intro: alphaInputDistinct)
 
 lemma outputInduct'[consumes 2, case_names cAlpha cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   yvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  'a \<Rightarrow> name list \<Rightarrow> 'a \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     rAlpha: "\<And>\<Psi> P M xvec N P' p C. \<lbrakk>xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M;  xvec \<sharp>* C; xvec \<sharp>* (p \<bullet> xvec); 
                                            set p \<subseteq> set xvec \<times> set(p \<bullet> xvec); distinctPerm p;
                                            (p \<bullet> xvec) \<sharp>* N; (p \<bullet> xvec) \<sharp>* P'; Prop C \<Psi> P M xvec N P'\<rbrakk> \<Longrightarrow>
                                            Prop C \<Psi> P M (p \<bullet> xvec) (p \<bullet> N) (p \<bullet> P')"
   and     rOutput: "\<And>\<Psi> M K N P C. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) K ([]) N P"
   and     rCase: "\<And>\<Psi> P M xvec N P' \<phi> Cs C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<And>C. Prop C \<Psi> P M xvec N P'; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow>
                                              Prop C \<Psi> (Cases Cs) M xvec N P'"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N  P' A\<^sub>Q Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P M xvec N P';
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; 
                     A\<^sub>Q \<sharp>* xvec; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C; xvec \<sharp>* Q;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) M xvec N (P' \<parallel> Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q M xvec N  Q' A\<^sub>P P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>;  distinct A\<^sub>P;
                     \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q M xvec N Q';
                     A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; 
                     A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C; xvec \<sharp>* Q;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) M xvec N (P \<parallel> Q')"
   and     rOpen:  "\<And>\<Psi> P M xvec yvec N P' x C.
                    \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; x \<in> supp N; \<And>C. Prop C \<Psi> P M (xvec@yvec) N P';
                     x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> yvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; 
                     yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; yvec \<sharp>* C; x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow> 
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M (xvec@x#yvec) N P'"
   and     rScope: "\<And>\<Psi> P M xvec N P' x C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<And>C. Prop C \<Psi> P M xvec N P';
                     x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> N; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* P; xvec \<sharp>* M; x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M xvec N (\<lparr>\<nu>x\<rparr>P')"
   and     rBang:    "\<And>\<Psi> P M xvec N P' C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) M xvec N P'\<rbrakk> \<Longrightarrow>
                       Prop C \<Psi> (!P) M xvec N P'"
   shows "Prop C \<Psi> P M xvec N P'"
 proof -
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   moreover from \<open>xvec \<sharp>* M\<close> have "bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) \<sharp>* subject(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)" by simp
   moreover from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> have "distinct(bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>))"
     by(rule boundOutputDistinct)
   ultimately show ?thesis
   proof(nominal_induct \<Psi> P \<alpha>=="M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" P' avoiding: C arbitrary: M xvec N rule: semanticsInduct)
     case(cAlpha \<Psi> P \<alpha> P' p C M xvec N)
     from \<open>(p \<bullet> \<alpha>) = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> have "(p \<bullet> p \<bullet> \<alpha>) = p \<bullet> (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)"
       by(simp add: fresh_bij)
     with \<open>distinctPerm p\<close> have A: "\<alpha> = (p \<bullet> M)\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle>"
       by(simp add: eqvts)
     with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha> \<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* bn(p \<bullet> \<alpha>)\<close> \<open>distinctPerm p\<close>
     have "(p \<bullet> xvec) \<sharp>* \<Psi>" and  "(p \<bullet> xvec) \<sharp>* P" and  "(p \<bullet> xvec) \<sharp>* (p \<bullet> M)" and  "(p \<bullet> xvec) \<sharp>* C" and  "(p \<bullet> xvec) \<sharp>* (p \<bullet> p \<bullet> xvec)"
       by auto
     moreover from A \<open>set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))\<close> \<open>distinctPerm p\<close>
     have S: "set p \<subseteq> set(p \<bullet> xvec) \<times> set(p \<bullet> p \<bullet> xvec)" by simp
     moreover note \<open>distinctPerm p\<close>
     moreover from A \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* P'\<close>
     have "(p \<bullet> p \<bullet> xvec) \<sharp>* (p \<bullet> N)" and "(p \<bullet> p \<bullet> xvec) \<sharp>* P'" by simp+
     moreover from A have "Prop C \<Psi> P (p \<bullet> M) (p \<bullet> xvec) (p \<bullet> N) P'"
       by(rule cAlpha)
     ultimately have "Prop C \<Psi> P (p \<bullet> M) (p \<bullet> p \<bullet> xvec) (p \<bullet> p \<bullet> N) (p \<bullet> P')"
       by(rule rAlpha)
     moreover from A \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> M)" by simp
     hence "xvec \<sharp>* M" by(simp add: fresh_star_bij)
     from A \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>distinctPerm p\<close> have "xvec \<sharp>* (p \<bullet> M)" by simp
     hence "(p \<bullet> xvec) \<sharp>* (p \<bullet> p \<bullet> M)" by(simp add: fresh_star_bij)
     with \<open>distinctPerm p\<close> have "(p \<bullet> xvec) \<sharp>* M" by simp
     with \<open>xvec \<sharp>* M\<close> S \<open>distinctPerm p\<close> have  "(p \<bullet> M) = M" by simp
     ultimately show ?case using S \<open>distinctPerm p\<close> by simp 
   next
     case cInput
     thus ?case by(simp add: residualInject)
   next
     case cOutput
     thus ?case by(force dest: rOutput simp add: action.inject)
   next
     case cCase
     thus ?case by(force intro: rCase)
   next
     case cPar1
     thus ?case by(force intro: rPar1)
   next
     case cPar2
     thus ?case by(force intro: rPar2)
   next
     case cComm1
     thus ?case by(simp add: action.inject)
   next
     case cComm2
     thus ?case by(simp add: action.inject)
   next
     case cOpen
     thus ?case by(fastforce intro: rOpen simp add: action.inject)
   next
     case cScope
     thus ?case by(fastforce intro: rScope)
   next
     case cBang
     thus ?case by(fastforce intro: rBang)
   qed
 qed
 
 lemma inputInduct[consumes 1, case_names cInput cCase cPar1 cPar2 cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  'a \<Rightarrow> 'a \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     rInput: "\<And>\<Psi> M K xvec N Tvec P C.
                    \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N;
                     length xvec = length Tvec; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (M\<lparr>\<lambda>*xvec N\<rparr>.P)
                               K (N[xvec::=Tvec]) (P[xvec::=Tvec])"
   and     rCase: "\<And>\<Psi> P M N P' \<phi> Cs C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<And>C. Prop C \<Psi> P M N P'; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow>
                                         Prop C \<Psi> (Cases Cs) M N P'" 
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>Q Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P M N P'; distinct A\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* N;
                    A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M N (P' \<parallel> Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q M N Q' A\<^sub>P P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q M N Q'; distinct A\<^sub>P;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N;
                    A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M N (P \<parallel> Q')"
   and     rScope: "\<And>\<Psi> P M N P' x C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<And>C. Prop C \<Psi> P M N P'; x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> N; x \<sharp> C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M N (\<lparr>\<nu>x\<rparr>P')"
   and     rBang:    "\<And>\<Psi> P M N P' C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) M N P'\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) M N P'"
   shows "Prop C \<Psi> P M N P'"
 using Trans
 proof(nominal_induct \<Psi> P Rs=="M\<lparr>N\<rparr> \<prec> P'" avoiding: C arbitrary: P' rule: semantics.strong_induct)
   case(cInput \<Psi> M K xvec N Tvec P C)
   thus ?case
     by(force intro: rInput simp add: residualInject action.inject)
 next
   case(Output \<Psi> M K N P C)
   thus ?case by(simp add: residualInject)
 next
   case(Case \<Psi> P Rs \<phi> CS C)
   thus ?case by(force intro: rCase)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q C P'')
   thus ?case by(force intro: rPar1 simp add: residualInject)
 next 
   case(cPar2 \<Psi> \<Psi>P Q \<alpha> Q' xvec P C Q'')
   thus ?case by(force intro: rPar2 simp add: residualInject)
 next
   case(cComm1 \<Psi> \<Psi>Q P M N P' xvec \<Psi>P Q K zvec Q' yvec C PQ)
   thus ?case by(simp add: residualInject)
 next
   case(cComm2 \<Psi> \<Psi>Q P M zvec N P' xvec \<Psi>P Q K yvec Q' C PQ)
   thus ?case by(simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec N P' x yvec C P'') 
   thus ?case by(simp add: residualInject)
 next
   case(cScope \<Psi> P \<alpha> P' x C P'')
   thus ?case by(force intro: rScope simp add: residualInject)
 next
   case(Bang \<Psi> P Rs C)
   thus ?case by(force intro: rBang)
 qed
 
 lemma tauInduct[consumes 1, case_names cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Rs   :: "('a, 'b, 'c) residual"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     rCase: "\<And>\<Psi> P P' \<phi> Cs C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'; \<And>C. Prop C \<Psi> P P'; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> 
                                     Prop C \<Psi> (Cases Cs) P'"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P P' A\<^sub>Q Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<tau> \<prec> P'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P P';
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>;
                    A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (P' \<parallel> Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q Q' A\<^sub>P P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<tau> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q Q';
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>;
                    A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (P \<parallel> Q')"
   and     rComm1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rComm2: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P';  extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; 
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rScope: "\<And>\<Psi> P P' x C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'; \<And>C. Prop C \<Psi> P P'; x \<sharp> \<Psi>; x \<sharp> C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (\<lparr>\<nu>x\<rparr>P')"
   and     rBang:    "\<And>\<Psi> P P' C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<tau> \<prec> P'; guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) P'\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) P'"
   shows "Prop C \<Psi> P P'"
 using Trans
 proof(nominal_induct \<Psi> P Rs=="\<tau> \<prec> P'" avoiding: C arbitrary: P' rule: semantics.strong_induct)
   case(cInput M K xvec N Tvec P C)
   thus ?case by(simp add: residualInject)
 next
   case(Output \<Psi> M K N P C)
   thus ?case by(simp add: residualInject)
 next
   case(Case \<Psi> P Rs \<phi> Cs C)
   thus ?case by(force intro: rCase simp add: residualInject)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q C P'')
   thus ?case by(force intro: rPar1 simp add: residualInject)
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P C Q'')
   thus ?case by(force intro: rPar2 simp add: residualInject)
 next
   case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C PQ)
   thus ?case by(force intro: rComm1 simp add: residualInject)
 next
   case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>P Q' A\<^sub>Q C PQ)
   thus ?case by(force intro: rComm2 simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec N P' x yvec C P'')
   thus ?case by(simp add: residualInject)
 next
   case(cScope \<Psi> P \<alpha> P' x C P'')
   thus ?case by(force intro: rScope simp add: residualInject)
 next
   case(Bang \<Psi> P Rs C )
   thus ?case by(force intro: rBang simp add: residualInject)
 qed
 
 lemma semanticsFrameInduct[consumes 3, case_names cAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Rs   :: "('a, 'b, 'c) residual"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  ('a, 'b, 'c) residual \<Rightarrow> name list \<Rightarrow> 'b \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto> Rs"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     rAlpha: "\<And>\<Psi> P A\<^sub>P \<Psi>\<^sub>P p Rs C. \<lbrakk>A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* (p \<bullet> A\<^sub>P); A\<^sub>P \<sharp>* Rs; A\<^sub>P \<sharp>* C;
                                          set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P); distinctPerm p;
                                           Prop C \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P Rs (p \<bullet> A\<^sub>P) (p \<bullet> \<Psi>\<^sub>P)"
   and     rInput: "\<And>\<Psi> M K xvec N Tvec P C.
                    \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N;
                     length xvec = length Tvec; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (M\<lparr>\<lambda>*xvec N\<rparr>.P)
                               (K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (P[xvec::=Tvec])) ([]) (\<one>)"
   and     rOutput: "\<And>\<Psi> M K N P C. \<Psi> \<turnstile> M \<leftrightarrow> K \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) (K\<langle>N\<rangle> \<prec> P) ([]) (\<one>)"
   and     rCase: "\<And>\<Psi> P Rs \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto> Rs; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; \<And>C. Prop C \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P;
                                             (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P;  \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                                             A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Rs; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (Cases Cs) Rs ([]) (\<one>)"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P; distinct(bn \<alpha>);
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P' \<parallel> Q)) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (\<alpha> \<prec> Q') A\<^sub>Q \<Psi>\<^sub>Q; distinct(bn \<alpha>);
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P ((M\<lparr>N\<rparr>) \<prec> P') A\<^sub>P \<Psi>\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q') A\<^sub>Q \<Psi>\<^sub>Q; distinct xvec;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm2: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P') A\<^sub>P \<Psi>\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>N\<rparr> \<prec> Q') A\<^sub>Q \<Psi>\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rOpen: "\<And>\<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P') A\<^sub>P \<Psi>\<^sub>P; x \<in> supp N; x \<sharp> \<Psi>; x \<sharp> M;
                      x \<sharp> A\<^sub>P; x \<sharp> xvec; x \<sharp> yvec; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
                      A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* yvec; xvec \<sharp>* yvec; distinct xvec; distinct yvec;
                      xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P; yvec \<sharp>* \<Psi>\<^sub>P;
                      yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; A\<^sub>P \<sharp>* C; x \<sharp> C; xvec \<sharp>* C; yvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rScope: "\<And>\<Psi> P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P;
                      x \<sharp> \<Psi>; x \<sharp> \<alpha>; x \<sharp> A\<^sub>P; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P;
                      A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; distinct(bn \<alpha>);
                      bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P;
                      A\<^sub>P \<sharp>* C; x \<sharp> C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P')) (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rBang:    "\<And>\<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs; guarded P; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                       \<And>C. Prop C \<Psi> (P \<parallel> !P) Rs A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>); \<Psi>\<^sub>P \<simeq> \<one>; supp \<Psi>\<^sub>P = ({}::name set);
                       A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Rs; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) Rs ([]) (\<one>)"
   shows "Prop C \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P"
 using Trans FrP \<open>distinct A\<^sub>P\<close>
 proof(nominal_induct  avoiding: A\<^sub>P \<Psi>\<^sub>P C rule: semantics.strong_induct)
   case(cInput \<Psi> M K xvec N Tvec P A\<^sub>P \<Psi>\<^sub>P C)
   from \<open>extractFrame (M\<lparr>\<lambda>*xvec N\<rparr>.P) = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>
   have "A\<^sub>P = []" and "\<Psi>\<^sub>P = \<one>"
     by auto
   with \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
        \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* K\<close> \<open>xvec \<sharp>* C\<close>
   show ?case by(blast intro: rInput)
 next
   case(Output \<Psi> M K N P A\<^sub>P \<Psi>\<^sub>P)
   from \<open>extractFrame (M\<langle>N\<rangle>.P) = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>
   have "A\<^sub>P = []" and "\<Psi>\<^sub>P = \<one>"
     by auto
   with \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> show ?case
     by(blast intro: rOutput)
 next
   case(Case \<Psi> P Rs \<phi> Cs A\<^sub>c\<^sub>P \<Psi>\<^sub>c\<^sub>P C)
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                   and "A\<^sub>P \<sharp>* (\<Psi>, P, Rs, C)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* Rs" and "A\<^sub>P \<sharp>* C"
     by simp+
   note \<open>\<Psi> \<rhd> P \<longmapsto> Rs\<close> FrP \<open>distinct A\<^sub>P\<close>
   moreover from FrP \<open>distinct A\<^sub>P\<close> \<open>\<And>A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P\<close> 
   have "\<And>C. Prop C \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P" by simp
   moreover note \<open>(\<phi>, P) mem Cs\<close> \<open>\<Psi> \<turnstile> \<phi>\<close> \<open>guarded P\<close>
   moreover from \<open>guarded P\<close> FrP have "\<Psi>\<^sub>P \<simeq> \<one>" and "supp \<Psi>\<^sub>P = ({}::name set)" by(metis guardedStatEq)+
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Rs\<close> \<open>A\<^sub>P \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (Cases Cs) Rs ([]) (\<one>)"
     by(rule rCase)
   thus ?case using \<open>extractFrame(Cases Cs) = \<langle>A\<^sub>c\<^sub>P, \<Psi>\<^sub>c\<^sub>P\<rangle>\<close> by simp
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q A\<^sub>P\<^sub>Q \<Psi>\<^sub>P\<^sub>Q C)
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                            "A\<^sub>P \<sharp>* (P, Q, \<Psi>, \<alpha>, P', A\<^sub>Q, A\<^sub>P\<^sub>Q, C, \<Psi>\<^sub>Q)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* Q" and "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* \<alpha>" and "A\<^sub>P \<sharp>* P'"
     and "A\<^sub>P \<sharp>* A\<^sub>Q" and "A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>P \<sharp>* C" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by simp+
 
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
 
   from \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> FrP have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>bn \<alpha> \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> FrP have "bn \<alpha> \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
     by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "set p \<subseteq> set(A\<^sub>P@A\<^sub>Q) \<times> set((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = (p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
   
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close> FrQ \<open>distinct A\<^sub>Q\<close>
 
   moreover from FrP \<open>distinct A\<^sub>P\<close> \<open>\<And>A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P\<rbrakk> \<Longrightarrow> Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P" by simp
 
   moreover note \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close>
                 \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>distinct(bn \<alpha>)\<close>
                 \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close>  \<open>bn \<alpha> \<sharp>* Q\<close>  \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>  \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close>  \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> 
                 \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P' \<parallel> Q)) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rPar1)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* C\<close>
        \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
        S \<open>distinctPerm p\<close> Aeq
   have "Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P' \<parallel> Q)) (p \<bullet> (A\<^sub>P@A\<^sub>Q)) (p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q))"
     by(rule_tac rAlpha) (assumption | simp add: eqvts)+
   with \<Psi>eq Aeq show ?case by(simp add: eqvts)
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P A\<^sub>P\<^sub>Q \<Psi>\<^sub>P\<^sub>Q C)
   obtain A\<^sub>Q \<Psi>\<^sub>Q where FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q"
                            "A\<^sub>Q \<sharp>* (P, Q, \<Psi>, \<alpha>, Q', A\<^sub>P, A\<^sub>P\<^sub>Q, C, \<Psi>\<^sub>P)"
     by(rule freshFrame)
   hence "A\<^sub>Q \<sharp>* P" and "A\<^sub>Q \<sharp>* Q" and "A\<^sub>Q \<sharp>* \<Psi>" and "A\<^sub>Q \<sharp>* \<alpha>" and "A\<^sub>Q \<sharp>* Q'"
     and "A\<^sub>Q \<sharp>* A\<^sub>P" and "A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>Q \<sharp>* C" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by simp+
 
   from \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> have "A\<^sub>P \<sharp>* A\<^sub>Q" by simp
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
 
   from \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> FrQ have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)
   from \<open>bn \<alpha> \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> FrQ have "bn \<alpha> \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
     by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "(set p \<subseteq> (set(A\<^sub>P@A\<^sub>Q)) \<times> (set A\<^sub>P\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = ((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> FrP \<open>distinct A\<^sub>P\<close> FrQ \<open>distinct A\<^sub>Q\<close>
 
   moreover from FrQ \<open>distinct A\<^sub>Q\<close> \<open>\<And>A\<^sub>Q \<Psi>\<^sub>Q C. \<lbrakk>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q\<rbrakk> \<Longrightarrow> Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (\<alpha> \<prec> Q') A\<^sub>Q \<Psi>\<^sub>Q\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (\<alpha> \<prec> Q') A\<^sub>Q \<Psi>\<^sub>Q" by simp
 
   moreover note \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close>
                 \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>distinct(bn \<alpha>)\<close>
                 \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close>  \<open>bn \<alpha> \<sharp>* Q\<close>  \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>  \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close>  \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> 
                 \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rPar2)
 
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* C\<close>
        \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
        S \<open>distinctPerm p\<close> Aeq
   have "Prop C \<Psi> (P \<parallel> Q) (\<alpha> \<prec> (P \<parallel> Q')) (p \<bullet> (A\<^sub>P@A\<^sub>Q)) (p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q))"
     by(rule_tac rAlpha) (assumption | simp add: eqvts)+
   with \<Psi>eq Aeq show ?case by(simp add: eqvts)
 next
   case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q A\<^sub>P\<^sub>Q \<Psi>\<^sub>P\<^sub>Q C)
   from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   from cComm1 have  "Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rComm1)
   moreover from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>
                 \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
     by simp
   with \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct(A\<^sub>P@A\<^sub>Q)\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
   obtain p where S: "(set p \<subseteq> (set(A\<^sub>P@A\<^sub>Q)) \<times> (set A\<^sub>P\<^sub>Q))"  and "distinctPerm p"
              and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = p \<bullet> (A\<^sub>P@A\<^sub>Q)"
     by(rule_tac frameChainEq') (assumption | simp)+
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close>
                 \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close>
                 \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (p \<bullet> (A\<^sub>P@A\<^sub>Q)) (p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q))"
     by(rule_tac rAlpha) auto
   with \<Psi>eq Aeq show ?case by simp
 next
   case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q A\<^sub>P\<^sub>Q \<Psi>\<^sub>P\<^sub>Q C)
   from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   from cComm2 have  "Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rComm2)
   moreover from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>
                 \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
     by simp
   with \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct(A\<^sub>P@A\<^sub>Q)\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
   obtain p where S: "(set p \<subseteq> (set(A\<^sub>P@A\<^sub>Q)) \<times> (set A\<^sub>P\<^sub>Q))"  and "distinctPerm p"
              and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = p \<bullet> (A\<^sub>P@A\<^sub>Q)"
     by(rule_tac frameChainEq') (assumption | simp)+
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close>
                 \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close>
                 \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (p \<bullet> (A\<^sub>P@A\<^sub>Q)) (p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q))"
     by(rule_tac rAlpha) auto
   with \<Psi>eq Aeq show ?case by simp
 next
   case(cOpen \<Psi> P M xvec yvec N P' x A\<^sub>x\<^sub>P \<Psi>\<^sub>x\<^sub>P C)
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                   and "A\<^sub>P \<sharp>* (\<Psi>, P, M, xvec, yvec, N, P', A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P, C, x)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* M" and "A\<^sub>P \<sharp>* xvec"and "A\<^sub>P \<sharp>* yvec" and "A\<^sub>P \<sharp>* N" and "A\<^sub>P \<sharp>* P'"
     and "A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>x\<^sub>P" and "A\<^sub>P \<sharp>* C" and "x \<sharp> A\<^sub>P"
     by simp+
 
   from \<open>xvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> FrP have "xvec \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
   from \<open>yvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> FrP have "yvec \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(\<lparr>\<nu>x\<rparr>P) = \<langle>A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P\<rangle>\<close> FrP
   have "\<langle>(x#A\<^sub>P), \<Psi>\<^sub>P\<rangle> = \<langle>A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P\<rangle>"
     by simp
   moreover from \<open>x \<sharp> A\<^sub>P\<close> \<open>distinct A\<^sub>P\<close> have "distinct(x#A\<^sub>P)" by simp
   ultimately obtain p where S: "set p \<subseteq> set (x#A\<^sub>P) \<times> set (p \<bullet> (x#A\<^sub>P))" and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>x\<^sub>P = p \<bullet> \<Psi>\<^sub>P" and Aeq: "A\<^sub>x\<^sub>P = (p \<bullet> x)#(p \<bullet> A\<^sub>P)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close>\<open>x \<sharp> A\<^sub>x\<^sub>P\<close> \<open>distinct A\<^sub>x\<^sub>P\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close>
   moreover from FrP \<open>distinct A\<^sub>P\<close> \<open>\<And>A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P') A\<^sub>P \<Psi>\<^sub>P\<close>
   have "\<And>C. Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P') A\<^sub>P \<Psi>\<^sub>P" by simp
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<in> supp N\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* P'\<close>
                 \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close>  \<open>xvec \<sharp>* M\<close>  \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>yvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* P\<close>  \<open>yvec \<sharp>* M\<close>  \<open>yvec \<sharp>* \<Psi>\<^sub>P\<close> 
                 \<open>A\<^sub>P \<sharp>* C\<close> \<open>x \<sharp> C\<close> \<open>xvec \<sharp>* C\<close> \<open>yvec \<sharp>* C\<close> \<open>xvec \<sharp>* yvec\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P') (x#A\<^sub>P) \<Psi>\<^sub>P"
     by(rule_tac rOpen)
   
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>x \<sharp> A\<^sub>x\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close> \<open>x \<sharp> A\<^sub>P\<close>
        \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> C\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> Aeq
        S \<open>distinctPerm p\<close>
   have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P') (p \<bullet> (x#A\<^sub>P)) (p \<bullet> \<Psi>\<^sub>P)"
     by(rule_tac A\<^sub>P="x#A\<^sub>P" in rAlpha) (assumption | simp add: abs_fresh fresh_star_def boundOutputFresh)+
   with \<Psi>eq Aeq show ?case by(simp add: eqvts)
 next
   case(cScope \<Psi> P \<alpha> P' x A\<^sub>x\<^sub>P \<Psi>\<^sub>x\<^sub>P C)
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                   and "A\<^sub>P \<sharp>* (\<Psi>, P, \<alpha>, P', A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P, C, x)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* \<alpha>" and "A\<^sub>P \<sharp>* P'"
     and "A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>x\<^sub>P" and "A\<^sub>P \<sharp>* C" and "x \<sharp> A\<^sub>P"
     by simp+
 
   from \<open>bn \<alpha> \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> FrP have "bn \<alpha> \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(\<lparr>\<nu>x\<rparr>P) = \<langle>A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P\<rangle>\<close> FrP
   have "\<langle>(x#A\<^sub>P), \<Psi>\<^sub>P\<rangle> = \<langle>A\<^sub>x\<^sub>P, \<Psi>\<^sub>x\<^sub>P\<rangle>"
     by simp
   moreover from \<open>x \<sharp> A\<^sub>P\<close> \<open>distinct A\<^sub>P\<close> have "distinct(x#A\<^sub>P)" by simp
   ultimately obtain p where S: "set p \<subseteq> set (x#A\<^sub>P) \<times> set (p \<bullet> (x#A\<^sub>P))" and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>x\<^sub>P = p \<bullet> \<Psi>\<^sub>P" and Aeq: "A\<^sub>x\<^sub>P = (p \<bullet> x)#(p \<bullet> A\<^sub>P)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close>\<open>x \<sharp> A\<^sub>x\<^sub>P\<close> \<open>distinct A\<^sub>x\<^sub>P\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   note \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close>
   moreover from FrP \<open>distinct A\<^sub>P\<close> \<open>\<And>A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P\<close>
   have "\<And>C. Prop C \<Psi> P (\<alpha> \<prec> P') A\<^sub>P \<Psi>\<^sub>P" by simp
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>distinct(bn \<alpha>)\<close>
                 \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close>  \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>  \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>x \<sharp> C\<close> \<open>bn \<alpha> \<sharp>* C\<close> 
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P')) (x#A\<^sub>P) \<Psi>\<^sub>P"
     by(rule_tac rScope)
   
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>x \<sharp> A\<^sub>x\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>x\<^sub>P\<close> \<open>x \<sharp> A\<^sub>P\<close>
        \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> C\<close> Aeq
        S \<open>distinctPerm p\<close>
   have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P')) (p \<bullet> (x#A\<^sub>P)) (p \<bullet> \<Psi>\<^sub>P)"
     by(rule_tac A\<^sub>P="x#A\<^sub>P" in rAlpha) (assumption | simp add: abs_fresh fresh_star_def)+
   with \<Psi>eq Aeq show ?case by(simp add: eqvts)
 next
   case(Bang \<Psi> P Rs A\<^sub>b\<^sub>P \<Psi>\<^sub>b\<^sub>P C)
 
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                   and "A\<^sub>P \<sharp>* (\<Psi>, P, Rs, C)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* Rs" and "A\<^sub>P \<sharp>* C" 
     by simp+
 
   note \<open>\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs\<close> \<open>guarded P\<close> FrP \<open>distinct A\<^sub>P\<close>
   moreover from FrP have "extractFrame (P \<parallel> !P) = \<langle>A\<^sub>P, \<Psi>\<^sub>P \<otimes> \<one>\<rangle>"
     by simp
   with \<open>distinct A\<^sub>P\<close> \<open>\<And>A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>extractFrame (P \<parallel> !P) = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) Rs A\<^sub>P \<Psi>\<^sub>P\<close>
   have "\<And>C. Prop C \<Psi> (P \<parallel> !P) Rs A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>)" by simp
   moreover from \<open>guarded P\<close> FrP have "\<Psi>\<^sub>P \<simeq> \<one>" and "supp \<Psi>\<^sub>P = ({}::name set)" by(metis guardedStatEq)+
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Rs\<close> \<open>A\<^sub>P \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (!P) Rs ([]) (\<one>)"
     by(rule rBang) 
   thus ?case using \<open>extractFrame(!P) = \<langle>A\<^sub>b\<^sub>P, \<Psi>\<^sub>b\<^sub>P\<rangle>\<close> by simp
 qed
 
 lemma semanticsFrameInduct'[consumes 5, case_names cAlpha cFrameAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Rs   :: "('a, 'b, 'c) residual"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> 'a action \<Rightarrow>
                  ('a, 'b, 'c) psi \<Rightarrow> name list \<Rightarrow> 'b \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     rAlpha: "\<And>\<Psi> P \<alpha> P' p A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P;
                                            bn \<alpha> \<sharp>* C; bn \<alpha> \<sharp>* (p \<bullet> \<alpha>); A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C;
                                            set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>)); distinctPerm p;
                                            bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>; (bn(p \<bullet> \<alpha>)) \<sharp>* P'; Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow>
                                            Prop C \<Psi> P (p \<bullet> \<alpha>) (p \<bullet> P') A\<^sub>P \<Psi>\<^sub>P"
   and     rFrameAlpha: "\<And>\<Psi> P A\<^sub>P \<Psi>\<^sub>P p \<alpha> P' C. \<lbrakk>A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* (p \<bullet> A\<^sub>P); A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C;
                                                 set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P); distinctPerm p; A\<^sub>P \<sharp>* subject \<alpha>;
                                                 Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P \<alpha> P' (p \<bullet> A\<^sub>P) (p \<bullet> \<Psi>\<^sub>P)"
   and     rInput: "\<And>\<Psi> M K xvec N Tvec P C.
                    \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N;
                     length xvec = length Tvec; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (M\<lparr>\<lambda>*xvec N\<rparr>.P)
                               (K\<lparr>(N[xvec::=Tvec])\<rparr>) (P[xvec::=Tvec]) ([]) (\<one>)"
   and     rOutput: "\<And>\<Psi> M K N P C. \<Psi> \<turnstile> M \<leftrightarrow> K \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) (K\<langle>N\<rangle>) P ([]) (\<one>)"
   and     rCase: "\<And>\<Psi> P \<alpha> P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; \<And>C. Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P;
                                             (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P;  \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                                             A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (Cases Cs) \<alpha> P' ([]) (\<one>)"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) \<alpha> (P' \<parallel> Q) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q \<alpha> Q' A\<^sub>Q \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) \<alpha> (P \<parallel> Q') (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>N\<rparr>) P' A\<^sub>P \<Psi>\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) Q' A\<^sub>Q \<Psi>\<^sub>Q;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm2: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) P' A\<^sub>P \<Psi>\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>N\<rparr>) Q' A\<^sub>Q \<Psi>\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rOpen: "\<And>\<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P y C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle>) P' A\<^sub>P \<Psi>\<^sub>P; x \<in> supp N; x \<sharp> \<Psi>; x \<sharp> M;
                      x \<sharp> A\<^sub>P; x \<sharp> xvec; x \<sharp> yvec; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
                      A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* yvec; xvec \<sharp>* yvec; distinct xvec; distinct yvec;
                      xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P; 
                      yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; A\<^sub>P \<sharp>* C; x \<sharp> C; xvec \<sharp>* C; yvec \<sharp>* C;
                      y \<noteq> x; y \<sharp> \<Psi>; y \<sharp> P; y \<sharp> M; y \<sharp> xvec; y \<sharp> yvec; y \<sharp> N; y \<sharp> P'; y \<sharp> A\<^sub>P; y \<sharp> \<Psi>\<^sub>P; y \<sharp> C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle>) ([(x, y)] \<bullet> P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rScope: "\<And>\<Psi> P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P;
                      x \<sharp> \<Psi>; x \<sharp> \<alpha>; x \<sharp> A\<^sub>P; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P;
                      A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P';
                      bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P;
                      A\<^sub>P \<sharp>* C; x \<sharp> C; bn \<alpha> \<sharp>* C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) \<alpha> (\<lparr>\<nu>x\<rparr>P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rBang:    "\<And>\<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<alpha> \<prec> P'; guarded P; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                       \<And>C. Prop C \<Psi> (P \<parallel> !P) \<alpha> P' A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>); \<Psi>\<^sub>P \<simeq> \<one>; supp \<Psi>\<^sub>P = ({}::name set);
                       A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) \<alpha> P' ([]) (\<one>)"
   shows "Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P"
 using Trans FrP \<open>distinct A\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close>
 proof(nominal_induct \<Psi> P Rs=="\<alpha> \<prec> P'" A\<^sub>P \<Psi>\<^sub>P avoiding: C \<alpha> P' rule: semanticsFrameInduct)
   case cAlpha 
   thus ?case using rFrameAlpha
     by auto
 next
   case cInput
   thus ?case using rInput
     by(auto simp add: residualInject)
 next
   case cOutput
   thus ?case using rOutput
     by(auto simp add: residualInject)
 next
   case cCase
   thus ?case using rCase
     by(auto simp add: residualInject)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C \<alpha>' P'')
   note \<open>\<alpha> \<prec> (P' \<parallel> Q) = \<alpha>' \<prec> P''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P' \<parallel> Q)" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and P'eq: "P'' = p \<bullet> (P' \<parallel> Q)" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (P' \<parallel> Q)"
     by(rule residualEq)
     
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P" by(rule_tac cPar1) auto
 
   moreover note \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* C\<close>
                 \<open>bn \<alpha> \<sharp>* Q\<close> \<open>distinct(bn \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close>
                 \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) \<alpha> (P' \<parallel> Q) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rPar1)
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* (bn \<alpha>')\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P' \<parallel> Q)\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<alpha>Eq \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
   have "Prop C \<Psi> (P \<parallel> Q) (p \<bullet> \<alpha>) (p \<bullet> (P' \<parallel> Q)) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rAlpha) auto
   with \<alpha>Eq P'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C \<alpha>' Q'')
   note \<open>\<alpha> \<prec> (P \<parallel> Q') = \<alpha>' \<prec> Q''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P \<parallel> Q')" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> Q'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and Q'eq: "Q'' = p \<bullet> (P \<parallel> Q')" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (P \<parallel> Q')"
     by(rule residualEq)
     
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close>
   have "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q \<alpha> Q' A\<^sub>Q \<Psi>\<^sub>Q" by(rule_tac cPar2) auto
 
   moreover note \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* C\<close>
                 \<open>bn \<alpha> \<sharp>* Q\<close> \<open>distinct(bn \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close>
                 \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close>
   ultimately have "Prop C \<Psi> (P \<parallel> Q) \<alpha> (P \<parallel> Q') (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
     by(rule_tac rPar2) auto
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* (bn \<alpha>')\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P \<parallel> Q')\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<alpha>Eq \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
   have "Prop C \<Psi> (P \<parallel> Q) (p \<bullet> \<alpha>) (p \<bullet> (P \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
    by(rule_tac rAlpha) auto
   with \<alpha>Eq Q'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C \<alpha> P'')
   thus ?case using rComm1
     apply(auto)
     apply(drule_tac x="M\<lparr>N\<rparr>" in meta_spec)
     apply(drule_tac x="K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" in meta_spec)
     apply(drule_tac x=P' in meta_spec)
     apply(drule_tac x=Q' in meta_spec)
     apply auto
     apply(drule_tac x=\<Psi> in meta_spec)
     apply(drule_tac x=\<Psi>\<^sub>Q in meta_spec)
     apply(drule_tac x=P in meta_spec)
     apply(drule_tac x=M in meta_spec)
     apply(drule_tac x=N in meta_spec)
     apply(drule_tac x=P' in meta_spec)
     apply(drule_tac x=A\<^sub>P in meta_spec)
     apply(drule_tac x=\<Psi>\<^sub>P in meta_spec)
     apply(drule_tac x=Q in meta_spec)
     apply(drule_tac x=K in meta_spec)
     apply(drule_tac x=xvec in meta_spec)
     apply(drule_tac x=Q' in meta_spec)
     apply(drule_tac x=A\<^sub>Q in meta_spec)
     apply auto
     apply(subgoal_tac "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) Q' A\<^sub>Q \<Psi>\<^sub>Q")
     apply(subgoal_tac "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>N\<rparr>) P' A\<^sub>P \<Psi>\<^sub>P")
     by(auto simp add: residualInject)
 next
   case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C \<alpha> Q'')
   thus ?case using rComm2
     apply(drule_tac x="M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" in meta_spec)
     apply(drule_tac x="K\<lparr>N\<rparr>" in meta_spec)
     apply(drule_tac x=P' in meta_spec)
     apply(drule_tac x=Q' in meta_spec)
     apply auto
     apply(drule_tac x=\<Psi> in meta_spec)
     apply(drule_tac x=\<Psi>\<^sub>Q in meta_spec)
     apply(drule_tac x=P in meta_spec)
     apply(drule_tac x=M in meta_spec)
     apply(drule_tac x=xvec in meta_spec)
     apply(drule_tac x=N in meta_spec)
     apply(drule_tac x=P' in meta_spec)
     apply(drule_tac x=A\<^sub>P in meta_spec)
     apply(drule_tac x=\<Psi>\<^sub>P in meta_spec)
     apply(drule_tac x=Q in meta_spec)
     apply(drule_tac x=K in meta_spec)
     apply(drule_tac x=Q' in meta_spec)
     apply(drule_tac x=A\<^sub>Q in meta_spec)
     apply auto
     apply(subgoal_tac "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) P' A\<^sub>P \<Psi>\<^sub>P")
     apply(subgoal_tac "\<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q (K\<lparr>N\<rparr>) Q' A\<^sub>Q \<Psi>\<^sub>Q")
     by(auto simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P C \<alpha> P'')
   note \<open>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close>
   moreover from \<open>xvec \<sharp>* \<alpha>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>yvec \<sharp>* \<alpha>\<close> have "(xvec@x#yvec) \<sharp>* (bn \<alpha>)"
     by auto
   moreover from \<open>xvec \<sharp>* yvec\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
   have "distinct(xvec@x#yvec)"
     by(auto simp add: fresh_star_def) (simp add: fresh_def name_list_supp)
   moreover note \<open>distinct(bn \<alpha>)\<close>
   moreover from \<open>xvec \<sharp>* M\<close> \<open>x \<sharp> M\<close> \<open>yvec \<sharp>* M\<close> have "(xvec@x#yvec) \<sharp>* M" by auto
   hence "(xvec@x#yvec) \<sharp>* (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P')" by auto
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P'')" by simp
   ultimately obtain p where S: "(set p) \<subseteq> (set(xvec@x#yvec)) \<times> (set(p \<bullet> (xvec@x#yvec)))" and "distinctPerm p"
              and \<alpha>eq: "\<alpha> = (p \<bullet> M)\<lparr>\<nu>*(p \<bullet> (xvec@x#yvec))\<rparr>\<langle>(p \<bullet> N)\<rangle>" and P'eq: "P'' = (p \<bullet> P')"
              and A: "(xvec@x#yvec) \<sharp>* ((p \<bullet> M)\<lparr>\<nu>*(p \<bullet> (xvec@x#yvec))\<rparr>\<langle>(p \<bullet> N)\<rangle>)"
              and B: "(p \<bullet> (xvec@x#yvec)) \<sharp>* (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle>)"
              and C: "(p \<bullet> (xvec@x#yvec)) \<sharp>* P'"
     by(rule_tac residualEq) (assumption | simp)+
 
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>x \<in> (supp N)\<close>
 
   moreover {
     fix C
     from \<open>xvec \<sharp>* M\<close> \<open>yvec \<sharp>* M\<close> have "(xvec@yvec) \<sharp>* M" by simp
     moreover from \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>xvec \<sharp>* yvec\<close> have "distinct(xvec@yvec)"
       by auto (simp add: fresh_star_def name_list_supp fresh_def) 
     ultimately have "Prop C \<Psi> P (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle>) P' A\<^sub>P \<Psi>\<^sub>P" using \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* N\<close>
       by(rule_tac cOpen) auto
   }
   moreover obtain y::name where "y \<sharp> \<Psi>" and "y \<noteq> x" and "y \<sharp> P" and "y \<sharp> xvec" and "y \<sharp> yvec" and "y \<sharp> \<alpha>" and "y \<sharp> P'" and "y \<sharp> A\<^sub>P" and "y \<sharp> \<Psi>\<^sub>P" and "y \<sharp> M" and "y \<sharp> N" and "y \<sharp> C" and "y \<sharp> p"
     by(generate_fresh "name") auto
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* M\<close>
                  \<open>yvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* P\<close> \<open>yvec \<sharp>* M\<close> \<open>yvec \<sharp>* C\<close> \<open>x \<sharp> C\<close> \<open>xvec \<sharp>* C\<close> \<open>distinct xvec\<close> \<open>distinct yvec\<close>
                  \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>xvec \<sharp>* yvec\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close>
                  \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* C\<close> 
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle>) ([(x, y)] \<bullet> P') (x#A\<^sub>P) \<Psi>\<^sub>P"
     by(rule_tac rOpen)
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> M) = [(x, y)] \<bullet> p \<bullet> M"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<sharp> M\<close> \<open>x \<sharp> \<alpha>\<close> \<alpha>eq \<open>y \<sharp> p\<close> \<open>x \<sharp> M\<close> have D: "(([(x, y)] \<bullet> p) \<bullet> M) = p \<bullet> M"
     by(auto simp add: eqvts freshChainSimps)
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> xvec) = [(x, y)] \<bullet> p \<bullet> xvec"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<sharp> xvec\<close> \<open>x \<sharp> \<alpha>\<close> \<alpha>eq \<open>y \<sharp> p\<close> \<open>x \<sharp> xvec\<close> have E: "(([(x, y)] \<bullet> p) \<bullet> xvec) = p \<bullet> xvec"
     by(auto simp add: eqvts freshChainSimps)
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> yvec) = [(x, y)] \<bullet> p \<bullet> yvec"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<sharp> yvec\<close> \<open>x \<sharp> \<alpha>\<close> \<alpha>eq \<open>y \<sharp> p\<close> \<open>x \<sharp> yvec\<close> have F: "(([(x, y)] \<bullet> p) \<bullet> yvec) = p \<bullet> yvec"
     by(auto simp add: eqvts freshChainSimps)
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> x) = [(x, y)] \<bullet> p \<bullet> x"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<noteq> x\<close> \<open>y \<sharp> p\<close> have G: "(([(x, y)] \<bullet> p) \<bullet> y) = p \<bullet> x"
     apply(simp add: freshChainSimps calc_atm)
     apply(subgoal_tac "y \<noteq> p \<bullet> x")
     apply(clarsimp)
     using A \<alpha>eq
     apply(simp add: eqvts)
     apply(subst fresh_atm[symmetric])
     apply(simp only: freshChainSimps)
     by simp
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> N) = [(x, y)] \<bullet> p \<bullet> N"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<sharp> N\<close> \<open>x \<sharp> \<alpha>\<close> \<open>y \<sharp> p\<close> \<alpha>eq have H: "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> N) = p \<bullet> N"
     by(auto simp add: eqvts freshChainSimps)
   moreover have "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> P') = [(x, y)] \<bullet> p \<bullet> P'"
     by(subst perm_compose[symmetric]) simp
   with \<open>y \<sharp> P'\<close> \<open>x \<sharp> P''\<close> \<open>y \<sharp> p\<close> P'eq have I: "(([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> P') = p \<bullet> P'"
     by(auto simp add: eqvts freshChainSimps)
   from \<open>y \<sharp> p\<close> \<open>y \<noteq> x\<close> have "y \<noteq> p \<bullet> x"
     apply(subst fresh_atm[symmetric])
     apply(simp only: freshChainSimps)
     by simp
   moreover from S have "([(x, y)] \<bullet> set p) \<subseteq> [(x, y)] \<bullet> (set(xvec@x#yvec) \<times> set(p \<bullet> (xvec@x#yvec)))"
     by(simp)
   with \<open>y \<noteq> p \<bullet> x\<close> \<open>(([(x, y)] \<bullet> p) \<bullet> y) = p \<bullet> x\<close> \<open>x \<sharp> xvec\<close> \<open>y \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>y \<sharp> yvec\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> \<alpha>\<close> \<alpha>eq have 
     "set([(x, y)] \<bullet> p) \<subseteq> set(xvec@y#yvec) \<times> set(([(x, y)] \<bullet> p) \<bullet> (xvec@y#yvec))"
     by(simp add: eqvts calc_atm perm_compose)
   moreover note \<open>xvec \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>yvec \<sharp>* P\<close> \<open>xvec \<sharp>* M\<close> \<open>yvec \<sharp>* M\<close> 
                 \<open>yvec \<sharp>* C\<close>  S \<open>distinctPerm p\<close> \<open>x \<sharp> C\<close> \<open>xvec \<sharp>* C\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>yvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>x \<sharp> \<Psi>\<close>
                 \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* N\<close>
                  A B C  \<alpha>eq \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>y \<sharp> \<Psi>\<close> \<open>y \<noteq> x\<close> \<open>y \<sharp> P\<close> \<open>y \<sharp> M\<close> \<open>y \<sharp> \<Psi>\<^sub>P\<close> \<open>y \<sharp> C\<close> \<open>xvec \<sharp>* \<alpha>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>yvec \<sharp>* \<alpha>\<close> \<open>y \<sharp> \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>y \<sharp> A\<^sub>P\<close> \<open>y \<sharp> N\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>y \<sharp> P'\<close> \<open>A\<^sub>P \<sharp>* C\<close> P'eq
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (([(x, y)] \<bullet> p) \<bullet> (M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle>)) (([(x, y)] \<bullet> p) \<bullet> [(x, y)] \<bullet> P') (x#A\<^sub>P) \<Psi>\<^sub>P"
     apply(rule_tac \<alpha>="M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle>" in rAlpha)
     apply(assumption | simp)+
     apply(simp add: eqvts)
     apply(assumption | simp add: abs_fresh)+
     apply(simp add: fresh_left calc_atm)
     apply(assumption | simp)+
     apply(simp add: fresh_left calc_atm)
     apply(assumption | simp)+
     by(simp add: eqvts fresh_left)+
   with \<alpha>eq P'eq D E F G H I show ?case 
     by(simp add: eqvts)
 next    
  case(cScope \<Psi> P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P C \<alpha>' P'')
   note \<open>\<alpha> \<prec> (\<lparr>\<nu>x\<rparr>P') = \<alpha>' \<prec> P''\<close>
   moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* (bn \<alpha>')" by auto
   moreover note \<open>distinct (bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
   have "bn \<alpha> \<sharp>* (\<alpha> \<prec> \<lparr>\<nu>x\<rparr>P')" and "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp+
   ultimately obtain p where S: "(set p) \<subseteq> (set(bn \<alpha>)) \<times> (set(bn(p \<bullet> \<alpha>)))" and "distinctPerm p"
                         and \<alpha>Eq: "\<alpha>' = p \<bullet> \<alpha>" and P'eq: "P'' = p \<bullet> (\<lparr>\<nu>x\<rparr>P')" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>"
                         and "(bn(p \<bullet> \<alpha>)) \<sharp>* (\<lparr>\<nu>x\<rparr>P')"
     by(rule residualEq)
     
   note \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close>
   moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close>
   have "\<And>C. Prop C \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P" by(rule_tac cScope) auto
 
   moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close>
                 \<open>x \<sharp> C\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>distinct(bn \<alpha>)\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>
                 \<open>distinct A\<^sub>P\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* C\<close>
   ultimately have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) \<alpha> (\<lparr>\<nu>x\<rparr>P') (x#A\<^sub>P) \<Psi>\<^sub>P"
     by(rule_tac rScope) 
   with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>x \<sharp> \<alpha>\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>bn \<alpha> \<sharp>* (bn \<alpha>')\<close> S \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (\<lparr>\<nu>x\<rparr>P')\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<alpha>Eq \<open>x \<sharp> \<alpha>'\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> \<open>x \<sharp> \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>x \<sharp> C\<close> \<open>A\<^sub>P \<sharp>* C\<close>
   have "Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (p \<bullet> \<alpha>) (p \<bullet> (\<lparr>\<nu>x\<rparr>P'))  (x#A\<^sub>P) \<Psi>\<^sub>P" 
     by(rule_tac rAlpha) (simp add: abs_fresh)+
   with \<alpha>Eq P'eq \<open>distinctPerm p\<close> show ?case by simp
 next
   case(cBang \<Psi> P Rs A\<^sub>P \<Psi>\<^sub>P C \<alpha>)
   thus ?case by(rule_tac rBang) auto 
 qed
 
 lemma inputFrameInduct[consumes 3, case_names cAlpha cInput cCase cPar1 cPar2 cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  'a \<Rightarrow> 'a \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> name list \<Rightarrow> 'b \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     rAlpha: "\<And>\<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P p C. \<lbrakk>A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* (p \<bullet> A\<^sub>P); A\<^sub>P \<sharp>* C;
                                             set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P); distinctPerm p;
                                              Prop C \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P M N P' (p \<bullet> A\<^sub>P) (p \<bullet> \<Psi>\<^sub>P)"
   and     rInput: "\<And>\<Psi> M K xvec N Tvec P C.
                    \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N;
                     length xvec = length Tvec; xvec \<sharp>* \<Psi>;
                     xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (M\<lparr>\<lambda>*xvec N\<rparr>.P)
                               K (N[xvec::=Tvec]) (P[xvec::=Tvec]) ([]) (\<one>)"
   and     rCase: "\<And>\<Psi> P M N P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; \<And>C. Prop C \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P;
                                               (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P;  \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                                               A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (Cases Cs) M N P' ([]) (\<one>)"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P M N P' A\<^sub>P \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M N (P' \<parallel> Q) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q M N Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q M N Q' A\<^sub>Q \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M N (P \<parallel> Q') (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rScope: "\<And>\<Psi> P M N P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P; x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> N; 
                      x \<sharp> A\<^sub>P; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
                      A\<^sub>P \<sharp>* C; x \<sharp> C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M N (\<lparr>\<nu>x\<rparr>P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rBang:    "\<And>\<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; guarded P; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>;  distinct A\<^sub>P;
                       \<And>C. Prop C \<Psi> (P \<parallel> !P) M N P' A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>); \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                       A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) M N P' ([]) (\<one>)"
   shows "Prop C \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P"
 using assms
 by(nominal_induct \<Psi> P Rs=="M\<lparr>N\<rparr> \<prec> P'" A\<^sub>P \<Psi>\<^sub>P avoiding: C arbitrary: P' rule: semanticsFrameInduct)
   (auto simp add: residualInject)
 
 lemma outputFrameInduct[consumes 3, case_names cAlpha cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  'a \<Rightarrow> ('a, 'b, 'c) boundOutput \<Rightarrow> name list \<Rightarrow> 'b \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>ROut M B"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     rAlpha: "\<And>\<Psi> P M A\<^sub>P \<Psi>\<^sub>P p B C. \<lbrakk>A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* (p \<bullet> A\<^sub>P); A\<^sub>P \<sharp>* B; A\<^sub>P \<sharp>* C;
                                          set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P); distinctPerm p;
                                           Prop C \<Psi> P M B A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P M B (p \<bullet> A\<^sub>P) (p \<bullet> \<Psi>\<^sub>P)"
   and     rOutput: "\<And>\<Psi> M K N P C. \<Psi> \<turnstile> M \<leftrightarrow> K \<Longrightarrow> Prop C \<Psi> (M\<langle>N\<rangle>.P) K (N \<prec>' P) ([]) (\<one>)"
   and     rCase: "\<And>\<Psi> P M B \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>(ROut M B); extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; \<And>C. Prop C \<Psi> P M B A\<^sub>P \<Psi>\<^sub>P;
                                             (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P;  \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                                             A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* B; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (Cases Cs) M B ([]) (\<one>)"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P') A\<^sub>P \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* xvec; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* Q; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P' \<parallel> Q)) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q M xvec N Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' Q') A\<^sub>Q \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* xvec; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* Q; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rOpen: "\<And>\<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P M (\<lparr>\<nu>*(xvec@yvec)\<rparr>N \<prec>' P') A\<^sub>P \<Psi>\<^sub>P; x \<in> supp N; x \<sharp> \<Psi>; x \<sharp> M;
                      x \<sharp> A\<^sub>P; x \<sharp> xvec; x \<sharp> yvec; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P';
                      A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* yvec;
                      xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P; 
                      yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; A\<^sub>P \<sharp>* C; x \<sharp> C; xvec \<sharp>* C; yvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M (\<lparr>\<nu>*(xvec@x#yvec)\<rparr>N \<prec>' P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rScope: "\<And>\<Psi> P M xvec N P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P') A\<^sub>P \<Psi>\<^sub>P;
                      x \<sharp> \<Psi>; x \<sharp> M; x \<sharp> xvec; x \<sharp> N; x \<sharp> A\<^sub>P; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P;
                      A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* xvec;
                      xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* \<Psi>\<^sub>P;
                      A\<^sub>P \<sharp>* C; x \<sharp> C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (\<lparr>\<nu>x\<rparr>P')) (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rBang:    "\<And>\<Psi> P M B A\<^sub>P \<Psi>\<^sub>P C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>ROut M B; guarded P; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                       \<And>C. Prop C \<Psi> (P \<parallel> !P) M B A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>); \<Psi>\<^sub>P \<simeq> \<one>; supp \<Psi>\<^sub>P = ({}::name set);
                       A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) M B ([]) (\<one>)"
   shows "Prop C \<Psi> P M B A\<^sub>P \<Psi>\<^sub>P"
 proof -
   {
     fix B
     assume "\<Psi> \<rhd> P \<longmapsto>ROut M B"
     hence "Prop C \<Psi> P M B A\<^sub>P \<Psi>\<^sub>P" using FrP \<open>distinct A\<^sub>P\<close>
     proof(nominal_induct \<Psi> P Rs=="ROut M B" A\<^sub>P \<Psi>\<^sub>P avoiding: C arbitrary: B rule: semanticsFrameInduct)
       case cAlpha
       thus ?case by(fastforce intro: rAlpha) 
     next
       case cInput 
       thus ?case by(simp add: residualInject)
     next
       case cOutput
       thus ?case by(force intro: rOutput simp add: residualInject)
     next
       case cCase
       thus ?case by(force intro: rCase simp add: residualInject)
     next
       case cPar1
       thus ?case
         by(fastforce intro: rPar1 simp add: residualInject)
     next
       case cPar2
       thus ?case
         by(fastforce intro: rPar2 simp add: residualInject)
     next
       case cComm1
       thus ?case by(simp add: residualInject)
     next
       case cComm2
       thus ?case by(simp add: residualInject)
     next
       case cOpen
       thus ?case by(fastforce intro: rOpen simp add: residualInject)
     next
       case cScope
       thus ?case by(force intro: rScope simp add: residualInject)
     next
       case cBang
       thus ?case by(force intro: rBang simp add: residualInject)
     qed
   }
   with Trans show ?thesis by(simp add: residualInject)
 qed
 
 lemma tauFrameInduct[consumes 3, case_names cAlpha cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                  ('a, 'b, 'c) psi \<Rightarrow> name list \<Rightarrow> 'b \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     rAlpha: "\<And>\<Psi> P P' A\<^sub>P \<Psi>\<^sub>P p C. \<lbrakk>A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* (p \<bullet> A\<^sub>P); A\<^sub>P \<sharp>* C;
                                         set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P); distinctPerm p;
                                          Prop C \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P\<rbrakk> \<Longrightarrow> Prop C \<Psi> P P' (p \<bullet> A\<^sub>P) (p \<bullet> \<Psi>\<^sub>P)"
   and     rCase: "\<And>\<Psi> P P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P; \<And>C. Prop C \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P;
                                           (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P;  \<Psi>\<^sub>P \<simeq> \<one>; (supp \<Psi>\<^sub>P) = ({}::name set);
                                           A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (Cases Cs) P' ([]) (\<one>)"
   and     rPar1: "\<And>\<Psi> \<Psi>\<^sub>Q P P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<tau> \<prec> P';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>Q) P P' A\<^sub>P \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (P' \<parallel> Q) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rPar2: "\<And>\<Psi> \<Psi>\<^sub>P Q Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<tau> \<prec> Q';
                    extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                    extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                    \<And>C. Prop C (\<Psi> \<otimes> \<Psi>\<^sub>P) Q Q' A\<^sub>Q \<Psi>\<^sub>Q; 
                    A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;
                    A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                    A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow>
                    Prop C \<Psi> (P \<parallel> Q) (P \<parallel> Q') (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm1: "\<And>\<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rComm2: "\<And>\<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C.
                    \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
                     A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* P'; 
                     A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; 
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* Q';
                     A\<^sub>Q \<sharp>* xvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; 
                     xvec \<sharp>* Q; xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> Q) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) (A\<^sub>P@A\<^sub>Q) (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)"
   and     rScope: "\<And>\<Psi> P P' x A\<^sub>P \<Psi>\<^sub>P C.
                     \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<And>C. Prop C \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P; x \<sharp> \<Psi>;
                      x \<sharp> A\<^sub>P; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* P';
                      A\<^sub>P \<sharp>* C; x \<sharp> C\<rbrakk> \<Longrightarrow>
                      Prop C \<Psi> (\<lparr>\<nu>x\<rparr>P) (\<lparr>\<nu>x\<rparr>P') (x#A\<^sub>P) \<Psi>\<^sub>P"
   and     rBang:    "\<And>\<Psi> P P' A\<^sub>P \<Psi>\<^sub>P C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<tau> \<prec> P'; guarded P; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>;  distinct A\<^sub>P;
                       \<And>C. Prop C \<Psi> (P \<parallel> !P) P' A\<^sub>P (\<Psi>\<^sub>P \<otimes> \<one>); \<Psi>\<^sub>P \<simeq> \<one>; supp \<Psi>\<^sub>P = ({}::name set);
                       A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) P' ([]) (\<one>)"
   shows "Prop C \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P"
 using Trans FrP \<open>distinct A\<^sub>P\<close>
 proof(nominal_induct \<Psi> P Rs=="\<tau> \<prec> P'" A\<^sub>P \<Psi>\<^sub>P avoiding: C arbitrary: P' rule: semanticsFrameInduct)
   case cAlpha
   thus ?case by(force intro: rAlpha simp add: residualInject)
 next
   case cInput 
   thus ?case by(simp add: residualInject)
 next
   case cOutput
   thus ?case by(simp add: residualInject)
 next
   case cCase
   thus ?case by(force intro: rCase simp add: residualInject)
 next
   case cPar1
   thus ?case by(force intro: rPar1 simp add: residualInject)
 next
   case cPar2
   thus ?case by(force intro: rPar2 simp add: residualInject)
 next
   case cComm1
   thus ?case by(force intro: rComm1 simp add: residualInject)
 next
   case cComm2
   thus ?case by(force intro: rComm2 simp add: residualInject)
 next
   case cOpen
   thus ?case by(simp add: residualInject)
 next
   case cScope
   thus ?case by(force intro: rScope simp add: residualInject)
 next
   case cBang
   thus ?case by(force intro: rBang simp add: residualInject)
 qed
 
 lemma inputFreshDerivative:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "x \<sharp> P"
   and     "x \<sharp> N"
 
   shows "x \<sharp> P'"
 proof -
   have "bn(M\<lparr>N\<rparr>) \<sharp>* subject(M\<lparr>N\<rparr>)" and "distinct(bn(M\<lparr>N\<rparr>))" by simp+
   with \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> show ?thesis using \<open>x \<sharp> P\<close> \<open>x \<sharp> N\<close>
   proof(nominal_induct \<Psi> P \<alpha>=="M\<lparr>N\<rparr>" P' avoiding: x rule: semanticsInduct)
     case(cAlpha \<Psi> P \<alpha> P' p x)
     thus ?case by simp
   next
     case(cInput \<Psi> M' K xvec N' Tvec P x)
     from \<open>K\<lparr>(N'[xvec::=Tvec])\<rparr> = M\<lparr>N\<rparr>\<close> have "M = K" and NeqN': "N = N'[xvec::=Tvec]" by(simp add: action.inject)+ 
     note \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close> then
     moreover have "x \<sharp> Tvec" using \<open>set xvec \<subseteq> supp N'\<close> \<open>x \<sharp> N\<close> NeqN'
       by(blast intro: substTerm.subst3)
     moreover from \<open>xvec \<sharp>* x\<close> \<open>x \<sharp> M'\<lparr>\<lambda>*xvec N'\<rparr>.P\<close>
     have "x \<sharp> P" by(simp add: inputChainFresh) (simp add: name_list_supp fresh_def)
     ultimately show ?case using \<open>xvec \<sharp>* x\<close> by auto
   next
     case(cOutput \<Psi> M  K N P x)
     thus ?case by simp
   next
     case(cCase \<Psi> P P' \<phi> Cs x)
     thus ?case by(induct Cs, auto)
   next
     case(cPar1 \<Psi> \<Psi>\<^sub>Q P P' xvec Q x)
     thus ?case by simp
   next
     case(cPar2 \<Psi> \<Psi>\<^sub>P Q Q' xvec P x)
     thus ?case by simp
   next
     case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q x)
     thus ?case by simp
   next
     case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xwec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q x)
     thus ?case by simp
   next
     case(cOpen \<Psi> P M xvec yvec N P' x y)
     thus ?case by simp
   next
     case(cScope \<Psi> P P' x y)
     thus ?case by(simp add: abs_fresh)
   next
     case(cBang \<Psi> P P' x)
     thus ?case by simp
   qed
 qed
   
 lemma inputFreshChainDerivative:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   xvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "xvec \<sharp>* P"
   and     "xvec \<sharp>* N"
   
   shows "xvec \<sharp>* P'"
 using assms
 by(induct xvec)
   (auto intro: inputFreshDerivative)
 
 lemma outputFreshDerivative:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   x    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     "distinct xvec"
   and     "x \<sharp> P"
   and     "x \<sharp> xvec"
 
   shows "x \<sharp> N"
   and   "x \<sharp> P'"
 proof -
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   moreover from \<open>xvec \<sharp>* M\<close> have "bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) \<sharp>* subject(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)" by simp
   moreover from \<open>distinct xvec\<close> have "distinct(bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>))" by simp
   ultimately show "x \<sharp> N" using \<open>x \<sharp> P\<close> \<open>x \<sharp> xvec\<close>
   proof(nominal_induct \<Psi> P \<alpha>=="M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" P' avoiding: x arbitrary: M xvec N rule: semanticsInduct)
     case(cAlpha \<Psi> P \<alpha> P' p x M xvec N)
     have S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" by fact
     from \<open>(p \<bullet> \<alpha>) = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> have "(p \<bullet> p \<bullet> \<alpha>) = p \<bullet> (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)" by(simp add: fresh_star_bij)
     with \<open>distinctPerm p\<close> have "\<alpha>  = (p \<bullet> M)\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle>" by simp
     moreover from \<open>(p \<bullet> \<alpha>) = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> \<open>x \<sharp> xvec\<close> have "x \<sharp> (bn(p \<bullet> \<alpha>))" by simp
     with \<open>(bn \<alpha>) \<sharp>* x\<close> \<open>x \<sharp> xvec\<close> S have "x \<sharp> (p \<bullet> xvec)"
       by(drule_tac pt_fresh_bij1[OF pt_name_inst, OF at_name_inst, where pi=p and x=xvec]) simp
     ultimately have "x \<sharp> (p \<bullet> N)" using \<open>x \<sharp> P\<close> by(rule_tac cAlpha)
     hence "(p \<bullet> x) \<sharp> (p \<bullet> p \<bullet> N)" by(simp add: pt_fresh_bij1[OF pt_name_inst, OF at_name_inst])
     with \<open>distinctPerm p\<close> \<open>bn(\<alpha>) \<sharp>* x\<close> \<open>x \<sharp> (bn(p \<bullet> \<alpha>))\<close>S show ?case by simp
   next
     case cInput
     thus ?case by simp
   next
     case cOutput
     thus ?case by(simp add: action.inject)
   next
     case cCase
     thus ?case
       by(rule_tac cCase) (auto dest: memFresh)
   next
     case cPar1
     thus ?case by simp
   next
     case cPar2
     thus ?case by simp
   next
     case cComm1
     thus ?case by simp
   next
     case cComm2
     thus ?case by simp
   next
     case(cOpen \<Psi> P M xvec yvec N P' x y M' zvec N')
     from \<open>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> = M'\<lparr>\<nu>*zvec\<rparr>\<langle>N'\<rangle>\<close> have "zvec = xvec@x#yvec" and "N = N'"
       by(simp add: action.inject)+
     from \<open>y \<sharp> \<lparr>\<nu>x\<rparr>P\<close> \<open>x \<sharp> y\<close>  have "y \<sharp> P" by(simp add: abs_fresh)
     moreover from \<open>y \<sharp> zvec\<close> \<open>zvec = xvec@x#yvec\<close>have "y \<sharp> (xvec@yvec)"
       by simp
     ultimately have "y \<sharp> N" by(rule_tac cOpen) auto
     with \<open>N = N'\<close> show ?case by simp
   next
     case cScope
     thus ?case by(auto simp add: abs_fresh)
   next
     case cBang
     thus ?case by simp
   qed
 next
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   moreover from \<open>xvec \<sharp>* M\<close> have "bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) \<sharp>* subject(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)" by simp
   moreover from \<open>distinct xvec\<close> have "distinct(bn(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>))" by simp
   ultimately show "x \<sharp> P'" using \<open>x \<sharp> P\<close> \<open>x \<sharp> xvec\<close>
   proof(nominal_induct \<Psi> P \<alpha>=="M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" P' avoiding: x arbitrary: M xvec N rule: semanticsInduct)
     case(cAlpha \<Psi> P \<alpha> P' p x M xvec N)
     have S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" by fact
     from \<open>(p \<bullet> \<alpha>) = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> have "(p \<bullet> p \<bullet> \<alpha>) = p \<bullet> (M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>)" by(simp add: fresh_star_bij)
     with \<open>distinctPerm p\<close> have "\<alpha>  = (p \<bullet> M)\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle>" by simp
     moreover from \<open>(p \<bullet> \<alpha>) = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> \<open>x \<sharp> xvec\<close> have "x \<sharp> (bn(p \<bullet> \<alpha>))" by simp
     with \<open>(bn \<alpha>) \<sharp>* x\<close> \<open>x \<sharp> xvec\<close> S have "x \<sharp> (p \<bullet> xvec)"
       by(drule_tac pt_fresh_bij1[OF pt_name_inst, OF at_name_inst, where pi=p and x=xvec]) simp
     ultimately have "x \<sharp> P'" using \<open>x \<sharp> P\<close> by(rule_tac cAlpha)
     hence "(p \<bullet> x) \<sharp> (p \<bullet> P')" by(simp add: pt_fresh_bij1[OF pt_name_inst, OF at_name_inst])
     with \<open>distinctPerm p\<close> \<open>bn(\<alpha>) \<sharp>* x\<close> \<open>x \<sharp> (bn(p \<bullet> \<alpha>))\<close>S show ?case by simp
   next
     case cInput
     thus ?case by simp
   next
     case cOutput
     thus ?case by(simp add: action.inject)
   next
     case cCase
     thus ?case by(fastforce simp add: action.inject dest: memFresh)
   next
     case cPar1
     thus ?case by simp
   next
     case cPar2
     thus ?case by simp
   next
     case cComm1
     thus ?case by simp
   next
     case cComm2
     thus ?case by simp
   next
     case(cOpen \<Psi> P M xvec yvec N P' x y M' zvec N')
     from \<open>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> = M'\<lparr>\<nu>*zvec\<rparr>\<langle>N'\<rangle>\<close> have "zvec = xvec@x#yvec" 
       by(simp add: action.inject)
     from \<open>y \<sharp> \<lparr>\<nu>x\<rparr>P\<close> \<open>x \<sharp> y\<close>  have "y \<sharp> P" by(simp add: abs_fresh)
     moreover from \<open>y \<sharp> zvec\<close> \<open>zvec = xvec@x#yvec\<close>have "y \<sharp> (xvec@yvec)"
       by simp
     ultimately show "y \<sharp> P'" by(rule_tac cOpen) auto
   next
     case cScope
     thus ?case by(auto simp add: abs_fresh)
   next
     case cBang
     thus ?case by simp
   qed
 qed
 
 lemma outputFreshChainDerivative:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   yvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     "distinct xvec"
   and     "yvec \<sharp>* P"
   and     "yvec \<sharp>* xvec"
 
   shows "yvec \<sharp>* N"
   and   "yvec \<sharp>* P'"
 using assms
 by(induct yvec) (auto intro: outputFreshDerivative)
 
 lemma tauFreshDerivative:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     "x \<sharp> P"
 
   shows "x \<sharp> P'"
 proof -
   have "bn(\<tau>) \<sharp>* subject(\<tau>)" and "distinct(bn(\<tau>))" by simp+
   with \<open>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'\<close> show ?thesis using \<open>x \<sharp> P\<close>
   proof(nominal_induct \<Psi> P \<alpha>=="(\<tau>::('a action))" P' avoiding: x rule: semanticsInduct)
     case cAlpha
     thus ?case by simp
   next
     case cInput
     thus ?case by simp
   next
     case cOutput
     thus ?case by simp
   next 
     case cCase
     thus ?case by(auto dest: memFresh)
   next
     case cPar1
     thus ?case by simp
   next
     case cPar2
     thus ?case by simp
   next
     case cComm1
     thus ?case
       by(fastforce dest: inputFreshDerivative outputFreshDerivative simp add: resChainFresh)
   next
     case cComm2
     thus ?case
       by(fastforce dest: inputFreshDerivative outputFreshDerivative simp add: resChainFresh)
   next
     case cOpen
     thus ?case by simp
   next
     case cScope
     thus ?case by(simp add: abs_fresh)
   next
     case cBang
     thus ?case by simp
   qed
 qed
 
 lemma tauFreshChainDerivative:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   xvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     "xvec \<sharp>* P"
   
   shows "xvec \<sharp>* P'"
 using assms
 by(induct xvec) (auto intro: tauFreshDerivative)
 
 lemma freeFreshDerivative:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   \<alpha>  :: "'a action"
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     "x \<sharp> \<alpha>"
   and     "x \<sharp> P"
 
   shows   "x \<sharp> P'"
 using assms
 by(rule_tac actionCases[where \<alpha>=\<alpha>])
   (auto intro: inputFreshDerivative tauFreshDerivative outputFreshDerivative)
 
 lemma freeFreshChainDerivative:
   fixes \<Psi>     :: 'b
   and   P     :: "('a, 'b, 'c) psi"
   and   \<alpha>     :: "'a action"
   and   P'    :: "('a, 'b, 'c) psi"
   and   xvec  :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     "xvec \<sharp>* P"
   and     "xvec \<sharp>* \<alpha>"
 
   shows   "xvec \<sharp>* P'"
 using assms
 by(auto intro: freeFreshDerivative simp add: fresh_star_def)
 
 lemma Input:
   fixes \<Psi>    :: 'b
   and   M    :: 'a
   and   K    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   Tvec :: "'a list"
 
   assumes "\<Psi> \<turnstile> M \<leftrightarrow> K"
   and     "distinct xvec"
   and     "set xvec \<subseteq> supp N"
   and     "length xvec = length Tvec"
 
   shows "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>K\<lparr>N[xvec::=Tvec]\<rparr> \<prec> P[xvec::=Tvec]"
 proof -
   obtain p where xvecFreshPsi: "((p::name prm) \<bullet> (xvec::name list)) \<sharp>* \<Psi>"
              and xvecFreshM: "(p \<bullet> xvec) \<sharp>* M"
              and xvecFreshN: "(p \<bullet> xvec) \<sharp>* N"
              and xvecFreshK: "(p \<bullet> xvec) \<sharp>* K"
              and xvecFreshTvec: "(p \<bullet> xvec) \<sharp>* Tvec"
              and xvecFreshP: "(p \<bullet> xvec) \<sharp>* P"
              and S: "(set p) \<subseteq> (set xvec) \<times> (set(p \<bullet> xvec))"
              and dp: "distinctPerm p"
     by(rule_tac xvec=xvec and c="(\<Psi>, M, K, N, P, Tvec)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)  
   note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close>
   moreover from \<open>distinct xvec\<close> have "distinct(p \<bullet> xvec)"
     by simp
   moreover from \<open>(set xvec) \<subseteq> (supp N)\<close> have "(p \<bullet> (set xvec)) \<subseteq> (p \<bullet> (supp N))"
     by simp
   hence "set(p \<bullet> xvec) \<subseteq> supp(p \<bullet> N)"
     by(simp add: eqvts)
   moreover from \<open>length xvec = length Tvec\<close> have "length(p \<bullet> xvec) = length Tvec"
     by simp
   ultimately have "\<Psi> \<rhd> M\<lparr>\<lambda>*(p \<bullet> xvec) (p \<bullet> N)\<rparr>.(p \<bullet> P) \<longmapsto>K\<lparr>(p \<bullet> N)[(p \<bullet> xvec)::=Tvec]\<rparr> \<prec> (p \<bullet> P)[(p \<bullet> xvec)::=Tvec]"
     using xvecFreshPsi xvecFreshM xvecFreshK xvecFreshTvec
     by(rule_tac cInput)
   thus ?thesis using xvecFreshN xvecFreshP S \<open>length xvec = length Tvec\<close> dp
     by(auto simp add: inputChainAlpha' substTerm.renaming renaming)
 qed
 
 lemma residualAlpha:
   fixes p :: "name prm"
   and   \<alpha> :: "'a action"
   and   P :: "('a, 'b, 'c) psi"
 
   assumes "bn(p \<bullet> \<alpha>) \<sharp>* object  \<alpha>"
   and     "bn(p \<bullet> \<alpha>) \<sharp>* P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "bn(p \<bullet> \<alpha>) \<sharp>* subject \<alpha>"
   and     "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))"
 
   shows "\<alpha> \<prec> P = (p \<bullet> \<alpha>) \<prec> (p \<bullet> P)"
 using assms
 apply(rule_tac \<alpha>=\<alpha> in actionCases)
 apply(simp only: eqvts bn.simps)
 apply simp
 apply(simp add: boundOutputChainAlpha'' residualInject)
 by simp
 
 lemma Par1:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>Q   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>Q   :: "name list"
   and   Q    :: "('a, 'b, 'c) psi"
 
   assumes Trans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
   and     "bn \<alpha> \<sharp>* Q"
   and     "A\<^sub>Q \<sharp>* \<Psi>"
   and     "A\<^sub>Q \<sharp>* P"
   and     "A\<^sub>Q \<sharp>* \<alpha>"
   
   shows "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P' \<parallel> Q)"
 proof -
   {
     fix \<Psi>    :: 'b
     and \<Psi>\<^sub>Q   :: 'b
     and P    :: "('a, 'b, 'c) psi"
     and \<alpha>    :: "'a action"
     and P'   :: "('a, 'b, 'c) psi"
     and A\<^sub>Q   :: "name list"
     and Q    :: "('a, 'b, 'c) psi"
 
     assume "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
     and     "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
     and     "bn \<alpha> \<sharp>* Q"
     and     "bn \<alpha> \<sharp>* subject \<alpha>"
     and     "A\<^sub>Q \<sharp>* \<Psi>"
     and     "A\<^sub>Q \<sharp>* P"
     and     "A\<^sub>Q \<sharp>* \<alpha>"
     and     "distinct A\<^sub>Q"
   
     have  "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P' \<parallel> Q)"
     proof -
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> have "distinct(bn \<alpha>)" by(rule boundOutputDistinct)
       obtain q::"name prm" where "bn(q \<bullet> \<alpha>) \<sharp>* \<Psi>" and "bn(q \<bullet> \<alpha>) \<sharp>* P" and "bn(q \<bullet> \<alpha>) \<sharp>* Q" and "bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>"
                              and "bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>Q" and "bn(q \<bullet> \<alpha>) \<sharp>* P'" and "bn(q \<bullet> \<alpha>) \<sharp>* \<Psi>\<^sub>Q"
                              and Sq: "(set q) \<subseteq> (set (bn \<alpha>)) \<times> (set(bn(q \<bullet> \<alpha>)))"
         by(rule_tac xvec="bn \<alpha>" and c="(\<Psi>, P, Q, \<alpha>, A\<^sub>Q, \<Psi>\<^sub>Q, P')" in name_list_avoiding) (auto simp add: eqvts)
       obtain p::"name prm" where "(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>Q) \<sharp>* P" and "(p \<bullet> A\<^sub>Q) \<sharp>* Q" and "(p \<bullet> A\<^sub>Q) \<sharp>* \<alpha>" 
                               and "(p \<bullet> A\<^sub>Q) \<sharp>* \<alpha>" and "(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)" and "(p \<bullet> A\<^sub>Q) \<sharp>* P'" 
                              and "(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')" and "(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q" and Sp: "(set p) \<subseteq> (set A\<^sub>Q) \<times> (set(p \<bullet> A\<^sub>Q))"
         by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, \<alpha>, bn \<alpha>, q \<bullet> \<alpha>, P', (q \<bullet> P'), \<Psi>\<^sub>Q)" in name_list_avoiding) auto
       from \<open>distinct(bn \<alpha>)\<close> have "distinct(bn(q \<bullet> \<alpha>))" 
         by(rule_tac \<alpha>=\<alpha> in actionCases) (auto simp add: eqvts)
       from \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>Q\<close> Sq have "A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)"
         apply(rule_tac \<alpha>=\<alpha> in actionCases)
         apply(simp only: bn.simps eqvts, simp)
         apply(simp add: freshChainSimps)
         by simp
       from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "(q \<bullet> (bn \<alpha>)) \<sharp>* (q \<bullet> (subject \<alpha>))"
         by(simp add: fresh_star_bij)
       hence "bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)" by(simp add: eqvts)
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* P'\<close> \<open>bn \<alpha> \<sharp>* (subject \<alpha>)\<close> Sq
       have Trans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> P')"
         by(force simp add: residualAlpha)
       hence "A\<^sub>Q \<sharp>* (q \<bullet> P')" using  \<open>bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)\<close>
         by(auto intro: freeFreshChainDerivative)
       from Trans have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> (p \<bullet> P) \<longmapsto>p \<bullet> ((q \<bullet> \<alpha>) \<prec> (q \<bullet> P'))"
         by(rule semantics.eqvt)
       with \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> P')\<close>
            \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')\<close> Sp
       have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> P')" by(simp add: eqvts)
       moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close> Sp have  "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), (p \<bullet> \<Psi>\<^sub>Q)\<rangle>"
         by(simp add: frameChainAlpha' eqvts)
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close> Sp 
       have "(bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)"
         by(simp add: freshAlphaPerm)
       moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>Q)" by simp
       ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> ((q \<bullet> P') \<parallel> Q)"
         using \<open>(p \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close>
               \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P\<close> 
               \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* (subject (q \<bullet> \<alpha>))\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close>
         by(rule_tac cPar1)
         
       thus ?thesis using \<open>bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* P'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* Q\<close> Sq
         by(force simp add: residualAlpha) 
     qed
   }
   note Goal = this
   from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close>
   obtain A\<^sub>Q' where FrQ: "extractFrame Q = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q'" and "A\<^sub>Q' \<sharp>* \<Psi>" and "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* \<alpha>"
     by(rule_tac C="(\<Psi>, P, \<alpha>)" in distinctFrame) auto
   show ?thesis
   proof(induct rule: actionCases[where \<alpha>=\<alpha>])
     case(cInput M N)
     from Trans FrQ \<open>A\<^sub>Q' \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>\<close> \<open>distinct A\<^sub>Q'\<close> \<open>bn \<alpha> \<sharp>* Q\<close>
     show ?case using \<open>\<alpha> = M\<lparr>N\<rparr>\<close> by(force intro: Goal)
   next
     case cTau 
     from Trans FrQ \<open>A\<^sub>Q' \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>\<close> \<open>distinct A\<^sub>Q'\<close> \<open>bn \<alpha> \<sharp>* Q\<close>
     show ?case using \<open>\<alpha> = \<tau>\<close> by(force intro: Goal)
   next
     case(cOutput M xvec N)
     from \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>\<close> \<open>bn \<alpha> \<sharp>* Q\<close> have "xvec \<sharp>* A\<^sub>Q'" and "xvec \<sharp>* Q"
       by simp+
     obtain p where "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* P'" and "(p \<bullet> xvec) \<sharp>* Q"
                and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* A\<^sub>Q'" 
                and S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
       by(rule_tac xvec=xvec and c="(N, P', Q, M, A\<^sub>Q')" in name_list_avoiding) auto
     from Trans \<open>\<alpha>=M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by simp
     with \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> S
     have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> P')"
       by(simp add: boundOutputChainAlpha'' create_residual.simps)
     moreover from \<open>xvec \<sharp>* A\<^sub>Q'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>Q'\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>\<close> S
     have "A\<^sub>Q' \<sharp>* (p \<bullet> \<alpha>)" by(simp add: freshChainSimps del: actionFreshChain)
     ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> P') \<parallel> Q"
       using FrQ \<open>A\<^sub>Q' \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>distinct A\<^sub>Q'\<close> \<open>(p \<bullet> xvec) \<sharp>* Q\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>\<close>
            \<open>(p \<bullet> xvec) \<sharp>* M\<close> \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close>
       by(force intro: Goal)
     with \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>(p \<bullet> xvec) \<sharp>* Q\<close> \<open>xvec \<sharp>* Q\<close> S \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close>
     show ?case
       by(simp add: boundOutputChainAlpha'' eqvts create_residual.simps)
   qed
 qed
 
 lemma Par2:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>P   :: 'b
   and   Q    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   Q'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   P    :: "('a, 'b, 'c) psi"
 
   assumes Trans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "bn \<alpha> \<sharp>* P"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* Q"
   and     "A\<^sub>P \<sharp>* \<alpha>"
   
   shows "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P \<parallel> Q')"
 proof -
   {
     fix \<Psi>    :: 'b
     and \<Psi>\<^sub>P   :: 'b
     and Q    :: "('a, 'b, 'c) psi"
     and \<alpha>    :: "'a action"
     and Q'   :: "('a, 'b, 'c) psi"
     and A\<^sub>P   :: "name list"
     and P    :: "('a, 'b, 'c) psi"
 
     assume "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'"
     and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
     and     "bn \<alpha> \<sharp>* P"
     and     "bn \<alpha> \<sharp>* subject \<alpha>"
     and     "A\<^sub>P \<sharp>* \<Psi>"
     and     "A\<^sub>P \<sharp>* Q"
     and     "A\<^sub>P \<sharp>* \<alpha>"
     and     "distinct A\<^sub>P"
   
     have  "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> (P \<parallel> Q')"
     proof -
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> have "distinct(bn \<alpha>)" by(rule boundOutputDistinct)
       obtain q::"name prm" where "bn(q \<bullet> \<alpha>) \<sharp>* \<Psi>" and "bn(q \<bullet> \<alpha>) \<sharp>* P" and "bn(q \<bullet> \<alpha>) \<sharp>* Q" and "bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>"
                              and "bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>P" and "bn(q \<bullet> \<alpha>) \<sharp>* Q'" and "bn(q \<bullet> \<alpha>) \<sharp>* \<Psi>\<^sub>P"
                              and Sq: "(set q) \<subseteq> (set (bn \<alpha>)) \<times> (set(bn(q \<bullet> \<alpha>)))"
         by(rule_tac xvec="bn \<alpha>" and c="(\<Psi>, P, Q, \<alpha>, A\<^sub>P, \<Psi>\<^sub>P, Q')" in name_list_avoiding) (auto simp add: eqvts)
       obtain p::"name prm" where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" and "(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>" 
                               and "(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>" and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)" and "(p \<bullet> A\<^sub>P) \<sharp>* Q'" 
                               and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" 
                               and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))"
         by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, \<alpha>, q \<bullet> \<alpha>, Q', (q \<bullet> Q'), \<Psi>\<^sub>P)" in name_list_avoiding) auto
       from \<open>distinct(bn \<alpha>)\<close> have "distinct(bn(q \<bullet> \<alpha>))" 
         by(rule_tac \<alpha>=\<alpha> in actionCases) (auto simp add: eqvts)
       from \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>P\<close> Sq have "A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)"
         apply(rule_tac \<alpha>=\<alpha> in actionCases)
         apply(simp only: bn.simps eqvts, simp)
         apply(simp add: freshChainSimps)
         by simp
       from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "(q \<bullet> (bn \<alpha>)) \<sharp>* (q \<bullet> (subject \<alpha>))"
         by(simp add: fresh_star_bij)
       hence "bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)" by(simp add: eqvts)
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* Q'\<close> \<open>bn \<alpha> \<sharp>* (subject \<alpha>)\<close> Sq
       have Trans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> Q')"
         by(force simp add: residualAlpha)
       hence "A\<^sub>P \<sharp>* (q \<bullet> Q')" using  \<open>bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)\<close>
         by(auto intro: freeFreshChainDerivative)
       from Trans have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> (p \<bullet> Q) \<longmapsto>p \<bullet> ((q \<bullet> \<alpha>) \<prec> (q \<bullet> Q'))"
         by(rule semantics.eqvt)
       with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> Q')\<close>
            \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')\<close> Sp
       have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> Q')" by(simp add: eqvts)
       moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close> Sp have  "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
         by(simp add: frameChainAlpha' eqvts)
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close> Sp 
       have "(bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
         by(simp add: freshAlphaPerm)
       moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)" by simp
       ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> (P \<parallel> (q \<bullet> Q'))"
         using \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close>
               \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P\<close> 
               \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* (subject (q \<bullet> \<alpha>))\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close>
         by(rule_tac cPar2)
         
       thus ?thesis using \<open>bn(q \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* Q'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* P\<close> Sq
         by(force simp add: residualAlpha) 
     qed
   }
   note Goal = this
   from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close>
   obtain A\<^sub>P' where FrP: "extractFrame P = \<langle>A\<^sub>P', \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P'" and "A\<^sub>P' \<sharp>* \<Psi>" and "A\<^sub>P' \<sharp>* Q" and "A\<^sub>P' \<sharp>* \<alpha>"
     by(rule_tac C="(\<Psi>, Q, \<alpha>)" in distinctFrame) auto
   show ?thesis
   proof(induct rule: actionCases[where \<alpha>=\<alpha>])
     case(cInput M N)
     from Trans FrP \<open>A\<^sub>P' \<sharp>* \<Psi>\<close> \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>\<close> \<open>distinct A\<^sub>P'\<close> \<open>bn \<alpha> \<sharp>* P\<close>
     show ?case using \<open>\<alpha> = M\<lparr>N\<rparr>\<close> by(force intro: Goal)
   next
     case cTau 
     from Trans FrP \<open>A\<^sub>P' \<sharp>* \<Psi>\<close> \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>\<close> \<open>distinct A\<^sub>P'\<close> \<open>bn \<alpha> \<sharp>* P\<close>
     show ?case using \<open>\<alpha> = \<tau>\<close> by(force intro: Goal)
   next
     case(cOutput M xvec N)
     from \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>\<close> \<open>bn \<alpha> \<sharp>* P\<close> have "xvec \<sharp>* A\<^sub>P'" and "xvec \<sharp>* P"
       by simp+
     obtain p where "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* Q'" and "(p \<bullet> xvec) \<sharp>* P"
                and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* A\<^sub>P'" 
                and S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
       by(rule_tac xvec=xvec and c="(N, Q', P, M, A\<^sub>P')" in name_list_avoiding) auto
     from Trans \<open>\<alpha>=M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'" by simp
     with \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* Q'\<close> S
     have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> Q')"
       by(simp add: boundOutputChainAlpha'' create_residual.simps)
     moreover from \<open>xvec \<sharp>* A\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>\<close> S
     have "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)" by(simp add: freshChainSimps del: actionFreshChain)
     ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> P \<parallel> (p \<bullet> Q')"
       using FrP \<open>A\<^sub>P' \<sharp>* \<Psi>\<close> \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>distinct A\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>\<close>
            \<open>(p \<bullet> xvec) \<sharp>* M\<close> \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close>
       by(force intro: Goal)
     with \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* Q'\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>xvec \<sharp>* P\<close> S \<open>\<alpha> = M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close>
     show ?case
       by(simp add: boundOutputChainAlpha'' eqvts create_residual.simps)
   qed
 qed
 
 lemma Open:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   yvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   x    :: name
 
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "x \<in> supp N"
   and     "x \<sharp> \<Psi>"
   and     "x \<sharp> M"
   and     "x \<sharp> xvec"
   and     "x \<sharp> yvec"
 
   shows "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   from Trans have "distinct(xvec@yvec)" by(force dest: boundOutputDistinct)
   hence "xvec \<sharp>* yvec" by(induct xvec) auto
   
   obtain p where "(p \<bullet> yvec) \<sharp>* \<Psi>" and "(p \<bullet> yvec) \<sharp>* P"  and "(p \<bullet> yvec) \<sharp>* M"
              and "(p \<bullet> yvec) \<sharp>* yvec" and "(p \<bullet> yvec) \<sharp>* N" and "(p \<bullet> yvec) \<sharp>* P'"
              and "x \<sharp> (p \<bullet> yvec)" and "(p \<bullet> yvec) \<sharp>* xvec"
              and Sp: "(set p) \<subseteq> (set yvec) \<times> (set(p \<bullet> yvec))"
     by(rule_tac xvec=yvec and c="(\<Psi>, P, M, xvec, yvec, N, P', x)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
   obtain q where "(q \<bullet> xvec) \<sharp>* \<Psi>" and "(q \<bullet> xvec) \<sharp>* P"  and "(q \<bullet> xvec) \<sharp>* M"
              and "(q \<bullet> xvec) \<sharp>* xvec" and "(q \<bullet> xvec) \<sharp>* N" and "(q \<bullet> xvec) \<sharp>* P'"
              and "x \<sharp> (q \<bullet> xvec)" and "(q \<bullet> xvec) \<sharp>* yvec"
              and "(q \<bullet> xvec) \<sharp>* p" and "(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)"
              and Sq: "(set q) \<subseteq> (set xvec) \<times> (set(q \<bullet> xvec))"
     by(rule_tac xvec=xvec and c="(\<Psi>, P, M, xvec, yvec, p \<bullet> yvec, N, P', x, p)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
 
   note \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   moreover from \<open>(p \<bullet> yvec) \<sharp>* N\<close> \<open>(q \<bullet> xvec) \<sharp>* N\<close> \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> Sp Sq 
   have "((p@q) \<bullet> (xvec @ yvec)) \<sharp>* N" apply(simp only: eqvts) apply(simp only: pt2[OF pt_name_inst])
     by simp
   moreover from \<open>(p \<bullet> yvec) \<sharp>* P'\<close> \<open>(q \<bullet> xvec) \<sharp>* P'\<close> \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> Sp Sq 
   have "((p@q) \<bullet> (xvec @ yvec)) \<sharp>* P'" by(simp del: freshAlphaPerm add: eqvts pt2[OF pt_name_inst])
   moreover from Sp Sq \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close>
   have Spq: "set(p@q) \<subseteq> set(xvec@yvec) \<times> set((p@q) \<bullet> (xvec@yvec))"
     by(simp add: pt2[OF pt_name_inst] eqvts) blast
   ultimately have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*((p@q) \<bullet> (xvec@yvec))\<rparr>\<langle>((p@q) \<bullet> N)\<rangle> \<prec> ((p@q) \<bullet> P')"
     apply(simp add: create_residual.simps)
     by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)
 
   with  Sp Sq \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close>
   have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*((q \<bullet> xvec)@(p \<bullet> yvec))\<rparr>\<langle>((p@q) \<bullet> N)\<rangle> \<prec> ((p@q) \<bullet> P')"
     by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
   moreover from \<open>x \<in> supp N\<close> have "((p@q) \<bullet> x) \<in> (p@q) \<bullet> (supp N)"
     by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> Sp Sq
   have "x \<in> supp((p@q)\<bullet> N)" by(simp add: eqvts pt2[OF pt_name_inst])
   moreover from \<open>distinct(xvec@yvec)\<close> have "distinct(q \<bullet> xvec)" and "distinct(p \<bullet> yvec)"
     by auto
   moreover note \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> \<Psi>\<close> 
                 \<open>(q \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(q \<bullet> xvec) \<sharp>* P\<close> \<open>(q \<bullet> xvec) \<sharp>* M\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close>
                 \<open>(p \<bullet> yvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> yvec) \<sharp>* P\<close> \<open>(p \<bullet> yvec) \<sharp>* M\<close> \<open>distinct(q \<bullet> xvec)\<close>
   ultimately have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*((q \<bullet> xvec)@x#(p \<bullet> yvec))\<rparr>\<langle>((p@q) \<bullet> N)\<rangle> \<prec> ((p@q) \<bullet> P')"
     by(rule_tac cOpen) 
   with \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close>
        \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> Sp Sq
   have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*((p@q) \<bullet> (xvec@x#yvec))\<rparr>\<langle>((p@q) \<bullet> N)\<rangle> \<prec> ((p@q) \<bullet> P')"
     by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
   thus ?thesis using \<open>((p@q) \<bullet> (xvec @ yvec)) \<sharp>* N\<close> \<open>((p@q) \<bullet> (xvec @ yvec)) \<sharp>* P'\<close> Spq
     apply(simp add: create_residual.simps)
     by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)
 qed
 
 lemma Scope:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   x    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "x \<sharp> \<Psi>"
   and     "x \<sharp> \<alpha>"
 
   shows "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>\<alpha> \<prec> \<lparr>\<nu>x\<rparr>P'"
 proof -
   {
     fix \<Psi> P M xvec N P' x
 
     assume "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     and    "(x::name) \<sharp> \<Psi>"
     and    "x \<sharp> M"
     and    "x \<sharp> xvec"
     and    "x \<sharp> N"
 
     obtain p::"name prm" where "(p \<bullet> xvec) \<sharp>* \<Psi>" and "(p \<bullet> xvec) \<sharp>* P" and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* xvec" 
                            and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* P'" and "x \<sharp> (p \<bullet> xvec)"
                            and S: "(set p) \<subseteq> (set xvec) \<times> (set(p \<bullet> xvec))"
       by(rule_tac xvec=xvec and c="(\<Psi>, P, M, xvec, N, P', x)" in name_list_avoiding)
         (auto simp add: eqvts fresh_star_prod)
     from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> S
     have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> P')"
       by(simp add: boundOutputChainAlpha'' create_residual.simps)
     moreover hence "distinct(p \<bullet> xvec)" by(force dest: boundOutputDistinct)
     moreover note \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> (p \<bullet> xvec)\<close>
     moreover from \<open>x \<sharp> xvec\<close> \<open>x \<sharp> p \<bullet> xvec\<close> \<open>x \<sharp> N\<close> S have "x \<sharp> (p \<bullet> N)"
       by(simp add: fresh_left del: freshAlphaSwap)
     ultimately have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> \<lparr>\<nu>x\<rparr>(p \<bullet> P')" using \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>(p \<bullet> xvec) \<sharp>* M\<close>
       by(rule_tac cScope) auto
     moreover from \<open>x \<sharp> xvec\<close> \<open>x \<sharp> p \<bullet> xvec\<close> S have "p \<bullet> x = x" by simp
     ultimately have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*(p \<bullet> xvec)\<rparr>\<langle>(p \<bullet> N)\<rangle> \<prec> (p \<bullet> (\<lparr>\<nu>x\<rparr>P'))" by simp
     moreover from \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> (p \<bullet> xvec)\<close> have "(p \<bullet> xvec) \<sharp>* \<lparr>\<nu>x\<rparr>P'" 
       by(simp add: abs_fresh_star)
     ultimately have"\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> \<lparr>\<nu>x\<rparr>P'" using \<open>(p \<bullet> xvec) \<sharp>* N\<close> S
       by(simp add: boundOutputChainAlpha'' create_residual.simps)
   }
   note Goal = this
   show ?thesis
   proof(induct rule: actionCases[where \<alpha>=\<alpha>])
     case(cInput M N)
     with assms show ?case by(force intro: cScope)
   next
     case(cOutput M xvec N)
     with assms show ?case by(force intro: Goal)
   next
     case cTau
     with assms show ?case by(force intro: cScope)
   qed
 qed
 
 lemma inputSwapFrameSubject:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
   and   y  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
 
   shows "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto> ([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
 using assms
 proof(nominal_induct avoiding: x y rule: inputInduct)
   case(cInput \<Psi> M K xvec N Tvec P x y)
   from \<open>x \<sharp> M\<lparr>\<lambda>*xvec N\<rparr>.P\<close> have "x \<sharp> M" by simp
   from \<open>y \<sharp> M\<lparr>\<lambda>*xvec N\<rparr>.P\<close> have "y \<sharp> M" by simp
   from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> ([(x, y)] \<bullet> M) \<leftrightarrow> ([(x, y)] \<bullet> K)"
     by(rule chanEqClosed)
   with \<open>x \<sharp> M\<close> \<open>y \<sharp> M\<close>  have "([(x, y)] \<bullet> \<Psi>) \<turnstile> M \<leftrightarrow> ([(x, y)] \<bullet> K)"
     by(simp)
   thus ?case using \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
     by(rule Input)
 next
   case(cCase \<Psi> P M N P' \<phi> Cs x y)
   from \<open>x \<sharp> Cases Cs\<close> \<open>y \<sharp> Cases Cs\<close> \<open>(\<phi>, P) mem Cs\<close> have "x \<sharp> \<phi>" and "x \<sharp> P" and "y \<sharp> \<phi>" and "y \<sharp> P"
     by(auto dest: memFresh)
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> have "([(x ,y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto> ([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'" by(rule cCase)
   moreover note \<open>(\<phi>, P) mem Cs\<close>
   moreover from \<open>\<Psi> \<turnstile> \<phi>\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> ([(x, y)] \<bullet> \<phi>)" by(rule statClosed)
   with \<open>x \<sharp> \<phi>\<close> \<open>y \<sharp> \<phi>\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> \<phi>" by simp
   ultimately show ?case using \<open>guarded P\<close> by(rule Case)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>Q Q x y)
   from \<open>x \<sharp> P \<parallel> Q\<close> have "x \<sharp> P" and "x \<sharp> Q" by simp+
   from \<open>y \<sharp> P \<parallel> Q\<close> have "y \<sharp> P" and "y \<sharp> Q" by simp+
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> P; y \<sharp> P\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<otimes> ([(x, y)] \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
     by(simp add: eqvts)
 
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> have "([(x, y)] \<bullet> (extractFrame Q)) = ([(x, y)] \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>)"
     by simp
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>x \<sharp> Q\<close> \<open>A\<^sub>Q \<sharp>* y\<close> \<open>y \<sharp> Q\<close> have "\<langle>A\<^sub>Q, ([(x, y)] \<bullet> \<Psi>\<^sub>Q)\<rangle> = extractFrame Q"
     by(simp add: eqvts)
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> have "([(x, y)] \<bullet> A\<^sub>Q) \<sharp>* ([(x, y)] \<bullet> \<Psi>)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>A\<^sub>Q \<sharp>* y\<close> have "A\<^sub>Q \<sharp>* ([(x, y)] \<bullet> \<Psi>)" by simp
   moreover from \<open>A\<^sub>Q \<sharp>* M\<close> have "([(x, y)] \<bullet> A\<^sub>Q) \<sharp>* ([(x, y)] \<bullet> M)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>A\<^sub>Q \<sharp>* y\<close> have "A\<^sub>Q \<sharp>* ([(x, y)] \<bullet> M)" by simp
   ultimately show ?case using \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* N\<close>
     by(rule_tac Par1) auto
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q M N Q' A\<^sub>P P x y)
   from \<open>x \<sharp> P \<parallel> Q\<close> have "x \<sharp> P" and "x \<sharp> Q" by simp+
   from \<open>y \<sharp> P \<parallel> Q\<close> have "y \<sharp> P" and "y \<sharp> Q" by simp+
   from \<open>x \<sharp> Q\<close> \<open>y \<sharp> Q\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> Q; y \<sharp> Q\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> Q'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<otimes> ([(x, y)] \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> Q'"
     by(simp add: eqvts)
 
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> have "([(x, y)] \<bullet> (extractFrame P)) = ([(x, y)] \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>)"
     by simp
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>x \<sharp> P\<close> \<open>A\<^sub>P \<sharp>* y\<close> \<open>y \<sharp> P\<close> have "\<langle>A\<^sub>P, ([(x, y)] \<bullet> \<Psi>\<^sub>P)\<rangle> = extractFrame P"
     by(simp add: eqvts)
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<close> have "([(x, y)] \<bullet> A\<^sub>P) \<sharp>* ([(x, y)] \<bullet> \<Psi>)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>A\<^sub>P \<sharp>* y\<close> have "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> \<Psi>)" by simp
   moreover from \<open>A\<^sub>P \<sharp>* M\<close> have "([(x, y)] \<bullet> A\<^sub>P) \<sharp>* ([(x, y)] \<bullet> M)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>A\<^sub>P \<sharp>* y\<close> have "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> M)" by simp
   ultimately show ?case using \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* N\<close>
     by(rule_tac Par2) auto
 next
   case(cScope \<Psi> P M N P' z x y)
   from \<open>x \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> x\<close> have "x \<sharp> P" by(simp add: abs_fresh)
   from \<open>y \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> y\<close> have "y \<sharp> P" by(simp add: abs_fresh)
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> P; y \<sharp> P\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'" by simp
   moreover with \<open>z \<sharp> \<Psi>\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> \<Psi>"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> \<Psi>" by simp
   moreover with \<open>z \<sharp> M\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> M"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> M" by simp
   ultimately show ?case using \<open>z \<sharp> N\<close>
     by(rule_tac Scope) (assumption | simp)+
 next
   case(cBang \<Psi> P M N P' x y)
   thus ?case by(force intro: Bang)
 qed
 
 lemma inputPermFrameSubject:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   p  :: "name prm"
   and   Xs :: "name set"
   and   Ys :: "name set"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     S: "set p \<subseteq> Xs \<times> Ys"
   and     "Xs \<sharp>* P"
   and     "Ys \<sharp>* P"
 
   shows "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto> (p \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
 using S
 proof(induct p)
   case Nil
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close>
   show ?case by simp
 next
   case(Cons a p)
   from \<open>set(a#p) \<subseteq> Xs \<times> Ys\<close> have "set p \<subseteq> Xs \<times> Ys" by auto
   with \<open>set p \<subseteq> Xs \<times> Ys \<Longrightarrow> (p \<bullet> \<Psi>) \<rhd> P \<longmapsto> (p \<bullet> M)\<lparr>N\<rparr> \<prec> P'\<close>
   have Trans: "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto> (p \<bullet> M)\<lparr>N\<rparr> \<prec> P'" by simp
   from \<open>set(a#p) \<subseteq> Xs \<times> Ys\<close> show ?case
   proof(cases a, clarsimp)
     fix a b
     assume "a \<in> Xs" and "b \<in> Ys"
     with \<open>Xs \<sharp>* P\<close> \<open>Ys \<sharp>* P\<close>
     have "a \<sharp> P" and "b \<sharp> P"
       by(auto simp add: fresh_star_def)
     with Trans show "([(a, b)] \<bullet> p \<bullet> \<Psi>) \<rhd> P \<longmapsto> ([(a, b)] \<bullet> p \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
       by(rule inputSwapFrameSubject)
   qed  
 qed
 
 lemma inputSwapSubject:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
   and   y  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
   and     "x \<sharp> \<Psi>"
   and     "y \<sharp> \<Psi>"
 
   shows "\<Psi> \<rhd> P \<longmapsto> ([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
     by(rule inputSwapFrameSubject)
   with \<open>x \<sharp> \<Psi>\<close> \<open>y \<sharp> \<Psi>\<close> show ?thesis
     by simp
 qed
 
 lemma inputPermSubject:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   p  :: "name prm"
   and   Xs :: "name set"
   and   Ys :: "name set"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     S: "set p \<subseteq> Xs \<times> Ys"
   and     "Xs \<sharp>* P"
   and     "Ys \<sharp>* P"
   and     "Xs \<sharp>* \<Psi>"
   and     "Ys \<sharp>* \<Psi>"
 
   shows "\<Psi> \<rhd> P \<longmapsto> (p \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> S \<open>Xs \<sharp>* P\<close> \<open>Ys \<sharp>* P\<close>
   have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
     by(rule inputPermFrameSubject)
   with \<open>Xs \<sharp>* \<Psi>\<close> \<open>Ys \<sharp>* \<Psi>\<close> S show ?thesis
     by simp
 qed
 
 lemma inputSwapFrame:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   x  :: name
   and   y  :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
   and     "x \<sharp> M"
   and     "y \<sharp> M"
 
   shows "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto> M\<lparr>N\<rparr> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
     by(rule inputSwapFrameSubject)
   with \<open>x \<sharp> M\<close> \<open>y \<sharp> M\<close> show ?thesis
     by simp
 qed
 
 lemma inputPermFrame:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   p  :: "name prm"
   and   Xs :: "name set"
   and   Ys :: "name set"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     S: "set p \<subseteq> Xs \<times> Ys"
   and     "Xs \<sharp>* P"
   and     "Ys \<sharp>* P"
   and     "Xs \<sharp>* M"
   and     "Ys \<sharp>* M"
 
   shows "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto> M\<lparr>N\<rparr> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> S \<open>Xs \<sharp>* P\<close> \<open>Ys \<sharp>* P\<close>
   have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>N\<rparr> \<prec> P'"
     by(rule inputPermFrameSubject)
   with \<open>Xs \<sharp>* M\<close> \<open>Ys \<sharp>* M\<close> S show ?thesis
     by simp
 qed
 
 lemma inputAlpha:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   p    :: "name prm"
   and   xvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "set p \<subseteq> (set xvec) \<times> (set (p \<bullet> xvec))"
   and     "distinctPerm p"
   and     "xvec \<sharp>* P"
   and     "(p \<bullet> xvec) \<sharp>* P"
 
   shows "\<Psi> \<rhd> P \<longmapsto>M\<lparr>(p \<bullet> N)\<rparr> \<prec> (p \<bullet> P')"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>set p \<subseteq> (set xvec) \<times> (set (p \<bullet> xvec))\<close> \<open>xvec \<sharp>* P\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close>
   have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>N\<rparr> \<prec> P'" by(rule_tac inputPermFrameSubject) auto
   hence "(p \<bullet> p \<bullet> \<Psi>) \<rhd> (p \<bullet> P) \<longmapsto>(p \<bullet> ((p \<bullet> M)\<lparr>N\<rparr> \<prec> P'))" by(rule eqvts)
   with \<open>distinctPerm p\<close> \<open>xvec \<sharp>* P\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>set p \<subseteq> (set xvec) \<times> (set (p \<bullet> xvec))\<close> 
   show ?thesis by(simp add: eqvts)
 qed
 
 lemma frameFresh[dest]:
   fixes x  :: name
   and   A\<^sub>F :: "name list"
   and   \<Psi>\<^sub>F :: 'b
 
   assumes "x \<sharp> A\<^sub>F"
   and     "x \<sharp> \<langle>A\<^sub>F, \<Psi>\<^sub>F\<rangle>"
 
   shows "x \<sharp> \<Psi>\<^sub>F"
 using assms
 by(simp add: frameResChainFresh) (simp add: fresh_def name_list_supp)
 
 lemma outputSwapFrameSubject:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   x    :: name
   and   y    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
 
   shows "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 using assms
 proof(nominal_induct avoiding: x y rule: outputInduct')
   case cAlpha
   thus ?case by(simp add: create_residual.simps boundOutputChainAlpha'')
 next
   case(cOutput \<Psi> M K N P x y)
   from \<open>x \<sharp> M\<langle>N\<rangle>.P\<close> have "x \<sharp> M" by simp
   from \<open>y \<sharp> M\<langle>N\<rangle>.P\<close> have "y \<sharp> M" by simp
   from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> ([(x, y)] \<bullet> M) \<leftrightarrow> ([(x, y)] \<bullet> K)"
     by(rule chanEqClosed)
   with \<open>x \<sharp> M\<close> \<open>y \<sharp> M\<close>  have "([(x, y)] \<bullet> \<Psi>) \<turnstile> M \<leftrightarrow> ([(x, y)] \<bullet> K)"
     by(simp)
   thus ?case by(rule Output)
 next
   case(cCase \<Psi> P M xvec N P' \<phi> Cs x y)
   from \<open>x \<sharp> Cases Cs\<close> \<open>y \<sharp> Cases Cs\<close> \<open>(\<phi>, P) mem Cs\<close> have "x \<sharp> \<phi>" and "x \<sharp> P" and "y \<sharp> \<phi>" and "y \<sharp> P"
     by(auto dest: memFresh)
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> have "([(x ,y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(rule cCase)
   moreover note \<open>(\<phi>, P) mem Cs\<close>
   moreover from \<open>\<Psi> \<turnstile> \<phi>\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> ([(x, y)] \<bullet> \<phi>)" by(rule statClosed)
   with \<open>x \<sharp> \<phi>\<close> \<open>y \<sharp> \<phi>\<close> have "([(x, y)] \<bullet> \<Psi>) \<turnstile> \<phi>" by simp
   ultimately show ?case using \<open>guarded P\<close> by(rule Case)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>Q Q x y)
   from \<open>x \<sharp> P \<parallel> Q\<close> have "x \<sharp> P" and "x \<sharp> Q" by simp+
   from \<open>y \<sharp> P \<parallel> Q\<close> have "y \<sharp> P" and "y \<sharp> Q" by simp+
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> P; y \<sharp> P\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<otimes> ([(x, y)] \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     by(simp add: eqvts)
 
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> have "([(x, y)] \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>) = ([(x, y)] \<bullet> (extractFrame Q))"
     by simp
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>x \<sharp> Q\<close> \<open>A\<^sub>Q \<sharp>* y\<close> \<open>y \<sharp> Q\<close> have "\<langle>A\<^sub>Q, ([(x, y)] \<bullet> \<Psi>\<^sub>Q)\<rangle> = extractFrame Q"
     by(simp add: eqvts)
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> have "([(x, y)] \<bullet> A\<^sub>Q) \<sharp>* ([(x, y)] \<bullet> \<Psi>)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>A\<^sub>Q \<sharp>* y\<close> have "A\<^sub>Q \<sharp>* ([(x, y)] \<bullet> \<Psi>)" by simp
   moreover from \<open>A\<^sub>Q \<sharp>* M\<close> have "([(x, y)] \<bullet> A\<^sub>Q) \<sharp>* ([(x, y)] \<bullet> M)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>Q \<sharp>* x\<close> \<open>A\<^sub>Q \<sharp>* y\<close> have "A\<^sub>Q \<sharp>* ([(x, y)] \<bullet> M)" by simp
   ultimately show ?case using \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* N\<close> \<open>xvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close>
     by(rule_tac Par1) auto
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q M xvec N Q' A\<^sub>P P x y)
   from \<open>x \<sharp> P \<parallel> Q\<close> have "x \<sharp> P" and "x \<sharp> Q" by simp+
   from \<open>y \<sharp> P \<parallel> Q\<close> have "y \<sharp> P" and "y \<sharp> Q" by simp+
   from \<open>x \<sharp> Q\<close> \<open>y \<sharp> Q\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> Q; y \<sharp> Q\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<otimes> ([(x, y)] \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'"
     by(simp add: eqvts)
 
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> have "([(x, y)] \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>) = ([(x, y)] \<bullet> (extractFrame P))"
     by simp
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>x \<sharp> P\<close> \<open>A\<^sub>P \<sharp>* y\<close> \<open>y \<sharp> P\<close> have "\<langle>A\<^sub>P, ([(x, y)] \<bullet> \<Psi>\<^sub>P)\<rangle> = extractFrame P"
     by(simp add: eqvts)
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<close> have "([(x, y)] \<bullet> A\<^sub>P) \<sharp>* ([(x, y)] \<bullet> \<Psi>)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>A\<^sub>P \<sharp>* y\<close> have "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> \<Psi>)" by simp
   moreover from \<open>A\<^sub>P \<sharp>* M\<close> have "([(x, y)] \<bullet> A\<^sub>P) \<sharp>* ([(x, y)] \<bullet> M)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>P \<sharp>* x\<close> \<open>A\<^sub>P \<sharp>* y\<close> have "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> M)" by simp
   ultimately show ?case using \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>xvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* xvec\<close>
     by(rule_tac Par2) auto
 next
   case(cOpen \<Psi> P M xvec yvec N P' z x y)
   from \<open>x \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> x\<close> have "x \<sharp> P" by(simp add: abs_fresh)
   from \<open>y \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> y\<close> have "y \<sharp> P" by(simp add: abs_fresh)
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> P; y \<sharp> P\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'" by simp
   moreover with \<open>z \<sharp> \<Psi>\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> \<Psi>"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> \<Psi>" by simp
   moreover with \<open>z \<sharp> M\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> M"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> M" by simp
   ultimately show ?case using \<open>z \<in> supp N\<close> \<open>z \<sharp> xvec\<close> \<open>z \<sharp> yvec\<close>
     by(rule_tac Open) (assumption | simp)+
 next
   case(cScope \<Psi> P M xvec N P' z x y)
   from \<open>x \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> x\<close> have "x \<sharp> P" by(simp add: abs_fresh)
   from \<open>y \<sharp> \<lparr>\<nu>z\<rparr>P\<close> \<open>z \<sharp> y\<close> have "y \<sharp> P" by(simp add: abs_fresh)
   from \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close> \<open>\<And>x y. \<lbrakk>x \<sharp> P; y \<sharp> P\<rbrakk> \<Longrightarrow> ([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by simp
   moreover with \<open>z \<sharp> \<Psi>\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> \<Psi>"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> \<Psi>" by simp
   moreover with \<open>z \<sharp> M\<close> have "([(x, y)] \<bullet> z) \<sharp> [(x, y)] \<bullet> M"
     by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>z \<sharp> x\<close> \<open>z \<sharp> y\<close> have "z \<sharp> [(x, y)] \<bullet> M" by simp
   ultimately show ?case using \<open>z \<sharp> N\<close> \<open>z \<sharp> xvec\<close>
     by(rule_tac Scope) (assumption | simp)+
 next
   case(cBang \<Psi> P M B x y)
   thus ?case by(force intro: Bang)
 qed
 
 lemma outputPermFrameSubject:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   p    :: "name prm"
   and   yvec :: "name list"
   and   zvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     S: "set p \<subseteq> set yvec \<times> set zvec"
   and     "yvec \<sharp>* P"
   and     "zvec \<sharp>* P"
 
   shows "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   {
     fix xvec N P' Xs YS
     assume "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" and "xvec \<sharp>* M" and "xvec \<sharp>* yvec" and "xvec \<sharp>* zvec"
     have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" using S
     proof(induct p)
       case Nil
       from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
       show ?case by simp
     next
       case(Cons a p)
       from \<open>set(a#p) \<subseteq> set yvec \<times> set zvec\<close> have "set p \<subseteq> set yvec \<times> set zvec" by auto
       then have Trans: "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(rule Cons)
       from \<open>set(a#p) \<subseteq> set yvec \<times> set zvec\<close> show ?case
       proof(cases a, clarsimp)
         fix x y
         note Trans
         moreover from \<open>xvec \<sharp>* yvec\<close> \<open>xvec \<sharp>* zvec\<close> \<open>set p \<subseteq> set yvec \<times> set zvec\<close> \<open>xvec \<sharp>* M\<close> have "xvec \<sharp>* (p \<bullet> M)"
           by(simp add: freshChainSimps)
         moreover assume "x \<in> set yvec" and "y \<in> set zvec"
         with \<open>yvec \<sharp>* P\<close> \<open>zvec \<sharp>* P\<close> have "x \<sharp> P" and "y \<sharp> P"
           by(auto simp add: fresh_star_def)
         ultimately show "([(x, y)] \<bullet> p \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
           by(rule outputSwapFrameSubject)
       qed
     qed
   }
   note Goal = this
   obtain q::"name prm" where "(q \<bullet> xvec) \<sharp>* yvec" and "(q \<bullet> xvec) \<sharp>* zvec" and "(q \<bullet> xvec) \<sharp>* xvec" 
                          and "(q \<bullet> xvec) \<sharp>* N" and "(q \<bullet> xvec) \<sharp>* P'" and "(q \<bullet> xvec) \<sharp>* M" 
                          and Sq: "(set q) \<subseteq> (set xvec) \<times> (set(q \<bullet> xvec))"
     by(rule_tac xvec=xvec and c="(P, xvec, yvec, zvec, N, M, P')" in name_list_avoiding) auto
   with \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(q \<bullet> xvec)\<rparr>\<langle>(q \<bullet> N)\<rangle> \<prec> (q \<bullet> P')"
     by(simp add: boundOutputChainAlpha'' residualInject)
   hence "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*(q \<bullet> xvec)\<rparr>\<langle>(q \<bullet> N)\<rangle> \<prec> (q \<bullet> P')"
     using \<open>(q \<bullet> xvec) \<sharp>* M\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* zvec\<close>
     by(rule Goal)
   with \<open>(q \<bullet> xvec) \<sharp>* N\<close> \<open>(q \<bullet> xvec) \<sharp>* P'\<close> Sq show ?thesis
     by(simp add: boundOutputChainAlpha'' residualInject)
 qed   
 
 lemma outputSwapSubject:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   x    :: name
   and   y    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
   and     "x \<sharp> \<Psi>"
   and     "y \<sharp> \<Psi>"
 
   shows "\<Psi> \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>xvec \<sharp>* M\<close> \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     by(rule outputSwapFrameSubject)
   with \<open>x \<sharp> \<Psi>\<close> \<open>y \<sharp> \<Psi>\<close> show ?thesis
     by simp
 qed
 
 lemma outputPermSubject:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   p    :: "name prm"
   and   yvec :: "name list"
   and   zvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     S: "set p \<subseteq> set yvec \<times> set zvec"
   and     "yvec \<sharp>* P"
   and     "zvec \<sharp>* P"
   and     "yvec \<sharp>* \<Psi>"
   and     "zvec \<sharp>* \<Psi>"
 
   shows "\<Psi> \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   from assms have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
    by(rule_tac outputPermFrameSubject)
   with S \<open>yvec \<sharp>* \<Psi>\<close> \<open>zvec \<sharp>* \<Psi>\<close> show ?thesis
     by simp
 qed
  
 lemma outputSwapFrame:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   x    :: name
   and   y    :: name
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "xvec \<sharp>* M"
   and     "x \<sharp> P"
   and     "y \<sharp> P"
   and     "x \<sharp> M"
   and     "y \<sharp> M"
 
   shows "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>xvec \<sharp>* M\<close> \<open>x \<sharp> P\<close> \<open>y \<sharp> P\<close>
   have "([(x, y)] \<bullet> \<Psi>) \<rhd> P \<longmapsto>([(x, y)] \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     by(rule outputSwapFrameSubject)
   with \<open>x \<sharp> M\<close> \<open>y \<sharp> M\<close> show ?thesis
     by simp
 qed
 
 lemma outputPermFrame:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   B    :: "('a, 'b, 'c) boundOutput"
   and   p    :: "name prm"
   and   yvec :: "name list"
   and   zvec :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     S: "set p \<subseteq> set yvec \<times> set zvec"
   and     "yvec \<sharp>* P"
   and     "zvec \<sharp>* P"
   and     "yvec \<sharp>* M"
   and     "zvec \<sharp>* M"
 
   shows "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 proof -
   from assms have "(p \<bullet> \<Psi>) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     by(rule_tac outputPermFrameSubject)
   with S \<open>yvec \<sharp>* M\<close> \<open>zvec \<sharp>* M\<close> show ?thesis
     by simp
 qed
 
 lemma Comm1:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>Q  :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P  :: 'b
   and   Q    :: "('a, 'b, 'c) psi"
   and   K    :: 'a
   and   xvec :: "name list"
   and   Q'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>Q   :: "name list"
   
   assumes "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'"
   and     "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* Q"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>P \<sharp>* A\<^sub>Q"
   and     "A\<^sub>Q \<sharp>* \<Psi>"
   and     "A\<^sub>Q \<sharp>* P"
   and     "A\<^sub>Q \<sharp>* Q"
   and     "A\<^sub>Q \<sharp>* K"
   and     "xvec \<sharp>* P"
 
   shows "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
 proof -
   {
     fix \<Psi>    :: 'b
     and \<Psi>\<^sub>Q  :: 'b
     and P    :: "('a, 'b, 'c) psi"
     and M    :: 'a
     and N    :: 'a
     and P'   :: "('a, 'b, 'c) psi"
     and A\<^sub>P   :: "name list"
     and \<Psi>\<^sub>P  :: 'b
     and Q    :: "('a, 'b, 'c) psi"
     and K    :: 'a
     and xvec :: "name list"
     and Q'   :: "('a, 'b, 'c) psi"
     and A\<^sub>Q   :: "name list"
  
     assume "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
     and    "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
     and    "distinct A\<^sub>P"
     and    "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'"
     and    "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
     and    "distinct A\<^sub>Q"
     and    "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
     and    "A\<^sub>P \<sharp>* \<Psi>"
     and    "A\<^sub>P \<sharp>* P"
     and    "A\<^sub>P \<sharp>* Q"
     and    "A\<^sub>P \<sharp>* M"
     and    "A\<^sub>P \<sharp>* A\<^sub>Q"
     and    "A\<^sub>Q \<sharp>* \<Psi>"
     and    "A\<^sub>Q \<sharp>* P"
     and    "A\<^sub>Q \<sharp>* Q"
     and    "A\<^sub>Q \<sharp>* K"
     and    "xvec \<sharp>* P"
 
     have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
     proof -
 
       obtain r::"name prm" where "(r \<bullet> xvec) \<sharp>* \<Psi>" and "(r \<bullet> xvec) \<sharp>* P" and "(r \<bullet> xvec) \<sharp>* Q" and "(r \<bullet> xvec) \<sharp>* M"
                              and "(r \<bullet> xvec) \<sharp>* K" and "(r \<bullet> xvec) \<sharp>* N" and "(r \<bullet> xvec) \<sharp>* A\<^sub>P" and "(r \<bullet> xvec) \<sharp>* A\<^sub>Q"
                              and "(r \<bullet> xvec) \<sharp>* P'" and "(r \<bullet> xvec) \<sharp>* Q'" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q"
                              and Sr: "(set r) \<subseteq> (set xvec) \<times> (set(r \<bullet> xvec))" and "distinctPerm r"
         by(rule_tac xvec=xvec and c="(\<Psi>, P, Q, M, K, N, A\<^sub>P, A\<^sub>Q, \<Psi>\<^sub>P, \<Psi>\<^sub>Q, P', Q')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
       obtain q::"name prm" where "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(q \<bullet> A\<^sub>Q) \<sharp>* P" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* K"
                              and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')"
                              and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q"
                              and Sq: "set q \<subseteq> set A\<^sub>Q \<times> set(q \<bullet> A\<^sub>Q)"
         by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, K, r \<bullet> N, r \<bullet> xvec, \<Psi>\<^sub>Q, A\<^sub>P, \<Psi>\<^sub>P, r \<bullet> Q', r \<bullet> P')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
       obtain p::"name prm" where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" and "(p \<bullet> A\<^sub>P) \<sharp>* M"
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')" 
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q" and "(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q"
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)" and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))"
         by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, M, r \<bullet> N, r \<bullet> xvec, A\<^sub>Q, q \<bullet> A\<^sub>Q, \<Psi>\<^sub>Q, \<Psi>\<^sub>P, r \<bullet> Q', r \<bullet> P')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
 
       have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
       have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
       
       from \<open>A\<^sub>P \<sharp>* Q\<close> FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
         by(drule_tac extractFrameFreshChain) auto
       from \<open>A\<^sub>Q \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
         by(drule_tac extractFrameFreshChain) auto
       from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> A\<^sub>P)"
         by(simp add: freshChainSimps)
 
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> Sr \<open>distinctPerm r\<close> \<open>xvec \<sharp>* P\<close> \<open>(r \<bullet> xvec) \<sharp>* P\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')"
         by(rule inputAlpha)
       hence "(q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close>
         by(rule_tac inputPermFrameSubject) (assumption | simp)+
       hence PTrans: "\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
         by(simp add: eqvts)
   
       moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>  Sp \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close>
       have FrP: "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
         by(simp add: frameChainAlpha)
       moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)"  by simp
       
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> Sr \<open>(r \<bullet> xvec) \<sharp>* N\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')"
         by(simp add: boundOutputChainAlpha'' create_residual.simps)
       hence "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(r \<bullet> xvec) \<sharp>* (p \<bullet> A\<^sub>P)\<close>
         by(rule_tac outputPermFrameSubject) (assumption | auto)
       hence QTrans: "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
         by(simp add: eqvts)
       moreover hence "distinct(r \<bullet> xvec)" by(force dest: boundOutputDistinct)
       moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>  Sq \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close>
       have FrQ: "extractFrame Q = \<langle>(q \<bullet> A\<^sub>Q), (q \<bullet> \<Psi>\<^sub>Q)\<rangle>"
         by(simp add: frameChainAlpha)
       moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(q \<bullet> A\<^sub>Q)"  by simp
   
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<turnstile> (p \<bullet> q \<bullet> M) \<leftrightarrow> (p \<bullet> q \<bullet> K)"
         by(rule_tac chanEqClosed)+
       with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close>
            \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
            \<open>A\<^sub>Q \<sharp>* K\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close>  Sp Sq
       have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<turnstile> (q \<bullet> M) \<leftrightarrow> (p \<bullet> K)" by(simp add: eqvts freshChainSimps)
       moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
       moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)" 
         by(simp add: freshChainSimps)
       moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> 
       moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> M)"
         by(simp add: freshChainSimps)
       moreover note  \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
                      \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
       moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
         by(simp add: freshChainSimps)
       moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)\<close>\<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q\<close> 
       moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> K)"
         by(simp add: freshChainSimps)
       moreover note  \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<close>
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
         by(simp add: freshChainSimps)
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)"
         by(simp add: freshChainSimps)
       moreover note \<open>(r \<bullet> xvec) \<sharp>* P\<close> 
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> M)"
       by(simp add: freshChainSimps)
       moreover note \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> K)"  
         by(simp add: freshChainSimps)
       ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>((r \<bullet> P') \<parallel> (r \<bullet> Q'))"
         by(rule_tac cComm1)
       with \<open>(r \<bullet> xvec) \<sharp>* P'\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close> Sr 
       show ?thesis
         by(subst resChainAlpha) auto
     qed
   }
   note Goal = this
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close>
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close>
   obtain A\<^sub>P' where "extractFrame P = \<langle>A\<^sub>P', \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P'" and "A\<^sub>P' \<sharp>* \<Psi>" and "A\<^sub>P' \<sharp>* P" and "A\<^sub>P' \<sharp>* Q" and "A\<^sub>P' \<sharp>* M" and "A\<^sub>P' \<sharp>* A\<^sub>Q"
     by(rule_tac C="(\<Psi>, P, Q, M, A\<^sub>Q)" in distinctFrame) auto
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close>
   obtain A\<^sub>Q' where "extractFrame Q = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q'" and "A\<^sub>Q' \<sharp>* \<Psi>" and "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* Q" and "A\<^sub>Q' \<sharp>* K" and "A\<^sub>P' \<sharp>* A\<^sub>Q'"
     apply(rule_tac C="(\<Psi>, P, Q, K, A\<^sub>P')" in distinctFrame) by auto
   ultimately show ?thesis using \<open>xvec \<sharp>* P\<close>
     by(rule_tac Goal) 
 qed
  
 lemma Comm2:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>Q  :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P  :: 'b
   and   Q    :: "('a, 'b, 'c) psi"
   and   K    :: 'a
   and   Q'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>Q   :: "name list"
   
   assumes "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'"
   and     "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* Q"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>P \<sharp>* A\<^sub>Q"
   and     "A\<^sub>Q \<sharp>* \<Psi>"
   and     "A\<^sub>Q \<sharp>* P"
   and     "A\<^sub>Q \<sharp>* Q"
   and     "A\<^sub>Q \<sharp>* K"
   and     "xvec \<sharp>* Q"
 
   shows "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
 proof -
   {
     fix \<Psi>    :: 'b
     and \<Psi>\<^sub>Q  :: 'b
     and P    :: "('a, 'b, 'c) psi"
     and M    :: 'a
     and xvec :: "name list"
     and N    :: 'a
     and P'   :: "('a, 'b, 'c) psi"
     and A\<^sub>P   :: "name list"
     and \<Psi>\<^sub>P  :: 'b
     and Q    :: "('a, 'b, 'c) psi"
     and K    :: 'a
     and Q'   :: "('a, 'b, 'c) psi"
     and A\<^sub>Q   :: "name list"
  
     assume "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
     and    "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
     and    "distinct A\<^sub>P"
     and    "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'"
     and    "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
     and    "distinct A\<^sub>Q"
     and    "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
     and    "A\<^sub>P \<sharp>* \<Psi>"
     and    "A\<^sub>P \<sharp>* P"
     and    "A\<^sub>P \<sharp>* Q"
     and    "A\<^sub>P \<sharp>* M"
     and    "A\<^sub>P \<sharp>* A\<^sub>Q"
     and    "A\<^sub>Q \<sharp>* \<Psi>"
     and    "A\<^sub>Q \<sharp>* P"
     and    "A\<^sub>Q \<sharp>* Q"
     and    "A\<^sub>Q \<sharp>* K"
     and    "xvec \<sharp>* Q"
 
     have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')"
     proof -
 
       obtain r::"name prm" where "(r \<bullet> xvec) \<sharp>* \<Psi>" and "(r \<bullet> xvec) \<sharp>* P" and "(r \<bullet> xvec) \<sharp>* Q" and "(r \<bullet> xvec) \<sharp>* M"
                              and "(r \<bullet> xvec) \<sharp>* K" and "(r \<bullet> xvec) \<sharp>* N" and "(r \<bullet> xvec) \<sharp>* A\<^sub>P" and "(r \<bullet> xvec) \<sharp>* A\<^sub>Q"
                              and "(r \<bullet> xvec) \<sharp>* P'" and "(r \<bullet> xvec) \<sharp>* Q'" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q"
                              and Sr: "(set r) \<subseteq> (set xvec) \<times> (set(r \<bullet> xvec))" and "distinctPerm r"
         by(rule_tac xvec=xvec and c="(\<Psi>, P, Q, M, K, N, A\<^sub>P, A\<^sub>Q, \<Psi>\<^sub>P, \<Psi>\<^sub>Q, P', Q')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
       obtain q::"name prm" where "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(q \<bullet> A\<^sub>Q) \<sharp>* P" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* K"
                              and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')"
                              and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q"
                              and Sq: "set q \<subseteq> set A\<^sub>Q \<times> set(q \<bullet> A\<^sub>Q)"
         by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, K, r \<bullet> N, r \<bullet> xvec, \<Psi>\<^sub>Q, A\<^sub>P, \<Psi>\<^sub>P, r \<bullet> Q', r \<bullet> P')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
       obtain p::"name prm" where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" and "(p \<bullet> A\<^sub>P) \<sharp>* M"
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')" 
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q" and "(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q"
                              and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)" and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))"
         by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, M, r \<bullet> N, r \<bullet> xvec, A\<^sub>Q, q \<bullet> A\<^sub>Q, \<Psi>\<^sub>Q, \<Psi>\<^sub>P, r \<bullet> Q', r \<bullet> P')" in name_list_avoiding)
           (auto simp add: eqvts fresh_star_prod)
 
       have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
       have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
       
       from \<open>A\<^sub>P \<sharp>* Q\<close> FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
         by(drule_tac extractFrameFreshChain) auto
       from \<open>A\<^sub>Q \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
         by(drule_tac extractFrameFreshChain) auto
 
       from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> A\<^sub>Q)"
         by(simp add: freshChainSimps)
   
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> Sr \<open>(r \<bullet> xvec) \<sharp>* N\<close> \<open>(r \<bullet> xvec) \<sharp>* P'\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')"
         by(simp add: boundOutputChainAlpha'' create_residual.simps)
       hence "(q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(r \<bullet> xvec) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
         by(rule_tac outputPermFrameSubject) (assumption | auto)
       hence PTrans: "\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
         by(simp add: eqvts)
       moreover hence "distinct(r \<bullet> xvec)" by(force dest: boundOutputDistinct)
   
       moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>  Sp \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close>
       have FrP: "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
         by(simp add: frameChainAlpha)
       moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)"  by simp
       
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> Sr \<open>distinctPerm r\<close> \<open>xvec \<sharp>* Q\<close> \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')"
         by(rule inputAlpha)
       hence "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close>
         by(rule_tac inputPermFrameSubject) (assumption | simp)+
       hence QTrans: "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
         by(simp add: eqvts)
   
       moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>  Sq \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close>
       have FrQ: "extractFrame Q = \<langle>(q \<bullet> A\<^sub>Q), (q \<bullet> \<Psi>\<^sub>Q)\<rangle>"
         by(simp add: frameChainAlpha)
       moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(q \<bullet> A\<^sub>Q)"  by simp
   
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<turnstile> (p \<bullet> q \<bullet> M) \<leftrightarrow> (p \<bullet> q \<bullet> K)"
         by(rule_tac chanEqClosed)+
       with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close>
            \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
            \<open>A\<^sub>Q \<sharp>* K\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close>  Sp Sq
       have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<turnstile> (q \<bullet> M) \<leftrightarrow> (p \<bullet> K)"
         by(simp add: eqvts freshChainSimps)
       moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
       moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)" 
         by(simp add: freshChainSimps)
       moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> 
       moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> M)" 
         by(simp add: freshChainSimps)
       moreover note  \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
                      \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
       moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
         by(simp add: freshChainSimps)
       moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)\<close>\<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q\<close> 
       moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> K)"
         by(simp add: freshChainSimps)
       moreover note  \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<close>
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)" 
         by(simp add: freshChainSimps)
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)"
         by(simp add: freshChainSimps)
       moreover note \<open>(r \<bullet> xvec) \<sharp>* P\<close>
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> M)"  
         by(simp add: freshChainSimps)
       moreover note \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
       moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> K)"
         by(simp add: freshChainSimps)
       ultimately have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>((r \<bullet> P') \<parallel> (r \<bullet> Q'))"
         by(rule_tac cComm2)
       with \<open>(r \<bullet> xvec) \<sharp>* P'\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close> Sr 
       show ?thesis
         by(subst resChainAlpha) auto
     qed
   }
   note Goal = this
   note \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close>
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close>
   obtain A\<^sub>P' where "extractFrame P = \<langle>A\<^sub>P', \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P'" and "A\<^sub>P' \<sharp>* \<Psi>" and "A\<^sub>P' \<sharp>* P" and "A\<^sub>P' \<sharp>* Q" and "A\<^sub>P' \<sharp>* M" and "A\<^sub>P' \<sharp>* A\<^sub>Q"
     by(rule_tac C="(\<Psi>, P, Q, M, A\<^sub>Q)" in distinctFrame) auto
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close>
   obtain A\<^sub>Q' where "extractFrame Q = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q'" and "A\<^sub>Q' \<sharp>* \<Psi>" and "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* Q" and "A\<^sub>Q' \<sharp>* K" and "A\<^sub>P' \<sharp>* A\<^sub>Q'"
     by(rule_tac C="(\<Psi>, P, Q, K, A\<^sub>P')" in distinctFrame) auto
   ultimately show ?thesis using \<open>xvec \<sharp>* Q\<close>
     by(rule_tac Goal) 
 qed
 
 lemma semanticsCasesAux[consumes 1, case_names cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
   fixes \<Psi>  :: 'b
   and   cP  :: "('a, 'b, 'c) psi"
   and   cRs :: "('a, 'b, 'c) residual"
   and   C   :: "'d::fs_name"
   and   x   :: name
 
   assumes "\<Psi> \<rhd> cP \<longmapsto> cRs"
   and     rInput: "\<And>M K xvec N Tvec P. \<lbrakk>cP = M\<lparr>\<lambda>*xvec N\<rparr>.P;  cRs = K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> P[xvec::=Tvec];
                                             \<Psi> \<turnstile> M \<leftrightarrow> K; distinct xvec; set xvec \<subseteq> supp N; length xvec=length Tvec;
                                             xvec \<sharp>* Tvec; xvec \<sharp>* \<Psi>; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow> Prop"
   and     rOutput: "\<And>M K N P. \<lbrakk>cP = M\<langle>N\<rangle>.P; cRs = K\<langle>N\<rangle> \<prec> P; \<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> Prop"
   and     rCase: "\<And>Cs P \<phi>. \<lbrakk>cP = Cases Cs; \<Psi> \<rhd> P \<longmapsto> cRs; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> Prop"
 
   and  rPar1: "\<And>\<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q. \<lbrakk>cP = P \<parallel> Q; cRs = \<alpha> \<prec> (P' \<parallel> Q);
                (\<Psi> \<otimes> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto> (\<alpha> \<prec> P'); extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* C; A\<^sub>Q \<sharp>* P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha>  \<sharp>* \<Psi>\<^sub>Q; 
                bn \<alpha>  \<sharp>* Q; bn \<alpha>  \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow>
                Prop"
   and     rPar2:   "\<And>\<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P. \<lbrakk>cP = P \<parallel> Q; cRs = \<alpha> \<prec> (P \<parallel> Q');
                       (\<Psi> \<otimes> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
              A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* C;
              A\<^sub>P \<sharp>* Q'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* \<Psi>\<^sub>P; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* Q; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow> Prop"
              
   and     rComm1: "\<And>\<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q.
                    \<lbrakk>cP = P \<parallel> Q; cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>P' \<parallel> Q';
                     \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N;
                     A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* Q;
                     xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop"
   and     rComm2: "\<And>\<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q.
                    \<lbrakk>cP = P \<parallel> Q; cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>P' \<parallel> Q';
                     \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N;
                     A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* Q;
                     xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop"
   and    rOpen: "\<And>P M xvec yvec N P' x.
                 \<lbrakk>cP = \<lparr>\<nu>x\<rparr>P; cRs = M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; 
                  \<Psi> \<rhd> P \<longmapsto> M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; x \<in> supp N; x \<sharp> xvec; x \<sharp> yvec; x \<sharp> M; x \<sharp> \<Psi>; distinct xvec; distinct yvec;
                  xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* yvec; yvec \<sharp>* \<Psi>; yvec \<sharp>* P; yvec \<sharp>* M; xvec \<sharp>* C; x \<sharp> C; yvec \<sharp>* C\<rbrakk> \<Longrightarrow>
                  Prop"
   and    rScope: "\<And>P \<alpha> P' x. \<lbrakk>cP = \<lparr>\<nu>x\<rparr>P; cRs = \<alpha> \<prec> \<lparr>\<nu>x\<rparr>P';
                                  \<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; x \<sharp> \<Psi>; x \<sharp> \<alpha>; x \<sharp> C; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow> Prop"
   and    rBang:  "\<And>P. \<lbrakk>cP = !P; \<Psi> \<rhd> P \<parallel> !P \<longmapsto> cRs; guarded P\<rbrakk> \<Longrightarrow> Prop"
   shows Prop
 using \<open>\<Psi> \<rhd> cP \<longmapsto> cRs\<close>
 proof(cases rule: semantics.cases)
   case(cInput M K xvec N Tvec P)
   obtain p::"name prm" where "(p \<bullet> xvec) \<sharp>* \<Psi>" and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* K"
                          and "(p \<bullet> xvec) \<sharp>* Tvec" and "(p \<bullet> xvec) \<sharp>* P" and "(p \<bullet> xvec) \<sharp>* C"
                          and S: "(set p) \<subseteq> (set xvec) \<times> (set(p \<bullet> xvec))" and "distinctPerm p"
     by(rule_tac xvec=xvec and c="(\<Psi>, M, K, N, P, C, Tvec)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
     from \<open>cP = M\<lparr>\<lambda>*xvec N\<rparr>.P\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> S
     have "cP = M\<lparr>\<lambda>*(p \<bullet> xvec) (p \<bullet> N)\<rparr>.(p \<bullet> P)"
       by(simp add: inputChainAlpha')
     moreover from \<open>cRs = K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> P[xvec::=Tvec]\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> S \<open>length xvec = length Tvec\<close> \<open>distinctPerm p\<close>
     have "cRs = K\<lparr>((p \<bullet> N)[(p \<bullet> xvec)::=Tvec])\<rparr> \<prec> (p \<bullet> P)[(p \<bullet> xvec)::=Tvec]"
       by(auto simp add: substTerm.renaming renaming residualInject)
     
     moreover note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close>
     moreover from \<open>distinct xvec\<close> have "distinct(p \<bullet> xvec)"
       by simp
     moreover from \<open>(set xvec) \<subseteq> (supp N)\<close> have "(p \<bullet> (set xvec)) \<subseteq> (p \<bullet> (supp N))"
       by simp
     hence "set(p \<bullet> xvec) \<subseteq> supp(p \<bullet> N)"
       by(simp add: eqvts)
     moreover from \<open>length xvec = length Tvec\<close> have "length(p \<bullet> xvec) = length Tvec"
       by simp
   ultimately show ?thesis using \<open>(p \<bullet> xvec) \<sharp>* Tvec\<close> \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> xvec) \<sharp>* M\<close> \<open>(p \<bullet> xvec) \<sharp>* K\<close>
                                 \<open>(p \<bullet> xvec) \<sharp>* C\<close>
     by(rule rInput)
 next
   case(Output M K N P)
   thus ?thesis by(rule rOutput)
 next
   case(Case P \<phi> Cs)
   thus ?thesis by(rule rCase)
 next
   case(cPar1 \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q)
   obtain q::"name prm" where "(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>" and "(bn(q \<bullet> \<alpha>)) \<sharp>* P" and "(bn(q \<bullet> \<alpha>)) \<sharp>* Q" 
                          and "(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>Q" and "(bn(q \<bullet> \<alpha>)) \<sharp>* P'" and "(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>Q"
                          and "distinctPerm q"
                          and "(bn(q \<bullet> \<alpha>)) \<sharp>* C" and Sq: "(set q) \<subseteq> set(bn \<alpha>) \<times> (set(bn(q \<bullet> \<alpha>)))"
     by(rule_tac xvec="bn \<alpha>" and c="(\<Psi>, P, Q, \<alpha>, A\<^sub>Q, \<Psi>\<^sub>Q, P', C)" in name_list_avoiding) (auto simp add: eqvts)
   obtain p::"name prm" where "(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>Q) \<sharp>* P" and "(p \<bullet> A\<^sub>Q) \<sharp>* Q" 
                          and "(p \<bullet> A\<^sub>Q) \<sharp>* \<alpha>" and "(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)" and "(p \<bullet> A\<^sub>Q) \<sharp>* P'" 
                          and "(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')" and "(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q" and "(p \<bullet> A\<^sub>Q) \<sharp>* C" 
                          and Sp: "(set p) \<subseteq> (set A\<^sub>Q) \<times> (set(p \<bullet> A\<^sub>Q))" and "distinctPerm p"
     by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, \<alpha>, q \<bullet> \<alpha>, P', (q \<bullet> P'), \<Psi>\<^sub>Q, C)" in name_list_avoiding) auto
   from \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>Q\<close> Sq \<open>distinctPerm q\<close> have "A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)"
     by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
   from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinctPerm q\<close> have "bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)"
     by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
   from \<open>distinct(bn \<alpha>)\<close> \<open>distinctPerm q\<close> have "distinct(bn(q \<bullet> \<alpha>))" 
     by(subst distinctClosed[symmetric, of _ q]) (simp add: eqvts)
   note \<open>cP = P \<parallel> Q\<close>
 
   moreover from \<open>cRs = \<alpha> \<prec> (P' \<parallel> Q)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P'\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* Q\<close> Sq
   have "cRs = (q \<bullet> \<alpha>) \<prec> (q \<bullet> P') \<parallel> Q"
     by(force simp add: residualAlpha)
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P'\<close> Sq
   have Trans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> P')"
     by(force simp add: residualAlpha)
   hence "A\<^sub>Q \<sharp>* (q \<bullet> P')" using \<open>bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)\<close>
     by(drule_tac freeFreshChainDerivative) auto
 
   from Trans have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> (p \<bullet> P) \<longmapsto>p \<bullet> ((q \<bullet> \<alpha>) \<prec> (q \<bullet> P'))"
     by(rule semantics.eqvt)
   with \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>A\<^sub>Q \<sharp>* (q \<bullet> P')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>Q\<close>  \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close>
        \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* P\<close>  \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')\<close> Sp
   have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> P')" by(simp add: eqvts)
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close> Sp have  "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), (p \<bullet> \<Psi>\<^sub>Q)\<rangle>"
     by(simp add: frameChainAlpha' eqvts)
   moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close> Sp have "(bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)"
     by(simp add: freshAlphaPerm)
   moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>Q)" by simp
   ultimately show ?thesis
     using \<open>(p \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> \<alpha>)\<close>
           \<open>(p \<bullet> A\<^sub>Q) \<sharp>* (q \<bullet> P')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P\<close>
           \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* C\<close> \<open>(p \<bullet> A\<^sub>Q) \<sharp>* C\<close> \<open>bn (q \<bullet> \<alpha>) \<sharp>* subject (q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close>
     by(rule_tac rPar1)
 next
   case(cPar2 \<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P)
   obtain q::"name prm" where "(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>" and "(bn(q \<bullet> \<alpha>)) \<sharp>* P" and "(bn(q \<bullet> \<alpha>)) \<sharp>* Q" 
                          and "(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>P" and "(bn(q \<bullet> \<alpha>)) \<sharp>* Q'" and "(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>P"
                          and "distinctPerm q"
                          and "(bn(q \<bullet> \<alpha>)) \<sharp>* C" and Sq: "(set q) \<subseteq> set(bn \<alpha>) \<times> (set(bn(q \<bullet> \<alpha>)))"
     by(rule_tac xvec="bn \<alpha>" and c="(\<Psi>, P, Q, \<alpha>, A\<^sub>P, \<Psi>\<^sub>P, Q', C)" in name_list_avoiding) (auto simp add: eqvts)
   obtain p::"name prm" where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" 
                          and "(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>" and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)" and "(p \<bullet> A\<^sub>P) \<sharp>* Q'" 
                          and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> A\<^sub>P) \<sharp>* C" 
                          and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))" and "distinctPerm p"
     by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, \<alpha>, q \<bullet> \<alpha>, Q', (q \<bullet> Q'), \<Psi>\<^sub>P, C)" in name_list_avoiding) auto
   from \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>bn(q \<bullet> \<alpha>) \<sharp>* A\<^sub>P\<close> Sq \<open>distinctPerm q\<close> have "A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)"
     by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
   from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinctPerm q\<close> have "bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)"
     by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
   from \<open>distinct(bn \<alpha>)\<close> \<open>distinctPerm q\<close> have "distinct(bn(q \<bullet> \<alpha>))" 
     by(subst distinctClosed[symmetric, of _ q]) (simp add: eqvts)
   note \<open>cP = P \<parallel> Q\<close>
 
   moreover from \<open>cRs = \<alpha> \<prec> (P \<parallel> Q')\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q'\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* P\<close> Sq
   have "cRs = (q \<bullet> \<alpha>) \<prec> P \<parallel>  (q \<bullet> Q')"
     by(force simp add: residualAlpha)
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q'\<close> Sq
   have Trans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> Q')"
     by(force simp add: residualAlpha)
   hence "A\<^sub>P \<sharp>* (q \<bullet> Q')" using \<open>bn(q \<bullet> \<alpha>) \<sharp>* subject(q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)\<close>
     by(drule_tac freeFreshChainDerivative) auto
 
   from Trans have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> (p \<bullet> Q) \<longmapsto>p \<bullet> ((q \<bullet> \<alpha>) \<prec> (q \<bullet> Q'))"
     by(rule semantics.eqvt)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> \<alpha>)\<close> \<open>A\<^sub>P \<sharp>* (q \<bullet> Q')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>P\<close>  \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close>
        \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close>  \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')\<close> Sp
   have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(q \<bullet> \<alpha>) \<prec> (q \<bullet> Q')" by(simp add: eqvts)
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close> Sp have  "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
     by(simp add: frameChainAlpha' eqvts)
   moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close> Sp have "(bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
     by(simp add: freshAlphaPerm)
   moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)" by simp
   ultimately show ?thesis
     using \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<alpha>)\<close>
           \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> Q')\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<Psi>\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Q\<close> \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P\<close>
           \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* C\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* C\<close> \<open>bn (q \<bullet> \<alpha>) \<sharp>* subject (q \<bullet> \<alpha>)\<close> \<open>distinct(bn(q \<bullet> \<alpha>))\<close>
     by(rule_tac rPar2)
 next
   case(cComm1 \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q)
   obtain r::"name prm" where "(r \<bullet> xvec) \<sharp>* \<Psi>" and "(r \<bullet> xvec) \<sharp>* P" and "(r \<bullet> xvec) \<sharp>* Q" and "(r \<bullet> xvec) \<sharp>* M"
                          and "(r \<bullet> xvec) \<sharp>* K" and "(r \<bullet> xvec) \<sharp>* N" and "(r \<bullet> xvec) \<sharp>* A\<^sub>P" and "(r \<bullet> xvec) \<sharp>* A\<^sub>Q"
                          and "(r \<bullet> xvec) \<sharp>* P'" and "(r \<bullet> xvec) \<sharp>* Q'" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q"
                          and "(r \<bullet> xvec) \<sharp>* C" and Sr: "(set r) \<subseteq> (set xvec) \<times> (set(r \<bullet> xvec))" and "distinctPerm r"
     by(rule_tac xvec=xvec and c="(\<Psi>, P, Q, M, K, N, A\<^sub>P, A\<^sub>Q, \<Psi>\<^sub>P, \<Psi>\<^sub>Q, P', Q', C)" in name_list_avoiding)
       (auto simp add: eqvts)
 
   obtain q::"name prm" where "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(q \<bullet> A\<^sub>Q) \<sharp>* P" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* K"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* N" and "(q \<bullet> A\<^sub>Q) \<sharp>* xvec" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q'" and "(q \<bullet> A\<^sub>Q) \<sharp>* P'"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P" and  "(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* C" and Sq: "(set q) \<subseteq> (set A\<^sub>Q) \<times> (set(q \<bullet> A\<^sub>Q))"
     by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, K, N, xvec, r \<bullet> xvec, \<Psi>\<^sub>Q, A\<^sub>P, \<Psi>\<^sub>P, Q', P', C)" in name_list_avoiding) clarsimp
   
   obtain p::"name prm"  where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" and "(p \<bullet> A\<^sub>P) \<sharp>* M"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* N" and "(p \<bullet> A\<^sub>P) \<sharp>* xvec" and "(p \<bullet> A\<^sub>P) \<sharp>* Q'" and "(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* P'" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q" and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* C" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)" and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))"
     by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, M, N, xvec, r \<bullet> xvec, A\<^sub>Q, q \<bullet> A\<^sub>Q, \<Psi>\<^sub>Q, \<Psi>\<^sub>P, Q', P', C)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   
   from \<open>A\<^sub>P \<sharp>* Q\<close> FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by(drule_tac extractFrameFreshChain) auto
   from \<open>A\<^sub>Q \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by(drule_tac extractFrameFreshChain) auto
   note \<open>cP = P \<parallel> Q\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* P'\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close> have "(r \<bullet> xvec) \<sharp>* (P' \<parallel> Q')"
     by simp
   with \<open>cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')\<close> \<open>(r \<bullet> xvec) \<sharp>* N\<close> Sr
   have "cRs = \<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>(r \<bullet> (P' \<parallel> Q'))" by(simp add: resChainAlpha residualInject)
   hence "cRs = \<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>((r \<bullet> P') \<parallel> (r \<bullet> Q'))" by simp
   
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> Sr \<open>distinctPerm r\<close> \<open>xvec \<sharp>* P\<close> \<open>(r \<bullet> xvec) \<sharp>* P\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')"
     by(rule inputAlpha)
   hence "(q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close>
     by(rule_tac inputPermFrameSubject) (assumption | simp)+
   hence PTrans: "\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
     by(simp add: eqvts)
   
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>  Sp \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close>
   have FrP: "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
     by(simp add: frameChainAlpha)
   moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)"  by simp
 
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> Sr \<open>(r \<bullet> xvec) \<sharp>* N\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')"
     by(simp add: boundOutputChainAlpha'' residualInject)
   hence "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close>\<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close>
     by(rule_tac outputPermFrameSubject) (assumption | auto)
 
   hence QTrans: "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
     by(simp add: eqvts)
   
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>  Sq \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close>
   have FrQ: "extractFrame Q = \<langle>(q \<bullet> A\<^sub>Q), (q \<bullet> \<Psi>\<^sub>Q)\<rangle>"
     by(simp add: frameChainAlpha)
   moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(q \<bullet> A\<^sub>Q)"  by simp
   
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<turnstile> (p \<bullet> q \<bullet> M) \<leftrightarrow> (p \<bullet> q \<bullet> K)"
     by(rule_tac chanEqClosed)+
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close>
        \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
        \<open>A\<^sub>Q \<sharp>* K\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close>  Sp Sq
   have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<turnstile> (q \<bullet> M) \<leftrightarrow> (p \<bullet> K)"
     by(simp add: eqvts freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)"
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> 
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> M)" 
     by(simp add: freshChainSimps)
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* N\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)" 
     by(simp add: freshChainSimps)
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')" 
     by(simp add: freshChainSimps)
   moreover note  \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close>
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q'\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')"
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> 
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> K)"
     by(simp add: freshChainSimps)
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* N\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)" 
     by(simp add: freshChainSimps)
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P'\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q\<close> 
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q'\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"  
     by(simp add: freshChainSimps)
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)"  
     by(simp add: freshChainSimps)
   moreover note \<open>(r \<bullet> xvec) \<sharp>* P\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> M)"  
     by(simp add: freshChainSimps)
   moreover note \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> K)"  
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* C\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* C\<close> \<open>(r \<bullet> xvec) \<sharp>* C\<close> 
   moreover from \<open>distinct xvec\<close> have "distinct(r \<bullet> xvec)" by simp
   ultimately show ?thesis by(rule rComm1) 
 next
   case(cComm2 \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q)
   obtain r::"name prm" where "(r \<bullet> xvec) \<sharp>* \<Psi>" and "(r \<bullet> xvec) \<sharp>* P" and "(r \<bullet> xvec) \<sharp>* Q" and "(r \<bullet> xvec) \<sharp>* M"
     and "(r \<bullet> xvec) \<sharp>* K" and "(r \<bullet> xvec) \<sharp>* N" and "(r \<bullet> xvec) \<sharp>* A\<^sub>P" and "(r \<bullet> xvec) \<sharp>* A\<^sub>Q"
                          and "(r \<bullet> xvec) \<sharp>* P'" and "(r \<bullet> xvec) \<sharp>* Q'" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P" and "(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q"
                          and "(r \<bullet> xvec) \<sharp>* C" and Sr: "(set r) \<subseteq> (set xvec) \<times> (set(r \<bullet> xvec))" and "distinctPerm r"
     by(rule_tac xvec=xvec and c="(\<Psi>, P, Q, M, K, N, A\<^sub>P, A\<^sub>Q, \<Psi>\<^sub>P, \<Psi>\<^sub>Q, P', Q', C)" in name_list_avoiding)
       (auto simp add: eqvts)
 
   obtain q::"name prm" where "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>" and "(q \<bullet> A\<^sub>Q) \<sharp>* P" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* K"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* N" and "(q \<bullet> A\<^sub>Q) \<sharp>* xvec" and "(q \<bullet> A\<^sub>Q) \<sharp>* Q'" and "(q \<bullet> A\<^sub>Q) \<sharp>* P'"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P" and  "(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P" and "(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q" and "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)"
                          and "(q \<bullet> A\<^sub>Q) \<sharp>* C" and Sq: "(set q) \<subseteq> (set A\<^sub>Q) \<times> (set(q \<bullet> A\<^sub>Q))"
     by(rule_tac xvec=A\<^sub>Q and c="(\<Psi>, P, Q, K, N, xvec, r \<bullet> xvec, \<Psi>\<^sub>Q, A\<^sub>P, \<Psi>\<^sub>P, Q', P', C)" in name_list_avoiding) clarsimp
   
   obtain p::"name prm"  where "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>P) \<sharp>* P" and "(p \<bullet> A\<^sub>P) \<sharp>* Q" and "(p \<bullet> A\<^sub>P) \<sharp>* M"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* N" and "(p \<bullet> A\<^sub>P) \<sharp>* xvec" and "(p \<bullet> A\<^sub>P) \<sharp>* Q'" and "(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* P'" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q" and "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)"
                           and "(p \<bullet> A\<^sub>P) \<sharp>* C" and "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)" and Sp: "(set p) \<subseteq> (set A\<^sub>P) \<times> (set(p \<bullet> A\<^sub>P))"
     by(rule_tac xvec=A\<^sub>P and c="(\<Psi>, P, Q, M, N, xvec, r \<bullet> xvec, A\<^sub>Q, q \<bullet> A\<^sub>Q, \<Psi>\<^sub>Q, \<Psi>\<^sub>P, Q', P', C)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   
   from \<open>A\<^sub>P \<sharp>* Q\<close> FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by(drule_tac extractFrameFreshChain) auto
   from \<open>A\<^sub>Q \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by(drule_tac extractFrameFreshChain) auto
   
   note \<open>cP = P \<parallel> Q\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* P'\<close> \<open>(r \<bullet> xvec) \<sharp>* Q'\<close> have "(r \<bullet> xvec) \<sharp>* (P' \<parallel> Q')"
     by simp
   with \<open>cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')\<close> \<open>(r \<bullet> xvec) \<sharp>* N\<close> Sr
   have "cRs = \<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>(r \<bullet> (P' \<parallel> Q'))" by(simp add: resChainAlpha residualInject)
   hence "cRs = \<tau> \<prec> \<lparr>\<nu>*(r \<bullet> xvec)\<rparr>((r \<bullet> P') \<parallel> (r \<bullet> Q'))"
     by simp
   
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> Sr \<open>(r \<bullet> xvec) \<sharp>* N\<close> \<open>(r \<bullet> xvec) \<sharp>* P'\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')" by(simp add: boundOutputChainAlpha'' residualInject)
   hence "(q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close>
     by(rule_tac outputPermFrameSubject) (assumption | auto)
   hence PTrans: "\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>(q \<bullet> M)\<lparr>\<nu>*(r \<bullet> xvec)\<rparr>\<langle>(r \<bullet> N)\<rangle> \<prec> (r \<bullet> P')" using Sq \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
     by(simp add: eqvts)
   
   moreover from \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close>  Sp \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>P\<close>
   have FrP: "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), (p \<bullet> \<Psi>\<^sub>P)\<rangle>"
     by(simp add: frameChainAlpha)
   moreover from \<open>distinct A\<^sub>P\<close> have "distinct(p \<bullet> A\<^sub>P)"  by simp
 
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> Sr  \<open>distinctPerm r\<close> \<open>xvec \<sharp>* Q\<close> \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')" by(rule inputAlpha)
   hence "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close>
     by(rule_tac inputPermFrameSubject) (assumption | simp)+
   hence QTrans: "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>(p \<bullet> K)\<lparr>(r \<bullet> N)\<rparr> \<prec> (r \<bullet> Q')" using Sp \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
     by(simp add: eqvts)
   
   moreover from \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close>  Sq \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>Q\<close>
   have FrQ: "extractFrame Q = \<langle>(q \<bullet> A\<^sub>Q), (q \<bullet> \<Psi>\<^sub>Q)\<rangle>"
     by(simp add: frameChainAlpha)
   moreover from \<open>distinct A\<^sub>Q\<close> have "distinct(q \<bullet> A\<^sub>Q)"  by simp
   
   moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<turnstile> (p \<bullet> q \<bullet> M) \<leftrightarrow> (p \<bullet> q \<bullet> K)"
     by(rule_tac chanEqClosed)+
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close>
        \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close>
        \<open>A\<^sub>Q \<sharp>* K\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close>  Sp Sq
   have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<otimes> (q \<bullet> \<Psi>\<^sub>Q) \<turnstile> (q \<bullet> M) \<leftrightarrow> (p \<bullet> K)"
     by(simp add: eqvts freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close>
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)" 
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* P\<close> 
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> Sq have "(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> M)" 
     by(simp add: freshChainSimps)
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* N\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> N)" 
     by(simp add: freshChainSimps)
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> P')"
     by(simp add: freshChainSimps)
   moreover note  \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q\<close>
   moreover from \<open>(p \<bullet> A\<^sub>P) \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Q'\<close> Sr have "(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> Q')"
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<close>
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P\<close> 
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (q \<bullet> A\<^sub>Q)\<close> Sp Sq have "(q \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> K)"
     by(simp add: freshChainSimps)
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* N\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> N)"
     by(simp add: freshChainSimps)
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* P'\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> P')"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q\<close> 
   moreover from \<open>(q \<bullet> A\<^sub>Q) \<sharp>* xvec\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* Q'\<close> Sr have "(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> Q')"
     by(simp add: freshChainSimps)
   moreover note \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)"  
     by(simp add: freshChainSimps)
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> \<Psi>\<^sub>Q)"
     by(simp add: freshChainSimps)
   moreover note \<open>(r \<bullet> xvec) \<sharp>* P\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>Q\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* M\<close> Sq have "(r \<bullet> xvec) \<sharp>* (q \<bullet> M)"  
     by(simp add: freshChainSimps)
   moreover note \<open>(r \<bullet> xvec) \<sharp>* Q\<close>
   moreover from \<open>(r \<bullet> xvec) \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* (r \<bullet> xvec)\<close> \<open>(r \<bullet> xvec) \<sharp>* K\<close> Sp have "(r \<bullet> xvec) \<sharp>* (p \<bullet> K)"  
     by(simp add: freshChainSimps)
   moreover note \<open>(p \<bullet> A\<^sub>P) \<sharp>* C\<close> \<open>(q \<bullet> A\<^sub>Q) \<sharp>* C\<close> \<open>(r \<bullet> xvec) \<sharp>* C\<close>
   moreover from \<open>distinct xvec\<close> have "distinct(r \<bullet> xvec)" by simp
   ultimately show ?thesis by(rule rComm2) 
 next
   case(cOpen P M xvec yvec N P' x)
   from \<open>\<Psi> \<rhd> P \<longmapsto> M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close>  have "distinct(xvec@yvec)" by(force dest: boundOutputDistinct)
   hence "xvec \<sharp>* yvec" by(induct xvec) auto
   obtain p where "(p \<bullet> yvec) \<sharp>* \<Psi>" and "(p \<bullet> yvec) \<sharp>* P"  and "(p \<bullet> yvec) \<sharp>* M"
              and "(p \<bullet> yvec) \<sharp>* yvec" and "(p \<bullet> yvec) \<sharp>* N" and "(p \<bullet> yvec) \<sharp>* P'"
              and "x \<sharp> (p \<bullet> yvec)" and "(p \<bullet> yvec) \<sharp>* xvec"
              and "(p \<bullet> yvec) \<sharp>* C" and Sp: "(set p) \<subseteq> (set yvec) \<times> (set(p \<bullet> yvec))"
     by(rule_tac xvec=yvec and c="(\<Psi>, P, M, xvec, yvec, N, P', x, C)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod) 
   obtain q where "(q \<bullet> xvec) \<sharp>* \<Psi>" and "(q \<bullet> xvec) \<sharp>* P"  and "(q \<bullet> xvec) \<sharp>* M"
              and "(q \<bullet> xvec) \<sharp>* xvec" and "(q \<bullet> xvec) \<sharp>* N" and "(q \<bullet> xvec) \<sharp>* P'"
              and "x \<sharp> (q \<bullet> xvec)" and "(q \<bullet> xvec) \<sharp>* yvec" 
              and "(q \<bullet> xvec) \<sharp>* p" and "(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)"
              and "(q \<bullet> xvec) \<sharp>* C" and Sq: "(set q) \<subseteq> (set xvec) \<times> (set(q \<bullet> xvec))"
     by(rule_tac xvec=xvec and c="(\<Psi>, P, M, xvec, yvec, p \<bullet> yvec, N, P', x, p, C)" in name_list_avoiding)
       (auto simp add: eqvts fresh_star_prod)
   obtain y::name where "y \<sharp> P" and "y \<sharp> C" and "y \<sharp> xvec" and "y \<sharp> yvec" and "y \<noteq> x" and "y \<sharp> N" 
                    and "y \<sharp> (q \<bullet> xvec)" and "y \<sharp> (p \<bullet> yvec)" and "y \<sharp> M" and "y \<sharp> \<Psi>" and "y \<sharp> P'"
     by(generate_fresh "name") (auto simp add: freshChainSimps)
 
   from \<open>cP = \<lparr>\<nu>x\<rparr>P\<close> \<open>y \<sharp> P\<close> have "cP = \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> P)" by(simp add: alphaRes)
   moreover have "cRs = M\<lparr>\<nu>*((q \<bullet> xvec)@y#(p \<bullet> yvec))\<rparr>\<langle>((q@(x, y)#p) \<bullet> N)\<rangle> \<prec> ((q@(x, y)#p) \<bullet> P')"
   proof -
     note \<open>cRs = M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
     moreover have "\<lparr>\<nu>*(xvec@x#yvec)\<rparr>N \<prec>' P' = \<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*yvec\<rparr>N \<prec>' P'))" by(simp add: boundOutputApp)
     moreover from \<open>(p \<bullet> yvec) \<sharp>* N\<close> \<open>(p \<bullet> yvec) \<sharp>* P'\<close> Sp have "\<dots> = \<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>x\<rparr>(\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>(p \<bullet> N) \<prec>' (p \<bullet> P')))"
       by(simp add: boundOutputChainAlpha'')
     moreover with \<open>y \<sharp> N\<close> \<open>y \<sharp> P'\<close> \<open>y \<sharp> (p \<bullet> yvec)\<close> \<open>y \<sharp> yvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> Sp
     have "\<dots> = \<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>(([(x, y)] \<bullet> p \<bullet> N) \<prec>' ([(x, y)] \<bullet> p \<bullet> P'))))"
       by(subst alphaBoundOutput[where y=y]) (simp add: freshChainSimps eqvts)+
     moreover hence "\<dots> = \<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>((((x, y)#p) \<bullet> N) \<prec>' (((x, y)#p) \<bullet> P'))))"
       by simp
     moreover from \<open>(q \<bullet> xvec) \<sharp>* N\<close> \<open>(q \<bullet> xvec) \<sharp>* P'\<close> \<open>xvec \<sharp>* yvec\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> 
                   \<open>y \<sharp> xvec\<close> \<open>y \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> (q \<bullet> xvec)\<close> Sp Sq
     have "\<dots> = \<lparr>\<nu>*(q \<bullet> xvec)\<rparr>(\<lparr>\<nu>y\<rparr>(\<lparr>\<nu>*(p \<bullet> yvec)\<rparr>((q \<bullet> ((x, y)#p) \<bullet> N) \<prec>' (q \<bullet> ((x, y)#p) \<bullet> P'))))"
       apply(subst boundOutputChainAlpha[where p=q and xvec=xvec and yvec="xvec"])
       defer
       apply assumption
       apply simp
       apply(simp add: eqvts)
       apply(simp add: eqvts)
       apply(simp add: boundOutputFreshSet(4))
       apply(rule conjI)
       apply(simp add: freshChainSimps)
       apply(simp add: freshChainSimps)
       done
     moreover hence "\<dots> = \<lparr>\<nu>*(q \<bullet> xvec@y#(p \<bullet> yvec))\<rparr>((q@(x, y)#p) \<bullet> N) \<prec>' ((q@(x, y)#p) \<bullet> P')"
       by(simp only: pt2[OF pt_name_inst] boundOutputApp BOresChain.simps)
     ultimately show ?thesis
       by(simp only: residualInject)
   qed
   moreover have "\<Psi> \<rhd> ([(x, y)] \<bullet> P) \<longmapsto>M\<lparr>\<nu>*((q \<bullet> xvec)@(p \<bullet> yvec))\<rparr>\<langle>((q@(x, y)#p) \<bullet> N)\<rangle> \<prec> ((q@(x, y)#p) \<bullet> P')"
   proof -
     note\<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
     moreover from \<open>(p \<bullet> yvec) \<sharp>* N\<close> \<open>(q \<bullet> xvec) \<sharp>* N\<close> \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> Sp Sq 
     have "((q@p) \<bullet> (xvec @ yvec)) \<sharp>* N" apply(simp only: eqvts) apply(simp only: pt2[OF pt_name_inst])
       by simp
     moreover from \<open>(p \<bullet> yvec) \<sharp>* P'\<close> \<open>(q \<bullet> xvec) \<sharp>* P'\<close> \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close> Sp Sq 
     have "((q@p) \<bullet> (xvec @ yvec)) \<sharp>* P'" by(simp del: freshAlphaPerm add: eqvts pt2[OF pt_name_inst])
     moreover from Sp Sq \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close>
     have Spq: "set(q@p) \<subseteq> set(xvec@yvec) \<times> set((q@p) \<bullet> (xvec@yvec))"
       by(simp add: pt2[OF pt_name_inst] eqvts) blast
     ultimately have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*((q@p) \<bullet> (xvec@yvec))\<rparr>\<langle>((q@p) \<bullet> N)\<rangle> \<prec> ((q@p) \<bullet> P')"
       apply(simp only: residualInject)
       by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)
     with  Sp Sq \<open>xvec \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* yvec\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close> \<open>(p \<bullet> yvec) \<sharp>* xvec\<close>
     have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*((q \<bullet> xvec)@(p \<bullet> yvec))\<rparr>\<langle>((q@p) \<bullet> N)\<rangle> \<prec> ((q@p) \<bullet> P')"
       by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
     hence "([(x, y)] \<bullet> \<Psi>) \<rhd> ([(x, y)] \<bullet> P) \<longmapsto> [(x, y)] \<bullet> (M\<lparr>\<nu>*((q \<bullet> xvec)@(p \<bullet> yvec))\<rparr>\<langle>((q@p) \<bullet> N)\<rangle> \<prec> ((q@p) \<bullet> P'))"
       by(rule semantics.eqvt)
     with \<open>x \<sharp> \<Psi>\<close> \<open>y \<sharp> \<Psi>\<close> \<open>x \<sharp> M\<close> \<open>y \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>y \<sharp> xvec\<close> \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>y \<sharp> (q \<bullet> xvec) \<close>\<open>x \<sharp> yvec\<close> \<open>y \<sharp> yvec\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> \<open>y \<sharp> (p \<bullet> yvec)\<close> Sp Sq
     show ?thesis 
       apply(simp add: eqvts pt2[OF pt_name_inst])
       by(subst perm_compose[of q], simp)+
   qed
   moreover from \<open>x \<in> supp N\<close> have "((q@(x, y)#p) \<bullet> x) \<in> ((q@(x, y)#p) \<bullet> (supp N))"
     by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> \<open>y \<sharp> xvec\<close> \<open>y \<sharp> (q \<bullet> xvec)\<close> Sp Sq
   have "y \<in> supp((q@(x, y)#p)\<bullet> N)" by(simp add: pt2[OF pt_name_inst] calc_atm eqvts)
   moreover from \<open>distinct xvec\<close> have "distinct(q \<bullet> xvec)" by simp
   moreover from \<open>distinct yvec\<close> have "distinct(p \<bullet> yvec)" by simp
   moreover note \<open>x \<sharp> (q \<bullet> xvec)\<close> \<open>x \<sharp> (p \<bullet> yvec)\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> \<Psi>\<close> 
                 \<open>(q \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(q \<bullet> xvec) \<sharp>* P\<close> \<open>(q \<bullet> xvec) \<sharp>* M\<close> \<open>(q \<bullet> xvec) \<sharp>* (p \<bullet> yvec)\<close>
                 \<open>(p \<bullet> yvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> yvec) \<sharp>* P\<close> \<open>(p \<bullet> yvec) \<sharp>* M\<close> \<open>y \<sharp> (q \<bullet> xvec)\<close> \<open>y \<sharp> (p \<bullet> yvec)\<close> \<open>y \<sharp> M\<close> \<open>y \<sharp> C\<close> \<open>y \<sharp> \<Psi>\<close>
                  \<open>(p \<bullet> yvec) \<sharp>* C\<close> \<open>(q \<bullet> xvec) \<sharp>* C\<close>
   ultimately show Prop by(rule_tac rOpen) (assumption | simp)+
 next
   case(cScope P \<alpha> P' x)
   obtain p::"name prm" where "(bn(p \<bullet> \<alpha>)) \<sharp>* \<Psi>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P"
                          and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'" and "x \<sharp> bn(p \<bullet> \<alpha>)"
                          and "distinctPerm p"
                          and "(bn(p \<bullet> \<alpha>)) \<sharp>* C" and Sp: "(set p) \<subseteq> set(bn \<alpha>) \<times> (set(bn(p \<bullet> \<alpha>)))"
     by(rule_tac xvec="bn \<alpha>" and c="(\<Psi>, P, \<alpha>, x, P', C)" in name_list_avoiding) (auto simp add: eqvts)
   obtain y::name where "y \<sharp> \<Psi>" and "y \<sharp> P" and "y \<sharp> (p \<bullet> P')" and "y \<sharp> (p \<bullet> \<alpha>)" and "y \<sharp> C"
     by(generate_fresh "name") (auto simp add: freshChainSimps simp del: actionFresh)
   from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinctPerm p\<close> have "bn(p \<bullet> \<alpha>) \<sharp>* subject(p \<bullet> \<alpha>)"
     by(subst fresh_star_bij[symmetric, of _ _  p]) (simp add: eqvts)
   from \<open>distinct(bn \<alpha>)\<close> \<open>distinctPerm p\<close> have "distinct(bn(p \<bullet> \<alpha>))" 
     by(subst distinctClosed[symmetric, of _ p]) (simp add: eqvts)
   from \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> (bn(p \<bullet> \<alpha>))\<close> \<open>distinctPerm p\<close> Sp have "x \<sharp> (p \<bullet> \<alpha>)"
     by(subst fresh_bij[symmetric, of _ _ p]) (simp add: eqvts freshChainSimps)
 
   moreover from \<open>cP = \<lparr>\<nu>x\<rparr>P\<close> \<open>y \<sharp> P\<close> have "cP = \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> P)" by(simp add: alphaRes)
   moreover from \<open>cRs = \<alpha> \<prec> \<lparr>\<nu>x\<rparr>P'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>x \<sharp> bn(p \<bullet> \<alpha>)\<close> \<open>(bn(p \<bullet> \<alpha>)) \<sharp>* P'\<close> \<open>x \<sharp> \<alpha>\<close> Sp
   have "cRs = (p \<bullet> \<alpha>) \<prec> \<lparr>\<nu>x\<rparr>(p \<bullet> P')"
     by(force simp add: residualAlpha)
   with \<open>y \<sharp> (p \<bullet> P')\<close> have "cRs = (p \<bullet> \<alpha>) \<prec> \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> p \<bullet> P')"
     by(simp add: alphaRes)
   moreover from \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> \<open>(bn(p \<bullet> \<alpha>)) \<sharp>* P'\<close> Sp
   have "\<Psi> \<rhd> P \<longmapsto>(p \<bullet> \<alpha>) \<prec> (p \<bullet> P')" by(force simp add: residualAlpha)
   hence"([(x, y)] \<bullet> \<Psi>) \<rhd> ([(x, y)] \<bullet> P) \<longmapsto>[(x, y)] \<bullet> ((p \<bullet> \<alpha>) \<prec> (p \<bullet> P'))"
     by(rule eqvts)
   with \<open>x \<sharp> \<Psi>\<close> \<open>y \<sharp> \<Psi>\<close> \<open>y \<sharp> (p \<bullet> \<alpha>)\<close> \<open>x \<sharp> (p \<bullet> \<alpha>)\<close> Sp \<open>distinctPerm p\<close>
   have "\<Psi> \<rhd> ([(x, y)] \<bullet> P) \<longmapsto>(p \<bullet> \<alpha>) \<prec> ([(x, y)] \<bullet> p \<bullet> P')" 
     by(simp add: eqvts)
   moreover from \<open>bn(p \<bullet> \<alpha>) \<sharp>* P\<close> \<open>y \<sharp> (p \<bullet> \<alpha>)\<close> \<open>y \<sharp> P\<close> have "bn(p \<bullet> \<alpha>) \<sharp>* ([(x, y)] \<bullet> P)"
     by(auto simp add: fresh_star_def fresh_left calc_atm) (simp add: fresh_def name_list_supp)
   moreover from \<open>distinct(bn \<alpha>)\<close> have "distinct(p \<bullet> bn \<alpha>)" by simp
   hence "distinct(bn(p \<bullet> \<alpha>))" by(simp add: eqvts)
   ultimately show ?thesis
     using \<open>y \<sharp> \<Psi>\<close> \<open>y \<sharp> (p \<bullet> \<alpha>)\<close> \<open>y \<sharp> C\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<Psi>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* subject(p \<bullet> \<alpha>)\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* C\<close>
     by(rule_tac rScope)
 next
   case(Bang P)
   thus ?thesis by(rule_tac rBang) 
 qed
 
 nominal_primrec
   inputLength :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi \<Rightarrow> nat"
   and inputLength'  :: "('a::fs_name, 'b::fs_name, 'c::fs_name) input \<Rightarrow> nat"
   and inputLength'' :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psiCase \<Rightarrow> nat"
 
 where
   "inputLength (\<zero>) = 0"
 | "inputLength (M\<langle>N\<rangle>.P) = 0"
 | "inputLength (M\<lparr>I) = inputLength' I"
 | "inputLength (Case C) = 0"
 | "inputLength (P \<parallel> Q) = 0"
 | "inputLength (\<lparr>\<nu>x\<rparr>P) = 0"
 | "inputLength (\<lbrace>\<Psi>\<rbrace>) = 0"
 | "inputLength (!P) = 0"
 
 | "inputLength' (Trm M P) = 0"
 | "inputLength' (\<nu> y I) = 1 + (inputLength' I)"
 
 | "inputLength'' (\<bottom>\<^sub>c) = 0"
 | "inputLength'' (\<box>\<Phi> \<Rightarrow> P C) = 0"
 apply(finite_guess)+
 apply(rule TrueI)+
 by(fresh_guess add: fresh_nat)+
 
 nominal_primrec boundOutputLength :: "('a, 'b, 'c) boundOutput \<Rightarrow> nat"
 where
   "boundOutputLength (BOut M P) = 0"
 | "boundOutputLength (BStep x B) = (boundOutputLength B) + 1"
 apply(finite_guess)+
 apply(rule TrueI)+
 by(fresh_guess add: fresh_nat)+
   
 nominal_primrec residualLength :: "('a, 'b, 'c) residual \<Rightarrow> nat"
 where
   "residualLength (RIn M N P) = 0"
 | "residualLength (ROut M B) = boundOutputLength B"
 | "residualLength (RTau P) = 0"
 by(rule TrueI)+
 
 lemma inputLengthProc[simp]:
   shows "inputLength(M\<lparr>\<lambda>*xvec N\<rparr>.P) = length xvec"
 by(induct xvec) auto
 
 lemma boundOutputLengthSimp[simp]:
   shows "residualLength(M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P) = length xvec"
 by(induct xvec) (auto simp add: residualInject)
 
 lemma boundOuputLengthSimp2[simp]:
   shows "residualLength(\<alpha> \<prec> P) = length(bn \<alpha>)"
 by(nominal_induct \<alpha> rule: action.strong_induct, auto) (auto simp add: residualInject)
 
 lemmas [simp del] = inputLength_inputLength'_inputLength''.simps residualLength.simps boundOutputLength.simps
 
 lemma constructPerm:
   fixes xvec :: "name list"
   and   yvec :: "name list"
   
   assumes "length xvec = length yvec"
   and     "xvec \<sharp>* yvec"
   and     "distinct xvec"
   and     "distinct yvec"
 
   obtains p where "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)" and "distinctPerm p" and "yvec = p \<bullet> xvec"
 proof -
   assume "\<And>p. \<lbrakk>set p \<subseteq> set xvec \<times> set (p \<bullet> xvec); distinctPerm p; yvec = p \<bullet> xvec\<rbrakk> \<Longrightarrow> thesis"
   moreover obtain n where "n = length xvec" by auto
   with assms have "\<exists>p. (set p) \<subseteq> (set xvec) \<times> set (yvec) \<and> distinctPerm p \<and>  yvec = p \<bullet> xvec"
   proof(induct n arbitrary: xvec yvec)
     case(0 xvec yvec)
     thus ?case by simp
   next
     case(Suc n xvec yvec)
     from \<open>Suc n = length xvec\<close>
     obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
       by(case_tac xvec) auto
     from \<open>length xvec = length yvec\<close> \<open>xvec = x # xvec'\<close>
     obtain y yvec' where "length xvec' = length yvec'" and "yvec = y#yvec'"
       by(case_tac yvec) auto
     from \<open>xvec = x#xvec'\<close> \<open>yvec=y#yvec'\<close> \<open>xvec \<sharp>* yvec\<close>
     have "x \<noteq> y" and "xvec' \<sharp>* yvec'" and "x \<sharp> yvec'" and "y \<sharp> xvec'"
       by(auto simp add: fresh_list_cons)
     from \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close> have "x \<sharp> xvec'" and "y \<sharp> yvec'" and "distinct xvec'" and "distinct yvec'"
       by simp+
     from \<open>Suc n = length xvec\<close> \<open>xvec=x#xvec'\<close> have "n = length xvec'" by simp
     with \<open>length xvec' = length yvec'\<close> \<open>xvec' \<sharp>* yvec'\<close> \<open>distinct xvec'\<close> \<open>distinct yvec'\<close>
     obtain p where S: "set p \<subseteq> set xvec' \<times> set yvec'" and "distinctPerm p" and "yvec' = p \<bullet> xvec'"
       by(drule_tac Suc) auto
     from S have "set((x, y)#p) \<subseteq> set(x#xvec') \<times> set(y#yvec')" by auto
     moreover from \<open>x \<sharp> xvec'\<close> \<open>x \<sharp> yvec'\<close> \<open>y \<sharp> xvec'\<close> \<open>y \<sharp> yvec'\<close> S have "x \<sharp> p" and "y \<sharp> p"
       apply(induct p)
       by(auto simp add: fresh_list_nil fresh_list_cons fresh_prod name_list_supp) (auto simp add: fresh_def) 
 
     with S \<open>distinctPerm p\<close> \<open>x \<noteq> y\<close> have "distinctPerm((x, y)#p)" by auto
     moreover from \<open>yvec' = p \<bullet> xvec'\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> xvec'\<close> \<open>y \<sharp> xvec'\<close> have "(y#yvec') = ((x, y)#p) \<bullet> (x#xvec')"
       by(simp add: calc_atm freshChainSimps)
     ultimately show ?case using \<open>xvec=x#xvec'\<close> \<open>yvec=y#yvec'\<close>
       by blast
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma distinctApend[simp]:
   fixes xvec :: "name list"
   and   yvec :: "name list"
 
   shows "(set xvec \<inter> set yvec = {}) = xvec \<sharp>* yvec"
 by(auto simp add: fresh_star_def name_list_supp fresh_def)
 
 lemma lengthAux:
   fixes xvec :: "name list"
   and   y    :: name
   and   yvec :: "name list"
 
   assumes "length xvec = length(y#yvec)"
 
   obtains z zvec where "xvec = z#zvec" and "length zvec = length yvec"
 using assms
 by(induct xvec arbitrary: yvec y) auto
 
 lemma lengthAux2:
   fixes xvec :: "name list"
   and   yvec :: "name list"
   and   zvec :: "name list"
 
   assumes "length xvec = length(yvec@y#zvec)"
 
   obtains xvec1 x xvec2 where "xvec=xvec1@x#xvec2" and "length xvec1 = length yvec" and "length xvec2 = length zvec"
 proof -
   assume "\<And>xvec1 x xvec2.
         \<lbrakk>xvec = xvec1 @ x # xvec2; length xvec1 = length yvec;
          length xvec2 = length zvec\<rbrakk>
         \<Longrightarrow> thesis"
   moreover from assms have "\<exists>xvec1 x xvec2. xvec=xvec1@x#xvec2 \<and> length xvec1 = length yvec \<and> length xvec2 = length zvec"
     apply(rule_tac x="take (length yvec) xvec" in exI)
     apply(rule_tac x="hd(drop (length yvec) xvec)" in exI)
     apply(rule_tac x="tl(drop (length yvec) xvec)" in exI)
     by auto
   ultimately show ?thesis by blast
 qed
 
 lemma semanticsCases[consumes 11, case_names cInput cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
   fixes \<Psi>  :: 'b
   and   cP  :: "('a, 'b, 'c) psi"
   and   cRs :: "('a, 'b, 'c) residual"
   and   C   :: "'d::fs_name"
   and   x1   :: name
   and   x2   :: name
   and   xvec1 :: "name list"
   and   xvec2 :: "name list"
   and   xvec3 :: "name list"
   and   xvec4 :: "name list"
   and   xvec5 :: "name list"
 
   assumes "\<Psi> \<rhd> cP \<longmapsto>cRs"
   and     "length xvec1 = inputLength cP" and "distinct xvec1"
   and     "length xvec2 = residualLength cRs" and "distinct xvec2"
   and     "length xvec3 = residualLength cRs" and "distinct xvec3"
   and     "length xvec4 = residualLength cRs" and "distinct xvec4"
   and     "length xvec5 = residualLength cRs" and "distinct xvec5"
   and     rInput: "\<And>M K N Tvec P. (\<lbrakk>xvec1 \<sharp>* \<Psi>; xvec1 \<sharp>* cP; xvec1 \<sharp>* cRs\<rbrakk> \<Longrightarrow> cP = M\<lparr>\<lambda>*xvec1 N\<rparr>.P \<and>  cRs = K\<lparr>(N[xvec1::=Tvec])\<rparr> \<prec> P[xvec1::=Tvec] \<and>
                                             \<Psi> \<turnstile> M \<leftrightarrow> K \<and> distinct xvec1 \<and> set xvec1 \<subseteq> supp N \<and> length xvec1=length Tvec \<and>
                                             xvec1 \<sharp>* Tvec \<and> xvec1 \<sharp>* \<Psi> \<and> xvec1 \<sharp>* M \<and> xvec1 \<sharp>* K) \<Longrightarrow> Prop"
   and     rOutput: "\<And>M K N P. \<lbrakk>cP = M\<langle>N\<rangle>.P; cRs = K\<langle>N\<rangle> \<prec> P; \<Psi> \<turnstile> M \<leftrightarrow> K\<rbrakk> \<Longrightarrow> Prop"
   and     rCase: "\<And>Cs P \<phi>. \<lbrakk>cP = Cases Cs; \<Psi> \<rhd> P \<longmapsto> cRs; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> Prop"
   and     rPar1: "\<And>\<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q. (\<lbrakk>xvec2 \<sharp>* \<Psi>; xvec2 \<sharp>* cP; xvec2 \<sharp>* cRs\<rbrakk> \<Longrightarrow> 
                                          cP = P \<parallel> Q \<and> cRs = \<alpha> \<prec> (P' \<parallel> Q) \<and> xvec2 = bn \<alpha> \<and>
                                           \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P' \<and> extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle> \<and> distinct A\<^sub>Q \<and>
                                           A\<^sub>Q \<sharp>* P \<and> A\<^sub>Q \<sharp>* Q \<and> A\<^sub>Q \<sharp>* \<Psi> \<and> A\<^sub>Q \<sharp>* \<alpha> \<and> A\<^sub>Q \<sharp>* P' \<and> A\<^sub>Q \<sharp>* C) \<Longrightarrow> Prop"
   and     rPar2: "\<And>\<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P. (\<lbrakk>xvec3 \<sharp>* \<Psi>; xvec3 \<sharp>* cP; xvec3 \<sharp>* cRs\<rbrakk> \<Longrightarrow> 
                                          cP = P \<parallel> Q \<and> cRs = \<alpha> \<prec> (P \<parallel> Q') \<and> xvec3 = bn \<alpha> \<and>
                                           \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q' \<and> extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle> \<and> distinct A\<^sub>P \<and>
                                           A\<^sub>P \<sharp>* P \<and> A\<^sub>P \<sharp>* Q \<and> A\<^sub>P \<sharp>* \<Psi> \<and> A\<^sub>P \<sharp>* \<alpha> \<and> A\<^sub>P \<sharp>* Q' \<and> A\<^sub>P \<sharp>* C) \<Longrightarrow> Prop"
   and     rComm1: "\<And>\<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q.
                    \<lbrakk>cP = P \<parallel> Q; cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>P' \<parallel> Q';
                     \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N;
                     A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* Q;
                     xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop"
   and     rComm2: "\<And>\<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q.
                    \<lbrakk>cP = P \<parallel> Q; cRs = \<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>P' \<parallel> Q';
                     \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto> K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                     \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N;
                     A\<^sub>P \<sharp>* P'; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P \<sharp>* xvec; A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P;
                     A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* K; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* xvec;
                     xvec \<sharp>* \<Psi>; xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* \<Psi>\<^sub>Q; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* Q;
                     xvec \<sharp>* K; A\<^sub>P \<sharp>* C; A\<^sub>Q \<sharp>* C; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop"
   and    rOpen:  "\<And>P  M xvec y yvec N P'. 
                    (\<lbrakk>xvec4 \<sharp>* \<Psi>; xvec4 \<sharp>* cP; xvec4 \<sharp>* cRs; x1 \<sharp> \<Psi>; x1 \<sharp> cP; x1 \<sharp> cRs; x1 \<sharp> xvec4\<rbrakk> \<Longrightarrow>
                     cP = \<lparr>\<nu>x1\<rparr>P \<and> cRs = M\<lparr>\<nu>*(xvec@x1#yvec)\<rparr>\<langle>N\<rangle> \<prec> P' \<and> xvec4=xvec@y#yvec \<and>
                     \<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P' \<and> x1 \<in> supp N \<and> x1 \<sharp> xvec \<and> x1 \<sharp> yvec \<and>
                     distinct xvec \<and> distinct yvec \<and> xvec \<sharp>* \<Psi> \<and> xvec \<sharp>* P \<and> xvec \<sharp>* M \<and> xvec \<sharp>* yvec \<and>
                     yvec \<sharp>* \<Psi> \<and> yvec \<sharp>* P \<and> yvec \<sharp>* M) \<Longrightarrow> Prop"
   and     rScope: "\<And>P \<alpha> P'. (\<lbrakk>xvec5 \<sharp>* \<Psi>; xvec5 \<sharp>* cP; xvec5 \<sharp>* cRs; x2 \<sharp> \<Psi>; x2 \<sharp> cP; x2 \<sharp> cRs; x2 \<sharp> xvec5\<rbrakk> \<Longrightarrow> 
                               cP = \<lparr>\<nu>x2\<rparr>P \<and> cRs = \<alpha> \<prec> \<lparr>\<nu>x2\<rparr>P' \<and>  xvec5 = bn \<alpha> \<and>
                               \<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P' \<and> x2 \<sharp> \<Psi> \<and> x2 \<sharp> \<alpha> \<and> bn \<alpha> \<sharp>* subject \<alpha> \<and> distinct(bn \<alpha>)) \<Longrightarrow> Prop"
   and    rBang:  "\<And>P. \<lbrakk>cP = !P; \<Psi> \<rhd> P \<parallel> !P \<longmapsto> cRs; guarded P\<rbrakk> \<Longrightarrow> Prop"
   shows Prop
 using \<open>\<Psi> \<rhd> cP \<longmapsto>cRs\<close>
 proof(cases rule: semanticsCasesAux[where C="(xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)"])
   case(cInput M K xvec N Tvec P)
   have B: "cP = M\<lparr>\<lambda>*xvec N\<rparr>.P" and C: "cRs = K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (P[xvec::=Tvec])" 
     by fact+
   from \<open>xvec \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "xvec \<sharp>* xvec1" by simp
   
   from \<open>length xvec1 = inputLength cP\<close> B have "length xvec1 = length xvec"
     by simp
   then obtain p where S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)" and "distinctPerm p" and "xvec1 = p \<bullet> xvec"
     using \<open>xvec \<sharp>* xvec1\<close> \<open>distinct xvec\<close> \<open>distinct xvec1\<close>
     by(rule_tac constructPerm[where xvec=xvec and yvec=xvec1]) auto
   show ?thesis
   proof(rule rInput[where M=M and K=K and N = "p \<bullet> N" and Tvec=Tvec and P="p \<bullet> P"], goal_cases)
     case 1
     from B \<open>xvec \<sharp>* xvec1\<close> \<open>xvec1 \<sharp>* cP\<close> have "xvec1 \<sharp>* N" and "xvec1 \<sharp>* P"
       by(auto simp add: fresh_star_def inputChainFresh name_list_supp) (auto simp add: fresh_def)
 
     from \<open>cP = M\<lparr>\<lambda>*xvec N\<rparr>.P\<close> S \<open>xvec1 \<sharp>* N\<close> \<open>xvec1 \<sharp>* P\<close> \<open>xvec1 = p \<bullet> xvec\<close>
     have "cP = M\<lparr>\<lambda>*xvec1 (p \<bullet> N)\<rparr>.(p \<bullet> P)"
       apply simp
       by(subst inputChainAlpha) auto
     moreover from \<open>cRs = K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> P[xvec::=Tvec]\<close> S \<open>xvec1 \<sharp>* N\<close> \<open>xvec1 \<sharp>* P\<close> \<open>xvec1 = p \<bullet> xvec\<close> \<open>length xvec = length Tvec\<close> \<open>distinctPerm p\<close>
     have "cRs =  K\<lparr>((p \<bullet> N)[xvec1::=Tvec])\<rparr> \<prec> (p \<bullet> P)[xvec1::=Tvec]"
       by(simp add: renaming substTerm.renaming)
     moreover note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close>
     moreover from \<open>distinct xvec\<close> \<open>xvec1 = p \<bullet> xvec\<close> have "distinct xvec1" by simp
     moreover from \<open>set xvec \<subseteq> supp N\<close> have "(p \<bullet> set xvec) \<subseteq> (p \<bullet> (supp N))"
       by(simp add: eqvts)
     with \<open>xvec1 = p \<bullet> xvec\<close> have "set xvec1 \<subseteq> supp(p \<bullet> N)" by(simp add: eqvts)
     moreover from \<open>length xvec = length Tvec\<close> \<open>xvec1 = p \<bullet> xvec\<close> have "length xvec1 = length Tvec"
       by simp
 
     moreover from \<open>xvec1 \<sharp>* cRs\<close> C \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close>
     have "(set xvec1) \<sharp>* Tvec"
       by(rule_tac substTerm.subst3Chain[where T=N]) auto
     hence "xvec1 \<sharp>* Tvec" by simp
     moreover from \<open>xvec \<sharp>* Tvec\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> Tvec)" by(simp add: fresh_star_bij)
     with S \<open>xvec \<sharp>* Tvec\<close> \<open>xvec1 \<sharp>* Tvec\<close> \<open>xvec1 = p \<bullet> xvec\<close> have "xvec1 \<sharp>* Tvec" by simp
     moreover from \<open>xvec \<sharp>* M\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> M)" by(simp add: fresh_star_bij)
     with S \<open>xvec \<sharp>* M\<close> \<open>xvec1 \<sharp>* cP\<close> B \<open>xvec1 = p \<bullet> xvec\<close> have "xvec1 \<sharp>* M" by simp
     moreover from \<open>xvec \<sharp>* K\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> K)" by(simp add: fresh_star_bij)
     with S \<open>xvec \<sharp>* K\<close> \<open>xvec1 \<sharp>* cRs\<close> C \<open>xvec1 = p \<bullet> xvec\<close> have "xvec1 \<sharp>* K" by simp
     ultimately show ?case using \<open>xvec1 \<sharp>* \<Psi>\<close> by blast 
   qed
 next
   case(cOutput M K N P)
   thus ?thesis by(rule rOutput) 
 next
   case(cCase Cs P \<phi>)
   thus ?thesis by(rule rCase) 
 next
   case(cPar1 \<Psi>\<^sub>Q P \<alpha> P' Q A\<^sub>Q)
   have B: "cP = P \<parallel> Q" and C: "cRs = \<alpha> \<prec> P' \<parallel> Q"
     by fact+
   from \<open>bn \<alpha> \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "bn \<alpha> \<sharp>* xvec2" by simp
   from \<open>A\<^sub>Q \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "A\<^sub>Q \<sharp>* xvec2" and "A\<^sub>Q \<sharp>* C" by simp+
   
   from \<open>length xvec2 = residualLength cRs\<close> C have "length xvec2 = length(bn \<alpha>)"
     by simp
   then obtain p where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "xvec2= bn(p \<bullet> \<alpha>)"
     using \<open>bn \<alpha> \<sharp>* xvec2\<close> \<open>distinct(bn \<alpha>)\<close> \<open>distinct xvec2\<close>
     by(rule_tac constructPerm[where xvec="bn \<alpha>" and yvec=xvec2]) (auto simp add: eqvts)
   show ?thesis
   proof(rule rPar1[where P=P and Q=Q and \<alpha>="p \<bullet> \<alpha>" and P'="p \<bullet> P'" and A\<^sub>Q=A\<^sub>Q and \<Psi>\<^sub>Q=\<Psi>\<^sub>Q], goal_cases)
     case 1
     note \<open>cP = P \<parallel> Q\<close>
     moreover from B C S \<open>bn \<alpha> \<sharp>* xvec2\<close> \<open>xvec2 \<sharp>* cRs\<close> \<open>xvec2 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec2 \<sharp>* cP\<close> \<open>bn \<alpha> \<sharp>* Q\<close>
     have "cRs = (p \<bullet> \<alpha>) \<prec> (p \<bullet> P') \<parallel> Q"
       apply auto
       by(subst residualAlpha[where p=p]) auto
     moreover note \<open>xvec2 = bn(p \<bullet> \<alpha>)\<close>
     moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> S B C S \<open>bn \<alpha> \<sharp>* xvec2\<close> \<open>xvec2 \<sharp>* cRs\<close> \<open>xvec2 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec2 \<sharp>* cP\<close>
     have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>(p \<bullet> \<alpha>) \<prec> (p \<bullet> P')"
       by(subst residualAlpha[symmetric]) auto
     moreover note \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close>
     moreover from \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* xvec2\<close> S \<open>xvec2 = bn(p \<bullet> \<alpha>)\<close> \<open>distinctPerm p\<close> have "A\<^sub>Q \<sharp>* (p \<bullet> \<alpha>)"
       by(subst fresh_star_bij[symmetric, where pi=p]) simp
     moreover from \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> \<open>A\<^sub>Q \<sharp>* xvec2\<close> S \<open>xvec2 = bn(p \<bullet> \<alpha>)\<close> \<open>distinctPerm p\<close> have "A\<^sub>Q \<sharp>* (p \<bullet> P')"
       by(subst fresh_star_bij[symmetric, where pi=p]) simp
     moreover note \<open>A\<^sub>Q \<sharp>* C\<close>
     ultimately show ?case by blast
   qed
 next
   case(cPar2 \<Psi>\<^sub>P Q \<alpha> Q' P A\<^sub>P)
   have B: "cP = P \<parallel> Q" and C: "cRs = \<alpha> \<prec> P \<parallel> Q'"
     by fact+
   from \<open>bn \<alpha> \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "bn \<alpha> \<sharp>* xvec3" by simp
   from \<open>A\<^sub>P \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "A\<^sub>P \<sharp>* xvec3" and "A\<^sub>P \<sharp>* C" by simp+
   
   from \<open>length xvec3 = residualLength cRs\<close> C have "length xvec3 = length(bn \<alpha>)"
     by simp
   then obtain p where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "xvec3 = bn(p \<bullet> \<alpha>)"
     using \<open>bn \<alpha> \<sharp>* xvec3\<close> \<open>distinct(bn \<alpha>)\<close> \<open>distinct xvec3\<close>
     by(rule_tac constructPerm[where xvec="bn \<alpha>" and yvec=xvec3]) (auto simp add: eqvts)
   show ?thesis
   proof(rule rPar2[where P=P and Q=Q and \<alpha>="p \<bullet> \<alpha>" and Q'="p \<bullet> Q'" and A\<^sub>P=A\<^sub>P and \<Psi>\<^sub>P=\<Psi>\<^sub>P], goal_cases)
     case 1
     note \<open>cP = P \<parallel> Q\<close>
     moreover from B C S \<open>bn \<alpha> \<sharp>* xvec3\<close> \<open>xvec3 \<sharp>* cRs\<close> \<open>xvec3 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec3 \<sharp>* cP\<close> \<open>bn \<alpha> \<sharp>* P\<close>
     have "cRs = (p \<bullet> \<alpha>) \<prec> P \<parallel> (p \<bullet> Q')"
       apply auto
       by(subst residualAlpha[where p=p]) auto
     moreover note \<open>xvec3 = bn(p \<bullet> \<alpha>)\<close>
     moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> S B C S \<open>bn \<alpha> \<sharp>* xvec3\<close> \<open>xvec3 \<sharp>* cRs\<close> \<open>xvec3 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec3 \<sharp>* cP\<close>
     have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>(p \<bullet> \<alpha>) \<prec> (p \<bullet> Q')"
       by(subst residualAlpha[symmetric]) auto
     moreover note \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close>
     moreover from \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* xvec3\<close> S \<open>xvec3 = bn(p \<bullet> \<alpha>)\<close> \<open>distinctPerm p\<close> have "A\<^sub>P \<sharp>* (p \<bullet> \<alpha>)"
       by(subst fresh_star_bij[symmetric, where pi=p]) simp
     moreover from \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* xvec3\<close> S \<open>xvec3 = bn(p \<bullet> \<alpha>)\<close> \<open>distinctPerm p\<close> have "A\<^sub>P \<sharp>* (p \<bullet> Q')"
       by(subst fresh_star_bij[symmetric, where pi=p]) simp
     moreover note \<open>A\<^sub>P \<sharp>* C\<close>
     ultimately show ?case by blast
   qed
 next
   case(cComm1 \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q)
   thus ?thesis by(rule_tac rComm1[where P=P and Q=Q]) (assumption | simp)+
 next
   case(cComm2 \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q)
   thus ?thesis by(rule_tac rComm2[where P=P and Q=Q]) (assumption | simp)+
 next
   case(cOpen P M xvec yvec N P' x)
   have B: "cP = \<lparr>\<nu>x\<rparr>P" and C: "cRs = M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'"
     by fact+
   from \<open>xvec \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "xvec \<sharp>* xvec4" and "xvec \<sharp>* cP" and "xvec \<sharp>* cRs" and "x1 \<sharp> xvec" by simp+
   from \<open>x \<sharp> (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "x \<sharp> xvec4" and "x \<sharp> cP" and "x \<sharp> cRs" and "x \<noteq> x1" by simp+
   from \<open>yvec \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "yvec \<sharp>* xvec4" and "yvec \<sharp>* cP"  and "yvec \<sharp>* cRs" and "x1 \<sharp> yvec" by simp+
 
   from \<open>xvec \<sharp>* cRs\<close> \<open>x \<sharp> cRs\<close> \<open>yvec \<sharp>* cRs\<close> C have "(xvec@x#yvec) \<sharp>* M" by simp
   from \<open>xvec \<sharp>* \<Psi>\<close> \<open>x \<sharp> \<Psi>\<close> \<open>yvec \<sharp>* \<Psi>\<close> have "(xvec@x#yvec) \<sharp>* \<Psi>" by simp
   from \<open>length xvec4 = residualLength cRs\<close> C obtain xvec' y yvec' where D: "xvec4 = xvec'@y#yvec'" and "length xvec' = length xvec" and "length yvec' = length yvec"
     by(rule_tac lengthAux2) auto
   with \<open>distinct xvec\<close> \<open>distinct yvec\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>xvec \<sharp>* yvec\<close> \<open>xvec \<sharp>* xvec4\<close> \<open>yvec \<sharp>* xvec4\<close> \<open>x \<sharp> xvec4\<close> \<open>distinct xvec4\<close>
   have "distinct xvec'" and "distinct yvec'" and "xvec' \<sharp>* yvec'" and "x \<noteq> y" and "y \<sharp> xvec'" and "y \<sharp> yvec'" 
    and "x \<sharp> xvec'" and "x \<sharp> yvec'" and "y \<sharp> xvec" and "y \<sharp> yvec" and "xvec \<sharp>* xvec'" and "yvec \<sharp>* yvec'"
     by auto
   from \<open>length xvec' = length xvec\<close> \<open>xvec \<sharp>* xvec'\<close> \<open>distinct xvec\<close> \<open>distinct xvec'\<close> 
   obtain p where Sp: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)" and "distinctPerm p" and E: "xvec' = p \<bullet> xvec"
     by(metis constructPerm)
   from \<open>length yvec' = length yvec\<close> \<open>yvec \<sharp>* yvec'\<close> \<open>distinct yvec\<close> \<open>distinct yvec'\<close> 
   obtain q where Sq: "set q \<subseteq> set yvec \<times> set(q \<bullet> yvec)" and "distinctPerm q" and F: "yvec' = q \<bullet> yvec"
     by(metis constructPerm)
 
   show ?thesis
   proof(rule rOpen[where P="([(x, x1)] \<bullet> P)" and xvec="p \<bullet> xvec" and y="y" and yvec="q \<bullet> yvec" and N="(p@(x1, x)#q) \<bullet> N" and P'="(p@(x1, x)#q) \<bullet> P'" and M=M], goal_cases)
     case 1
     from \<open>xvec \<sharp>* xvec4\<close> \<open>x \<sharp> xvec4\<close> \<open>x1 \<sharp> xvec4\<close> \<open>yvec \<sharp>* xvec4\<close> D E F
     have "x \<noteq> y" and "x1 \<noteq> y" and "x1 \<sharp> p \<bullet> xvec" and "x1 \<sharp> q \<bullet> yvec" by simp+
     from \<open>xvec4 \<sharp>* cRs\<close> \<open>x1 \<sharp> cRs\<close> C have "xvec4 \<sharp>* M" and "x1 \<sharp> M" by simp+
     from \<open>cP = \<lparr>\<nu>x\<rparr>P\<close> \<open>x \<sharp> cP\<close> \<open>x \<noteq> x1\<close> have "([(x, x1)] \<bullet> cP) = [(x, x1)] \<bullet> \<lparr>\<nu>x\<rparr>P"
       by simp
     with \<open>x \<sharp> cP\<close> \<open>x1 \<sharp> cP\<close> have "cP = \<lparr>\<nu>x1\<rparr>([(x, x1)] \<bullet> P)" by(simp add: eqvts calc_atm)
     moreover from C have "((p@(x1, x)#q) \<bullet> cRs) = (p@(x1, x)#q) \<bullet> (M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P')" by(simp add: fresh_star_bij)
     with Sp Sq \<open>xvec4 \<sharp>* cRs\<close> D E F \<open>xvec \<sharp>* cRs\<close> \<open>x \<sharp> cRs\<close> \<open>yvec \<sharp>* cRs\<close> \<open>xvec4 \<sharp>* M\<close> \<open>(xvec@x#yvec) \<sharp>* M\<close> \<open>xvec \<sharp>* xvec4\<close> \<open>x \<sharp> xvec4\<close> \<open>yvec \<sharp>* xvec4\<close> \<open>xvec \<sharp>* yvec\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>y \<sharp> xvec'\<close> \<open>y \<sharp> yvec'\<close> \<open>xvec' \<sharp>* yvec'\<close> \<open>x1 \<sharp> xvec\<close> \<open>x1 \<sharp> yvec\<close> \<open>x1 \<noteq> y\<close> \<open>x1 \<sharp> xvec4\<close> \<open>x1 \<sharp> cRs\<close> \<open>x1 \<sharp> cRs\<close> \<open>x \<noteq> x1\<close> \<open>x1 \<sharp> M\<close>
     have "cRs = M\<lparr>\<nu>*((p \<bullet> xvec)@x1#(q \<bullet> yvec))\<rparr>\<langle>((p@(x1, x)#q) \<bullet> N)\<rangle> \<prec> ((p@(x1, x)#q) \<bullet> P')"
       by(simp add: eqvts pt2[OF pt_name_inst] calc_atm)
     moreover from D E F have "xvec4 = (p \<bullet> xvec)@y#(q \<bullet> yvec)" by simp
     moreover from \<open>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'\<close> have "((p@(x1, x)#q) \<bullet> \<Psi>) \<rhd> ((p@(x1, x)#q) \<bullet> P) \<longmapsto>((p@(x1, x)#q) \<bullet> (M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'))"
       by(intro eqvts)
     with Sp Sq B C D E F \<open>xvec4 \<sharp>* \<Psi>\<close> \<open>(xvec@x#yvec) \<sharp>* \<Psi>\<close> \<open>xvec4 \<sharp>* cRs\<close> \<open>x \<sharp> xvec4\<close> C D \<open>x \<sharp> cRs\<close> \<open>yvec \<sharp>* cRs\<close> \<open>xvec4 \<sharp>* M\<close> \<open>(xvec@x#yvec) \<sharp>* M\<close> \<open>x \<sharp> M\<close> \<open>x1 \<sharp> cRs\<close> \<open>x \<noteq> x1\<close> \<open>x1 \<sharp> xvec\<close> \<open>x1 \<sharp> yvec\<close> \<open>xvec \<sharp>* xvec4\<close> \<open>yvec \<sharp>* xvec4\<close> \<open>x1 \<sharp> xvec4\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x1 \<sharp> \<Psi>\<close> \<open>xvec4 \<sharp>* cP\<close> \<open>xvec \<sharp>* P\<close> \<open>yvec \<sharp>* P\<close> \<open>xvec' \<sharp>* yvec'\<close> \<open>x1 \<sharp> xvec4\<close> \<open>xvec4 \<sharp>* cP\<close> \<open>yvec \<sharp>* xvec4\<close> \<open>xvec \<sharp>* xvec4\<close> \<open>x \<noteq> x1\<close> \<open>xvec \<sharp>* yvec\<close>
     have "\<Psi> \<rhd> ([(x, x1)] \<bullet> P) \<longmapsto>M\<lparr>\<nu>*((p \<bullet> xvec)@(q \<bullet> yvec))\<rparr>\<langle>((p@(x1, x)#q) \<bullet> N)\<rangle> \<prec> ((p@(x1, x)#q) \<bullet> P')" 
       by(simp add: eqvts  pt_fresh_bij[OF pt_name_inst, OF at_name_inst] pt2[OF pt_name_inst] name_swap)
     
     moreover from \<open>x \<in> supp N\<close> have "((p@(x1, x)#q) \<bullet> x) \<in> ((p@(x1, x)#q) \<bullet> supp N)"
       by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
     hence "x1 \<in> supp((p@(x1, x)#q) \<bullet> N)"
       using \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x1 \<sharp> xvec\<close> \<open>x1 \<sharp> yvec\<close> \<open>x \<sharp> xvec4\<close> \<open>x1 \<sharp> xvec4\<close> \<open>xvec \<sharp>* xvec4\<close> \<open>yvec \<sharp>* xvec4\<close> \<open>xvec' \<sharp>* yvec'\<close> D E F Sp Sq \<open>x \<noteq> x1\<close>
       by(simp add: eqvts pt2[OF pt_name_inst] calc_atm)
     moreover from \<open>x1 \<sharp> xvec4\<close> D E F have "x1 \<sharp> (p \<bullet> xvec)" and "x1 \<sharp> (q \<bullet> yvec)" by simp+
     moreover from \<open>distinct xvec'\<close> \<open>distinct yvec'\<close> E F have "distinct(p \<bullet> xvec)" and "distinct(q \<bullet> yvec)" by simp+
     moreover from \<open>xvec' \<sharp>* yvec'\<close> E F have "(p \<bullet> xvec) \<sharp>* (q \<bullet> yvec)" by auto
     moreover from \<open>xvec \<sharp>* \<Psi>\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> \<Psi>)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
     with Sp D E \<open>xvec4 \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* \<Psi>\<close> have "(p \<bullet> xvec) \<sharp>* \<Psi>" by(simp add: eqvts)
     moreover from \<open>yvec \<sharp>* \<Psi>\<close> have "(p \<bullet> yvec) \<sharp>* (p \<bullet> \<Psi>)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
     with Sq D F \<open>xvec4 \<sharp>* \<Psi>\<close> \<open>yvec \<sharp>* \<Psi>\<close> have "(q \<bullet> yvec) \<sharp>* \<Psi>" by(simp add: eqvts)
     moreover from \<open>xvec4 \<sharp>* cP\<close> \<open>x \<sharp> xvec4\<close> \<open>x1 \<sharp> xvec4\<close> B D E F have "(p \<bullet> xvec) \<sharp>* ([(x, x1)] \<bullet> P)" and "(q \<bullet> yvec) \<sharp>* ([(x, x1)] \<bullet> P)"
       by simp+
     moreover from \<open>xvec4 \<sharp>* M\<close> C D E F have "(p \<bullet> xvec) \<sharp>* M" and "(q \<bullet> yvec) \<sharp>* M" by simp+
     ultimately show ?case
       by blast
   qed
 next
   case(cScope P \<alpha> P' x)
   have B: "cP = \<lparr>\<nu>x\<rparr>P" and C: "cRs = \<alpha> \<prec> \<lparr>\<nu>x\<rparr>P'"
     by fact+
   from \<open>bn \<alpha> \<sharp>* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "bn \<alpha> \<sharp>* xvec5" and "x2 \<sharp> bn \<alpha>" by simp+
   from \<open>x \<sharp> (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)\<close> have "x \<sharp> xvec5" and "x \<noteq> x2" and "x \<sharp> cRs" by simp+
   
   from \<open>length xvec5 = residualLength cRs\<close> C have "length xvec5 = length(bn \<alpha>)"
     by simp
   then obtain p where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "xvec5= bn(p \<bullet> \<alpha>)"
     using \<open>bn \<alpha> \<sharp>* xvec5\<close> \<open>distinct(bn \<alpha>)\<close> \<open>distinct xvec5\<close>
     by(rule_tac constructPerm[where xvec="bn \<alpha>" and yvec=xvec5]) (auto simp add: eqvts)
   show ?thesis
   proof(rule rScope[where P="[(x, x2)] \<bullet> P" and \<alpha>="[(x, x2)] \<bullet> p \<bullet> \<alpha>" and P'="[(x, x2)] \<bullet> p \<bullet> P'"], goal_cases)
     case 1
     from \<open>x2 \<sharp> cRs\<close> C \<open>x2 \<sharp> bn \<alpha>\<close> \<open>x \<noteq> x2\<close> have "x2 \<sharp> \<alpha>" and "x2 \<sharp> P'" by(auto simp add: abs_fresh)
     from \<open>cP = \<lparr>\<nu>x\<rparr>P\<close> \<open>x2 \<sharp> cP\<close> \<open>x \<noteq> x2\<close> have "cP = \<lparr>\<nu>x2\<rparr>([(x, x2)] \<bullet> P)"
       by(simp add: alphaRes abs_fresh)
     moreover from B C S \<open>bn \<alpha> \<sharp>* xvec5\<close> \<open>xvec5 \<sharp>* cRs\<close> \<open>xvec5 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec5 \<sharp>* cP\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> xvec5\<close> 
     have "cRs = (p \<bullet> \<alpha>) \<prec> \<lparr>\<nu>x\<rparr>(p \<bullet> P')"
       apply auto
       by(subst residualAlpha[where p=p] alphaRes) (auto simp del: actionFresh)
     hence "([(x, x2)] \<bullet> cRs) = [(x, x2)] \<bullet> ((p \<bullet> \<alpha>) \<prec> \<lparr>\<nu>x\<rparr>(p \<bullet> P'))"
       by simp
     with \<open>x2 \<sharp> cRs\<close> \<open>x \<sharp> cRs\<close> have "cRs = ([(x, x2)] \<bullet> p \<bullet> \<alpha>) \<prec> \<lparr>\<nu>x2\<rparr>([(x, x2)] \<bullet> p \<bullet> P')"
       by(simp add: eqvts calc_atm)
     moreover from \<open>xvec5= bn(p \<bullet> \<alpha>)\<close> have "([(x, x2)] \<bullet> xvec5) = ([(x, x2)] \<bullet> bn(p \<bullet> \<alpha>))"
       by simp
     with \<open>x \<sharp> xvec5\<close> \<open>x2 \<sharp> xvec5\<close> have "xvec5 = bn([(x, x2)] \<bullet> p \<bullet> \<alpha>)"
       by(simp add: eqvts)
     moreover from \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> S B C S \<open>bn \<alpha> \<sharp>* xvec5\<close> \<open>xvec5 \<sharp>* cRs\<close> \<open>xvec5 = bn(p \<bullet> \<alpha>)\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>xvec5 \<sharp>* cP\<close> \<open>x \<sharp> xvec5\<close>
     have "\<Psi> \<rhd> P \<longmapsto>(p \<bullet> \<alpha>) \<prec> (p \<bullet> P')"
       by(subst residualAlpha[symmetric]) auto
     hence "([(x, x2)] \<bullet> \<Psi>) \<rhd> ([(x, x2)] \<bullet> P) \<longmapsto>([(x, x2)] \<bullet> ((p \<bullet> \<alpha>) \<prec> (p \<bullet> P')))"
       by(rule eqvt)
     with \<open>x \<sharp> \<Psi>\<close> \<open>x2 \<sharp> \<Psi>\<close> have "\<Psi> \<rhd> ([(x, x2)] \<bullet> P) \<longmapsto>([(x, x2)] \<bullet> p \<bullet> \<alpha>) \<prec> ([(x, x2)] \<bullet> p \<bullet> P')"
       by(simp add: eqvts)
     moreover note \<open>x2 \<sharp> \<Psi>\<close>
     moreover from \<open>x \<sharp> \<alpha>\<close> \<open>x2 \<sharp> \<alpha>\<close> \<open>x \<sharp> xvec5\<close> \<open>x2 \<sharp> xvec5\<close> S \<open>x \<noteq> x2\<close> \<open>xvec5 = bn(p \<bullet> \<alpha>)\<close> have "x2 \<sharp> [(x, x2)] \<bullet> p \<bullet> \<alpha>"
       apply(subgoal_tac "x \<sharp> p \<and> x2 \<sharp> p")
       apply(simp add: perm_compose freshChainSimps del: actionFresh)
       by(auto dest: freshAlphaSwap)
     moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "([(x, x2)] \<bullet> p \<bullet> (bn \<alpha>)) \<sharp>* ([(x, x2)] \<bullet> p \<bullet> (subject \<alpha>))"
       by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
     hence "bn([(x, x2)] \<bullet> p \<bullet> \<alpha>) \<sharp>* subject([(x, x2)] \<bullet> p \<bullet> \<alpha>)"
       by(simp add: eqvts)
     moreover from \<open>distinct(bn \<alpha>)\<close> have "distinct([(x, x2)] \<bullet> p \<bullet> (bn \<alpha>))" by simp
     hence "distinct(bn([(x, x2)] \<bullet> p \<bullet> \<alpha>))" by(simp add: eqvts)
     ultimately show ?case  by blast
   qed
 next
   case(cBang P)
   thus ?thesis by(rule_tac rBang) auto
 qed
 
 lemma parCases[consumes 5, case_names cPar1 cPar2 cComm1 cComm2]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Q    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   T    :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> T"
   and     "bn \<alpha> \<sharp>* \<Psi>"
   and     "bn \<alpha> \<sharp>* P"
   and     "bn \<alpha> \<sharp>* Q"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     rPar1: "\<And>P' A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P';  extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                                   A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow> Prop \<alpha> (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q';  extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                                  A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop \<alpha> (P \<parallel> Q')"
   and     rComm1: "\<And>\<Psi>\<^sub>Q M N P' A\<^sub>P \<Psi>\<^sub>P K xvec Q' A\<^sub>Q.
            \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
             A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C; 
             A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C; 
             xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K; xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
             Prop (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rComm2: "\<And>\<Psi>\<^sub>Q M xvec N P' A\<^sub>P \<Psi>\<^sub>P K Q' A\<^sub>Q.
            \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
             A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C; 
             A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C; 
             xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K;  xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
             Prop (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
 
   shows "Prop \<alpha> T"
 proof -
   from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
   have "length(bn \<alpha>) = residualLength(\<alpha> \<prec> T)" by simp
   note Trans
   moreover have "length [] = inputLength(P \<parallel> Q)" and "distinct []"
     by(auto simp add: inputLength_inputLength'_inputLength''.simps)
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> T)\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> T)\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> T)\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> T)\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover obtain x::name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> Q" and "x \<sharp> \<alpha>" and "x \<sharp> T"
     by(generate_fresh "name") auto
   ultimately show ?thesis using \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>
     apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x x])
     apply(auto simp add: psi.inject)
     apply(force simp add: residualInject residualInject' intro: rPar1)
     apply(force simp add: residualInject residualInject' intro: rPar2)
     apply(fastforce simp add: residualInject residualInject' intro: rComm1)
     by(fastforce simp add: residualInject residualInject' intro: rComm2)
 qed
 
 lemma parInputCases[consumes 1, case_names cPar1 cPar2]:
   fixes \<Psi> :: 'b
   and   P :: "('a, 'b, 'c) psi"
   and   Q :: "('a, 'b, 'c) psi"
   and   M :: 'a
   and   N :: 'a
   and   R :: "('a, 'b, 'c) psi"
   and   C :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> R"
   and     rPar1: "\<And>P' A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P';  extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                        A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow> Prop (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                        A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop (P \<parallel> Q')"
   shows "Prop R"
 proof -
   from Trans obtain \<alpha> where "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> R" and "bn \<alpha> \<sharp>* \<Psi>" and "bn \<alpha> \<sharp>* P" and "bn \<alpha> \<sharp>* Q" and "bn \<alpha> \<sharp>* subject \<alpha>" and "\<alpha> = M\<lparr>N\<rparr>" by auto
   thus ?thesis using rPar1 rPar2
     by(induct rule: parCases) (auto simp add: residualInject)
 qed
 
 lemma parOutputCases[consumes 5, case_names cPar1 cPar2]:
   fixes \<Psi> :: 'b
   and   P :: "('a, 'b, 'c) psi"
   and   Q :: "('a, 'b, 'c) psi"
   and   M :: 'a
   and   xvec :: "name list"
   and   N :: 'a
   and   R :: "('a, 'b, 'c) psi"
   and   C :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R"
   and            "xvec \<sharp>* \<Psi>"
   and            "xvec \<sharp>* P"
   and            "xvec \<sharp>* Q"
   and            "xvec \<sharp>* M"
   and     rPar1: "\<And>P' A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P';  extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                        A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* xvec; A\<^sub>Q \<sharp>* N; A\<^sub>Q \<sharp>* C; A\<^sub>Q \<sharp>* xvec; distinct xvec\<rbrakk> \<Longrightarrow> Prop (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                        A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* xvec; A\<^sub>P \<sharp>* N; A\<^sub>P \<sharp>* C; A\<^sub>P \<sharp>* xvec; distinct xvec\<rbrakk> \<Longrightarrow> Prop (P \<parallel> Q')"
   shows "Prop R"
 proof -
   from Trans have "distinct xvec" by(auto dest: boundOutputDistinct)
   obtain \<alpha> where "\<alpha>=M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>" by simp
   with Trans \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* M\<close>
   have "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> R" and "bn \<alpha> \<sharp>* \<Psi>" and "bn \<alpha> \<sharp>* P" and "bn \<alpha> \<sharp>* Q" "bn \<alpha> \<sharp>* subject \<alpha>"
     by simp+
   thus ?thesis using \<open>\<alpha>=M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>\<close> rPar1 rPar2 \<open>distinct xvec\<close>
     by(induct rule: parCases[where C="(xvec, C)"]) (auto simp add: residualInject)
 qed
 
 lemma theEqvt[eqvt_force]:
   fixes p :: "name prm"
   and   \<alpha> :: "'a action"
 
   assumes "\<alpha> \<noteq> \<tau>"
 
   shows "(p \<bullet> the(subject \<alpha>)) = the(p \<bullet> (subject \<alpha>))"
 using assms
 by(induct rule: actionCases[where \<alpha>=\<alpha>]) auto
 
 lemma theSubjectFresh[simp]:
   fixes \<alpha> :: "'a action"
   and   x :: name
 
   assumes "\<alpha> \<noteq> \<tau>"
 
   shows "x \<sharp> the(subject \<alpha>) = x \<sharp> subject \<alpha>"
 using assms
 by(cases rule: actionCases) auto
 
 lemma theSubjectFreshChain[simp]:
   fixes \<alpha>    :: "'a action"
   and   xvec :: "name list"
 
   assumes "\<alpha> \<noteq> \<tau>"
 
   shows "xvec \<sharp>* the(subject \<alpha>) = xvec \<sharp>* subject \<alpha>"
 using assms
 by(cases rule: actionCases) auto
 
 lemma obtainPrefix:
   fixes \<Psi> :: 'b
   and   P   :: "('a, 'b, 'c) psi"
   and   \<alpha>   :: "'a action"
   and   P'  :: "('a, 'b, 'c) psi"
   and   A\<^sub>P  :: "name list"
   and   \<Psi>\<^sub>P :: 'b
   and   B   :: "name list"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     "\<alpha> \<noteq> \<tau>"
   and     "B \<sharp>* P"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* B"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* subject \<alpha>"
 
   obtains M where "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
 using assms
 proof(nominal_induct avoiding: B arbitrary: thesis rule: semanticsFrameInduct')
   case(cAlpha \<Psi> P \<alpha> P' p A\<^sub>P \<Psi>\<^sub>P B)
   then obtain M where subjEq: "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
     by(rule_tac cAlpha) auto
   from \<open>set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> subjEq
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject(p \<bullet> \<alpha>)) \<leftrightarrow> M"
     by(simp add: subjectEqvt[symmetric])
   thus ?case using cAlpha \<open>B \<sharp>* M\<close>
     by auto
 next
   case(cFrameAlpha \<Psi> P A\<^sub>P \<Psi>\<^sub>P p \<alpha> P' B)
   then obtain M where subjEq: "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M" 
     by(rule_tac cFrameAlpha) auto
   have S: "set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P)" by fact
   from subjEq have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<turnstile> (p \<bullet> the(subject \<alpha>)) \<leftrightarrow> (p \<bullet> M)"
     by(rule chanEqClosed)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* subject \<alpha>\<close> S \<open>\<alpha> \<noteq> \<tau>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close>
   have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<turnstile> the(subject \<alpha>) \<leftrightarrow> (p \<bullet> M)"
     by(simp add: eqvts del: subjectEqvt)
   moreover from \<open>B \<sharp>* M\<close> have "(p \<bullet> B) \<sharp>* (p \<bullet> M)"
     by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   with \<open>A\<^sub>P \<sharp>* B\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* B\<close> S have "B \<sharp>* (p \<bullet> M)" by(simp add: eqvts)
   ultimately show ?case by(rule cFrameAlpha)
 next
   case(cInput \<Psi> M K xvec N Tvec P B)
   from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt AssertionStatEqSym[OF Identity])
   hence "\<Psi> \<otimes> \<one> \<turnstile> K \<leftrightarrow> M" by(rule chanEqSym)
   moreover from \<open>B \<sharp>* (M\<lparr>\<lambda>*xvec N\<rparr>.P)\<close> have "B \<sharp>* M" by simp
   ultimately show ?case by(rule_tac cInput) auto
 next
   case(cOutput \<Psi> M K N P B)
   from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt AssertionStatEqSym[OF Identity])
   hence "\<Psi> \<otimes> \<one> \<turnstile> K \<leftrightarrow> M"
     by(rule chanEqSym)
   moreover from \<open>B \<sharp>* (M\<langle>N\<rangle>.P)\<close> have "B \<sharp>* M" by simp
   ultimately show ?case by(rule_tac cOutput) auto
 next
   case(cCase \<Psi> P \<alpha> P' \<phi> Cs  A\<^sub>P \<Psi>\<^sub>P B)
   then obtain M where "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
     by(rule_tac cCase) (auto dest: memFreshChain)
   with \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> show ?case by(blast intro: cCase statEqEnt compositionSym Identity)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P B)
   then obtain M where "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
     apply(rule_tac cPar1) by assumption auto
   thus ?case
     by(metis cPar1 statEqEnt Associativity Commutativity AssertionStatEqTrans Composition)
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q B)
   then obtain M where "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
     by(rule_tac cPar2) auto
   thus ?case by(metis cPar2 statEqEnt Associativity)
 next
   case cComm1
   thus ?case by simp
 next
   case cComm2
   thus ?case by simp
 next
   case(cOpen \<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P B)  
   then obtain K where "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K" and "B \<sharp>* K"
     apply(rule_tac cOpen) by force auto
   thus ?case by(fastforce intro: cOpen)
 next
   case(cScope \<Psi> P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P B)  
   then obtain M where "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> the(subject \<alpha>) \<leftrightarrow> M" and "B \<sharp>* M"
     by(rule_tac cScope) auto
   thus ?case by(fastforce intro: cScope)
 next
   case(cBang \<Psi> P \<alpha> P' A\<^sub>P \<Psi>\<^sub>P B)
   then obtain K where "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> the(subject \<alpha>) \<leftrightarrow> K" and "B \<sharp>* K"
     by(rule_tac cBang) auto
   with \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> show ?case by(metis cBang statEqEnt compositionSym Identity)
 qed
 
 lemma inputRenameSubject:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   M  :: 'a
   and   N  :: 'a
   and   P' :: "('a, 'b, 'c) psi"
   and   A\<^sub>P :: "name list"
   and   \<Psi>\<^sub>P :: 'b
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>P \<sharp>* K"
     
   shows "\<Psi> \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'"
 using assms
 proof(nominal_induct avoiding: K rule: inputFrameInduct)
   case(cAlpha \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P  p K)
   have S: "set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P)" by fact
   from \<open>\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P))) \<turnstile> (p \<bullet> M) \<leftrightarrow> (p \<bullet> K)" 
     by(rule chanEqClosed)
   with S \<open>distinctPerm p\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* K\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K" by(simp add: eqvts)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> 
        \<open>\<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'\<close>
   show ?case by blast
 next
   case(cInput \<Psi> M K xvec N Tvec P K')
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> K \<leftrightarrow> K'\<close> have "\<Psi> \<turnstile> K \<leftrightarrow> K'"
     by(blast intro: statEqEnt Identity)
   with \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<turnstile> M \<leftrightarrow> K'"
     by(rule chanEqTrans)
   thus ?case using \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
     by(rule Input)
 next
   case(cCase \<Psi> P M N P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close>
     \<open>\<And>K. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'\<close>
   have "\<Psi> \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'" by force
   thus ?case using \<open>(\<phi>, P) mem Cs\<close> \<open>\<Psi> \<turnstile> \<phi>\<close> \<open>guarded P\<close> by(rule Case)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
     by(metis statEqEnt Associativity Composition AssertionStatEqTrans Commutativity)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> 
        \<open>\<And>K. \<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* (\<Psi> \<otimes> \<Psi>\<^sub>Q); A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'" by force
   thus ?case using \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>Q \<sharp>* N\<close>
     by(rule_tac Par1) auto
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q M N Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q K)
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
     by(rule statEqEnt[OF AssertionStatEqSym[OF Associativity]])
   with \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* K\<close> 
        \<open>\<And>K. \<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>Q \<sharp>* (\<Psi> \<otimes> \<Psi>\<^sub>P); A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'" by force
   thus ?case using \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* N\<close>
     by(rule_tac Par2) auto
 next
   case(cScope \<Psi> P M N P' x A\<^sub>P \<Psi>\<^sub>P)
   hence "\<Psi> \<rhd> P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'" by force
   with \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> K\<close> \<open>x \<sharp> N\<close> show ?case
     by(rule_tac Scope) auto
 next
   case(cBang \<Psi> P M N P' A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close>
     \<open>\<And>K. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* (P \<parallel> !P); A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<parallel> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'\<close>
   have "\<Psi> \<rhd> P \<parallel> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P'" by force
   thus ?case using \<open>guarded P\<close> by(rule Bang)
 qed
 
 lemma outputRenameSubject:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
 
   assumes "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>P \<sharp>* K"
     
   shows "\<Psi> \<rhd> P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
 using assms
 apply(simp add: residualInject)
 proof(nominal_induct avoiding: K rule: outputFrameInduct)
   case(cAlpha \<Psi> P M A\<^sub>P \<Psi>\<^sub>P p B K)
   have S: "set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P)" by fact
   from \<open>\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P))) \<turnstile> (p \<bullet> M) \<leftrightarrow> (p \<bullet> K)" 
     by(rule chanEqClosed)
   with S \<open>distinctPerm p\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* M\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* K\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K" by(simp add: eqvts)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> 
   show ?case by(blast intro: cAlpha)
 next
   case(cOutput \<Psi> M K N P K')
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> K \<leftrightarrow> K'\<close> have "\<Psi> \<turnstile> K \<leftrightarrow> K'"
     by(blast intro: statEqEnt Identity)
   with \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<turnstile> M \<leftrightarrow> K'"
     by(rule chanEqTrans)
   thus ?case using Output by(force simp add: residualInject)
 next
   case(cCase \<Psi> P M B \<phi> Cs A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close>
     \<open>\<And>K. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<longmapsto>(ROut K B)\<close>
   have "\<Psi> \<rhd> P \<longmapsto>ROut K B" by force
   thus ?case using \<open>(\<phi>, P) mem Cs\<close> \<open>\<Psi> \<turnstile> \<phi>\<close> \<open>guarded P\<close> by(rule Case)
 next
   case(cPar1 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K"
     by(metis statEqEnt Associativity Composition AssertionStatEqTrans Commutativity)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close> 
        \<open>\<And>K. \<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* (\<Psi> \<otimes> \<Psi>\<^sub>Q); A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>(ROut K (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P'))\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(force simp add: residualInject)
   thus ?case using \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>xvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* K\<close>  \<open>A\<^sub>Q \<sharp>* xvec\<close>  \<open>A\<^sub>Q \<sharp>* N\<close> Par1[where \<alpha>="K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>"]
     by(auto simp add: residualInject)
 next
   case(cPar2 \<Psi> \<Psi>\<^sub>P Q M xvec N Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q K)
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K"
     by(rule statEqEnt[OF AssertionStatEqSym[OF Associativity]])
   with \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* K\<close> 
        \<open>\<And>K. \<lbrakk>(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; A\<^sub>Q \<sharp>* (\<Psi> \<otimes> \<Psi>\<^sub>P); A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; A\<^sub>Q \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>ROut K (\<lparr>\<nu>*xvec\<rparr>N \<prec>' Q')\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>ROut K (\<lparr>\<nu>*xvec\<rparr>N \<prec>' Q')" by force
   thus ?case using \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>xvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* K\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* N\<close> Par2[where \<alpha>="K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>"]
     by(auto simp add: residualInject)
 next
   case(cOpen \<Psi> P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P)
   hence "\<Psi> \<rhd> P \<longmapsto>K\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'" by(force simp add: residualInject)
   with \<open>x \<in> supp N\<close> \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> K\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> Open show ?case
     by(auto simp add: residualInject)
 next
   case(cScope \<Psi> P M xvec N P' x A\<^sub>P \<Psi>\<^sub>P)
   hence "\<Psi> \<rhd> P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(force simp add: residualInject)
   with \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> K\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> N\<close> Scope[where \<alpha>="K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>"] show ?case
     by(auto simp add: residualInject)
 next
   case(cBang \<Psi> P M B A\<^sub>P \<Psi>\<^sub>P K)
   from \<open>\<Psi> \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
   with \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K\<close>
     \<open>\<And>K. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* (P \<parallel> !P); A\<^sub>P \<sharp>* M; A\<^sub>P \<sharp>* K\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<parallel> !P \<longmapsto>ROut K B\<close>
   have "\<Psi> \<rhd> P \<parallel> !P \<longmapsto>ROut K B" by force
   thus ?case using \<open>guarded P\<close> by(rule Bang)
 qed
 
 lemma parCasesSubject[consumes 7, case_names cPar1 cPar2 cComm1 cComm2]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Q    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   R    :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
   and   yvec :: "name list"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>\<alpha> \<prec> R"
   and            "bn \<alpha> \<sharp>* \<Psi>"
   and            "bn \<alpha> \<sharp>* P"
   and            "bn \<alpha> \<sharp>* Q"
   and            "bn \<alpha> \<sharp>* subject \<alpha>"
   and            "yvec \<sharp>* P"
   and            "yvec \<sharp>* Q"
   and     rPar1: "\<And>P' A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P';  extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                        A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* \<alpha>; A\<^sub>Q \<sharp>* C\<rbrakk> \<Longrightarrow> Prop \<alpha> (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                        A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* \<alpha>; A\<^sub>P \<sharp>* C\<rbrakk> \<Longrightarrow> Prop \<alpha> (P \<parallel> Q')"
   and     rComm1: "\<And>\<Psi>\<^sub>Q M N P' A\<^sub>P \<Psi>\<^sub>P K xvec Q' A\<^sub>Q.
            \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; yvec \<sharp>* M; yvec \<sharp>* K; distinct xvec;
             A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C; 
             A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C; 
             xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K; xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
             Prop (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
   and     rComm2: "\<And>\<Psi>\<^sub>Q M xvec N P' A\<^sub>P \<Psi>\<^sub>P K Q' A\<^sub>Q.
            \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
             \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; yvec \<sharp>* M; yvec \<sharp>* K; distinct xvec;
             A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C; 
             A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C; 
             xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K;  xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C\<rbrakk> \<Longrightarrow>
             Prop (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))"
 
   shows "Prop \<alpha> R"
 using Trans \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close>
 proof(induct rule: parCases[where C="(C, yvec)"])
   case(cPar1 P' A\<^sub>Q \<Psi>\<^sub>Q)
   thus ?case by(rule_tac rPar1) auto 
 next
   case(cPar2 Q' A\<^sub>P \<Psi>\<^sub>P)
   thus ?case by(rule_tac rPar2) auto
 next
   case(cComm1 \<Psi>\<^sub>Q M N P' A\<^sub>P \<Psi>\<^sub>P K xvec Q' A\<^sub>Q)
   from \<open>A\<^sub>P \<sharp>* (C, yvec)\<close> \<open>A\<^sub>Q \<sharp>* (C, yvec)\<close> \<open>xvec \<sharp>* (C, yvec)\<close> 
   have "A\<^sub>P \<sharp>* C" and "A\<^sub>Q \<sharp>* C" and "xvec \<sharp>* C" and "A\<^sub>P \<sharp>* yvec" and "A\<^sub>Q \<sharp>* yvec" and "xvec \<sharp>* yvec"
     by simp+
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" 
    and MeqK: "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K" by fact+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>yvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close>
        \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>xvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close>
   obtain M' where MeqM': "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> M'" and "xvec \<sharp>* M'" and "yvec \<sharp>* M'" and "A\<^sub>Q \<sharp>* M'"
     by(rule_tac B="xvec@yvec@A\<^sub>Q" in obtainPrefix) (assumption | force)+ 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>yvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close>
        \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* yvec\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>xvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* K\<close> \<open>distinct xvec\<close>
   obtain K' where KeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'" and "xvec \<sharp>* K'" and "yvec \<sharp>* K'" and "A\<^sub>P \<sharp>* K'"
     by(rule_tac B="xvec@yvec@A\<^sub>P" in obtainPrefix) (assumption | force | metis freshChainSym)+
 
   from MeqK KeqK' have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans)
   with \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>N\<rparr> \<prec> P'" using \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K'\<close>
     by(rule_tac inputRenameSubject) (assumption | force)+
   moreover note FrP \<open>distinct A\<^sub>P\<close>
   moreover from MeqK MeqM' have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> M'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
   with \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'" using \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
     by(rule_tac outputRenameSubject) (assumption | force)+
   moreover note FrQ \<open>distinct A\<^sub>Q\<close>
   moreover from MeqM' KeqK' MeqK have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* K'\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* C\<close>
                 \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M'\<close> \<open>A\<^sub>Q \<sharp>* N\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
                 \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* M'\<close> \<open>xvec \<sharp>* K'\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>Q\<close> \<open>xvec \<sharp>* C\<close> \<open>yvec \<sharp>* M'\<close> \<open>yvec \<sharp>* K'\<close> \<open>distinct xvec\<close>
   ultimately show ?case
     by(rule_tac rComm1)
 next
   case(cComm2 \<Psi>\<^sub>Q M xvec N P' A\<^sub>P \<Psi>\<^sub>P K Q' A\<^sub>Q)
   from \<open>A\<^sub>P \<sharp>* (C, yvec)\<close> \<open>A\<^sub>Q \<sharp>* (C, yvec)\<close> \<open>xvec \<sharp>* (C, yvec)\<close> 
   have "A\<^sub>P \<sharp>* C" and "A\<^sub>Q \<sharp>* C" and "xvec \<sharp>* C" and "A\<^sub>P \<sharp>* yvec" and "A\<^sub>Q \<sharp>* yvec" and "xvec \<sharp>* yvec"
     by simp+
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" 
    and MeqK: "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K" by fact+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>yvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close>
        \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* yvec\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>xvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>xvec \<sharp>* M\<close> \<open>distinct xvec\<close>
   obtain M' where MeqM': "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> M'" and "xvec \<sharp>* M'" and "yvec \<sharp>* M'" and "A\<^sub>Q \<sharp>* M'"
     by(rule_tac B="xvec@yvec@A\<^sub>Q" in obtainPrefix) (assumption | force)+ 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>yvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close>
        \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* yvec\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>xvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> 
   obtain K' where KeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'" and "xvec \<sharp>* K'" and "yvec \<sharp>* K'" and "A\<^sub>P \<sharp>* K'"
     by(rule_tac B="xvec@yvec@A\<^sub>P" in obtainPrefix) (assumption | force | metis freshChainSym)+
 
   from MeqK KeqK' have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans)
   with \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" using \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K'\<close>
     by(rule_tac outputRenameSubject) (assumption | force)+
   moreover note FrP \<open>distinct A\<^sub>P\<close>
   moreover from MeqK MeqM' have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> M'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
   with \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close>
   have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>N\<rparr> \<prec> Q'" using \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
     by(rule_tac inputRenameSubject) (assumption | force)+
   moreover note FrQ \<open>distinct A\<^sub>Q\<close>
   moreover from MeqM' KeqK' MeqK have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'"
     by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
   moreover note \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* K'\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* C\<close>
                 \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M'\<close> \<open>A\<^sub>Q \<sharp>* N\<close> \<open>A\<^sub>Q \<sharp>* Q'\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* C\<close>
                 \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* M'\<close> \<open>xvec \<sharp>* K'\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>Q\<close> \<open>xvec \<sharp>* C\<close> \<open>yvec \<sharp>* M'\<close> \<open>yvec \<sharp>* K'\<close> \<open>distinct xvec\<close>
   ultimately show ?case
     by(rule_tac rComm2)
 qed
 
 lemma inputCases[consumes 1, case_names cInput]:
   fixes \<Psi>   :: 'b
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P    :: "('a, 'b, 'c) psi"  
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   
   assumes Trans: "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'"  
   and     rInput: "\<And>K Tvec. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; set xvec \<subseteq> supp N; length xvec = length Tvec; distinct xvec\<rbrakk> \<Longrightarrow> Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"
 
   shows "Prop \<alpha> P'"
 proof -
   {
     fix xvec N P
     assume Trans: "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'"
        and "xvec \<sharp>* \<Psi>" and "xvec \<sharp>* M" and "xvec \<sharp>* \<alpha>" and "xvec \<sharp>* P'" and "distinct xvec"
        and rInput: "\<And>K Tvec. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; set xvec \<subseteq> supp N; length xvec = length Tvec; distinct xvec\<rbrakk> \<Longrightarrow> Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"
 
     from Trans have "bn \<alpha> = []"
       apply -
       by(ind_cases "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'") (auto simp add: residualInject)
     from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
     have "length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')" by simp
     note Trans
     moreover have "length xvec = inputLength(M\<lparr>\<lambda>*xvec N\<rparr>.P)" by auto
     moreover note \<open>distinct xvec\<close>
     moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
     moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
     moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
     moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
     moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
     moreover obtain x::name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> M" and "x \<sharp> xvec" and "x \<sharp> \<alpha>" and "x \<sharp> P'" and "x \<sharp> N"
       by(generate_fresh "name") auto
     ultimately have "Prop \<alpha> P'" using \<open>bn \<alpha> = []\<close> \<open>xvec \<sharp>* \<Psi>\<close>\<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* \<alpha>\<close> \<open>xvec \<sharp>* P'\<close>
       apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x])  
       apply(force simp add: residualInject psi.inject rInput)
       by(fastforce simp add: residualInject psi.inject inputChainFresh)+
   }
   note Goal = this
   moreover obtain p :: "name prm" where "(p \<bullet> xvec) \<sharp>* \<Psi>" and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* P"
                                     and "(p \<bullet> xvec) \<sharp>* \<alpha>" and "(p \<bullet> xvec) \<sharp>* P'" and S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
                                     and "distinctPerm p"
     by(rule_tac xvec=xvec and c="(\<Psi>, M, N, P, \<alpha>, P')" in name_list_avoiding) auto
   from Trans \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> S have "\<Psi> \<rhd> M\<lparr>\<lambda>*(p \<bullet> xvec) (p \<bullet> N)\<rparr>.(p \<bullet> P) \<longmapsto>\<alpha> \<prec> P'"
     by(simp add: inputChainAlpha')
   moreover {
     fix K Tvec
     assume "\<Psi> \<turnstile> M \<leftrightarrow> K"
     moreover assume "set(p \<bullet> xvec) \<subseteq> supp(p \<bullet> N)"
     hence "(p \<bullet> set(p \<bullet> xvec)) \<subseteq> (p \<bullet> supp(p \<bullet> N))" by simp
     with \<open>distinctPerm p\<close> have "set xvec \<subseteq> supp N" by(simp add: eqvts)
     moreover assume "length(p \<bullet> xvec) = length(Tvec::'a list)"
     hence "length xvec = length Tvec" by simp
     moreover assume "distinct xvec"
     ultimately have "Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])" 
       by(rule rInput)
     with \<open>length xvec = length Tvec\<close> S \<open>distinctPerm p\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close>
     have "Prop (K\<lparr>(p \<bullet> N)[(p \<bullet> xvec)::=Tvec]\<rparr>) ((p \<bullet> P)[(p \<bullet> xvec)::=Tvec])"
       by(simp add: renaming substTerm.renaming)
   }
   moreover from Trans have "distinct xvec" by(rule inputDistinct)
   hence "distinct(p \<bullet> xvec)" by simp
   ultimately show ?thesis using \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> xvec) \<sharp>* M\<close> \<open>(p \<bullet> xvec) \<sharp>* \<alpha>\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>distinct xvec\<close>
     by(rule_tac Goal) assumption+
 qed
 
 lemma outputCases[consumes 1, case_names cOutput]:
   fixes \<Psi> :: 'b
   and   M  :: 'a
   and   N  :: 'a
   and   P  :: "('a, 'b, 'c) psi"  
   and   \<alpha>  :: "'a action"
   and   P' :: "('a, 'b, 'c) psi"
   
   assumes "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>\<alpha> \<prec> P'"
   and     "\<And>K. \<Psi> \<turnstile> M \<leftrightarrow> K \<Longrightarrow> Prop (K\<langle>N\<rangle>) P"
 
   shows "Prop \<alpha> P'"
 using assms
 by(cases rule: semantics.cases) (auto simp add: residualInject psi.inject)
 
 lemma caseCases[consumes 1, case_names cCase]:
   fixes \<Psi> :: 'b
   and   Cs :: "('c \<times> ('a, 'b, 'c) psi) list"
   and   \<alpha>  :: "'a action"
   and   P' :: "('a, 'b, 'c) psi"
   
   assumes Trans: "\<Psi> \<rhd> (Cases Cs) \<longmapsto> Rs"
   and     rCase: "\<And>\<phi> P. \<lbrakk>\<Psi> \<rhd> P \<longmapsto> Rs; (\<phi>, P) mem Cs; \<Psi> \<turnstile> \<phi>; guarded P\<rbrakk> \<Longrightarrow> Prop"
 
   shows "Prop"
 using assms
 by(cases rule: semantics.cases) (auto simp add: residualInject psi.inject)
 
 lemma resCases[consumes 7, case_names cOpen cRes]:
   fixes \<Psi>    :: 'b
   and   x    :: name
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>\<alpha> \<prec> P'"
   and     "x \<sharp> \<Psi>"
   and     "x \<sharp> \<alpha>"
   and     "x \<sharp> P'"
   and     "bn \<alpha> \<sharp>* \<Psi>"
   and     "bn \<alpha> \<sharp>* P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     rOpen: "\<And>M xvec yvec y N P'. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle> \<prec> ([(x, y)] \<bullet> P'); y \<in> supp N;
                                          x \<sharp> N; x \<sharp> P'; x \<noteq> y; y \<sharp> xvec; y \<sharp> yvec; y \<sharp> M; distinct xvec; distinct yvec;
                                          xvec \<sharp>* \<Psi>; y \<sharp> \<Psi>; yvec \<sharp>* \<Psi>; xvec \<sharp>* P; y \<sharp> P; yvec \<sharp>* P; xvec \<sharp>* M; y \<sharp> M;
                                          yvec \<sharp>* M; xvec \<sharp>* yvec\<rbrakk> \<Longrightarrow>
                                          Prop (M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>N\<rangle>) P'"
   and     rScope:  "\<And>P'. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<rbrakk> \<Longrightarrow> Prop \<alpha> (\<lparr>\<nu>x\<rparr>P')"
 
   shows "Prop \<alpha> P'"
 proof -
   from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
   have "length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')" by simp
   note Trans
   moreover have "length [] = inputLength(\<lparr>\<nu>x\<rparr>P)" and "distinct []"
     by(auto simp add: inputLength_inputLength'_inputLength''.simps)
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   ultimately show ?thesis using \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> P'\<close> \<open>distinct(bn \<alpha>)\<close>
     apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ _ x x]) 
     apply(auto simp add: psi.inject alpha abs_fresh residualInject boundOutputApp boundOutput.inject eqvts)
     apply(subgoal_tac "y \<in> supp Na")
     apply(rule_tac rOpen)
     apply(auto simp add: residualInject boundOutputApp)
     apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
     apply(simp add: calc_atm eqvts)
     by(rule rScope)
 qed
 
 lemma resCases'[consumes 7, case_names cOpen cRes]:
   fixes \<Psi>    :: 'b
   and   x    :: name
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>\<alpha> \<prec> P'"
   and     "x \<sharp> \<Psi>"
   and     "x \<sharp> \<alpha>"
   and     "x \<sharp> P'"
   and     "bn \<alpha> \<sharp>* \<Psi>"
   and     "bn \<alpha> \<sharp>* P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     rOpen: "\<And>M xvec yvec y N P'. \<lbrakk>\<Psi> \<rhd> ([(x, y)] \<bullet> P) \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'; y \<in> supp N;
                                          x \<sharp> N; x \<sharp> P'; x \<noteq> y; y \<sharp> xvec; y \<sharp> yvec; y \<sharp> M; distinct xvec; distinct yvec;
                                          xvec \<sharp>* \<Psi>; y \<sharp> \<Psi>; yvec \<sharp>* \<Psi>; xvec \<sharp>* P; y \<sharp> P; yvec \<sharp>* P; xvec \<sharp>* M; y \<sharp> M;
                                          yvec \<sharp>* M; xvec \<sharp>* yvec\<rbrakk> \<Longrightarrow>
                                          Prop (M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>N\<rangle>) P'"
   and     rScope:  "\<And>P'. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<rbrakk> \<Longrightarrow> Prop \<alpha> (\<lparr>\<nu>x\<rparr>P')"
 
   shows "Prop \<alpha> P'"
 proof -
   from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
   have "length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')" by simp
   note Trans
   moreover have "length [] = inputLength(\<lparr>\<nu>x\<rparr>P)" and "distinct []"
     by(auto simp add: inputLength_inputLength'_inputLength''.simps)
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
   ultimately show ?thesis using \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> P'\<close> \<open>distinct(bn \<alpha>)\<close>
     apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ _ x x]) 
     apply(auto simp add: psi.inject alpha abs_fresh residualInject boundOutputApp boundOutput.inject eqvts)
     apply(subgoal_tac "y \<in> supp Na")
     apply(rule_tac rOpen)
     apply(auto simp add: residualInject boundOutputApp)
     apply(drule_tac pi="[(x, y)]" in semantics.eqvt)
     apply(simp add: calc_atm eqvts)
     apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
     apply(simp add: calc_atm eqvts)
     by(rule rScope)
 qed
 
 abbreviation
   statImpJudge ("_ \<hookrightarrow> _" [80, 80] 80)
   where "\<Psi> \<hookrightarrow> \<Psi>' \<equiv> AssertionStatImp \<Psi> \<Psi>'"
 
 lemma statEqTransition:
   fixes \<Psi>  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   Rs :: "('a, 'b, 'c) residual"
   and   \<Psi>' :: 'b
 
   assumes "\<Psi> \<rhd> P \<longmapsto> Rs"
   and     "\<Psi> \<simeq> \<Psi>'"
 
   shows "\<Psi>' \<rhd> P \<longmapsto> Rs"
 using assms
 proof(nominal_induct avoiding: \<Psi>' rule: semantics.strong_induct)
   case(cInput \<Psi> M K xvec N Tvec P \<Psi>')
   from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>' \<turnstile> M \<leftrightarrow> K"
     by(simp add: AssertionStatImp_def AssertionStatEq_def)
   thus ?case using \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
     by(rule Input)
 next
   case(Output \<Psi> M K N P \<Psi>')
   from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>' \<turnstile> M \<leftrightarrow> K"
     by(simp add: AssertionStatImp_def AssertionStatEq_def) 
   thus ?case by(rule semantics.Output)
 next
   case(Case \<Psi> P Rs \<phi> Cs \<Psi>')
   then have "\<Psi>' \<rhd> P \<longmapsto> Rs" by(rule_tac Case)
   moreover note \<open>(\<phi>, P) mem Cs\<close>
   moreover from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi> \<turnstile> \<phi>\<close> have "\<Psi>' \<turnstile> \<phi>"
     by(simp add: AssertionStatImp_def AssertionStatEq_def)
   ultimately show ?case using \<open>guarded P\<close> by(rule semantics.Case)
 next
   case(cPar1 \<Psi> \<Psi>Q P \<alpha> P' xvec Q \<Psi>')
   thus ?case
     by(rule_tac Par1) (auto intro: Composition)
 next
   case(cPar2 \<Psi> \<Psi>P Q \<alpha> Q' xvec P \<Psi>')
   thus ?case
     by(rule_tac Par2) (auto intro: Composition)
 next
   case(cComm1 \<Psi> \<Psi>Q P M N P' xvec \<Psi>P Q K zvec Q' yvec \<Psi>')
   thus ?case
     by(clarsimp, rule_tac Comm1) (blast intro: Composition statEqEnt)+
 next
   case(cComm2 \<Psi> \<Psi>Q P M zvec N P' xvec \<Psi>P Q K Q' yvec \<Psi>')
   thus ?case
     by(clarsimp, rule_tac Comm2) (blast intro: Composition statEqEnt)+
 next
   case(cOpen \<Psi> P M xvec N P' x yvec \<Psi>')
   thus ?case by(force intro: Open)
 next
   case(cScope \<Psi> P \<alpha> P' x \<Psi>')
   thus ?case by(force intro: Scope)
 next
   case(Bang \<Psi> P Rs \<Psi>')
   thus ?case by(force intro: semantics.Bang)
 qed
 
 lemma actionPar1Dest':
   fixes \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   \<beta> :: "('a::fs_name) action"
   and   Q :: "('a, 'b, 'c) psi"
   and   R :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> (Q \<parallel> R)"
   and     "bn \<alpha> \<sharp>* R"
   and     "bn \<beta> \<sharp>* R"
 
   obtains T where "P = T \<parallel> R" and "\<alpha> \<prec> T = \<beta> \<prec> Q"
 using assms
 apply(cases rule: actionCases[where \<alpha>=\<alpha>])
 apply(auto simp add: residualInject)
 by(drule_tac boundOutputPar1Dest) auto
 
 lemma actionPar2Dest':
   fixes \<alpha> :: "('a::fs_name) action"
   and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
   and   \<beta> :: "('a::fs_name) action"
   and   Q :: "('a, 'b, 'c) psi"
   and   R :: "('a, 'b, 'c) psi"
 
   assumes "\<alpha> \<prec> P = \<beta> \<prec> (Q \<parallel> R)"
   and     "bn \<alpha> \<sharp>* Q"
   and     "bn \<beta> \<sharp>* Q"
 
   obtains T where "P = Q \<parallel> T" and "\<alpha> \<prec> T = \<beta> \<prec> R"
 using assms
 apply(cases rule: actionCases[where \<alpha>=\<alpha>])
 apply(auto simp add: residualInject)
 by(drule_tac boundOutputPar2Dest) auto
 
 lemma expandNonTauFrame:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P  :: 'b
   and   C    :: "'d::fs_name"
   and   C'   :: "'e::fs_name"
   
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* \<alpha>"
   and     "A\<^sub>P \<sharp>* C"
   and     "A\<^sub>P \<sharp>* C'"
   and     "bn \<alpha> \<sharp>* P"
   and     "bn \<alpha> \<sharp>* C'"
   and     "\<alpha> \<noteq> \<tau>"
 
   obtains p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "(p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinctPerm p" and
                               "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)" and
                               "A\<^sub>P' \<sharp>* C" and "(bn(p \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'" and "distinct A\<^sub>P'"
 proof -
   assume A: "\<And>p \<Psi>' \<Psi>\<^sub>P' A\<^sub>P'.
         \<lbrakk>set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>)); (p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'; distinctPerm p;
                               extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>; A\<^sub>P' \<sharp>* P'; A\<^sub>P' \<sharp>* \<alpha>; A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>);
                               A\<^sub>P' \<sharp>* C; (bn(p \<bullet> \<alpha>)) \<sharp>* C'; (bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>; (bn(p \<bullet> \<alpha>)) \<sharp>* P'; distinct A\<^sub>P'\<rbrakk>
         \<Longrightarrow> thesis"
 
   from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
 
   with Trans \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> have "A\<^sub>P \<sharp>* P'"
     by(drule_tac freeFreshChainDerivative) auto
   {
     fix X :: "name list"
     and Y :: "'b list"
     and Z :: "('a, 'b, 'c) psi list"
 
     assume "bn \<alpha> \<sharp>* X" and "bn \<alpha> \<sharp>* Y" and "bn \<alpha> \<sharp>* Z" and "A\<^sub>P \<sharp>* X" and "A\<^sub>P \<sharp>* Y" and "A\<^sub>P \<sharp>* Z" 
 
     with assms obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "(p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinctPerm p"
                                       and "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)"
                                       and "A\<^sub>P' \<sharp>* C" and "(bn(p \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'"
                                       and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" and "distinct A\<^sub>P'"
                                       and "(bn(p \<bullet> \<alpha>)) \<sharp>* X" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Y" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Z"
       using \<open>A\<^sub>P \<sharp>* P'\<close> \<open>distinct(bn \<alpha>)\<close>
     proof(nominal_induct \<Psi> P Rs=="\<alpha> \<prec> P'" A\<^sub>P \<Psi>\<^sub>P avoiding: C C' \<alpha> P' X Y Z arbitrary: thesis rule: semanticsFrameInduct)
       case(cAlpha \<Psi> P A\<^sub>P \<Psi>\<^sub>P p C C' \<alpha> P' X Y Z)
       then obtain q \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where Sq: "set q \<subseteq> set(bn \<alpha>) \<times> set(bn(q \<bullet> \<alpha>))" and PeqP': "(q \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinctPerm q"
                                   and FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (q \<bullet> \<alpha>)"
                                   and "A\<^sub>P' \<sharp>* C" and "(bn(q \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(q \<bullet> \<alpha>)) \<sharp>* P'"
                                   and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" and "distinct A\<^sub>P'"
                                   and "(bn(q \<bullet> \<alpha>)) \<sharp>* X" and "(bn(q \<bullet> \<alpha>)) \<sharp>* Y" and "(bn(q \<bullet> \<alpha>)) \<sharp>* Z"
         by metis
 
       have Sp: "set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P)" by fact
 
       from Sq have "(p \<bullet> set q) \<subseteq> p \<bullet> (set(bn \<alpha>) \<times> set(bn(q \<bullet> \<alpha>)))"
         by(simp add: subsetClosed)
       hence "set(p \<bullet> q) \<subseteq> set(bn(p \<bullet> \<alpha>)) \<times> set(p \<bullet> bn(q \<bullet> \<alpha>))"
         by(simp add: eqvts)
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> Sp have "set(p \<bullet> q) \<subseteq> set(bn \<alpha>) \<times> set(bn((p \<bullet> q) \<bullet> \<alpha>))"
         by(simp add: perm_compose bnEqvt[symmetric])
       moreover from PeqP' have "(p \<bullet> (q \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<simeq> (p \<bullet> \<Psi>\<^sub>P')"
         by(simp add: AssertionStatEqClosed)
       hence "((p \<bullet> q) \<bullet> p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>') \<simeq> (p \<bullet> \<Psi>\<^sub>P')"
         apply(subst perm_compose[symmetric])
         by(simp add: eqvts)
       moreover from \<open>distinctPerm q\<close> have "distinctPerm (p \<bullet> q)"
         by simp
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* C'\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> C')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* C'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* C'\<close> Sp have "bn((p \<bullet> q) \<bullet> \<alpha>) \<sharp>* C'"
         by(simp add: perm_compose bnEqvt[symmetric])
       moreover from FrP' have "(p \<bullet> extractFrame P') = p \<bullet> \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" by simp
       with \<open>A\<^sub>P \<sharp>* P'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> Sp have "extractFrame P' = \<langle>p \<bullet> A\<^sub>P', p \<bullet> \<Psi>\<^sub>P'\<rangle>"
         by(simp add: eqvts)
       moreover from \<open>A\<^sub>P' \<sharp>* P'\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> P')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* P'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* P'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* \<alpha>\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> \<alpha>)"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* \<alpha>" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* C\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> C)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* C\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* C\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* C" by simp
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* \<alpha>\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> \<alpha>)"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> Sp have "bn((p \<bullet> q) \<bullet> \<alpha>) \<sharp>* \<alpha>"
         by(simp add: perm_compose eqvts)
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* P'\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> P')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* P'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> Sp have "bn((p \<bullet> q) \<bullet> \<alpha>) \<sharp>* P'"
         by(simp add: perm_compose eqvts)
       moreover from \<open>A\<^sub>P' \<sharp>* (q \<bullet> \<alpha>)\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> q \<bullet> \<alpha>)"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with Sp \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* ((p \<bullet> q) \<bullet> \<alpha>)"
         by(simp add: perm_compose)
       moreover from \<open>A\<^sub>P' \<sharp>* X\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> X)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* X\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* X\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* X" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Y\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> Y)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* Y\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Y\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Z\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> Z)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* Z\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Z\<close> Sp have "(p \<bullet> A\<^sub>P') \<sharp>* Z" by simp
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* X\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> X)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* X\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* X\<close> Sp have "bn((p \<bullet> q) \<bullet>  \<alpha>) \<sharp>* X"
         by(simp add: perm_compose eqvts)
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Y\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> Y)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Y\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Y\<close> Sp have "bn((p \<bullet> q) \<bullet> \<alpha>) \<sharp>* Y"
         by(simp add: perm_compose eqvts)
       moreover from \<open>(bn(q \<bullet> \<alpha>)) \<sharp>* Z\<close> have "(p \<bullet> bn(q \<bullet> \<alpha>)) \<sharp>* (p \<bullet> Z)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<alpha>\<close> \<open>A\<^sub>P \<sharp>* Z\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Z\<close> Sp have "bn((p \<bullet> q) \<bullet> \<alpha>) \<sharp>* Z"
         by(simp add: perm_compose eqvts)
       moreover from \<open>distinct A\<^sub>P'\<close> have "distinct(p \<bullet> A\<^sub>P')" by simp
       ultimately show ?case
         by(rule_tac cAlpha)
     next
       case(cInput \<Psi> M K xvec N Tvec P C C' \<alpha> P' X Y Z)
       moreover obtain A\<^sub>P \<Psi>\<^sub>P where "extractFrame(P[xvec::=Tvec]) = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                       and "A\<^sub>P \<sharp>* (C, P[xvec::=Tvec], \<alpha>, P', X, Y, Z, N)"
         by(rule freshFrame)
       moreover have "\<one> \<otimes> \<Psi>\<^sub>P \<simeq> \<Psi>\<^sub>P"
         by(blast intro: Identity Commutativity AssertionStatEqTrans)
       ultimately show ?case
         by(rule_tac cInput) (assumption | simp add: residualInject)+
     next
       case(cOutput \<Psi> M K N P C C' \<alpha> P' X Y Z)
       moreover obtain A\<^sub>P \<Psi>\<^sub>P where "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                                and "A\<^sub>P \<sharp>* (C, C', P, \<alpha>, N, P', X, Y, Z)"
         by(rule freshFrame)
       moreover have "\<one> \<otimes> \<Psi>\<^sub>P \<simeq> \<Psi>\<^sub>P"
         by(blast intro: Identity Commutativity AssertionStatEqTrans)
       ultimately show ?case by(simp add: residualInject)
     next
       case(cCase \<Psi> P \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C C' \<alpha> P' X Y Z)
       moreover from \<open>bn \<alpha> \<sharp>* (Cases Cs)\<close> \<open>(\<phi>, P) mem Cs\<close> have "bn \<alpha> \<sharp>* P" by(auto dest: memFreshChain)
       ultimately obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))"
                                          and FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" 
                                          and PeqP': "(p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinct A\<^sub>P'"
                                          and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)"
                                          and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z"
                                          and "distinctPerm p" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'"
                                          and "(bn(p \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(p \<bullet> \<alpha>)) \<sharp>* X" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Y" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Z"
         by(rule_tac cCase) (assumption | simp (no_asm_use))+
       moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "(p \<bullet> \<Psi>\<^sub>P) \<simeq> (p \<bullet> \<one>)"
         by(simp add: AssertionStatEqClosed)
       hence "(p \<bullet> \<Psi>\<^sub>P) \<simeq> \<one>" by(simp add: permBottom)
       with PeqP' have "(\<one> \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P'"
         by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
       ultimately show ?case using cCase \<open>bn \<alpha> \<sharp>* P\<close>
         by(rule_tac cCase(20)) (assumption | simp)+
     next
       case(cPar1 \<Psi> \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C C' \<alpha>' PQ' X Y Z)
       have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and  FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
         by fact+
 
       note \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
       moreover from \<open>bn \<alpha>' \<sharp>* (P \<parallel> Q)\<close> have "bn \<alpha>' \<sharp>* P" and "bn \<alpha>' \<sharp>* Q" by simp+    
       moreover with FrP FrQ \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "bn \<alpha>' \<sharp>* \<Psi>\<^sub>P" and "bn \<alpha>' \<sharp>* \<Psi>\<^sub>Q" 
         by(force dest: extractFrameFreshChain)+
  
       moreover from \<open>bn \<alpha>' \<sharp>* X\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "bn \<alpha>' \<sharp>* (X@A\<^sub>Q)" by simp
       moreover from \<open>bn \<alpha>' \<sharp>* Y\<close> \<open>bn \<alpha>' \<sharp>* \<Psi>\<^sub>Q\<close> have "bn \<alpha>' \<sharp>* (\<Psi>\<^sub>Q#Y)" by simp
       moreover from \<open>bn \<alpha>' \<sharp>* Z\<close> \<open>bn \<alpha>' \<sharp>* Q\<close> have "bn \<alpha>' \<sharp>* (Q#Z)" by simp
       moreover from \<open>A\<^sub>P \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>P \<sharp>* (X@A\<^sub>Q)" by simp
       moreover from \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> have "A\<^sub>P \<sharp>* (\<Psi>\<^sub>Q#Y)" by force
       moreover from \<open>A\<^sub>P \<sharp>* Z\<close> \<open>A\<^sub>P \<sharp>* Q\<close> have "A\<^sub>P \<sharp>* (Q#Z)" by simp
       moreover from \<open>\<alpha> \<prec> (P' \<parallel> Q) = \<alpha>' \<prec> PQ'\<close> \<open>bn \<alpha> \<sharp>* Q\<close> \<open>bn \<alpha>' \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close>
       obtain P'' where A: "\<alpha> \<prec> P' = \<alpha>' \<prec> P''" and "PQ' = P'' \<parallel> Q"
         by(metis actionPar1Dest')
       moreover from \<open>A\<^sub>P \<sharp>* PQ'\<close> \<open>PQ' = P'' \<parallel> Q\<close> have "A\<^sub>P \<sharp>* P''" by simp
       ultimately obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set(bn \<alpha>') \<times> set (bn(p \<bullet> \<alpha>'))" and PeqP': "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P'"
                                         and "distinctPerm p" and "(bn(p \<bullet> \<alpha>')) \<sharp>* C'" and FrP': "extractFrame P'' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>"
                                         and "A\<^sub>P' \<sharp>* P''" and "A\<^sub>P' \<sharp>* \<alpha>'" "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>')" and "A\<^sub>P' \<sharp>* C" 
                                         and "(bn(p \<bullet> \<alpha>')) \<sharp>* \<alpha>'" and "(bn(p \<bullet> \<alpha>')) \<sharp>* P''" and "distinct A\<^sub>P'"
                                         and "A\<^sub>P' \<sharp>* (X @ A\<^sub>Q)" and "A\<^sub>P' \<sharp>* (\<Psi>\<^sub>Q#Y)"
                                         and "A\<^sub>P' \<sharp>* (Q#Z)" and "(bn(p \<bullet> \<alpha>')) \<sharp>* (X @ A\<^sub>Q)" and "(bn(p \<bullet> \<alpha>')) \<sharp>* (\<Psi>\<^sub>Q#Y)"
                                         and "(bn(p \<bullet> \<alpha>')) \<sharp>* (Q#Z)" using cPar1
         by(rule_tac cPar1)
 
       then have "A\<^sub>P' \<sharp>* Q" and "A\<^sub>P' \<sharp>* Z" and "A\<^sub>P' \<sharp>* A\<^sub>Q" and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q"  and "A\<^sub>P' \<sharp>* Y" 
             and "(bn(p \<bullet> \<alpha>')) \<sharp>* A\<^sub>Q" and "(bn(p \<bullet> \<alpha>')) \<sharp>* X" and "(bn(p \<bullet> \<alpha>')) \<sharp>* Y" and "(bn(p \<bullet> \<alpha>')) \<sharp>* Z" and "(bn(p \<bullet> \<alpha>')) \<sharp>* \<Psi>\<^sub>Q"
             and "(bn(p \<bullet> \<alpha>')) \<sharp>* Q"
         by(simp del: freshChainSimps)+
 
       from \<open>A\<^sub>Q \<sharp>* PQ'\<close> \<open>PQ' = P'' \<parallel> Q\<close> \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> FrP' have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P'"
         by(force dest: extractFrameFreshChain)
       note S
       moreover from PeqP' have "((p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P' \<otimes> (p \<bullet> \<Psi>\<^sub>Q)"
         by(simp add: eqvts) (metis Composition Associativity AssertionStatEqTrans AssertionStatEqSym Commutativity)
       with \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* \<Psi>\<^sub>Q\<close> \<open>bn \<alpha>' \<sharp>* \<Psi>\<^sub>Q\<close> S have "((p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q"
         by simp
       moreover from \<open>PQ' = P'' \<parallel> Q\<close> \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P'\<close> \<open>A\<^sub>Q \<sharp>* PQ'\<close> FrP' FrQ have "extractFrame PQ' = \<langle>(A\<^sub>P'@A\<^sub>Q), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q\<rangle>"
         by simp
       moreover note \<open>distinctPerm p\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* C'\<close>
       moreover from \<open>A\<^sub>P' \<sharp>* P''\<close> \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>PQ' = P'' \<parallel> Q\<close> have "A\<^sub>P' \<sharp>* PQ'" by simp
       moreover note \<open>A\<^sub>Q \<sharp>* PQ'\<close> \<open>A\<^sub>P' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* \<alpha>'\<close>
       moreover from \<open>bn \<alpha>' \<sharp>* Q\<close> have "(bn(p \<bullet> \<alpha>')) \<sharp>* (p \<bullet> Q)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
       with \<open>bn \<alpha> \<sharp>* Q\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Q\<close> S have "(bn(p \<bullet> \<alpha>')) \<sharp>* Q" by simp
       with \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* P''\<close> \<open>PQ' = P'' \<parallel> Q\<close> have "(bn(p \<bullet> \<alpha>')) \<sharp>* PQ'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* \<alpha>'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* C" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* X\<close> \<open>A\<^sub>Q \<sharp>* X\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* X" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* Y\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>A\<^sub>Q \<sharp>* Z\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* Z" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* PQ'\<close> \<open>A\<^sub>Q \<sharp>* PQ'\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* PQ'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* \<alpha>'" by simp
       moreover from \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<alpha>')"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
       with S \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* (p \<bullet> \<alpha>')"
         by simp
       with \<open>A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>')\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* A\<^sub>Q\<close> S have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* (p \<bullet> \<alpha>')"
         by simp
       moreover from \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>distinct A\<^sub>P'\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(A\<^sub>P'@A\<^sub>Q)" by auto
       moreover note \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* X\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Y\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Z\<close>
       ultimately show ?case using cPar1
         by metis
     next
       case(cPar2 \<Psi> \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C C' \<alpha>' PQ' X Y Z)
       have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and  FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
         by fact+
 
       note \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close>
       moreover from \<open>bn \<alpha>' \<sharp>* (P \<parallel> Q)\<close> have "bn \<alpha>' \<sharp>* Q" and "bn \<alpha>' \<sharp>* P" by simp+    
       moreover with FrP FrQ \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> have "bn \<alpha>' \<sharp>* \<Psi>\<^sub>P" and "bn \<alpha>' \<sharp>* \<Psi>\<^sub>Q" 
         by(force dest: extractFrameFreshChain)+
  
       moreover from \<open>bn \<alpha>' \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> have "bn \<alpha>' \<sharp>* (X@A\<^sub>P)" by simp
       moreover from \<open>bn \<alpha>' \<sharp>* Y\<close> \<open>bn \<alpha>' \<sharp>* \<Psi>\<^sub>P\<close> have "bn \<alpha>' \<sharp>* (\<Psi>\<^sub>P#Y)" by simp
       moreover from \<open>bn \<alpha>' \<sharp>* Z\<close> \<open>bn \<alpha>' \<sharp>* P\<close> have "bn \<alpha>' \<sharp>* (P#Z)" by simp
       moreover from \<open>A\<^sub>Q \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "A\<^sub>Q \<sharp>* (X@A\<^sub>P)" by simp
       moreover from \<open>A\<^sub>Q \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> have "A\<^sub>Q \<sharp>* (\<Psi>\<^sub>P#Y)" by force
       moreover from \<open>A\<^sub>Q \<sharp>* Z\<close> \<open>A\<^sub>Q \<sharp>* P\<close> have "A\<^sub>Q \<sharp>* (P#Z)" by simp
       moreover from \<open>\<alpha> \<prec> (P \<parallel> Q') = \<alpha>' \<prec> PQ'\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha>' \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close>
       obtain Q'' where A: "\<alpha> \<prec> Q' = \<alpha>' \<prec> Q''" and "PQ' = P \<parallel> Q''"
         by(metis actionPar2Dest')
       moreover from \<open>A\<^sub>Q \<sharp>* PQ'\<close> \<open>PQ' = P \<parallel> Q''\<close> have "A\<^sub>Q \<sharp>* Q''" by simp
       ultimately obtain p \<Psi>' A\<^sub>Q' \<Psi>\<^sub>Q' where S: "set p \<subseteq> set(bn \<alpha>') \<times> set (bn(p \<bullet> \<alpha>'))" and QeqQ': "((p \<bullet> \<Psi>\<^sub>Q) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>Q'"
                                         and "distinctPerm p" and "(bn(p \<bullet> \<alpha>')) \<sharp>* C'" and FrQ': "extractFrame Q'' = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q'\<rangle>"
                                         and "A\<^sub>Q' \<sharp>* Q''" and "A\<^sub>Q' \<sharp>* \<alpha>'" "A\<^sub>Q' \<sharp>* (p \<bullet> \<alpha>')" and "A\<^sub>Q' \<sharp>* C" 
                                         and "(bn(p \<bullet> \<alpha>')) \<sharp>* \<alpha>'" and "(bn(p \<bullet> \<alpha>')) \<sharp>* Q''" and "distinct A\<^sub>Q'"
                                         and "A\<^sub>Q' \<sharp>* (X @ A\<^sub>P)" and "A\<^sub>Q' \<sharp>* (\<Psi>\<^sub>P#Y)"
                                         and "A\<^sub>Q' \<sharp>* (P#Z)" and "(bn(p \<bullet> \<alpha>')) \<sharp>* (X @ A\<^sub>P)" and "(bn(p \<bullet> \<alpha>')) \<sharp>* (\<Psi>\<^sub>P#Y)"
                                         and "(bn(p \<bullet> \<alpha>')) \<sharp>* (P#Z)" using cPar2
         by(rule_tac cPar2)
 
       then have "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* Z" and "A\<^sub>Q' \<sharp>* A\<^sub>P" and "A\<^sub>Q' \<sharp>* X" and "A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P"  and "A\<^sub>Q' \<sharp>* Y" 
             and "(bn(p \<bullet> \<alpha>')) \<sharp>* A\<^sub>P" and "(bn(p \<bullet> \<alpha>')) \<sharp>* X" and "(bn(p \<bullet> \<alpha>')) \<sharp>* Y" and "(bn(p \<bullet> \<alpha>')) \<sharp>* Z" and "(bn(p \<bullet> \<alpha>')) \<sharp>* \<Psi>\<^sub>P"
             and "(bn(p \<bullet> \<alpha>')) \<sharp>* P"
         by(simp del: freshChainSimps)+
 
       from \<open>A\<^sub>P \<sharp>* PQ'\<close> \<open>PQ' = P \<parallel> Q''\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> FrQ' have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q'"
         by(force dest: extractFrameFreshChain)
       note S
       moreover from QeqQ' have "((p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<otimes> \<Psi>') \<simeq> (p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q'"
         by(simp add: eqvts) (metis Composition Associativity AssertionStatEqTrans AssertionStatEqSym Commutativity)
       with \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* \<Psi>\<^sub>P\<close> \<open>bn \<alpha>' \<sharp>* \<Psi>\<^sub>P\<close> S have "((p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q)) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q'"
         by simp
       moreover from \<open>PQ' = P \<parallel> Q''\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q'\<close> \<open>A\<^sub>P \<sharp>* PQ'\<close> FrQ' FrP have "extractFrame PQ' = \<langle>(A\<^sub>P@A\<^sub>Q'), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q'\<rangle>"
         by simp
       moreover note \<open>distinctPerm p\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* C'\<close>
       moreover from \<open>A\<^sub>Q' \<sharp>* Q''\<close> \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>PQ' = P \<parallel> Q''\<close> have "A\<^sub>Q' \<sharp>* PQ'" by simp
       moreover note \<open>A\<^sub>Q \<sharp>* PQ'\<close> \<open>A\<^sub>Q' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>'\<close> \<open>A\<^sub>Q' \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* \<alpha>'\<close>
       moreover from \<open>bn \<alpha>' \<sharp>* Q\<close> have "(bn(p \<bullet> \<alpha>')) \<sharp>* (p \<bullet> Q)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
       with \<open>bn \<alpha> \<sharp>* P\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* P\<close> S have "(bn(p \<bullet> \<alpha>')) \<sharp>* P" by simp
       with \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Q''\<close> \<open>PQ' = P \<parallel> Q''\<close> have "(bn(p \<bullet> \<alpha>')) \<sharp>* PQ'" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* \<alpha>'" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* C\<close> \<open>A\<^sub>P \<sharp>* C\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* C" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* X\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* X" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* Y\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* Z\<close> \<open>A\<^sub>P \<sharp>* Z\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* Z" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* PQ'\<close> \<open>A\<^sub>P \<sharp>* PQ'\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* PQ'" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* \<alpha>'" by simp
       moreover from \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> \<alpha>')"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
       with S \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* A\<^sub>P\<close> have "A\<^sub>P \<sharp>* (p \<bullet> \<alpha>')"
         by simp
       with \<open>A\<^sub>Q' \<sharp>* (p \<bullet> \<alpha>')\<close> \<open>A\<^sub>P \<sharp>* \<alpha>'\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* A\<^sub>P\<close> S have "(A\<^sub>P@A\<^sub>Q') \<sharp>* (p \<bullet> \<alpha>')"
         by simp
       moreover note \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* X\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Y\<close> \<open>(bn(p \<bullet> \<alpha>')) \<sharp>* Z\<close>
       moreover from \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q'\<close> have "distinct(A\<^sub>P@A\<^sub>Q')" by auto
       ultimately show ?case using cPar2
         by metis
     next
       case cComm1
       thus ?case by(simp add: residualInject)
     next
       case cComm2
       thus ?case by(simp add: residualInject)
     next
       case(cOpen \<Psi> P M xvec1 xvec2 N P' x A\<^sub>P \<Psi>\<^sub>P C C' \<alpha> P'' X Y Z)
       from \<open>M\<lparr>\<nu>*(xvec1@x#xvec2)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close> \<open>x \<sharp> xvec1\<close> \<open>x \<sharp> xvec2\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> P''\<close> \<open>distinct(bn \<alpha>)\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> \<open>x \<sharp> \<alpha>\<close>
       obtain yvec1 y yvec2 N' where yvecEq: "bn \<alpha> = yvec1@y#yvec2" and P'eqP'': "\<lparr>\<nu>*(xvec1@xvec2)\<rparr>N \<prec>' P' = \<lparr>\<nu>*(yvec1@yvec2)\<rparr>([(x, y)] \<bullet> N') \<prec>' ([(x, y)] \<bullet> P'')" and "A\<^sub>P \<sharp>* N'" and Subj: "subject \<alpha> = Some M" and "x \<sharp> N'" and \<alpha>eq: "\<alpha> = M\<lparr>\<nu>*(yvec1@y#yvec2)\<rparr>\<langle>N'\<rangle>"
         apply(cases rule: actionCases[where \<alpha>=\<alpha>])
         apply(auto simp add: residualInject)
         apply(rule boundOutputOpenDest)
         by assumption auto
       note \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close>
       moreover from Subj yvecEq \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "yvec1 \<sharp>* M" "yvec2 \<sharp>* M" by simp+
       moreover from yvecEq \<open>A\<^sub>P \<sharp>* \<alpha>\<close> have "A\<^sub>P \<sharp>* (yvec1@yvec2)" by simp
       moreover note \<open>A\<^sub>P \<sharp>* C\<close>
       moreover from yvecEq  \<open>bn \<alpha> \<sharp>* \<lparr>\<nu>x\<rparr>P\<close> \<open>x \<sharp> \<alpha>\<close> have "(yvec1@yvec2) \<sharp>* P" by simp
       moreover from yvecEq \<open>bn \<alpha> \<sharp>* C'\<close> \<open>bn \<alpha> \<sharp>* X\<close> \<open>bn \<alpha> \<sharp>* Y\<close> \<open>bn \<alpha> \<sharp>* Z\<close> \<open>distinct(bn \<alpha>)\<close> \<open>x \<sharp> \<alpha>\<close>
       have "(yvec1@yvec2) \<sharp>* C'" and "(yvec1@yvec2) \<sharp>* (x#y#X)" and "(yvec1@yvec2) \<sharp>* Y" and "(yvec1@yvec2) \<sharp>* Z"
         by simp+
       moreover from \<open>A\<^sub>P \<sharp>* X\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> yvecEq have "A\<^sub>P \<sharp>* (x#y#X)" by simp
       moreover note \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* Z\<close>
       moreover from \<open>A\<^sub>P \<sharp>* N'\<close> \<open>A\<^sub>P \<sharp>* P''\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> yvecEq have "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> N')" and  "A\<^sub>P \<sharp>* ([(x, y)] \<bullet> P'')"
         by simp+
       moreover from yvecEq \<open>distinct(bn \<alpha>)\<close> have "distinct(yvec1@yvec2)" by simp
       moreover from P'eqP'' have "M\<lparr>\<nu>*(xvec1@xvec2)\<rparr>\<langle>N\<rangle> \<prec> P' = M\<lparr>\<nu>*(yvec1@yvec2)\<rparr>\<langle>([(x, y)] \<bullet> N')\<rangle> \<prec> ([(x, y)] \<bullet> P'')"
         by(simp add: residualInject)
       ultimately obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set (yvec1@yvec2) \<times> set (p \<bullet> (yvec1@yvec2))" and PeqP': "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P'"
                                         and "distinctPerm p" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* C'" and FrP': "extractFrame([(x, y)] \<bullet> P'') = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>"
                                         and "A\<^sub>P' \<sharp>* ([(x, y)] \<bullet> P'')" and "A\<^sub>P' \<sharp>* ([(x, y)] \<bullet> N')" and "A\<^sub>P' \<sharp>* C" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* ([(x, y)] \<bullet> N')" and "A\<^sub>P' \<sharp>* M" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* (yvec1@yvec2)" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* M" and "distinct A\<^sub>P'"
                                         and "(p \<bullet> (yvec1@yvec2)) \<sharp>* ([(x, y)] \<bullet> P'')" and "(yvec1@yvec2) \<sharp>* A\<^sub>P'" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* A\<^sub>P'"
                                         and "A\<^sub>P' \<sharp>* (x#y#X)" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* (x#y#X)"
                                         and "(p \<bullet> (yvec1@yvec2)) \<sharp>* Y" and "(p \<bullet> (yvec1@yvec2)) \<sharp>* Z" using \<open>A\<^sub>P \<sharp>* C'\<close>
         by(rule_tac cOpen(4)[where bd="x#y#X"]) (assumption | simp_all)+
 
       from \<open>A\<^sub>P' \<sharp>* (x#y#X)\<close> have "x \<sharp> A\<^sub>P'" and "y \<sharp> A\<^sub>P'" and "A\<^sub>P' \<sharp>* X" by simp+
       from \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* (x#y#X)\<close> have "x \<sharp> (p \<bullet> (yvec1@yvec2))" and  "y \<sharp> (p \<bullet> (yvec1@yvec2))" and  "(p \<bullet> (yvec1@yvec2)) \<sharp>* X" by simp+
 
       from \<open>x \<sharp> \<alpha>\<close> yvecEq have "x \<sharp> yvec1" and "x \<noteq> y" and "x \<sharp> yvec2" by simp+
       from \<open>distinct(bn \<alpha>)\<close> yvecEq have "yvec1 \<sharp>* yvec2" and "y \<sharp> yvec1" and "y \<sharp> yvec2" by simp+
       from \<open>bn \<alpha> \<sharp>* C'\<close> yvecEq have "yvec1 \<sharp>* C'" and "y \<sharp> C'" and "yvec2 \<sharp>* C'" by simp+
 
       from S \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> p \<bullet> (yvec1@yvec2)\<close> yvecEq have "x \<sharp> p" by(rule_tac freshAlphaSwap) (assumption | simp)+
       from S \<open>distinct(bn \<alpha>)\<close> \<open>y \<sharp> p \<bullet> (yvec1@yvec2)\<close> yvecEq have "y \<sharp> p" by(rule_tac freshAlphaSwap) (assumption | simp)+
 
       from yvecEq S \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p \<bullet> (yvec1@yvec2)\<close> \<open>y \<sharp> p \<bullet> (yvec1@yvec2)\<close>
       have "set ((y, x)#p) \<subseteq> set(bn \<alpha>) \<times> set(bn(((y, x)#p) \<bullet> \<alpha>))"
         apply(simp add: bnEqvt[symmetric])
         by(auto simp add: eqvts calc_atm)
 
       moreover from PeqP' have "([(y, x)] \<bullet> ((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>')) \<simeq> [(y, x)] \<bullet> \<Psi>\<^sub>P'"
         by(simp add: AssertionStatEqClosed)
       hence "(((y, x)#p) \<bullet> \<Psi>\<^sub>P) \<otimes> ([(y, x)] \<bullet> \<Psi>') \<simeq> ([(y, x)] \<bullet> \<Psi>\<^sub>P')"
         by(simp add: eqvts)
       moreover from \<open>distinctPerm p\<close> S \<open>x \<noteq> y\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> have "distinctPerm((y, x)#p)"
         by simp
       moreover from FrP' have "([(x, y)] \<bullet> (extractFrame([(x, y)] \<bullet> P''))) = ([(x, y)] \<bullet> \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>)"
         by simp
       with \<open>x \<sharp> A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> have "extractFrame P'' = \<langle>A\<^sub>P', ([(y, x)] \<bullet> \<Psi>\<^sub>P')\<rangle>"
         by(simp add: eqvts name_swap)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> N'\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* ([(x, y)] \<bullet> N')\<close> have "([(y, x)] \<bullet> p \<bullet> (yvec1@yvec2)) \<sharp>* ([(y, x)] \<bullet> [(x, y)] \<bullet> N')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       hence "(((y, x)#p) \<bullet> (yvec1@yvec2)) \<sharp>* N'" by(simp add: name_swap) 
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> C\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> N'\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* N'" by(simp add: bnEqvt[symmetric]) (simp add: eqvts perm_compose calc_atm freshChainSimps)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> N'\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* ([(x, y)] \<bullet> P'')\<close> have "([(y, x)] \<bullet> p \<bullet> (yvec1@yvec2)) \<sharp>* ([(y, x)] \<bullet> [(x, y)] \<bullet> P'')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       hence "(((y, x)#p) \<bullet> (yvec1@yvec2)) \<sharp>* P''" by(simp add: name_swap) 
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> P''\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* P''" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps) 
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> A\<^sub>P'\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* A\<^sub>P'\<close> have "(p \<bullet> (yvec1@x#yvec2)) \<sharp>* A\<^sub>P'"
         by(simp add: eqvts freshChainSimps)
       hence "([(y, x)] \<bullet> p \<bullet> (yvec1@x#yvec2)) \<sharp>* ([(y, x)] \<bullet> A\<^sub>P')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> A\<^sub>P'\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>y \<sharp> A\<^sub>P'\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* A\<^sub>P'" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> C'\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* C'\<close> have "(p \<bullet> (yvec1@x#yvec2)) \<sharp>* C'"
         by(simp add: eqvts freshChainSimps)
       hence "([(y, x)] \<bullet> p \<bullet> (yvec1@x#yvec2)) \<sharp>* ([(y, x)] \<bullet> C')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> C'\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>y \<sharp> C'\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* C'"  by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> X\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* X\<close> have "(p \<bullet> (yvec1@x#yvec2)) \<sharp>* X"
         by(simp add: eqvts freshChainSimps)
       hence "([(y, x)] \<bullet> p \<bullet> (yvec1@x#yvec2)) \<sharp>* ([(y, x)] \<bullet> X)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> X\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>bn \<alpha> \<sharp>* X\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* X" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> Y\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* Y\<close> have "(p \<bullet> (yvec1@x#yvec2)) \<sharp>* Y"
         by(simp add: eqvts freshChainSimps)
       hence "([(y, x)] \<bullet> p \<bullet> (yvec1@x#yvec2)) \<sharp>* ([(y, x)] \<bullet> Y)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> Y\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>bn \<alpha> \<sharp>* Y\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* Y" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
       moreover from \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> Z\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* Z\<close> have "(p \<bullet> (yvec1@x#yvec2)) \<sharp>* Z"
         by(simp add: eqvts freshChainSimps)
       hence "([(y, x)] \<bullet> p \<bullet> (yvec1@x#yvec2)) \<sharp>* ([(y, x)] \<bullet> Z)"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> yvec1\<close> \<open>x \<sharp> yvec2\<close> \<open>x \<noteq> y\<close> \<open>x \<sharp> Z\<close> \<open>y \<sharp> yvec1\<close> \<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close> \<open>y \<sharp> p\<close> \<open>bn \<alpha> \<sharp>* Z\<close> yvecEq
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* Z" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
       moreover from \<open>(yvec1@yvec2) \<sharp>* A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> yvecEq have "bn \<alpha> \<sharp>* A\<^sub>P'"
         by simp
       moreover from \<open>A\<^sub>P' \<sharp>* ([(x, y)] \<bullet> N')\<close> have "([(x, y)] \<bullet> A\<^sub>P') \<sharp>* ([(x, y)] \<bullet> [(x, y)] \<bullet> N')"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> have "A\<^sub>P' \<sharp>* N'" by simp
       with \<open>A\<^sub>P' \<sharp>* M\<close> \<open>(yvec1@yvec2) \<sharp>* A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> \<alpha>eq have "A\<^sub>P' \<sharp>* \<alpha>" by simp
       moreover hence "(((y, x)#p) \<bullet> A\<^sub>P') \<sharp>* (((y, x)#p) \<bullet> \<alpha>)"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> S \<open>(yvec1@yvec2) \<sharp>* A\<^sub>P'\<close> \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* A\<^sub>P'\<close>
       have "A\<^sub>P' \<sharp>* (((y, x)#p) \<bullet> \<alpha>)" by(simp add: eqvts)
       moreover from \<open>A\<^sub>P' \<sharp>* ([(x, y)] \<bullet> P'')\<close> have "([(x, y)] \<bullet> A\<^sub>P') \<sharp>* ([(x, y)] \<bullet> [(x, y)] \<bullet> P'')"
         by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>x \<sharp> A\<^sub>P'\<close> \<open>y \<sharp> A\<^sub>P'\<close> have "A\<^sub>P' \<sharp>* P''" by simp
       moreover from yvecEq \<alpha>eq \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* (yvec1@yvec2)\<close> \<open>y \<sharp> p\<close> \<open>x \<sharp> \<alpha>\<close> S \<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* M\<close>\<open>(p \<bullet> (yvec1@yvec2)) \<sharp>* ([(x, y)] \<bullet> N')\<close> \<open>y \<sharp> yvec1\<close>\<open>y \<sharp> yvec2\<close> \<open>x \<sharp> p\<close>
       have "bn(((y, x)#p) \<bullet> \<alpha>) \<sharp>* \<alpha>"
       apply(simp add: eqvts del: set_append) 
       apply(intro conjI)
       apply(simp add: perm_compose eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(simp add: perm_compose eqvts del: set_append)
       apply(simp add: perm_compose eqvts swapStarFresh del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) swapStarFresh calc_atm eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(subst pt_fresh_star_bij[symmetric, OF pt_name_inst, OF at_name_inst, where pi="[(x, y)]"])
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       apply(subst pt_fresh_star_bij[symmetric, OF pt_name_inst, OF at_name_inst, where pi="[(x, y)]"])
       by(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
       moreover note \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>P' \<sharp>* X\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>distinct A\<^sub>P'\<close>
 
       ultimately show ?case
         by(rule_tac cOpen)
     next
       case(cScope \<Psi> P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P C C' \<alpha>' P'' X Y Z)
       from \<open>\<alpha> \<prec> \<lparr>\<nu>x\<rparr>P' = \<alpha>' \<prec> P''\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> \<alpha>'\<close>
       obtain P''' where "\<alpha> \<prec> P' = \<alpha>' \<prec> P'''" and "P'' = \<lparr>\<nu>x\<rparr>P'''"
         apply(cases rule: actionCases[where \<alpha>=\<alpha>])
         apply(auto simp add: residualInject)
         by(metis boundOutputScopeDest)
       then obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set(bn \<alpha>') \<times> set(bn(p \<bullet> \<alpha>'))" and PeqP': "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P'"
                                   and "distinctPerm p" and "bn(p \<bullet> \<alpha>') \<sharp>* C'" and FrP': "extractFrame P''' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>"
                                   and "A\<^sub>P' \<sharp>* P'''" and "A\<^sub>P' \<sharp>* \<alpha>'" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>')" and "A\<^sub>P' \<sharp>* C" and "distinct A\<^sub>P'"
                                   and "bn(p \<bullet> \<alpha>') \<sharp>* P'''" and "A\<^sub>P' \<sharp>* (x#X)" and "A\<^sub>P' \<sharp>* Y" and "bn(p \<bullet> \<alpha>') \<sharp>* \<alpha>'"
                                   and "A\<^sub>P' \<sharp>* Z" and "bn(p \<bullet> \<alpha>') \<sharp>* (x#X)" and "bn(p \<bullet> \<alpha>') \<sharp>* Y"
                                   and "bn(p \<bullet> \<alpha>') \<sharp>* Z" using cScope
         by(rule_tac cScope) (assumption | simp)+
       from \<open>A\<^sub>P' \<sharp>* (x#X)\<close> have "x \<sharp> A\<^sub>P'" and "A\<^sub>P' \<sharp>* X" by simp+
       from \<open>bn(p \<bullet> \<alpha>') \<sharp>* (x#X)\<close> have "x \<sharp> bn(p \<bullet> \<alpha>')" and "bn(p \<bullet> \<alpha>') \<sharp>* X" by simp+
 
       note S PeqP' \<open>distinctPerm p\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* C'\<close>
       moreover from FrP' \<open>P'' = \<lparr>\<nu>x\<rparr>P'''\<close> have "extractFrame P'' = \<langle>(x#A\<^sub>P'), \<Psi>\<^sub>P'\<rangle>" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* P'''\<close> \<open>P'' = \<lparr>\<nu>x\<rparr>P'''\<close> \<open>x \<sharp> A\<^sub>P'\<close> have "(x#A\<^sub>P') \<sharp>* P''" by(simp add: abs_fresh)
       moreover from \<open>A\<^sub>P' \<sharp>* \<alpha>'\<close> \<open>A\<^sub>P' \<sharp>* C\<close>  \<open>x \<sharp> \<alpha>'\<close> \<open>x \<sharp> C\<close> have "(x#A\<^sub>P') \<sharp>* \<alpha>'"  and "(x#A\<^sub>P') \<sharp>* C" by simp+
       moreover note \<open>bn(p \<bullet> \<alpha>') \<sharp>* \<alpha>'\<close>
       moreover from \<open>bn(p \<bullet> \<alpha>') \<sharp>* P'''\<close> \<open>P'' = \<lparr>\<nu>x\<rparr>P'''\<close> \<open>x \<sharp> bn(p \<bullet> \<alpha>')\<close> have "bn(p \<bullet> \<alpha>') \<sharp>* P''" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* \<alpha>'\<close> \<open>x \<sharp> \<alpha>'\<close> have "(x#A\<^sub>P') \<sharp>* \<alpha>'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>')\<close> \<open>x \<sharp> \<alpha>'\<close> S \<open>x \<sharp> bn(p \<bullet> \<alpha>')\<close> have "(x#A\<^sub>P') \<sharp>* (p \<bullet> \<alpha>')" 
         by(simp add: subjectEqvt[symmetric] bnEqvt[symmetric] okjectEqvt[symmetric] freshChainSimps)
       moreover from \<open>A\<^sub>P' \<sharp>* X\<close> \<open>x \<sharp> X\<close> have "(x#A\<^sub>P') \<sharp>* X" by simp+
       moreover from \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>x \<sharp> Y\<close> have "(x#A\<^sub>P') \<sharp>* Y" by simp+
       moreover from \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>x \<sharp> Z\<close> have "(x#A\<^sub>P') \<sharp>* Z" by simp+
       moreover note \<open>bn(p \<bullet> \<alpha>') \<sharp>* X\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* Y\<close> \<open>bn(p \<bullet> \<alpha>') \<sharp>* Z\<close>
       moreover from \<open>distinct A\<^sub>P'\<close> \<open>x \<sharp> A\<^sub>P'\<close> have "distinct(x#A\<^sub>P')" by simp
       ultimately show ?case by(rule_tac cScope)
     next
       case(cBang \<Psi> P A\<^sub>P \<Psi>\<^sub>P C C' \<alpha> P' X Y Z)
       then obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))"
                                   and FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" 
                                   and PeqP': "(p \<bullet> (\<Psi>\<^sub>P \<otimes> \<one>)) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'"
                                   and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)"
                                   and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" and "distinct A\<^sub>P'"
                                   and "distinctPerm p" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'"
                                   and "(bn(p \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(p \<bullet> \<alpha>)) \<sharp>* X" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Y" and "(bn(p \<bullet> \<alpha>)) \<sharp>* Z"
         by(rule_tac cBang) (assumption | simp (no_asm_use))+
       moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "(p \<bullet> \<Psi>\<^sub>P) \<simeq> (p \<bullet> \<one>)"
         by(simp add: AssertionStatEqClosed)
       hence "(p \<bullet> \<Psi>\<^sub>P) \<simeq> \<one>" by(simp add: permBottom)
       with PeqP' have "(\<one> \<otimes> \<Psi>') \<simeq> \<Psi>\<^sub>P'"
         by(simp add: eqvts permBottom) (metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
       ultimately show ?case using cBang
         apply(rule_tac cBang(18)) by(assumption | simp)+ 
     qed
     
     with A have ?thesis by blast
   }
   moreover have "bn \<alpha> \<sharp>* ([]::name list)" and "bn \<alpha> \<sharp>* ([]::'b list)" and "bn \<alpha> \<sharp>* ([]::('a, 'b, 'c) psi list)"
            and  "A\<^sub>P \<sharp>* ([]::name list)" and "A\<^sub>P \<sharp>* ([]::'b list)" and "A\<^sub>P \<sharp>* ([]::('a, 'b, 'c) psi list)" 
     by simp+
   ultimately show ?thesis by blast
 qed
 
 lemma expandTauFrame:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b,'c) psi"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   C    :: "'d::fs_name"
 
   assumes "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* C"
 
   obtains \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>"  and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" and "distinct A\<^sub>P'"
 proof -
   assume A: "\<And>A\<^sub>P' \<Psi>\<^sub>P' \<Psi>'.
         \<lbrakk>extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>; \<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'; A\<^sub>P' \<sharp>* C; A\<^sub>P' \<sharp>* P'; distinct A\<^sub>P'\<rbrakk>
         \<Longrightarrow> thesis"
 
   from \<open>\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec>P'\<close> \<open>A\<^sub>P \<sharp>* P\<close> have "A\<^sub>P \<sharp>* P'" by(rule tauFreshChainDerivative)
 
   {
     fix X :: "name list"
     and Y :: "'b list"
     and Z :: "('a, 'b, 'c) psi list"
 
     assume "A\<^sub>P \<sharp>* X"
     and    "A\<^sub>P \<sharp>* Y"
     and    "A\<^sub>P \<sharp>* Z"
     
     with assms \<open>A\<^sub>P \<sharp>* P'\<close> obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "A\<^sub>P' \<sharp>* C"
                                                and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" and "distinct A\<^sub>P'"
     proof(nominal_induct avoiding: C X Y Z arbitrary: thesis rule: tauFrameInduct)
       case(cAlpha \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P p C X Y Z)
       then obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinct A\<^sub>P'"
                                 and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z"
         by metis
 
       have S: "set p \<subseteq> set A\<^sub>P \<times> set(p \<bullet> A\<^sub>P)" by fact
 
       from FrP' have "(p \<bullet> extractFrame P') = p \<bullet> \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" by simp
       with \<open>A\<^sub>P \<sharp>* P'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> S have "extractFrame P' = \<langle>(p \<bullet> A\<^sub>P'), (p \<bullet> \<Psi>\<^sub>P')\<rangle>" by(simp add: eqvts)
       moreover from \<open>\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'\<close> have "(p \<bullet> (\<Psi>\<^sub>P \<otimes> \<Psi>')) \<simeq> (p \<bullet> \<Psi>\<^sub>P')" by(rule AssertionStatEqClosed)
       hence "(p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>') \<simeq> (p \<bullet> \<Psi>\<^sub>P')" by(simp add: eqvts)
       moreover from \<open>A\<^sub>P' \<sharp>* C\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> C)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* C\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* C\<close> S have "(p \<bullet> A\<^sub>P') \<sharp>* C" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* P'\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> P')" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* P'\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* P'\<close> S have "(p \<bullet> A\<^sub>P') \<sharp>* P'" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* X\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> X)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* X\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* X\<close> S have "(p \<bullet> A\<^sub>P') \<sharp>* X" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Y\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> Y)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* Y\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Y\<close> S have "(p \<bullet> A\<^sub>P') \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Z\<close> have "(p \<bullet> A\<^sub>P') \<sharp>* (p \<bullet> Z)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>P \<sharp>* Z\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* Z\<close> S have "(p \<bullet> A\<^sub>P') \<sharp>* Z" by simp
       moreover from \<open>distinct A\<^sub>P'\<close> have "distinct(p \<bullet> A\<^sub>P')" by simp
       ultimately show ?case by(rule cAlpha)
     next
       case(cCase \<Psi> P P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P C B Y Z thesis)
       then obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" 
                                 and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinct A\<^sub>P'"
                                 and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'"
                                 and "A\<^sub>P' \<sharp>* B" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z"
         by(rule_tac cCase) (assumption | simp (no_asm_use))+
       with \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'\<close> have "\<one> \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'"
         by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
       thus ?case using FrP' \<open>A\<^sub>P' \<sharp>* P'\<close> \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>P' \<sharp>* B\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>distinct A\<^sub>P'\<close> using cCase
         by force
     next
       case(cPar1 \<Psi> \<Psi>\<^sub>Q P P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P C X Y Z)
       moreover from \<open>A\<^sub>P \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Z\<close>
       have "A\<^sub>P \<sharp>* (X@A\<^sub>Q)" and  "A\<^sub>P \<sharp>* (\<Psi>\<^sub>Q#Y)" and  "A\<^sub>P \<sharp>* (Q#Z)"
         by simp+
       ultimately obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "distinct A\<^sub>P'"
                                       and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* C" and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" 
                                       and "A\<^sub>P' \<sharp>* (X@A\<^sub>Q)" and "A\<^sub>P' \<sharp>* (\<Psi>\<^sub>Q#Y)" and "A\<^sub>P' \<sharp>* (Q#Z)"
         by metis
 
       hence "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* A\<^sub>Q" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q" and "A\<^sub>P' \<sharp>* Q" and "A\<^sub>P' \<sharp>* Z"
         by simp+
 
       from \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> FrP' have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P'" by(force dest: extractFrameFreshChain)
       with \<open>A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> FrP'
       have "extractFrame(P' \<parallel> Q) = \<langle>(A\<^sub>P'@A\<^sub>Q), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q\<rangle>" by simp
 
       moreover from \<open>\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'\<close>have "(\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q" 
         by(metis Associativity Commutativity Composition AssertionStatEqTrans AssertionStatEqSym)
 
       moreover from \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* C\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* C" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* P'\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* (P' \<parallel> Q)" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* X\<close> \<open>A\<^sub>Q \<sharp>* X\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* X" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* Y\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>A\<^sub>Q \<sharp>* Z\<close> have "(A\<^sub>P'@A\<^sub>Q) \<sharp>* Z" by simp
       moreover from \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>distinct A\<^sub>P'\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(A\<^sub>P'@A\<^sub>Q)" by simp
       ultimately show ?case by(rule cPar1)
     next
       case(cPar2 \<Psi> \<Psi>\<^sub>P Q Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q C X Y Z)
       moreover from \<open>A\<^sub>Q \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Z\<close>
       have "A\<^sub>Q \<sharp>* (X@A\<^sub>P)" and  "A\<^sub>Q \<sharp>* (\<Psi>\<^sub>P#Y)" and  "A\<^sub>Q \<sharp>* (P#Z)"
         by(simp add: freshChainSimps)+
       ultimately obtain \<Psi>' A\<^sub>Q' \<Psi>\<^sub>Q' where FrQ': "extractFrame Q' = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q'\<rangle>" and "distinct A\<^sub>Q'"
                                        and "\<Psi>\<^sub>Q \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>Q'"and "A\<^sub>Q' \<sharp>* C" and "A\<^sub>Q' \<sharp>* Q'" 
                                        and "A\<^sub>Q' \<sharp>* (X@A\<^sub>P)" and "A\<^sub>Q' \<sharp>* (\<Psi>\<^sub>P#Y)" and "A\<^sub>Q' \<sharp>* (P#Z)"
         by metis
 
       hence "A\<^sub>Q' \<sharp>* X" and "A\<^sub>Q' \<sharp>* A\<^sub>P" and "A\<^sub>Q' \<sharp>* Y" and "A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P" and "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* Z"
         by simp+
 
       from \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> FrQ' have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q'" by(force dest: extractFrameFreshChain)
       with \<open>A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> FrQ'
       have "extractFrame(P \<parallel> Q') = \<langle>(A\<^sub>P@A\<^sub>Q'), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q'\<rangle>" by simp
 
       moreover from \<open>\<Psi>\<^sub>Q \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>Q'\<close>have "(\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q'" 
         by(metis Associativity Commutativity Composition AssertionStatEqTrans AssertionStatEqSym)
       moreover from \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>Q' \<sharp>* C\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* C" by simp
       moreover from \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>Q' \<sharp>* Q'\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* (P \<parallel> Q')" by simp
       moreover from \<open>A\<^sub>P \<sharp>* X\<close> \<open>A\<^sub>Q' \<sharp>* X\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* X" by simp
       moreover from \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>Q' \<sharp>* Y\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* Y" by simp
       moreover from \<open>A\<^sub>P \<sharp>* Z\<close> \<open>A\<^sub>Q' \<sharp>* Z\<close> have "(A\<^sub>P@A\<^sub>Q') \<sharp>* Z" by simp
       moreover from \<open>A\<^sub>Q' \<sharp>* A\<^sub>P\<close> \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q'\<close> have "distinct(A\<^sub>P@A\<^sub>Q')" by simp
       ultimately show ?case by(rule cPar2)
     next
       case(cComm1 \<Psi> \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q C X Y Z)
       have PTrans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'" and QTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'" by fact+
       from PTrans \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* N\<close> \<open>A\<^sub>P \<sharp>* M\<close>
            \<open>A\<^sub>P \<sharp>* Q'\<close> \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>P \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* Z\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close>
       obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and PeqP': "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'"
                            and "A\<^sub>P' \<sharp>* Q'" and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "distinct A\<^sub>P'"
                            and "A\<^sub>P' \<sharp>* Z" and "A\<^sub>P' \<sharp>* A\<^sub>Q" and "A\<^sub>P' \<sharp>* xvec" and "A\<^sub>P' \<sharp>* P'"
         by(rule_tac C="(Q', C, X, Y, Z, A\<^sub>Q, xvec)" and C'="(Q', C, X, Y, Z, A\<^sub>Q, xvec)" in expandNonTauFrame) auto
       moreover from QTrans  have "distinct xvec" by(auto dest: boundOutputDistinct)
       from QTrans \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>xvec \<sharp>* K\<close> \<open>distinct xvec\<close>
            \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P' \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>xvec \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* N\<close> 
            \<open>A\<^sub>Q \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* X\<close> \<open>A\<^sub>Q \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* Z\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* C\<close> \<open>xvec \<sharp>* X\<close> \<open>xvec \<sharp>* Y\<close> \<open>xvec \<sharp>* Z\<close>
       obtain p \<Psi>'' A\<^sub>Q' \<Psi>\<^sub>Q' where S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)" and QeqQ': "(p \<bullet> \<Psi>\<^sub>Q) \<otimes> \<Psi>'' \<simeq> \<Psi>\<^sub>Q'" and FrQ': "extractFrame Q' = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q'\<rangle>"
                              and "A\<^sub>Q' \<sharp>* A\<^sub>P'" and "A\<^sub>Q' \<sharp>* C" and "A\<^sub>Q' \<sharp>* X" and "A\<^sub>Q' \<sharp>* Y" and "A\<^sub>Q' \<sharp>* Z" and "A\<^sub>Q' \<sharp>* P" and "A\<^sub>Q' \<sharp>* N" and "distinct A\<^sub>Q'"
                              and "(p \<bullet> xvec) \<sharp>* A\<^sub>P'" and "(p \<bullet> xvec) \<sharp>* C" and "(p \<bullet> xvec) \<sharp>* X" and "(p \<bullet> xvec) \<sharp>* Y" and "(p \<bullet> xvec) \<sharp>* P"
                              and "(p \<bullet> xvec) \<sharp>* Z" and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P" and "(p \<bullet> xvec) \<sharp>* A\<^sub>Q'"and "(p \<bullet> xvec) \<sharp>* Q'"
                              and "distinctPerm p" and "A\<^sub>Q' \<sharp>* xvec" and "A\<^sub>Q' \<sharp>* Q'"
         by(rule_tac C="(P, C, X, Y, Z, A\<^sub>P', \<Psi>\<^sub>P)" and C'="(P, C, X, Y, Z, A\<^sub>P', \<Psi>\<^sub>P)" in expandNonTauFrame) (assumption | simp)+
 
       from PTrans \<open>A\<^sub>Q' \<sharp>* P\<close> \<open>A\<^sub>Q' \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> 
       have "A\<^sub>Q' \<sharp>* P'" and "(p \<bullet> xvec) \<sharp>* P'" by(force dest: inputFreshChainDerivative)+
       with FrP' \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> have "A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P'" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P'" by(force dest: extractFrameFreshChain)+
       from FrQ' \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>P' \<sharp>* Q'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>Q'\<close> \<open>(p \<bullet> xvec) \<sharp>* Q'\<close> have "A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q'" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q'"
         by(force dest: extractFrameFreshChain)+
       
       have "extractFrame(\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) = \<langle>((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q'), (p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q')\<rangle>"
       proof -
         from FrP' FrQ' \<open>A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q'\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P'\<close> have "extractFrame(P' \<parallel> Q') = \<langle>(A\<^sub>P'@A\<^sub>Q'), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'\<rangle>"
           by simp
         hence "extractFrame(\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) = \<langle>(xvec@A\<^sub>P'@A\<^sub>Q'), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'\<rangle>"
           by(induct xvec) auto
         moreover from \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q'\<close> S 
         have "\<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(p \<bullet> \<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert(\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q')))"
           by(rule_tac frameChainAlpha) (auto simp add: fresh_star_def frameResChainFresh)
         hence "\<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert((p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q'))))"
           using \<open>A\<^sub>P' \<sharp>* xvec\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* xvec\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>Q'\<close> S
           by(fastforce simp add: eqvts)
         ultimately show ?thesis
           by(simp add: frameChainAppend)
       qed
           
       moreover have "(\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<otimes> ((p \<bullet> \<Psi>') \<otimes> (p \<bullet> \<Psi>'')) \<simeq> (p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q')"
       proof -
         have "(\<Psi>\<^sub>P \<otimes> (p \<bullet> \<Psi>\<^sub>Q)) \<otimes> (\<Psi>' \<otimes> \<Psi>'') \<simeq> (\<Psi>\<^sub>P \<otimes> \<Psi>') \<otimes> ((p \<bullet> \<Psi>\<^sub>Q) \<otimes> \<Psi>'')"
           by(metis Associativity Commutativity Composition AssertionStatEqTrans)
         moreover from PeqP' QeqQ' have "(\<Psi>\<^sub>P \<otimes> \<Psi>') \<otimes> ((p \<bullet> \<Psi>\<^sub>Q) \<otimes> \<Psi>'') \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'"
           by(metis Associativity Commutativity Composition AssertionStatEqTrans)
         ultimately have "(\<Psi>\<^sub>P \<otimes> (p \<bullet> \<Psi>\<^sub>Q)) \<otimes> (\<Psi>' \<otimes> \<Psi>'') \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'"
           by(metis AssertionStatEqTrans)
         hence "(p \<bullet> ((\<Psi>\<^sub>P \<otimes> (p \<bullet> \<Psi>\<^sub>Q)) \<otimes> (\<Psi>' \<otimes> \<Psi>''))) \<simeq> (p \<bullet> (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))"
           by(rule AssertionStatEqClosed)
         with \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P\<close> S \<open>distinctPerm p\<close> show ?thesis
           by(simp add: eqvts)
       qed
 
       moreover from \<open>(p \<bullet> xvec) \<sharp>* C\<close> \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>Q' \<sharp>* C\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* C" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* X\<close> \<open>A\<^sub>P' \<sharp>* X\<close> \<open>A\<^sub>Q' \<sharp>* X\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* X" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* Y\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>Q' \<sharp>* Y\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* Y" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* Z\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>A\<^sub>Q' \<sharp>* Z\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* Z" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>(p \<bullet> xvec) \<sharp>* Q'\<close> \<open>A\<^sub>P' \<sharp>* P'\<close> \<open>A\<^sub>P' \<sharp>* Q' \<close>\<open>A\<^sub>Q' \<sharp>* P'\<close> \<open>A\<^sub>Q' \<sharp>* Q'\<close>
       have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))" by(auto simp add: resChainFresh fresh_star_def)
       moreover from \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>Q'\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>distinct xvec\<close> \<open>distinct A\<^sub>P'\<close> \<open>distinct A\<^sub>Q'\<close>
        have "distinct((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q')"
          by auto (simp add: name_list_supp fresh_star_def fresh_def)+
 
       ultimately show ?case using cComm1
         by metis
     next
       case(cComm2 \<Psi> \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q C X Y Z)
       have PTrans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" and QTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'" by fact+
       from PTrans have "distinct xvec" by(auto dest: boundOutputDistinct)
       from PTrans \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>xvec \<sharp>* Q\<close> \<open>distinct xvec\<close> \<open>xvec \<sharp>* M\<close>
                   \<open>A\<^sub>P \<sharp>* C\<close> \<open>A\<^sub>P \<sharp>* X\<close> \<open>A\<^sub>P \<sharp>* Y\<close> \<open>A\<^sub>P \<sharp>* Z\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* xvec\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* N\<close>
                   \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* C\<close> \<open>xvec \<sharp>* X\<close> \<open>xvec \<sharp>* Y\<close> \<open>xvec \<sharp>* Z\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>Q\<close>
       obtain p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
                            and FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and PeqP': "(p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinct A\<^sub>P'"
                            and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* X" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* N" and "A\<^sub>P' \<sharp>* Q" and "(p \<bullet> xvec) \<sharp>* Q"
                            and "A\<^sub>P' \<sharp>* Z" and "A\<^sub>P' \<sharp>* A\<^sub>Q" and "A\<^sub>P' \<sharp>* xvec" and "A\<^sub>P' \<sharp>* P'" and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q"
                            and "(p \<bullet> xvec) \<sharp>* A\<^sub>P'" and "(p \<bullet> xvec) \<sharp>* C" and "(p \<bullet> xvec) \<sharp>* X" and "(p \<bullet> xvec) \<sharp>* A\<^sub>Q" 
                            and "(p \<bullet> xvec) \<sharp>* Y" and "(p \<bullet> xvec) \<sharp>* Z" and "(p \<bullet> xvec) \<sharp>* P'" and "distinctPerm p"
         by(rule_tac C="(C, X, Y, Z, A\<^sub>Q, Q, \<Psi>\<^sub>Q)" and C'="(C, X, Y, Z, A\<^sub>Q, Q, \<Psi>\<^sub>Q)" in expandNonTauFrame) (assumption | simp)+
 
       from QTrans \<open>extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* xvec\<close> \<open>A\<^sub>Q \<sharp>* P'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>Q\<close>
            \<open>A\<^sub>P' \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* C\<close> \<open>A\<^sub>Q \<sharp>* X\<close> \<open>A\<^sub>Q \<sharp>* Y\<close> \<open>A\<^sub>Q \<sharp>* Z\<close> \<open>A\<^sub>Q \<sharp>* N\<close>  \<open>A\<^sub>Q \<sharp>* K\<close> 
       obtain \<Psi>'' A\<^sub>Q' \<Psi>\<^sub>Q' where QeqQ': "\<Psi>\<^sub>Q \<otimes> \<Psi>'' \<simeq> \<Psi>\<^sub>Q'" and FrQ': "extractFrame Q' = \<langle>A\<^sub>Q', \<Psi>\<^sub>Q'\<rangle>" and "distinct A\<^sub>Q'"
                              and "A\<^sub>Q' \<sharp>* xvec" and "A\<^sub>Q' \<sharp>* Q'" and "A\<^sub>Q' \<sharp>* xvec" and "A\<^sub>Q' \<sharp>* P'" and "A\<^sub>Q' \<sharp>* (p \<bullet> xvec)"
                              and "A\<^sub>Q' \<sharp>* A\<^sub>P'" and "A\<^sub>Q' \<sharp>* C" and "A\<^sub>Q' \<sharp>* X" and "A\<^sub>Q' \<sharp>* Y" and "A\<^sub>Q' \<sharp>* Z" and "A\<^sub>Q' \<sharp>* P"
         by(rule_tac C="(P, C, P', X, Y, Z, A\<^sub>P', xvec, (p \<bullet> xvec), \<Psi>\<^sub>P)" and C'="(P, C, P', X, Y, Z, A\<^sub>P', xvec, (p \<bullet> xvec), \<Psi>\<^sub>P)" in expandNonTauFrame) (assumption | simp)+
 
       from QTrans \<open>A\<^sub>P' \<sharp>* Q\<close> \<open>A\<^sub>P' \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* Q\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> 
       have "A\<^sub>P' \<sharp>* Q'" and "(p \<bullet> xvec) \<sharp>* Q'" by(force dest: inputFreshChainDerivative)+
       with FrQ' \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* (p \<bullet> xvec)\<close> have "A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q'" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q'" by(force dest: extractFrameFreshChain)+
       from FrP' \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* P'\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> have "A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P'" and "(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P'"
         by(force dest: extractFrameFreshChain)+
 
       have "extractFrame(\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) = \<langle>((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q'), (p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q')\<rangle>"
       proof -
         from FrP' FrQ' \<open>A\<^sub>P' \<sharp>* \<Psi>\<^sub>Q'\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* \<Psi>\<^sub>P'\<close> have "extractFrame(P' \<parallel> Q') = \<langle>(A\<^sub>P'@A\<^sub>Q'), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'\<rangle>"
           by simp
         hence "extractFrame(\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')) = \<langle>(xvec@A\<^sub>P'@A\<^sub>Q'), \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'\<rangle>"
           by(induct xvec) auto
         moreover from \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>P'\<close> \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q'\<close> S 
         have "\<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(p \<bullet> \<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert(\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q')))"
           by(rule_tac frameChainAlpha) (auto simp add: fresh_star_def frameResChainFresh)
         hence "\<lparr>\<nu>*xvec\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(\<lparr>\<nu>*(A\<^sub>P'@A\<^sub>Q')\<rparr>(FAssert((p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q'))))"
           using \<open>A\<^sub>P' \<sharp>* xvec\<close> \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open>A\<^sub>Q' \<sharp>* xvec\<close> \<open>A\<^sub>Q' \<sharp>* (p \<bullet> xvec)\<close> S
           by(fastforce simp add: eqvts)
         ultimately show ?thesis
           by(simp add: frameChainAppend)
       qed
           
       moreover have "(\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<otimes> ((p \<bullet> \<Psi>') \<otimes> (p \<bullet> \<Psi>'')) \<simeq> (p \<bullet> \<Psi>\<^sub>P') \<otimes> (p \<bullet> \<Psi>\<^sub>Q')"
       proof -
         have "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q) \<otimes> (\<Psi>' \<otimes> \<Psi>'') \<simeq> ((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>'')"
           by(metis Associativity Commutativity Composition AssertionStatEqTrans)
         moreover from PeqP' QeqQ' have "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>') \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>'') \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'"
           by(metis Associativity Commutativity Composition AssertionStatEqTrans)
         ultimately have "((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q) \<otimes> (\<Psi>' \<otimes> \<Psi>'') \<simeq> \<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'"
           by(metis AssertionStatEqTrans)
         hence "(p \<bullet> ((p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q) \<otimes> (\<Psi>' \<otimes> \<Psi>'')) \<simeq> (p \<bullet> (\<Psi>\<^sub>P' \<otimes> \<Psi>\<^sub>Q'))"
           by(rule AssertionStatEqClosed)
         with \<open>xvec \<sharp>* \<Psi>\<^sub>Q\<close> \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<^sub>Q\<close> S \<open>distinctPerm p\<close> show ?thesis
           by(simp add: eqvts)
       qed
 
       moreover from \<open>(p \<bullet> xvec) \<sharp>* C\<close> \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>Q' \<sharp>* C\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* C" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* X\<close> \<open>A\<^sub>P' \<sharp>* X\<close> \<open>A\<^sub>Q' \<sharp>* X\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* X" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* Y\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>Q' \<sharp>* Y\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* Y" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* Z\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>A\<^sub>Q' \<sharp>* Z\<close> have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* Z" by simp
       moreover from \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>(p \<bullet> xvec) \<sharp>* Q'\<close> \<open>A\<^sub>P' \<sharp>* P'\<close> \<open>A\<^sub>P' \<sharp>* Q' \<close>\<open>A\<^sub>Q' \<sharp>* P'\<close> \<open>A\<^sub>Q' \<sharp>* Q'\<close>
       have "((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q') \<sharp>* (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q'))" by(auto simp add: resChainFresh fresh_star_def)
       moreover from \<open>(p \<bullet> xvec) \<sharp>* A\<^sub>P'\<close> \<open> A\<^sub>Q' \<sharp>* (p \<bullet> xvec)\<close> \<open>A\<^sub>Q' \<sharp>* A\<^sub>P'\<close> \<open>distinct xvec\<close> \<open>distinct A\<^sub>P'\<close> \<open>distinct A\<^sub>Q'\<close>
        have "distinct((p \<bullet> xvec)@A\<^sub>P'@A\<^sub>Q')"
          by auto (simp add: name_list_supp fresh_star_def fresh_def)+
 
       ultimately show ?case using cComm2 by metis
     next
       case(cScope \<Psi> P P' x A\<^sub>P \<Psi>\<^sub>P C X Y Z)
       then obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "distinct A\<^sub>P'"
                                 and "\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'"
                                 and "A\<^sub>P' \<sharp>* (x#X)" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z" 
         by(rule_tac cScope(4)[where ba="x#X"]) auto
       from \<open>A\<^sub>P' \<sharp>* (x#X)\<close> have "x \<sharp> A\<^sub>P'" and "A\<^sub>P' \<sharp>* X" by simp+
       moreover from FrP' have "extractFrame(\<lparr>\<nu>x\<rparr>P') = \<langle>(x#A\<^sub>P'), \<Psi>\<^sub>P'\<rangle>" by simp
       moreover note \<open>\<Psi>\<^sub>P \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'\<close>
       moreover from \<open>x \<sharp> C\<close> \<open>A\<^sub>P' \<sharp>* C\<close> have "(x#A\<^sub>P') \<sharp>* C" by simp
       moreover from  \<open>A\<^sub>P' \<sharp>* P'\<close> have "(x#A\<^sub>P') \<sharp>* (\<lparr>\<nu>x\<rparr>P')" by(simp add: abs_fresh fresh_star_def)
       moreover from \<open>x \<sharp> X\<close> \<open>A\<^sub>P' \<sharp>* X\<close> have "(x#A\<^sub>P') \<sharp>* X" by simp
       moreover from \<open>x \<sharp> Y\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> have "(x#A\<^sub>P') \<sharp>* Y" by simp
       moreover from \<open>x \<sharp> Z\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> have "(x#A\<^sub>P') \<sharp>* Z" by simp
       moreover from \<open>x \<sharp> A\<^sub>P'\<close> \<open>distinct A\<^sub>P'\<close> have "distinct(x#A\<^sub>P')" by simp
       ultimately show ?case by(rule_tac cScope)
     next
       case(cBang \<Psi> P P' A\<^sub>P \<Psi>\<^sub>P C B Y Z)
       then obtain \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where FrP': "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" 
                                 and "(\<Psi>\<^sub>P \<otimes> \<one>) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'"
                                 and "A\<^sub>P' \<sharp>* C" and "A\<^sub>P' \<sharp>* P'" and "distinct A\<^sub>P'"
                                 and "A\<^sub>P' \<sharp>* B" and "A\<^sub>P' \<sharp>* Y" and "A\<^sub>P' \<sharp>* Z"
         by(rule_tac cBang) (assumption | simp)+
       with \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>(\<Psi>\<^sub>P \<otimes> \<one>) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'\<close> have "\<one> \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'"
         by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
       thus ?case using FrP' \<open>A\<^sub>P' \<sharp>* P'\<close> \<open>A\<^sub>P' \<sharp>* C\<close> \<open>A\<^sub>P' \<sharp>* B\<close> \<open>A\<^sub>P' \<sharp>* Y\<close> \<open>A\<^sub>P' \<sharp>* Z\<close> \<open>distinct A\<^sub>P'\<close>
         by(rule_tac cBang)
     qed
     with A have ?thesis by simp
   }
   moreover have "A\<^sub>P \<sharp>* ([]::name list)" and "A\<^sub>P \<sharp>* ([]::'b list)" and "A\<^sub>P \<sharp>* ([]::('a, 'b, 'c) psi list)" by simp+
   ultimately show ?thesis by blast
 qed
 
 lemma expandFrame:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>   :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P  :: 'b
   and   C    :: "'d::fs_name"
   and   C'   :: "'e::fs_name"
   
   assumes Trans: "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     "distinct(bn \<alpha>)"
   and     "A\<^sub>P \<sharp>* \<alpha>"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* C"
   and     "A\<^sub>P \<sharp>* C'"
   and     "bn \<alpha> \<sharp>* P"
   and     "bn \<alpha> \<sharp>* C'"
 
   obtains p \<Psi>' A\<^sub>P' \<Psi>\<^sub>P' where "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "(p \<bullet> \<Psi>\<^sub>P) \<otimes> \<Psi>' \<simeq> \<Psi>\<^sub>P'" and "distinctPerm p" and
                               "extractFrame P' = \<langle>A\<^sub>P', \<Psi>\<^sub>P'\<rangle>" and "A\<^sub>P' \<sharp>* P'" and "A\<^sub>P' \<sharp>* \<alpha>" and "A\<^sub>P' \<sharp>* (p \<bullet> \<alpha>)" and
                               "A\<^sub>P' \<sharp>* C" and "(bn(p \<bullet> \<alpha>)) \<sharp>* C'" and "(bn(p \<bullet> \<alpha>)) \<sharp>* \<alpha>" and "(bn(p \<bullet> \<alpha>)) \<sharp>* P'" and "distinct A\<^sub>P'"
 using assms
 apply(cases "\<alpha>=\<tau>")
 by(auto intro: expandTauFrame[where C=C] expandNonTauFrame[where C=C and C'=C'])
 
 abbreviation
   frameImpJudge ("_ \<hookrightarrow>\<^sub>F _" [80, 80] 80)
   where "F \<hookrightarrow>\<^sub>F G \<equiv> FrameStatImp F G"
 
 lemma FrameStatEqImpCompose:
   fixes F :: "'b frame"
   and   G :: "'b frame"
   and   H :: "'b frame"
   and   I :: "'b frame"
 
   assumes "F \<simeq>\<^sub>F G"
   and     "G \<hookrightarrow>\<^sub>F H"
   and     "H \<simeq>\<^sub>F I"
 
   shows "F \<hookrightarrow>\<^sub>F I"
 using assms
 by(auto simp add: FrameStatEq_def) (blast intro: FrameStatImpTrans)
 
 lemma transferNonTauFrame:
   fixes \<Psi>\<^sub>F  :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>F   :: "name list"
   and   A\<^sub>G   :: "name list"
   and   \<Psi>\<^sub>G   :: 'b
 
   assumes "\<Psi>\<^sub>F \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "distinct(bn \<alpha>)"
   and     "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
   and     "A\<^sub>F \<sharp>* P"
   and     "A\<^sub>G \<sharp>* P"
   and     "A\<^sub>F \<sharp>* subject \<alpha>"
   and     "A\<^sub>G \<sharp>* subject \<alpha>"
   and     "A\<^sub>P \<sharp>* A\<^sub>F"
   and     "A\<^sub>P \<sharp>* A\<^sub>G"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>F"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>G"
   and     "\<alpha> \<noteq> \<tau>"
 
   shows "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
 using assms
 proof(nominal_induct \<Psi>\<^sub>F P Rs=="\<alpha> \<prec> P'" A\<^sub>P \<Psi>\<^sub>P avoiding: \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G rule: semanticsFrameInduct)
   case(cAlpha \<Psi>\<^sub>F P A\<^sub>P \<Psi>\<^sub>P p \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>\<close>
   have "(p \<bullet> (\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>)) \<hookrightarrow>\<^sub>F (p \<bullet> (\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>))"
     by(rule FrameStatImpClosed)
   with \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>G\<close>
     \<open>distinctPerm p\<close> \<open>set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P)\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   with cAlpha show ?case by force
 next
   case(cInput \<Psi>\<^sub>F M K xvec N Tvec P \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from cInput have "A\<^sub>F \<sharp>* K" and "A\<^sub>G \<sharp>* K" by(auto simp add: residualInject)
 
   from \<open>A\<^sub>F \<sharp>* (M\<lparr>\<lambda>*xvec N\<rparr>.P)\<close> \<open>A\<^sub>G \<sharp>* (M\<lparr>\<lambda>*xvec N\<rparr>.P)\<close> have "A\<^sub>F \<sharp>* M" and "A\<^sub>G \<sharp>* M" by simp+
   from \<open>\<Psi>\<^sub>F \<turnstile> M \<leftrightarrow> K\<close>
   have "\<Psi>\<^sub>F \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity AssertionStatEqSym)
   with \<open>A\<^sub>F \<sharp>* M\<close> \<open>A\<^sub>F \<sharp>* K\<close>
   have "(\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> K"
     by(force intro: frameImpI)
   with \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   have "(\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> K"
     by(simp add: FrameStatEq_def FrameStatImp_def)
   with \<open>A\<^sub>G \<sharp>* M\<close> \<open>A\<^sub>G \<sharp>* K\<close>
   have "\<Psi>\<^sub>G \<otimes> \<one> \<turnstile> M \<leftrightarrow> K" by(force dest: frameImpE)
   hence "\<Psi>\<^sub>G \<turnstile> M \<leftrightarrow> K" by(blast intro: statEqEnt Identity)
   thus ?case using \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close> using cInput Input
     by(force simp add: residualInject)
 next
   case(cOutput \<Psi>\<^sub>F M K N P \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from cOutput have "A\<^sub>F \<sharp>* K" and "A\<^sub>G \<sharp>* K" by(auto simp add: residualInject)
 
   from \<open>A\<^sub>F \<sharp>* (M\<langle>N\<rangle>.P)\<close> \<open>A\<^sub>G \<sharp>* (M\<langle>N\<rangle>.P)\<close> have "A\<^sub>F \<sharp>* M" and "A\<^sub>G \<sharp>* M" by simp+
   from \<open>\<Psi>\<^sub>F \<turnstile> M \<leftrightarrow> K\<close>
   have "\<Psi>\<^sub>F \<otimes> \<one> \<turnstile> M \<leftrightarrow> K"
     by(blast intro: statEqEnt Identity AssertionStatEqSym)
   with \<open>A\<^sub>F \<sharp>* M\<close> \<open>A\<^sub>F \<sharp>* K\<close>
   have "(\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> K"
     by(force intro: frameImpI)
   with \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   have "(\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> K"
     by(simp add: FrameStatImp_def) 
   with \<open>A\<^sub>G \<sharp>* M\<close> \<open>A\<^sub>G \<sharp>* K\<close>
   have "\<Psi>\<^sub>G \<otimes> \<one> \<turnstile> M \<leftrightarrow> K" by(force dest: frameImpE)
   hence "\<Psi>\<^sub>G \<turnstile> M \<leftrightarrow> K" by(blast intro: statEqEnt Identity) 
   thus ?case using cOutput Output by(force simp add: residualInject) 
 next
   case(cCase \<Psi>\<^sub>F P \<phi> Cs A\<^sub>P \<Psi>\<^sub>P \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
   ultimately have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(rule FrameStatEqImpCompose)
   with cCase have "\<Psi>\<^sub>G \<rhd> P \<longmapsto> \<alpha> \<prec> P'" by(fastforce dest: memFreshChain)
   moreover note \<open>(\<phi>, P) mem Cs\<close> 
   moreover from \<open>A\<^sub>F \<sharp>* (Cases Cs)\<close>\<open>A\<^sub>G \<sharp>* (Cases Cs)\<close> \<open>(\<phi>, P) mem Cs\<close> have "A\<^sub>F \<sharp>* \<phi>" and "A\<^sub>G \<sharp>* \<phi>"
     by(auto dest: memFreshChain)
   from \<open>\<Psi>\<^sub>F \<turnstile> \<phi>\<close> have "\<Psi>\<^sub>F \<otimes> \<one> \<turnstile> \<phi>" by(blast intro: statEqEnt Identity AssertionStatEqSym)
   with \<open>A\<^sub>F \<sharp>* \<phi>\<close> have "(\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>" by(force intro: frameImpI)
   with \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close> have "(\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>"
     by(simp add: FrameStatImp_def)
   with \<open>A\<^sub>G \<sharp>* \<phi>\<close> have "\<Psi>\<^sub>G \<otimes> \<one> \<turnstile> \<phi>" by(force dest: frameImpE)
   hence "\<Psi>\<^sub>G \<turnstile> \<phi>" by(blast intro: statEqEnt Identity)
   ultimately show ?case using \<open>guarded P\<close> cCase Case by(force intro: residualInject)
 next
   case(cPar1 \<Psi>\<^sub>F \<Psi>\<^sub>Q P \<alpha> P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P \<alpha>' PQ' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>\<close>
   moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> "
     by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
   ultimately have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(rule FrameStatEqImpCompose)
   moreover from \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>Q" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   moreover note \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>F \<sharp>* subject \<alpha>'\<close> \<open>A\<^sub>G \<sharp>* subject \<alpha>'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close>
   moreover from \<open>\<alpha> \<prec> P' \<parallel> Q = \<alpha>' \<prec> PQ'\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> 
   obtain p P'' where "\<alpha> \<prec> P' = \<alpha>' \<prec> P''" and "set p \<subseteq> set(bn \<alpha>') \<times> set(bn \<alpha>)" and "PQ' = P'' \<parallel> (p \<bullet> Q)"
     apply(drule_tac sym)
     by(rule_tac actionPar1Dest) (assumption | simp | blast dest: sym)+
   ultimately have  "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<alpha> \<prec> P'" using \<open>\<alpha>' \<noteq> \<tau>\<close> by(force intro: cPar1)
   thus ?case using FrQ \<open>(bn \<alpha>) \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* \<alpha>\<close> using cPar1
     by(metis Par1)
 next
   case(cPar2 \<Psi>\<^sub>F \<Psi>\<^sub>P Q \<alpha> Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q \<alpha>' PQ' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(metis Associativity frameResChainPres frameNilStatEq)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>\<close>
   moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> "
     by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
   ultimately have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(rule FrameStatEqImpCompose)
   moreover from \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>P" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)+
   moreover note \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>F \<sharp>* subject \<alpha>'\<close> \<open>A\<^sub>G \<sharp>* subject \<alpha>'\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close>
   moreover from \<open>\<alpha> \<prec> P \<parallel> Q' = \<alpha>' \<prec> PQ'\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> 
   obtain p Q'' where "\<alpha> \<prec> Q' = \<alpha>' \<prec> Q''" and "set p \<subseteq> set(bn \<alpha>') \<times> set(bn \<alpha>)" and "PQ' = (p \<bullet> P) \<parallel> Q''"
     apply(drule_tac sym)
     by(rule_tac actionPar2Dest) (assumption | simp | blast dest: sym)+
   ultimately have  "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'" using \<open>\<alpha>' \<noteq> \<tau>\<close> by(force intro: cPar2)
   thus ?case using FrP \<open>(bn \<alpha>) \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* \<alpha>\<close> using cPar2
     by(metis Par2)
 next
   case cComm1
   thus ?case by(simp add: residualInject)
 next
   case cComm2
   thus ?case by(simp add: residualInject)
 next
   case(cOpen \<Psi>\<^sub>F P M xvec yvec N P' x A\<^sub>P \<Psi>\<^sub>P \<alpha> P'' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>M\<lparr>\<nu>*(xvec @ x # yvec)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> P''\<close> \<open>distinct(bn \<alpha>)\<close>
   obtain xvec' x' yvec' N' where "M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P' =  M\<lparr>\<nu>*(xvec'@yvec')\<rparr>\<langle>([(x, x')] \<bullet> N')\<rangle> \<prec> ([(x, x')] \<bullet> P'')" 
                              and "\<alpha> = M\<lparr>\<nu>*(xvec'@x'#yvec')\<rparr>\<langle>N'\<rangle>"
     apply(cases rule: actionCases[where \<alpha>=\<alpha>])
     apply(auto simp add: residualInject)
     apply(rule boundOutputOpenDest) by assumption auto
 
   then have "\<Psi>\<^sub>G \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N\<rangle> \<prec> P'" using cOpen
     by(rule_tac cOpen) (assumption | simp)+
   with \<open>x \<in> supp N\<close> \<open>x \<sharp> \<Psi>\<^sub>G\<close> \<open>x \<sharp> M\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close>
   have "\<Psi>\<^sub>G \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>M\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N\<rangle> \<prec> P'" 
     by(rule_tac Open)
   thus ?case using \<open>\<alpha> = M\<lparr>\<nu>*(xvec'@x'#yvec')\<rparr>\<langle>N'\<rangle>\<close> \<open>M\<lparr>\<nu>*(xvec @ x # yvec)\<rparr>\<langle>N\<rangle> \<prec> P' = \<alpha> \<prec> P''\<close>
     by simp
 next
   case(cScope \<Psi>\<^sub>F P \<alpha> P' x A\<^sub>P \<Psi>\<^sub>P \<alpha>' xP \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<alpha> \<prec> \<lparr>\<nu>x\<rparr>P' = \<alpha>' \<prec> xP\<close> \<open>x \<sharp> \<alpha>\<close> \<open>x \<sharp> \<alpha>'\<close> obtain P'' where "xP = \<lparr>\<nu>x\<rparr>P''" and "\<alpha> \<prec> P' = \<alpha>' \<prec> P''"
     by(drule_tac sym) (force intro: actionScopeDest)
   then have "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<alpha> \<prec> P'" using cScope by auto
   with \<open>x \<sharp> \<Psi>\<^sub>G\<close> \<open>x \<sharp> \<alpha>'\<close> \<open>\<alpha> \<prec> P' = \<alpha>' \<prec> P''\<close> \<open>xP = \<lparr>\<nu>x\<rparr>P''\<close> show ?case
     by(metis Scope)
 next
   case(cBang \<Psi>\<^sub>F P A\<^sub>P \<Psi>\<^sub>P \<alpha> P' \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
   ultimately have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle>"
     by(rule FrameStatEqImpCompose)
   with cBang have "\<Psi>\<^sub>G \<rhd> P \<parallel> !P \<longmapsto> \<alpha> \<prec> P'" by force
   thus ?case using \<open>guarded P\<close> using cBang by(metis Bang)
 qed
 
 lemma transferTauFrame:
   fixes \<Psi>\<^sub>F  :: 'b
   and   P  :: "('a, 'b, 'c) psi"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>F   :: "name list"
   and   A\<^sub>G   :: "name list"
   and   \<Psi>\<^sub>G   :: 'b
 
   assumes "\<Psi>\<^sub>F \<rhd> P \<longmapsto>\<tau> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
   and     "A\<^sub>F \<sharp>* P"
   and     "A\<^sub>G \<sharp>* P"
   and     "A\<^sub>P \<sharp>* A\<^sub>F"
   and     "A\<^sub>P \<sharp>* A\<^sub>G"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>F"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>G"
 
   shows "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<tau> \<prec> P'"
 using assms
 proof(nominal_induct avoiding: \<Psi>\<^sub>G A\<^sub>F A\<^sub>G rule: tauFrameInduct)
   case(cAlpha \<Psi>\<^sub>F P P' A\<^sub>P \<Psi>\<^sub>P p \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>\<close>
   have "(p \<bullet> (\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>)) \<hookrightarrow>\<^sub>F (p \<bullet> (\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> (p \<bullet> \<Psi>\<^sub>P)\<rangle>))"
     by(rule FrameStatImpClosed)
   with \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>(p \<bullet> A\<^sub>P) \<sharp>* \<Psi>\<^sub>G\<close>
     \<open>distinctPerm p\<close> \<open>set p \<subseteq> set A\<^sub>P \<times> set (p \<bullet> A\<^sub>P)\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   with cAlpha show ?case by blast
 next
   case(cCase \<Psi>\<^sub>F P P' \<phi> Cs A\<^sub>P \<Psi>\<^sub>P \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
   ultimately have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(rule FrameStatEqImpCompose)
   with cCase have "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<tau> \<prec> P'" by(fastforce dest: memFreshChain)
   moreover note \<open>(\<phi>, P) mem Cs\<close> 
   moreover from \<open>A\<^sub>F \<sharp>* (Cases Cs)\<close>\<open>A\<^sub>G \<sharp>* (Cases Cs)\<close> \<open>(\<phi>, P) mem Cs\<close> have "A\<^sub>F \<sharp>* \<phi>" and "A\<^sub>G \<sharp>* \<phi>"
     by(auto dest: memFreshChain)
   from \<open>\<Psi>\<^sub>F \<turnstile> \<phi>\<close> have "\<Psi>\<^sub>F \<otimes> \<one> \<turnstile> \<phi>" by(blast intro: statEqEnt Identity AssertionStatEqSym)
   with \<open>A\<^sub>F \<sharp>* \<phi>\<close> have "(\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>" by(force intro: frameImpI)
   with \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close> have "(\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>"
     by(simp add: FrameStatImp_def)
   with \<open>A\<^sub>G \<sharp>* \<phi>\<close> have "\<Psi>\<^sub>G \<otimes> \<one> \<turnstile> \<phi>" by(force dest: frameImpE)
   hence "\<Psi>\<^sub>G \<turnstile> \<phi>" by(blast intro: statEqEnt Identity)
   ultimately show ?case using \<open>guarded P\<close> by(rule Case)
 next
   case(cPar1 \<Psi>\<^sub>F \<Psi>\<^sub>Q P P' A\<^sub>Q Q A\<^sub>P \<Psi>\<^sub>P \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have IH: "\<And>\<Psi> A\<^sub>F A\<^sub>G. \<lbrakk>\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi> \<otimes> \<Psi>\<^sub>P\<rangle>; A\<^sub>F \<sharp>* P; A\<^sub>G \<sharp>* P;
                            A\<^sub>P \<sharp>* A\<^sub>F; A\<^sub>P \<sharp>* A\<^sub>G; A\<^sub>P \<sharp>* (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q); A\<^sub>P \<sharp>* \<Psi>\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
     by fact
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>\<close>
   moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> "
     by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
   ultimately have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle>"
     by(rule FrameStatEqImpCompose)
   moreover from \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>Q" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   moreover note \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close>
   ultimately have  "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>\<tau> \<prec> P'" by(rule_tac IH) (assumption | auto)+
   thus ?case using FrQ \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* P\<close>
     by(rule_tac Par1) auto
 next
   case(cPar2 \<Psi>\<^sub>F \<Psi>\<^sub>P Q Q' A\<^sub>P P A\<^sub>Q \<Psi>\<^sub>Q \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have IH: "\<And>\<Psi> A\<^sub>F A\<^sub>G. \<lbrakk>\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi> \<otimes> \<Psi>\<^sub>Q\<rangle>; A\<^sub>F \<sharp>* Q; A\<^sub>G \<sharp>* Q;
                            A\<^sub>Q \<sharp>* A\<^sub>F; A\<^sub>Q \<sharp>* A\<^sub>G; A\<^sub>Q \<sharp>* (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P); A\<^sub>Q \<sharp>* \<Psi>\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'"
     by fact
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(metis Associativity frameResChainPres frameNilStatEq)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>\<close>
   moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> "
     by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
   ultimately have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle>"
     by(rule FrameStatEqImpCompose)
   moreover from \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>P" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)+
   moreover note \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close>
   ultimately have  "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>\<tau> \<prec> Q'" by(rule_tac IH) (assumption | auto)+
   thus ?case using FrP \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* Q\<close>
     by(rule_tac Par2) auto
 next
   case(cComm1 \<Psi>\<^sub>F \<Psi>\<^sub>Q P M N P' A\<^sub>P \<Psi>\<^sub>P Q K xvec Q' A\<^sub>Q \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   have FimpG: "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>" by fact
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   from \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>P" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)+
   from \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>Q" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   from \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close> 
   obtain K' where KeqK': "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'" and "A\<^sub>P \<sharp>* K'" and "A\<^sub>F \<sharp>* K'" and "A\<^sub>G \<sharp>* K'" 
     using \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>xvec \<sharp>* K\<close> \<open>distinct xvec\<close>
     by(rule_tac B="A\<^sub>P@A\<^sub>F@A\<^sub>G" in obtainPrefix) force+
   have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>N\<rparr> \<prec> P'"
   proof -
     from KeqK' have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> K \<leftrightarrow> K'" by(rule statEqEnt[OF Associativity])
     with \<open>\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K'"
       by(rule chanEqTrans)
     hence "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K'"
       by(metis statEqEnt AssertionStatEqSym Associativity AssertionStatEqTrans compositionSym Commutativity)
     with \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close>
     have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>N\<rparr> \<prec> P'" using \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K'\<close>
       by(force intro: inputRenameSubject)
     moreover have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle>"
     proof -
       have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
         by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
       moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> "
         by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
       ultimately show ?thesis using FimpG
         by(rule_tac FrameStatEqImpCompose)
     qed
     ultimately show ?thesis using \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>F \<sharp>* K'\<close>
                                   \<open>A\<^sub>G \<sharp>* K'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> FrP \<open>distinct A\<^sub>P\<close>
       by(auto intro: transferNonTauFrame)
   qed
   
   moreover from FrP \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>distinct A\<^sub>P\<close>
   obtain M' where MeqM': "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> M'" and "A\<^sub>Q \<sharp>* M'" and "A\<^sub>F \<sharp>* M'" and "A\<^sub>G \<sharp>* M'"
     using \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close>
     by(rule_tac B="A\<^sub>Q@A\<^sub>F@A\<^sub>G" in obtainPrefix) force+
 
   have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'"
   proof -
     from MeqM' have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>P) \<turnstile> M \<leftrightarrow> M'" by(rule statEqEnt[OF Associativity])
     with \<open>\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>P) \<turnstile> K \<leftrightarrow> M'"
       by(blast intro: chanEqTrans chanEqSym compositionSym Commutativity statEqEnt)
     hence "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> M'"
       by(blast intro: statEqEnt AssertionStatEqSym Associativity
                       AssertionStatEqTrans compositionSym Commutativity)
     with \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close> 
     have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'" using \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
       by(force intro: outputRenameSubject)
     moreover have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle>"
     proof -
       have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
         by(metis Associativity frameResChainPres frameNilStatEq)
       moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> "
         by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
       ultimately show ?thesis using FimpG
         by(rule_tac FrameStatEqImpCompose)
     qed
 
     ultimately show ?thesis using \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>F \<sharp>* M'\<close> \<open>A\<^sub>G \<sharp>* M'\<close>
                                   \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> FrQ \<open>distinct A\<^sub>Q\<close> \<open>distinct xvec\<close> 
       by(auto intro: transferNonTauFrame)
   qed
 
   moreover have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'"
   proof -
     from MeqM' have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M' \<leftrightarrow> M"
       by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
     moreover from KeqK' have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'"
       by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
     ultimately have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'" using \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close>
       by(blast intro: chanEqSym chanEqTrans)
     thus ?thesis using \<open>A\<^sub>F \<sharp>* M'\<close> \<open>A\<^sub>F \<sharp>* K'\<close> \<open>A\<^sub>G \<sharp>* M'\<close> \<open>A\<^sub>G \<sharp>* K'\<close> FimpG
       apply(auto simp add: FrameStatImp_def)
       apply(erule_tac x="SChanEq' K' M'" in allE)
       by(force intro: frameImpI dest: frameImpE)
   qed
 
   ultimately show ?case using \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* K'\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M'\<close> \<open>xvec \<sharp>* P\<close> FrP FrQ
    by(rule_tac Comm1) (assumption | simp)+
 next
   case(cComm2 \<Psi>\<^sub>F \<Psi>\<^sub>Q P M xvec N P' A\<^sub>P \<Psi>\<^sub>P Q K Q' A\<^sub>Q \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   have FimpG: "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>" by fact
   from \<open>A\<^sub>F \<sharp>* (P \<parallel> Q)\<close> \<open>A\<^sub>G \<sharp>* (P \<parallel> Q)\<close> have "A\<^sub>F \<sharp>* P" and "A\<^sub>G \<sharp>* P" and "A\<^sub>F \<sharp>* Q" and "A\<^sub>G \<sharp>* Q"
     by simp+
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
   from \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> FrP \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>P" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)+
   from \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> have "A\<^sub>F \<sharp>* \<Psi>\<^sub>Q" and  "A\<^sub>G \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   from \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close>  
   obtain K' where KeqK': "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'" and "A\<^sub>P \<sharp>* K'" and "A\<^sub>F \<sharp>* K'" and "A\<^sub>G \<sharp>* K'"
     using \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close>
     by(rule_tac B="A\<^sub>P@A\<^sub>F@A\<^sub>G" in obtainPrefix) force+
   have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   proof -
     from KeqK' have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> K \<leftrightarrow> K'" by(rule statEqEnt[OF Associativity])
     with \<open>\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K'"
       by(rule chanEqTrans)
     hence "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K'"
       by(metis statEqEnt AssertionStatEqSym Associativity AssertionStatEqTrans compositionSym Commutativity)
     with \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> FrP \<open>distinct A\<^sub>P\<close> 
     have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" using \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* K'\<close>
       by(force intro: outputRenameSubject)
     moreover have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle>"
     proof -
       have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
         by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
       moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P\<rangle> "
         by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
       ultimately show ?thesis using FimpG
         by(rule_tac FrameStatEqImpCompose)
     qed
     ultimately show ?thesis using  \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>F \<sharp>* K'\<close>
                                   \<open>A\<^sub>G \<sharp>* K'\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> FrP \<open>distinct A\<^sub>P\<close>
                                   \<open>distinct xvec\<close>
       by(auto intro: transferNonTauFrame)
   qed
 
   moreover from FrP \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>distinct A\<^sub>P\<close> 
   obtain M' where MeqM': "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> M'" and "A\<^sub>Q \<sharp>* M'" and "A\<^sub>F \<sharp>* M'" and "A\<^sub>G \<sharp>* M'"
     using \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>F \<sharp>* P\<close> \<open>A\<^sub>G \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>xvec \<sharp>* M\<close> \<open>distinct xvec\<close>
     by(rule_tac B="A\<^sub>Q@A\<^sub>F@A\<^sub>G" in obtainPrefix) force+
 
   have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>N\<rparr> \<prec> Q'"
   proof -
     from MeqM' have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>P) \<turnstile> M \<leftrightarrow> M'" by(rule statEqEnt[OF Associativity])
     with \<open>\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q) \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi>\<^sub>F \<otimes> (\<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>P) \<turnstile> K \<leftrightarrow> M'"
       by(blast intro: chanEqTrans chanEqSym compositionSym Commutativity statEqEnt)
     hence "(\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> M'"
       by(blast intro: statEqEnt AssertionStatEqSym Associativity
                       AssertionStatEqTrans compositionSym Commutativity)
     with \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'\<close> FrQ \<open>distinct A\<^sub>Q\<close> 
     have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M'\<lparr>N\<rparr> \<prec> Q'" using \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* K\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
       by(force intro: inputRenameSubject)
     moreover have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle>"
     proof -
       have "\<langle>A\<^sub>F, (\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle>"
         by(metis Associativity frameResChainPres frameNilStatEq)
       moreover have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, (\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>Q\<rangle> "
         by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
       ultimately show ?thesis using FimpG
         by(rule_tac FrameStatEqImpCompose)
     qed
 
     ultimately show ?thesis using \<open>A\<^sub>F \<sharp>* Q\<close> \<open>A\<^sub>G \<sharp>* Q\<close> \<open>A\<^sub>F \<sharp>* M'\<close> \<open>A\<^sub>G \<sharp>* M'\<close>
                                   \<open>A\<^sub>Q \<sharp>* A\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>F\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> FrQ \<open>distinct A\<^sub>Q\<close> \<open>distinct xvec\<close>
       by(auto intro: transferNonTauFrame)
   qed
 
   moreover have "\<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'"
   proof -
     from MeqM' have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M' \<leftrightarrow> M"
       by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
     moreover from KeqK' have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K \<leftrightarrow> K'"
       by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
     ultimately have "\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> K' \<leftrightarrow> M'" using \<open>\<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K\<close>
       by(blast intro: chanEqSym chanEqTrans)
     thus ?thesis using \<open>A\<^sub>F \<sharp>* M'\<close> \<open>A\<^sub>F \<sharp>* K'\<close> \<open>A\<^sub>G \<sharp>* M'\<close> \<open>A\<^sub>G \<sharp>* K'\<close> FimpG
       apply(auto simp add: FrameStatImp_def)
       apply(erule_tac x="SChanEq' K' M'" in allE)
       by(force intro: frameImpI dest: frameImpE)
   qed
 
   ultimately show ?case using \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* K'\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>G\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* M'\<close> \<open>xvec \<sharp>* Q\<close> FrP FrQ
     by(rule_tac Comm2) (assumption | simp)+
 next
   case(cScope \<Psi>\<^sub>F P P' x A\<^sub>P \<Psi>\<^sub>P \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   then have "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<tau> \<prec> P'" by auto
   with \<open>x \<sharp> \<Psi>\<^sub>G\<close> show ?case
     by(rule_tac Scope) auto
 next
   case(cBang \<Psi>\<^sub>F P P' A\<^sub>P \<Psi>\<^sub>P \<Psi>\<^sub>G A\<^sub>F A\<^sub>G)
   from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
   moreover note \<open>\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle>\<close>
   moreover from \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle>"
     by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
   ultimately have "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P \<otimes> \<one>\<rangle>"
     by(rule FrameStatEqImpCompose)
   with cBang have "\<Psi>\<^sub>G \<rhd> P \<parallel> !P \<longmapsto>\<tau> \<prec> P'" by force
   thus ?case using \<open>guarded P\<close> by(rule Bang)
 qed
 
 lemma transferFrame:
   fixes \<Psi>\<^sub>F  :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>F   :: "name list"
   and   A\<^sub>G   :: "name list"
   and   \<Psi>\<^sub>G   :: 'b
 
   assumes "\<Psi>\<^sub>F \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
   and     "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     "distinct A\<^sub>P"
   and     "\<langle>A\<^sub>F, \<Psi>\<^sub>F \<otimes> \<Psi>\<^sub>P\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>G, \<Psi>\<^sub>G \<otimes> \<Psi>\<^sub>P\<rangle>"
   and     "A\<^sub>F \<sharp>* P"
   and     "A\<^sub>G \<sharp>* P"
   and     "A\<^sub>F \<sharp>* subject \<alpha>"
   and     "A\<^sub>G \<sharp>* subject \<alpha>"
   and     "A\<^sub>P \<sharp>* A\<^sub>F"
   and     "A\<^sub>P \<sharp>* A\<^sub>G"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>F"
   and     "A\<^sub>P \<sharp>* \<Psi>\<^sub>G"
 
   shows "\<Psi>\<^sub>G \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
 using assms
 proof -
   from \<open>\<Psi>\<^sub>F \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
   thus ?thesis using assms
     by(cases "\<alpha> = \<tau>") (auto intro: transferNonTauFrame transferTauFrame)
 qed
 
 lemma parCasesInputFrame[consumes 7, case_names cPar1 cPar2]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Q    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   T    :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> T"
   and     "extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
   and     "distinct A\<^sub>P\<^sub>Q"
   and     "A\<^sub>P\<^sub>Q \<sharp>* \<Psi>"
   and     "A\<^sub>P\<^sub>Q \<sharp>* P"
   and     "A\<^sub>P\<^sub>Q \<sharp>* Q"
   and     "A\<^sub>P\<^sub>Q \<sharp>* M"
   and     rPar1: "\<And>P' A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; 
                                       distinct A\<^sub>P; distinct A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M;  A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; 
                                       A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P\<^sub>Q = A\<^sub>P@A\<^sub>Q; \<Psi>\<^sub>P\<^sub>Q = \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rbrakk> \<Longrightarrow> Prop (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; 
                                       distinct A\<^sub>P; distinct A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M;  A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; 
                                       A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P\<^sub>Q = A\<^sub>P@A\<^sub>Q; \<Psi>\<^sub>P\<^sub>Q = \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rbrakk> \<Longrightarrow> Prop (P \<parallel> Q')"
   shows "Prop T"
 using Trans
 proof(induct rule: parInputCases[of _ _ _ _ _ _ "(A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)"])
   case(cPar1 P' A\<^sub>Q \<Psi>\<^sub>Q)
   from \<open>A\<^sub>Q \<sharp>* (A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)\<close> have "A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<^sub>Q" by simp+
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                            "A\<^sub>P \<sharp>* (P, Q, \<Psi>, M, A\<^sub>Q, A\<^sub>P\<^sub>Q, \<Psi>\<^sub>Q)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* Q" and "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* M" and "A\<^sub>P \<sharp>* A\<^sub>Q" and "A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by simp+
 
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
 
   from \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> FrP have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>" by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "set p \<subseteq> set(A\<^sub>P@A\<^sub>Q) \<times> set((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = (p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = (p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M\<close> Aeq
   have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'" 
     by(rule_tac inputPermFrame) auto
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> Aeq have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"  
     by(simp add: eqvts)
   moreover from FrP have "(p \<bullet> extractFrame P) = p \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> Aeq have "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), p \<bullet> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   moreover from FrQ have "(p \<bullet> extractFrame Q) = p \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> Aeq have "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), p \<bullet> \<Psi>\<^sub>Q\<rangle>"
     by(simp add: eqvts)
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>P)" and "distinct(p \<bullet> A\<^sub>Q)"
     by simp+
   moreover from \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> A\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   ultimately show ?case using \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> Aeq \<Psi>eq
     by(rule_tac rPar1) (assumption | simp)+
 next
   case(cPar2 Q' A\<^sub>P \<Psi>\<^sub>P)
   from \<open>A\<^sub>P \<sharp>* (A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)\<close> have "A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>P\<^sub>Q" by simp+
   obtain A\<^sub>Q \<Psi>\<^sub>Q where FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q"
                            "A\<^sub>Q \<sharp>* (P, Q, \<Psi>, M, A\<^sub>P, A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P)"
     by(rule freshFrame)
   hence "A\<^sub>Q \<sharp>* P" and "A\<^sub>Q \<sharp>* Q" and "A\<^sub>Q \<sharp>* \<Psi>" and "A\<^sub>Q \<sharp>* M" and "A\<^sub>Q \<sharp>* A\<^sub>P" and "A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by simp+
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
 
   from \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> FrQ have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain) 
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>" by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "set p \<subseteq> set(A\<^sub>P@A\<^sub>Q) \<times> set((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = (p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = (p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'\<close> S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M\<close> Aeq
   have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'" 
     by(rule_tac inputPermFrame) auto
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> Aeq have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> Q'"  
     by(simp add: eqvts)
   moreover from FrP have "(p \<bullet> extractFrame P) = p \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> Aeq have "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), p \<bullet> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   moreover from FrQ have "(p \<bullet> extractFrame Q) = p \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> Aeq have "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), p \<bullet> \<Psi>\<^sub>Q\<rangle>"
     by(simp add: eqvts)
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>P)" and "distinct(p \<bullet> A\<^sub>Q)"
     by simp+
   moreover from \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> A\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   ultimately show ?case using \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> Aeq \<Psi>eq
     by(rule_tac rPar2) (assumption | simp)+
 qed
 
 lemma parCasesOutputFrame[consumes 11, case_names cPar1 cPar2]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Q    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   T    :: "('a, 'b, 'c) psi"
   and   C    :: "'d::fs_name"
 
   assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> T"
   and     "xvec \<sharp>* \<Psi>"
   and     "xvec \<sharp>* P"
   and     "xvec \<sharp>* Q"
   and     "xvec \<sharp>* M"
   and     "extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>"
   and     "distinct A\<^sub>P\<^sub>Q"
   and     "A\<^sub>P\<^sub>Q \<sharp>* \<Psi>"
   and     "A\<^sub>P\<^sub>Q \<sharp>* P"
   and     "A\<^sub>P\<^sub>Q \<sharp>* Q"
   and     "A\<^sub>P\<^sub>Q \<sharp>* M"
   and     rPar1: "\<And>P' A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; 
                                       distinct A\<^sub>P; distinct A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M;  A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; 
                                       A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P\<^sub>Q = A\<^sub>P@A\<^sub>Q; \<Psi>\<^sub>P\<^sub>Q = \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rbrakk> \<Longrightarrow> Prop (P' \<parallel> Q)"
   and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; 
                                       distinct A\<^sub>P; distinct A\<^sub>Q; A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* M;  A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* M; 
                                       A\<^sub>P \<sharp>* \<Psi>\<^sub>Q; A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>P \<sharp>* A\<^sub>Q; A\<^sub>P\<^sub>Q = A\<^sub>P@A\<^sub>Q; \<Psi>\<^sub>P\<^sub>Q = \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rbrakk> \<Longrightarrow> Prop (P \<parallel> Q')"
   shows "Prop T"
 using Trans \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* P\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* M\<close>
 proof(induct rule: parOutputCases[of _ _ _ _ _ _ _ "(A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)"])
   case(cPar1 P' A\<^sub>Q \<Psi>\<^sub>Q)
   from \<open>A\<^sub>Q \<sharp>* (A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)\<close> have "A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<^sub>Q" by simp+
   obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "distinct A\<^sub>P"
                            "A\<^sub>P \<sharp>* (P, Q, \<Psi>, M, A\<^sub>Q, A\<^sub>P\<^sub>Q, \<Psi>\<^sub>Q)"
     by(rule freshFrame)
   hence "A\<^sub>P \<sharp>* P" and "A\<^sub>P \<sharp>* Q" and "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* M" and "A\<^sub>P \<sharp>* A\<^sub>Q" and "A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by simp+
 
   have FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by fact
 
   from \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> FrP have "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by(force dest: extractFrameFreshChain)
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>" by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "set p \<subseteq> set(A\<^sub>P@A\<^sub>Q) \<times> set((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = (p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = (p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M\<close> Aeq
   have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>Q)) \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" 
     by(rule_tac outputPermFrame) (assumption | simp)+
 
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> Aeq have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>Q) \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"  
     by(simp add: eqvts)
   moreover from FrP have "(p \<bullet> extractFrame P) = p \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> Aeq have "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), p \<bullet> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   moreover from FrQ have "(p \<bullet> extractFrame Q) = p \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> Aeq have "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), p \<bullet> \<Psi>\<^sub>Q\<rangle>"
     by(simp add: eqvts)
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>P)" and "distinct(p \<bullet> A\<^sub>Q)"
     by simp+
   moreover from \<open>A\<^sub>P \<sharp>* A\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> A\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   ultimately show ?case using \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> Aeq \<Psi>eq
     by(rule_tac rPar1) (assumption | simp)+
 next
   case(cPar2 Q' A\<^sub>P \<Psi>\<^sub>P)
   from \<open>A\<^sub>P \<sharp>* (A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q)\<close> have "A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>P\<^sub>Q" by simp+
   obtain A\<^sub>Q \<Psi>\<^sub>Q where FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" and "distinct A\<^sub>Q"
                            "A\<^sub>Q \<sharp>* (P, Q, \<Psi>, M, A\<^sub>P, A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P)"
     by(rule freshFrame)
   hence "A\<^sub>Q \<sharp>* P" and "A\<^sub>Q \<sharp>* Q" and "A\<^sub>Q \<sharp>* \<Psi>" and "A\<^sub>Q \<sharp>* M" and "A\<^sub>Q \<sharp>* A\<^sub>P" and "A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>P"
     by simp+
 
   have FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by fact
 
   from \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> FrQ have "A\<^sub>P \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain) 
 
   from \<open>extractFrame(P \<parallel> Q) = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>\<close> FrP FrQ \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close>
   have "\<langle>(A\<^sub>P@A\<^sub>Q), \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q\<rangle> = \<langle>A\<^sub>P\<^sub>Q, \<Psi>\<^sub>P\<^sub>Q\<rangle>" by simp
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> have "distinct(A\<^sub>P@A\<^sub>Q)"
     by(auto simp add: fresh_star_def fresh_def name_list_supp)
   ultimately obtain p where S: "set p \<subseteq> set(A\<^sub>P@A\<^sub>Q) \<times> set((p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q))"  and "distinctPerm p"
                         and \<Psi>eq: "\<Psi>\<^sub>P\<^sub>Q = (p \<bullet> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>Q)" and Aeq: "A\<^sub>P\<^sub>Q = (p \<bullet> A\<^sub>P)@(p \<bullet> A\<^sub>Q)"
     using \<open>A\<^sub>P \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<^sub>Q\<close> \<open>distinct A\<^sub>P\<^sub>Q\<close>
     by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
 
   from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'\<close> S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M\<close> Aeq
   have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'" 
     by(rule_tac outputPermFrame) (assumption | simp)+
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>Q \<sharp>* \<Psi>\<close> Aeq have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>P) \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'"  
     by(simp add: eqvts)
   moreover from FrP have "(p \<bullet> extractFrame P) = p \<bullet> \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>Q \<sharp>* P\<close> Aeq have "extractFrame P = \<langle>(p \<bullet> A\<^sub>P), p \<bullet> \<Psi>\<^sub>P\<rangle>"
     by(simp add: eqvts)
   moreover from FrQ have "(p \<bullet> extractFrame Q) = p \<bullet> \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" by simp
   with S \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P \<sharp>* Q\<close> \<open>A\<^sub>Q \<sharp>* Q\<close> Aeq have "extractFrame Q = \<langle>(p \<bullet> A\<^sub>Q), p \<bullet> \<Psi>\<^sub>Q\<rangle>"
     by(simp add: eqvts)
   moreover from \<open>distinct A\<^sub>P\<close> \<open>distinct A\<^sub>Q\<close> have "distinct(p \<bullet> A\<^sub>P)" and "distinct(p \<bullet> A\<^sub>Q)"
     by simp+
   moreover from \<open>A\<^sub>Q \<sharp>* A\<^sub>P\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> A\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>Q\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> \<Psi>\<^sub>Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   moreover from \<open>A\<^sub>Q \<sharp>* \<Psi>\<^sub>P\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> \<Psi>\<^sub>P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
   ultimately show ?case using \<open>A\<^sub>P\<^sub>Q \<sharp>* \<Psi>\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* P\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* Q\<close> \<open>A\<^sub>P\<^sub>Q \<sharp>* M\<close> Aeq \<Psi>eq
     by(rule_tac rPar2) (assumption | simp)+
 qed
 
 inductive bangPred :: "('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
 where
   aux1: "bangPred P (!P)"
 | aux2: "bangPred P (P \<parallel> !P)"
 
 lemma bangInduct[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cBang]:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   Rs   :: "('a, 'b, 'c) residual"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) residual \<Rightarrow> bool"
   and   C    :: 'd
 
   assumes "\<Psi> \<rhd> !P \<longmapsto> Rs"
   and     rPar1: "\<And>\<alpha> P' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P' \<parallel> !P))"
   and     rPar2: "\<And>\<alpha> P' C. \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>);
                              \<And>C. Prop C \<Psi> (!P) (\<alpha> \<prec> P')\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P \<parallel> P'))"
   and     rComm1: "\<And>M N P' K xvec P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''); \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rComm2: "\<And>M xvec N P' K P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>N\<rparr> \<prec> P''); \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rBang: "\<And>Rs C. \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs; \<And>C. Prop C \<Psi> (P \<parallel> !P) Rs; guarded P\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) Rs"
   shows "Prop C \<Psi> (!P) Rs"
 proof -
   from \<open>\<Psi> \<rhd> !P \<longmapsto> Rs\<close> have "guarded P"
     by(nominal_induct \<Psi> P=="!P" Rs rule: semantics.strong_induct) (auto simp add: psi.inject)
   {
     fix Q  :: "('a, 'b, 'c) psi"
     and \<Psi>' :: 'b
 
     assume "\<Psi>' \<rhd> Q \<longmapsto> Rs"
     and    "guarded Q"
     and    "bangPred P Q"
     and    "\<Psi> \<simeq> \<Psi>'"
 
     hence "Prop C \<Psi> Q Rs" using rPar1 rPar1 rPar2 rPar2 rComm1 rComm2 rBang
     proof(nominal_induct avoiding: \<Psi> C rule: semantics.strong_induct)
       case(cInput \<Psi>' M K xvec N Tvec Q \<Psi> C)
       thus ?case by - (ind_cases "bangPred P (M\<lparr>\<lambda>*xvec N\<rparr>.Q)")
     next
       case(Output \<Psi>' M K N Q \<Psi> C)
       thus ?case by - (ind_cases "bangPred P (M\<langle>N\<rangle>.Q)")
     next
       case(Case \<Psi>' Q Rs \<phi> Cs \<Psi> C)
       thus ?case by - (ind_cases "bangPred P (Cases Cs)")
     next
       case(cPar1 \<Psi>' \<Psi>\<^sub>R Q \<alpha> P' R A\<^sub>R \<Psi> C)
       have rPar1: "\<And>\<alpha> P' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P' \<parallel> !P))"
         by fact
       from \<open>bangPred P (Q \<parallel> R)\<close> have "Q = P" and "R = !P"
         by - (ind_cases "bangPred P (Q \<parallel> R)", auto simp add: psi.inject)+
       from \<open>R = !P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>R = []" and "\<Psi>\<^sub>R = \<one>" by auto
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R \<rhd> Q \<longmapsto>\<alpha> \<prec> P'\<close> \<open>Q = P\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>R = \<one>\<close> have "\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'"
         by(metis statEqTransition Identity AssertionStatEqSym)
       hence "Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P' \<parallel> !P))" using \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha>  \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>Q = P\<close> \<open>distinct(bn \<alpha>)\<close>
         by(rule_tac rPar1) auto
       with \<open>R = !P\<close> \<open>Q = P\<close> show ?case by simp
     next
       case(cPar2 \<Psi>' \<Psi>\<^sub>P R \<alpha> P' Q A\<^sub>P \<Psi> C)
       have rPar2: "\<And>\<alpha> P' C. \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>);
                              \<And>C. Prop C \<Psi> (!P) (\<alpha> \<prec> P')\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P \<parallel> P'))"
         by fact
       from \<open>bangPred P (Q \<parallel> R)\<close> have "Q = P" and "R = !P"
         by - (ind_cases "bangPred P (Q \<parallel> R)", auto simp add: psi.inject)+
       from \<open>Q = P\<close> \<open>extractFrame Q = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>guarded P\<close> have "\<Psi>\<^sub>P \<simeq> \<one>" and "supp \<Psi>\<^sub>P = ({}::name set)"
         by(blast dest: guardedStatEq)+
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>\<alpha> \<prec> P'\<close> \<open>R = !P\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'"
         by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
       moreover
       {
         fix C
         have "bangPred P (!P)" by(rule aux1)
         moreover from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<simeq> \<Psi>' \<otimes> \<Psi>\<^sub>P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
         ultimately have "\<And>C. Prop C \<Psi> (!P) (\<alpha> \<prec> P')" using cPar2 \<open>R = !P\<close> \<open>guarded P\<close> by simp
       }
       ultimately have "Prop C \<Psi> (P \<parallel> !P) (\<alpha> \<prec> (P \<parallel> P'))" using \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha>  \<sharp>* Q\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>Q = P\<close> \<open>distinct(bn \<alpha>)\<close>
         by(rule_tac rPar2) auto
       with \<open>R = !P\<close> \<open>Q = P\<close> show ?case by simp
     next
       case(cComm1 \<Psi>' \<Psi>\<^sub>R Q M N P' A\<^sub>P \<Psi>\<^sub>P R K xvec P'' A\<^sub>R \<Psi> C)
       have rComm1: "\<And>M N P' K xvec P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''); \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                            xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
         by fact
       from \<open>bangPred P (Q \<parallel> R)\<close> have "Q = P" and "R = !P"
         by - (ind_cases "bangPred P (Q \<parallel> R)", auto simp add: psi.inject)+
       from \<open>R = !P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>R = []" and "\<Psi>\<^sub>R = \<one>" by auto
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R \<rhd> Q \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close> \<open>Q = P\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>R = \<one>\<close> have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
         by(metis statEqTransition Identity AssertionStatEqSym)
       moreover from \<open>Q = P\<close> \<open>extractFrame Q = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>guarded P\<close> have "\<Psi>\<^sub>P \<simeq> \<one>" and "supp \<Psi>\<^sub>P = ({}::name set)"
         by(blast dest: guardedStatEq)+
       moreover from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''\<close> \<open>R = !P\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> have "\<Psi> \<rhd> !P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''"
         by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
       moreover 
       {
         fix C
         have "bangPred P (!P)" by(rule aux1)
         moreover from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<simeq> \<Psi>' \<otimes> \<Psi>\<^sub>P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
         ultimately have "\<And>C. Prop C \<Psi> (!P) (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'')" using cComm1 \<open>R = !P\<close> \<open>guarded P\<close> by simp
       }
       moreover from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>R = \<one>\<close> have "\<Psi> \<turnstile> M \<leftrightarrow> K"
         by(metis statEqEnt Identity Composition Commutativity AssertionStatEqSym)
       ultimately have "Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))" using \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* K\<close> \<open>xvec \<sharp>* C\<close> \<open>Q = P\<close> \<open>distinct xvec\<close>
         by(rule_tac rComm1) (assumption | auto)+
       with \<open>R = !P\<close> \<open>Q = P\<close> show ?case by simp
     next
       case(cComm2 \<Psi>' \<Psi>\<^sub>R Q M xvec N P' A\<^sub>P \<Psi>\<^sub>P R K P'' A\<^sub>R \<Psi> C)
       have rComm2: "\<And>M xvec N P' K P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>N\<rparr> \<prec> P''); \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                            xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
         by fact
       from \<open>bangPred P (Q \<parallel> R)\<close> have "Q = P" and "R = !P"
         by - (ind_cases "bangPred P (Q \<parallel> R)", auto simp add: psi.inject)+
       from \<open>R = !P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>R = []" and "\<Psi>\<^sub>R = \<one>" by auto
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R \<rhd> Q \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>Q = P\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>R = \<one>\<close> have "\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
         by(metis statEqTransition Identity AssertionStatEqSym)
       moreover from \<open>Q = P\<close> \<open>extractFrame Q = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>guarded P\<close> have "\<Psi>\<^sub>P \<simeq> \<one>" and "supp \<Psi>\<^sub>P = ({}::name set)"
         by(blast dest: guardedStatEq)+
       moreover from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K\<lparr>N\<rparr> \<prec> P''\<close> \<open>R = !P\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> have "\<Psi> \<rhd> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P''"
         by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
       moreover 
       {
         fix C
         have "bangPred P (!P)" by(rule aux1)
         moreover from \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> have "\<Psi> \<simeq> \<Psi>' \<otimes> \<Psi>\<^sub>P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
         ultimately have "\<And>C. Prop C \<Psi> (!P) (K\<lparr>N\<rparr> \<prec> P'')" using cComm2 \<open>R = !P\<close> \<open>guarded P\<close> by simp
       }
       moreover from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>\<^sub>P \<simeq> \<one>\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> \<open>\<Psi>\<^sub>R = \<one>\<close> have "\<Psi> \<turnstile> M \<leftrightarrow> K"
         by(metis statEqEnt Identity Composition Commutativity AssertionStatEqSym)
       ultimately have "Prop C \<Psi> (P \<parallel> !P) (\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))" using \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* Q\<close> \<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* K\<close> \<open>xvec \<sharp>* C\<close> \<open>Q = P\<close> \<open>distinct xvec\<close>
         by(rule_tac rComm2) (assumption | auto)+
       with \<open>R = !P\<close> \<open>Q = P\<close> show ?case by simp
     next
       case(cOpen \<Psi> Q M xvec yvec N P' x C)
       thus ?case by - (ind_cases "bangPred P (\<lparr>\<nu>x\<rparr>Q)")
     next
       case(cScope \<Psi> Q \<alpha> P' x C)
       thus ?case by - (ind_cases "bangPred P (\<lparr>\<nu>x\<rparr>Q)")
     next
       case(Bang \<Psi>' Q Rs \<Psi> C)
       have rBang: "\<And>Rs C. \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs; \<And>C. Prop C \<Psi> (P \<parallel> !P) Rs; guarded P\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) Rs"
         by fact
       from \<open>bangPred P (!Q)\<close> have "P = Q" 
         by - (ind_cases "bangPred P (!Q)", auto simp add: psi.inject)
       with \<open>\<Psi>' \<rhd> Q \<parallel> !Q \<longmapsto> Rs\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> have "\<Psi> \<rhd> P \<parallel> !P \<longmapsto> Rs" by(metis statEqTransition AssertionStatEqSym) 
       moreover 
       {
         fix C
         have "bangPred P (P \<parallel> !P)" by(rule aux2)
         with Bang \<open>P = Q\<close> have "\<And>C. Prop C \<Psi> (P \<parallel> !P) Rs" by simp
       }
       moreover from \<open>guarded Q\<close> \<open>P = Q\<close> have "guarded P" by simp
       ultimately have "Prop C \<Psi> (!P) Rs" by(rule rBang)
       with \<open>P = Q\<close> show ?case by simp
     qed
   }
   with \<open>guarded P\<close> \<open>\<Psi> \<rhd> !P \<longmapsto> Rs\<close>
   show ?thesis by(force intro: aux1)
 qed
 
 lemma bangInputInduct[consumes 1, case_names cPar1 cPar2 cBang]:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
 
   assumes "\<Psi> \<rhd> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"
   and     rPar1: "\<And>P'. \<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P' \<Longrightarrow> Prop \<Psi> (P \<parallel> !P) M N (P' \<parallel> !P)"
   and     rPar2: "\<And>P'. \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; Prop \<Psi> (!P) M N P'\<rbrakk> \<Longrightarrow> Prop \<Psi> (P \<parallel> !P) M N (P \<parallel> P')"
   and     rBang: "\<And>P'. \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; Prop \<Psi> (P \<parallel> !P) M N P'; guarded P\<rbrakk> \<Longrightarrow> Prop \<Psi> (!P) M N P'"
   shows "Prop \<Psi> (!P) M N P'"
 using \<open>\<Psi> \<rhd> !P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'\<close>
 by(nominal_induct \<Psi> P Rs=="M\<lparr>N\<rparr> \<prec> P'" arbitrary: P' rule: bangInduct)
   (auto simp add: residualInject intro: rPar1 rPar2 rBang)
 
 lemma bangOutputInduct[consumes 1, case_names cPar1 cPar2 cBang]:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> 'a \<Rightarrow> ('a, 'b, 'c) boundOutput \<Rightarrow> bool"
   and   C    :: 'd
 
   assumes "\<Psi> \<rhd> !P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     rPar1: "\<And>xvec N P' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P' \<parallel> !P))"
   and     rPar2: "\<And>xvec N P' C. \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<And>C. Prop C \<Psi> (!P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P'); xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> 
                                   Prop C \<Psi> (P \<parallel> !P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' (P \<parallel> P'))"
   and     rBang: "\<And>B C. \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>(ROut M B); \<And>C. Prop C \<Psi> (P \<parallel> !P) M B; guarded P\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) M B"
 
   shows "Prop C \<Psi> (!P) M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P')"
 using \<open>\<Psi> \<rhd> !P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close>
 apply(auto simp add: residualInject)
 by(nominal_induct \<Psi> P Rs=="ROut M (\<lparr>\<nu>*xvec\<rparr>N \<prec>' P')" avoiding: C arbitrary: xvec N P' rule: bangInduct)
   (force simp add: residualInject intro: rPar1 rPar2 rBang)+
 
 lemma bangTauInduct[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cBang]:
   fixes \<Psi>   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: 'd
 
   assumes "\<Psi> \<rhd> !P \<longmapsto>\<tau> \<prec> P'"
   and     rPar1: "\<And>P' C. \<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P' \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (P' \<parallel> !P)"
   and     rPar2: "\<And>P' C. \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>\<tau> \<prec> P'; \<And>C. Prop C \<Psi> (!P) P'\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (P \<parallel> P')"
   and     rComm1: "\<And>M N P' K xvec P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''; \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rComm2: "\<And>M N P' K xvec P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P''; \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rBang: "\<And>P' C. \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<tau> \<prec> P'; \<And>C. Prop C \<Psi> (P \<parallel> !P) P'; guarded P\<rbrakk> \<Longrightarrow> Prop C \<Psi> (!P) P'"
 
   shows "Prop C \<Psi> (!P) P'"
 using \<open>\<Psi> \<rhd> !P \<longmapsto>\<tau> \<prec> P'\<close>
 by(nominal_induct \<Psi> P Rs=="\<tau> \<prec> P'" avoiding: C arbitrary: P' rule: bangInduct)
   (auto simp add: residualInject intro: rPar1 rPar2 rComm1 rComm2 rBang)
 
 lemma bangInduct'[consumes 2, case_names cAlpha cPar1 cPar2 cComm1 cComm2 cBang]:
   fixes \<Psi>    :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   \<alpha>    :: "'a action"
   and   P'   :: "('a, 'b, 'c) psi"
   and   Prop :: "'d::fs_name \<Rightarrow> 'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> 'a action \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool"
   and   C    :: "'d::fs_name"
 
   assumes "\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'"
   and     "bn \<alpha> \<sharp>* subject \<alpha>"
   and     rAlpha: "\<And>\<alpha> P' p C. \<lbrakk>bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>;  bn \<alpha> \<sharp>* C;
                                 set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>)); distinctPerm p;
                                 bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>; bn(p \<bullet> \<alpha>) \<sharp>* P'; Prop C \<Psi> (P \<parallel> !P) \<alpha> P'\<rbrakk> \<Longrightarrow>
                                 Prop C \<Psi> (P \<parallel> !P) (p \<bullet> \<alpha>) (p \<bullet> P')"
   and     rPar1: "\<And>\<alpha> P' C.
                    \<lbrakk>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'; bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> !P) \<alpha> (P' \<parallel> !P)"
   and     rPar2: "\<And>\<alpha> P' C.
                    \<lbrakk>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'; \<And>C. Prop C \<Psi> (!P) \<alpha> P';
                     bn \<alpha> \<sharp>* \<Psi>; bn \<alpha> \<sharp>* P; bn \<alpha> \<sharp>* subject \<alpha>; bn \<alpha> \<sharp>* C; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow>
                     Prop C \<Psi> (P \<parallel> !P) \<alpha> (P \<parallel> P')"
   and     rComm1: "\<And>M N P' K xvec P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle>) P''; \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rComm2: "\<And>M xvec N P' K P'' C. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; \<Psi> \<rhd> !P \<longmapsto>K\<lparr>N\<rparr> \<prec> P''; \<And>C. Prop C \<Psi> (!P) (K\<lparr>N\<rparr>) P''; \<Psi> \<turnstile> M \<leftrightarrow> K; 
                                              xvec \<sharp>* \<Psi>; xvec \<sharp>* P; xvec \<sharp>* M; xvec \<sharp>* K; xvec \<sharp>* C; distinct xvec\<rbrakk> \<Longrightarrow> Prop C \<Psi> (P \<parallel> !P) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
   and     rBang:    "\<And>\<alpha> P' C.
                      \<lbrakk>\<Psi> \<rhd> P \<parallel> !P \<longmapsto>\<alpha> \<prec> P'; guarded P; \<And>C. Prop C \<Psi> (P \<parallel> !P) \<alpha> P'; guarded P; distinct(bn \<alpha>)\<rbrakk> \<Longrightarrow>
                       Prop C \<Psi> (!P) \<alpha> P'"
   shows "Prop C \<Psi> (!P) \<alpha> P'"
 proof -
   from \<open>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'\<close> have "distinct(bn \<alpha>)" by(rule boundOutputDistinct)
   with \<open>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> show ?thesis
   proof(nominal_induct \<Psi> P Rs=="\<alpha> \<prec> P'" avoiding: C \<alpha> P' rule: bangInduct)
     case(cPar1 \<alpha> P' C \<alpha>' P'')
     note  \<open>\<alpha> \<prec> (P' \<parallel> !P) = \<alpha>' \<prec> P''\<close>
     moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* bn \<alpha>'" by simp
     moreover note \<open>distinct(bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
     moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P' \<parallel> !P)" by simp
     moreover from \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close> have "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp
     ultimately obtain p where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "\<alpha>' = p \<bullet> \<alpha>"
                     and  P'eq: "P'' = p \<bullet> (P' \<parallel> !P)" and "bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>" and "bn(p \<bullet> \<alpha>) \<sharp>* (P' \<parallel> !P)"
       by(rule_tac residualEq)
 
     from \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> \<open>distinct(bn \<alpha>)\<close> 
     have "Prop C \<Psi> (P \<parallel> !P) \<alpha> (P' \<parallel> !P)"
       by(rule rPar1)
     with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> S \<open>distinctPerm p\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> \<open>bn \<alpha> \<sharp>* P''\<close> \<open>\<alpha>' = (p \<bullet> \<alpha>)\<close> P'eq \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P' \<parallel> !P)\<close>
     have "Prop C \<Psi> (P \<parallel> !P) (p \<bullet> \<alpha>) (p \<bullet> (P' \<parallel> !P))"
       by(rule_tac rAlpha) 
     with P'eq \<open>\<alpha>' = p \<bullet> \<alpha>\<close> \<open>distinctPerm p\<close> show ?case  by simp
   next
     case(cPar2 \<alpha> P' C \<alpha>' P'')
     note  \<open>\<alpha> \<prec> (P \<parallel> P') = \<alpha>' \<prec> P''\<close>
     moreover from \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> have "bn \<alpha> \<sharp>* bn \<alpha>'" by simp
     moreover note \<open>distinct(bn \<alpha>)\<close> \<open>distinct(bn \<alpha>')\<close>
     moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> have "bn \<alpha> \<sharp>* (\<alpha> \<prec> P \<parallel> P')" by simp
     moreover from \<open>bn \<alpha>' \<sharp>* subject \<alpha>'\<close> have "bn \<alpha>' \<sharp>* (\<alpha>' \<prec> P'')" by simp
     ultimately obtain p where S: "set p \<subseteq> set(bn \<alpha>) \<times> set(bn(p \<bullet> \<alpha>))" and "distinctPerm p" and "\<alpha>' = p \<bullet> \<alpha>"
                     and  P'eq: "P'' = p \<bullet> (P \<parallel> P')" and "bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>" and "bn(p \<bullet> \<alpha>) \<sharp>* (P \<parallel> P')"
       by(rule_tac residualEq)
     
     note \<open>\<Psi> \<rhd> !P \<longmapsto>\<alpha> \<prec> P'\<close>
     moreover from \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>distinct(bn \<alpha>)\<close> have "\<And>C. Prop C \<Psi> (!P) \<alpha> P'" by(rule_tac cPar2) auto
     moreover note \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha>  \<sharp>* P\<close> \<open>bn \<alpha>  \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha>  \<sharp>* C\<close> \<open>distinct(bn \<alpha>)\<close>
     ultimately have "Prop C \<Psi> (P \<parallel> !P) \<alpha> (P \<parallel> P')"
       by(rule rPar2)
     with \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> \<open>bn \<alpha> \<sharp>* subject \<alpha>\<close> \<open>bn \<alpha> \<sharp>* C\<close> S \<open>distinctPerm p\<close> \<open>bn \<alpha> \<sharp>* \<alpha>'\<close> \<open>bn \<alpha> \<sharp>* P''\<close> \<open>\<alpha>' = (p \<bullet> \<alpha>)\<close> P'eq \<open>bn(p \<bullet> \<alpha>) \<sharp>* \<alpha>\<close> \<open>bn(p \<bullet> \<alpha>) \<sharp>* (P \<parallel> P')\<close>
     have "Prop C \<Psi> (P \<parallel> !P) (p \<bullet> \<alpha>) (p \<bullet> (P \<parallel> P'))"
       by(rule_tac rAlpha) 
     with P'eq \<open>\<alpha>' = p \<bullet> \<alpha>\<close> show ?case by simp
   next
     case(cComm1 M N P' K xvec P'' C \<alpha> P''')
     hence "Prop C \<Psi> (P \<parallel> !P) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
       by(rule_tac rComm1) (assumption | simp)+
     thus ?case using \<open>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P'') = \<alpha> \<prec> P'''\<close>
       by(simp add: residualInject)
   next
     case(cComm2 M xvec N P' K P'' C \<alpha> P''')
     hence "Prop C \<Psi> (P \<parallel> !P) (\<tau>) (\<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P''))"
       by(rule_tac rComm2) (assumption | simp)+
     thus ?case using \<open>\<tau> \<prec> \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> P'') = \<alpha> \<prec> P'''\<close>
       by(simp add: residualInject)
   next
     case(cBang C \<alpha> P')
     thus ?case by(auto intro: rBang)
   qed
 qed
 
 lemma comm1Aux:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>Q   :: 'b
   and   R    :: "('a, 'b, 'c) psi"
   and   K    :: 'a
   and   xvec :: "name list"
   and   N    :: 'a
   and   R'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>R   :: "name list"
   and   \<Psi>\<^sub>R   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   L    :: 'a
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   A\<^sub>Q   :: "name list"
 
   assumes RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> R \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R'"
   and     FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>"
   and     PTrans: "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'"
   and     MeqK: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K"
   and     PeqQ: "\<langle>A\<^sub>Q, (\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
   and     "distinct A\<^sub>P"
   and     "distinct A\<^sub>R"
   and     "A\<^sub>R \<sharp>* A\<^sub>P"
   and     "A\<^sub>R \<sharp>* A\<^sub>Q"
   and     "A\<^sub>R \<sharp>* \<Psi>"
   and     "A\<^sub>R \<sharp>* P"
   and     "A\<^sub>R \<sharp>* Q"
   and     "A\<^sub>R \<sharp>* R"
   and     "A\<^sub>R \<sharp>* K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* R"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>Q \<sharp>* R"
   and     "A\<^sub>Q \<sharp>* M"
 
   obtains K' where "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R'" and "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "A\<^sub>R \<sharp>* K'"
 proof -
   from \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* Q\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> FrP FrQ have "A\<^sub>R \<sharp>* \<Psi>\<^sub>P" and "A\<^sub>R \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   assume Assumptions: "\<And>K'. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R'; \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'; A\<^sub>R \<sharp>* K'\<rbrakk> \<Longrightarrow> thesis"
   {
     fix \<Psi>'   ::'b
     and zvec ::"name list"
 
     assume A: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<simeq> \<Psi>'"
     assume "\<Psi>' \<rhd> R \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R'"
     hence "\<Psi>' \<rhd> R \<longmapsto>ROut K (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')" by(simp add: residualInject)
     moreover note FrR \<open>distinct A\<^sub>R\<close> PTrans
     moreover from \<open>\<Psi>' \<rhd> R \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> R'\<close> have "distinct xvec" by(auto dest: boundOutputDistinct)
     moreover assume "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K" and "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
                 and "A\<^sub>R \<sharp>* zvec" and "A\<^sub>P \<sharp>* zvec" and "zvec \<sharp>* R" and "zvec \<sharp>* P"
                 and "A\<^sub>R \<sharp>* \<Psi>'"
     ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R') \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"
       using FrP \<open>A\<^sub>P \<sharp>* R\<close> \<open>A\<^sub>Q \<sharp>* R\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>distinct A\<^sub>P\<close>  \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* R\<close> 
             \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>R \<sharp>* K\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close>
     proof(nominal_induct \<Psi>' R K B=="\<lparr>\<nu>*xvec\<rparr>N \<prec>' R'" A\<^sub>R \<Psi>\<^sub>R avoiding: \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec N R' arbitrary: M rule: outputFrameInduct)
       case(cAlpha \<Psi>' R K A\<^sub>R \<Psi>\<^sub>R p \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec N R' M)
       have S: "set p \<subseteq> set A\<^sub>R \<times> set (p \<bullet> A\<^sub>R)" by fact
       from \<open>\<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> (\<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<turnstile> (p \<bullet> M) \<leftrightarrow> (p \<bullet> K)"
         by(rule chanEqClosed)
       with \<open>A\<^sub>R \<sharp>* \<Psi>'\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>'\<close> \<open>A\<^sub>R \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* K\<close> S \<open>distinctPerm p\<close>
       have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K" by(simp add: eqvts)
       moreover from \<open>\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> S \<open>A\<^sub>R \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* P\<close> have "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>L\<rparr> \<prec> P'"
         by(rule_tac inputPermFrameSubject) auto
       with \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> S \<open>distinctPerm p\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>L\<rparr> \<prec> P'"
         by(simp add: eqvts)
       moreover from \<open>A\<^sub>P \<sharp>* M\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> M)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>P\<close> S have "A\<^sub>P \<sharp>* (p \<bullet> M)" by simp
       moreover from \<open>A\<^sub>Q \<sharp>* M\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> M)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>Q\<close> S have "A\<^sub>Q \<sharp>* (p \<bullet> M)" by simp
       moreover from \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle> \<close>
       have "(p \<bullet> \<langle>A\<^sub>Q, \<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle>) \<hookrightarrow>\<^sub>F (p \<bullet> \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle>)"
         by(rule FrameStatImpClosed)
       with \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* \<Psi>'\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>'\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close>
         \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> S \<open>distinctPerm p\<close>
       have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>" by(simp add: eqvts)
       ultimately obtain K' where "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')" and "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         using cAlpha
         by metis
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')\<close> S \<open>A\<^sub>R \<sharp>* R\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* R\<close>
       have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> R \<longmapsto>(ROut (p \<bullet> K') (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R'))" using outputPermFrameSubject 
         by(auto simp add: residualInject)
       with S \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>(ROut (p \<bullet> K') (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R'))"
         by(simp add: eqvts)
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K'\<close> have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R))\<turnstile> (p \<bullet> p \<bullet> M) \<leftrightarrow> (p \<bullet> K')"
         by(rule chanEqClosed)
       with S \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> \<open>distinctPerm p\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<turnstile> M \<leftrightarrow> (p \<bullet> K')"
         by(simp add: eqvts)
       moreover from \<open>zvec \<sharp>* K'\<close> have "(p \<bullet> zvec) \<sharp>* (p \<bullet> K')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* zvec\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* zvec\<close> S have "zvec \<sharp>* (p \<bullet> K')" by simp
       moreover from \<open>A\<^sub>R \<sharp>* K'\<close> have "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> K')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       ultimately show ?case by blast
     next
       case(cOutput \<Psi>' M' K N R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec N' R' M)
       from \<open>A\<^sub>P \<sharp>* (M'\<langle>N\<rangle>.R)\<close> \<open>A\<^sub>Q \<sharp>* (M'\<langle>N\<rangle>.R)\<close> \<open>zvec \<sharp>* (M'\<langle>N\<rangle>.R)\<close>
       have "A\<^sub>P \<sharp>* M'" and "A\<^sub>Q \<sharp>* M'" and "zvec \<sharp>* M'" by simp+
           
       from \<open>\<Psi>' \<turnstile> M' \<leftrightarrow> K\<close> have "\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> K" by(blast intro: statEqEnt Identity AssertionStatEqSym)
       hence "\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> M'" by(blast intro: chanEqSym chanEqTrans)
       with \<open>A\<^sub>Q \<sharp>* M'\<close> have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M' \<leftrightarrow> M'" by(force intro: frameImpI)
       
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close> have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M' \<leftrightarrow> M'"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* M'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> M' \<leftrightarrow> M'"  by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M' \<leftrightarrow> M'" by(blast intro: statEqEnt Identity) hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> M'\<langle>N\<rangle>.R \<longmapsto>M'\<langle>N\<rangle> \<prec> R"
         by(rule Output)
       
       moreover from \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> K\<close>
       have "\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'" by(metis chanEqSym chanEqTrans)
       with \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
       have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> M'"
         by(force intro: frameImpI)
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
       have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> M'"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'" 
         by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity)
       ultimately show ?case using cOutput by(auto simp add: residualInject)
     next
       case(cCase \<Psi>' R M' \<phi> Cs A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec N R' M)
       from \<open>guarded R\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "\<Psi>\<^sub>R \<simeq> \<one>"
         by(metis guardedStatEq)
       with \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'\<close> have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> M'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
       moreover have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
       proof -
         from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>Q,  \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
         moreover from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>R  \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
       moreover from \<open>zvec \<sharp>* (Cases Cs)\<close> \<open>A\<^sub>P \<sharp>* (Cases Cs)\<close>  \<open>A\<^sub>Q \<sharp>* (Cases Cs)\<close> \<open>(\<phi>, R) mem Cs\<close> 
       have "A\<^sub>P \<sharp>* R" and "A\<^sub>Q \<sharp>* R" and "zvec \<sharp>* R" and "A\<^sub>P \<sharp>* \<phi>" and "A\<^sub>Q \<sharp>* \<phi>"
         by(auto dest: memFreshChain)
       ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R') \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"  using cCase
         by(rule_tac cCase) (assumption | simp)+
       then obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         by metis
       note RTrans \<open>(\<phi>, R) mem Cs\<close>
       moreover from \<open>\<Psi>' \<turnstile> \<phi>\<close> have "\<Psi>' \<otimes> \<one> \<turnstile> \<phi>" by(blast intro: statEqEnt Identity AssertionStatEqSym)
       with \<open>A\<^sub>Q \<sharp>* \<phi>\<close> have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>" by(force intro: frameImpI)
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close> have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* \<phi>\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> \<phi>"  by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> \<phi>" by(blast intro: statEqEnt Identity) 
       ultimately have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Cases Cs \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')" using \<open>guarded R\<close> by(rule Case)
       moreover from MeqK' \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close>
         by fastforce
     next
       case(cPar1 \<Psi>' \<Psi>\<^sub>R\<^sub>2 R\<^sub>1 M' xvec N' R\<^sub>1' A\<^sub>R\<^sub>2 R\<^sub>2 A\<^sub>R\<^sub>1 \<Psi>\<^sub>R\<^sub>1 \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec yvec N R' M)
       have FrR2: "extractFrame R\<^sub>2 = \<langle>A\<^sub>R\<^sub>2, \<Psi>\<^sub>R\<^sub>2\<rangle>" by fact
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'\<close> have "(\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity Composition Commutativity)
       moreover have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle>"
       proof -
         have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>\<close>
         moreover have  "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'"
         by(metis statEqTransition Associativity Composition Commutativity)
       moreover from \<open>A\<^sub>R\<^sub>1 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (R\<^sub>1 \<parallel> R\<^sub>2)\<close> \<open>extractFrame R\<^sub>1 = \<langle>A\<^sub>R\<^sub>1, \<Psi>\<^sub>R\<^sub>1\<rangle>\<close> FrR2 have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>1" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>2"
         by(force dest: extractFrameFreshChain)+
 
       moreover from \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' (R\<^sub>1' \<parallel> R\<^sub>2) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'\<close> \<open>xvec \<sharp>* yvec\<close>
       obtain p T where "\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R\<^sub>1' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' T" and "R' = T \<parallel> (p \<bullet> R\<^sub>2)" and "set p \<subseteq> set yvec \<times> set xvec"
         apply(drule_tac sym)
         by(rule_tac boundOutputPar1Dest') (assumption | simp | blast dest: sym)+
       ultimately have "\<exists>K'. (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>1 \<longmapsto>ROut K' (\<lparr>\<nu>*yvec\<rparr>N \<prec>' T) \<and> (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> K' \<and> (A\<^sub>R\<^sub>2@zvec) \<sharp>* K' \<and> A\<^sub>R\<^sub>1 \<sharp>* K'" using cPar1
         apply(rule_tac cPar1(6)) by(assumption | simp | fastforce)+
       then  obtain K' where RTrans: "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>1 \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R\<^sub>1'"
                         and MeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> K'"  and "A\<^sub>R\<^sub>2 \<sharp>* K'" and "A\<^sub>R\<^sub>1 \<sharp>* K'" and "zvec \<sharp>* K'"
         using \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R\<^sub>1' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' T\<close> by(auto simp add: residualInject)
       
       from RTrans have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> R\<^sub>1 \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R\<^sub>1'"
         by(metis statEqTransition Associativity Composition Commutativity)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> (R\<^sub>1 \<parallel> R\<^sub>2) \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> (R\<^sub>1' \<parallel> R\<^sub>2)" using FrR2 \<open>xvec \<sharp>* R\<^sub>2\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* \<Psi>\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* R\<^sub>1\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* xvec\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* N'\<close>
         by(force intro: Par1)
       moreover from MeqK' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close>  \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' (R\<^sub>1' \<parallel> R\<^sub>2) = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'\<close>
         by(auto simp add: residualInject)
     next
       case(cPar2 \<Psi>' \<Psi>\<^sub>R\<^sub>1 R\<^sub>2 M' xvec N' R\<^sub>2' A\<^sub>R\<^sub>1 R\<^sub>1 A\<^sub>R\<^sub>2 \<Psi>\<^sub>R\<^sub>2 \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec yvec N R' M)
       have FrR1: "extractFrame R\<^sub>1 = \<langle>A\<^sub>R\<^sub>1, \<Psi>\<^sub>R\<^sub>1\<rangle>" by fact
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'\<close> have "(\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity Composition Commutativity)
       moreover have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
       proof -
         have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>\<close>
         moreover have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'"
         by(metis statEqTransition Associativity Composition Commutativity)
       moreover from \<open>A\<^sub>R\<^sub>1 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (R\<^sub>1 \<parallel> R\<^sub>2)\<close> FrR1 \<open>extractFrame R\<^sub>2 = \<langle>A\<^sub>R\<^sub>2, \<Psi>\<^sub>R\<^sub>2\<rangle>\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>1" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>2"
         by(force dest: extractFrameFreshChain)+
       moreover from \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' (R\<^sub>1 \<parallel> R\<^sub>2') = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'\<close> \<open>xvec \<sharp>* yvec\<close>
       obtain p T where "\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R\<^sub>2' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' T" and "R' = (p \<bullet> R\<^sub>1) \<parallel> T" and "set p \<subseteq> set yvec \<times> set xvec"
         apply(drule_tac sym)
         by(rule_tac boundOutputPar2Dest') (assumption | simp | blast dest: sym)+
       ultimately have "\<exists>K'. (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>2 \<longmapsto>ROut K' (\<lparr>\<nu>*yvec\<rparr>N \<prec>' T) \<and> (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K' \<and> (A\<^sub>R\<^sub>1@zvec) \<sharp>* K' \<and> A\<^sub>R\<^sub>2 \<sharp>* K'" using cPar2
         by(rule_tac cPar2(6)) (assumption | simp | fastforce)+
       then obtain K' where RTrans: "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>2 \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R\<^sub>2'"
                         and MeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"  and "A\<^sub>R\<^sub>1 \<sharp>* K'" and "zvec \<sharp>* K'" and "A\<^sub>R\<^sub>2 \<sharp>* K'" 
         using \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R\<^sub>2' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' T\<close> by(auto simp add: residualInject)
           
       from RTrans have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<rhd> R\<^sub>2 \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R\<^sub>2'"
         by(metis statEqTransition Associativity Composition Commutativity)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> (R\<^sub>1 \<parallel> R\<^sub>2) \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> (R\<^sub>1 \<parallel> R\<^sub>2')" using FrR1 \<open>xvec \<sharp>* R\<^sub>1\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* \<Psi>\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close>\<open>A\<^sub>R\<^sub>1 \<sharp>* xvec\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* N'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* R\<^sub>2\<close>
         by(force intro: Par2)
       moreover from MeqK' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close> \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' (R\<^sub>1 \<parallel> R\<^sub>2') = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'\<close>
         by(auto simp add: residualInject)
     next
       case(cOpen \<Psi>' R M' xvec yvec N' R' x A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec zvec2 N R'' M)
       from \<open>\<lparr>\<nu>*(xvec @ x # yvec)\<rparr>N' \<prec>' R' = \<lparr>\<nu>*zvec2\<rparr>N \<prec>' R''\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close> \<open>x \<sharp> zvec2\<close> \<open>x \<sharp> R''\<close> \<open>x \<sharp> N\<close> \<open>distinct zvec2\<close>
       obtain xvec' x' yvec' where A: "\<lparr>\<nu>*(xvec@yvec)\<rparr>N' \<prec>' R' =  \<lparr>\<nu>*(xvec'@yvec')\<rparr>([(x, x')] \<bullet> N) \<prec>' ([(x, x')] \<bullet> R'')" 
                               and B: "zvec2 = (xvec'@x'#yvec')"
         by(rule_tac boundOutputOpenDest) auto
       then have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*(xvec'@yvec')\<rparr>([(x, x')] \<bullet> N) \<prec>' ([(x, x')] \<bullet> R'')) \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> (zvec) \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'" using cOpen
         by(rule_tac cOpen(4)) (assumption | simp)+
       then  obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N'\<rangle> \<prec> R'"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         using A by(auto simp add: residualInject)
       from \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (\<lparr>\<nu>x\<rparr>R)\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R"
         by(force dest: extractFrameFreshChain)+
 
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>zvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* zvec\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* zvec\<close> \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>x \<sharp> P\<close>
 
       obtain K'' where MeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K''" and "A\<^sub>R \<sharp>* K''" and "zvec \<sharp>* K''" and "x \<sharp> K''"
         by(rule_tac B="(x#A\<^sub>R@zvec)" in obtainPrefix) (assumption | simp | force)+
       
       from MeqK'' MeqK' have KeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<turnstile> K' \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
       with RTrans \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> \<open>distinct A\<^sub>R\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* K'\<close> \<open>A\<^sub>R \<sharp>* K''\<close> \<open>A\<^sub>R \<sharp>* R\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K''\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>N'\<rangle> \<prec> R'"
         by(rule_tac outputRenameSubject) (assumption | force)+
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> \<lparr>\<nu>x\<rparr>R \<longmapsto>K''\<lparr>\<nu>*(xvec@x#yvec)\<rparr>\<langle>N'\<rangle> \<prec> R'"
         using \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<Psi>\<^sub>P\<close> \<open>x \<sharp> K''\<close> \<open>x \<sharp> xvec\<close> \<open> x \<sharp> yvec\<close> \<open>x \<in> supp N'\<close> \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* R\<close> \<open>x \<sharp> K''\<close>
         by(rule_tac Open) (assumption | force)+
       moreover from MeqK'' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K''\<close> \<open>x \<sharp> K''\<close> \<open>A\<^sub>R \<sharp>* K''\<close> B \<open>\<lparr>\<nu>*(xvec @ x # yvec)\<rparr>N' \<prec>' R' = \<lparr>\<nu>*zvec2\<rparr>N \<prec>' R''\<close>
         by(auto simp add: residualInject)
     next
       case(cScope \<Psi>' R M' xvec N' R' x A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec yvec N R'' M)
       from \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' \<lparr>\<nu>x\<rparr>R' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R''\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> yvec\<close>
       obtain R''' where "R'' = \<lparr>\<nu>x\<rparr>R'''" and "\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'''"
         apply(drule_tac sym)
         by(rule boundOutputScopeDest) (assumption | auto)+
       then have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*yvec\<rparr>N \<prec>' R''') \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"  using cScope
         by(rule_tac cScope(4)) (assumption | simp)+
       then obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R'"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         using \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' R' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R'''\<close>
         by(auto simp add: residualInject)
       from \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (\<lparr>\<nu>x\<rparr>R)\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R"
         by(force dest: extractFrameFreshChain)+
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>x \<sharp> P\<close> \<open>zvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* zvec\<close>  \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* zvec\<close> \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close>
       obtain K'' where MeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K''" and "x \<sharp> K''" and "A\<^sub>R \<sharp>* K''" and "zvec \<sharp>* K''"
         by(rule_tac B="(x#A\<^sub>R@zvec)" in obtainPrefix) (assumption | force)+
 
       from MeqK'' MeqK' have KeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<turnstile> K' \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
       with RTrans \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> \<open>distinct A\<^sub>R\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* K'\<close> \<open>A\<^sub>R \<sharp>* K''\<close> \<open>A\<^sub>R \<sharp>* R\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K''\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> R'"
         by(rule_tac outputRenameSubject) (assumption | force)+
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> \<lparr>\<nu>x\<rparr>R \<longmapsto>K''\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> \<lparr>\<nu>x\<rparr>R'" using \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<Psi>\<^sub>P\<close> \<open>x \<sharp> K''\<close> \<open>x \<sharp> xvec\<close> \<open>x \<sharp> N'\<close> \<open>xvec \<sharp>* \<Psi>\<close> \<open>xvec \<sharp>* \<Psi>\<^sub>P\<close> \<open>xvec \<sharp>* R\<close> \<open>x \<sharp> K''\<close>
         by(rule_tac Scope) (assumption | force)+
       moreover from MeqK'' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K''\<close> \<open>x \<sharp> K''\<close> \<open>A\<^sub>R \<sharp>* K''\<close> \<open>\<lparr>\<nu>*xvec\<rparr>N' \<prec>' \<lparr>\<nu>x\<rparr>R' = \<lparr>\<nu>*yvec\<rparr>N \<prec>' R''\<close>
         by(auto simp add: residualInject)
     next
       case(cBang \<Psi>' R M' A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec N R' M)
       from \<open>guarded R\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "\<Psi>\<^sub>R \<simeq> \<one>"
         by(metis guardedStatEq)
       with \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'\<close> have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
       moreover have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle>"
       proof -
         from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>Q,  \<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
         moreover from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'\<close> \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>L\<rparr> \<prec> P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
       ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<parallel> !R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R') \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"  using cBang
         by(rule_tac cBang(5)) (assumption |simp)+
       then  obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<parallel> !R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         by metis
       from RTrans \<open>guarded R\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> !R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R')" by(rule Bang)
       moreover from MeqK' \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close>
         by force
     qed
   }
   note Goal = this
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<simeq> \<Psi> \<otimes> \<Psi>\<^sub>Q" by simp
   moreover note RTrans
   moreover from MeqK have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K"
     by(metis statEqEnt Associativity Commutativity)
   moreover note PeqQ \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>Q\<close>
   ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>ROut K' (\<lparr>\<nu>*xvec\<rparr>N \<prec>' R') \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> ([]::name list) \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"
    by(rule_tac Goal) (assumption | force simp add: residualInject)+
   with Assumptions show ?thesis
     by(force simp add: residualInject)
 qed
 
 lemma comm2Aux:
   fixes \<Psi>    :: 'b
   and   \<Psi>\<^sub>Q   :: 'b
   and   R    :: "('a, 'b, 'c) psi"
   and   K    :: 'a
   and   N    :: 'a
   and   R'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>R   :: "name list"
   and   \<Psi>\<^sub>R   :: 'b
   and   P    :: "('a, 'b, 'c) psi"
   and   M    :: 'a
   and   xvec :: "name list"
   and   P'   :: "('a, 'b, 'c) psi"
   and   A\<^sub>P   :: "name list"
   and   \<Psi>\<^sub>P   :: 'b
   and   A\<^sub>Q   :: "name list"
 
   assumes RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> R \<longmapsto>K\<lparr>N\<rparr> \<prec> R'"
   and     FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>"
   and     PTrans: "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
   and     MeqK: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K"
   and     QimpP: "\<langle>A\<^sub>Q, (\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
   and     FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>"
   and     FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>"
   and     "distinct A\<^sub>P"
   and     "distinct A\<^sub>R"
   and     "A\<^sub>R \<sharp>* A\<^sub>P"
   and     "A\<^sub>R \<sharp>* A\<^sub>Q"
   and     "A\<^sub>R \<sharp>* \<Psi>"
   and     "A\<^sub>R \<sharp>* P"
   and     "A\<^sub>R \<sharp>* Q"
   and     "A\<^sub>R \<sharp>* R"
   and     "A\<^sub>R \<sharp>* K"
   and     "A\<^sub>P \<sharp>* \<Psi>"
   and     "A\<^sub>P \<sharp>* R"
   and     "A\<^sub>P \<sharp>* P"
   and     "A\<^sub>P \<sharp>* M"
   and     "A\<^sub>Q \<sharp>* R"
   and     "A\<^sub>Q \<sharp>* M"
   and     "A\<^sub>R \<sharp>* xvec"
   and     "xvec \<sharp>* M"
 
   obtains  K' where "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'" and "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "A\<^sub>R \<sharp>* K'"
 proof -
   from \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* Q\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> FrP FrQ have "A\<^sub>R \<sharp>* \<Psi>\<^sub>P" and "A\<^sub>R \<sharp>* \<Psi>\<^sub>Q"
     by(force dest: extractFrameFreshChain)+
   assume Assumptions: "\<And>K'. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'; \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'; A\<^sub>R \<sharp>* K'\<rbrakk> \<Longrightarrow> thesis"
   {
     fix \<Psi>'::'b
     fix zvec::"name list"
     assume "A\<^sub>R \<sharp>* \<Psi>'"
     assume "A\<^sub>R \<sharp>* zvec"
     assume "A\<^sub>P \<sharp>* zvec"
     assume "zvec \<sharp>* R"
     assume "zvec \<sharp>* P"
     
     assume A: "\<Psi> \<otimes> \<Psi>\<^sub>Q \<simeq> \<Psi>'"
     with RTrans have "\<Psi>' \<rhd> R \<longmapsto>K\<lparr>N\<rparr> \<prec> R'" 
       by(rule statEqTransition)
     moreover note FrR \<open>distinct A\<^sub>R\<close>
     moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K"
       by(blast intro: statEqEnt Associativity AssertionStatEqSym)
     with A have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K" by(rule statEqEnt[OF Composition])
     moreover have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, (\<Psi> \<otimes> \<Psi>\<^sub>Q) \<otimes> \<Psi>\<^sub>R\<rangle>" using A
       by(blast dest: frameIntComposition FrameStatEqTrans FrameStatEqSym)
     with QimpP have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
       by(force intro: FrameStatEqImpCompose)
     moreover from PTrans have "distinct xvec" by(auto dest: boundOutputDistinct)
     ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R' \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"
       using PTrans FrP \<open>A\<^sub>R \<sharp>* K\<close> \<open>A\<^sub>R \<sharp>* \<Psi>'\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* R\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* R\<close> \<open>A\<^sub>Q \<sharp>* R\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<close>
                        \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* zvec\<close> \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>R \<sharp>* zvec\<close> \<open>zvec \<sharp>* R\<close> \<open>zvec \<sharp>* P\<close> \<open>distinct A\<^sub>P\<close>
                        \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>R \<sharp>* xvec\<close> \<open>xvec \<sharp>* M\<close>
     proof(nominal_induct avoiding: \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec arbitrary: M rule: inputFrameInduct)
       case(cAlpha \<Psi>' R K N R' A\<^sub>R \<Psi>\<^sub>R p \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       have S: "set p \<subseteq> set A\<^sub>R \<times> set (p \<bullet> A\<^sub>R)" by fact
       from \<open>\<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<turnstile> M \<leftrightarrow> K\<close> have "(p \<bullet> (\<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<turnstile> (p \<bullet> M) \<leftrightarrow> (p \<bullet> K)"
         by(rule chanEqClosed)
       with \<open>A\<^sub>R \<sharp>* \<Psi>'\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>'\<close> \<open>A\<^sub>R \<sharp>* K\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* K\<close> S \<open>distinctPerm p\<close>
       have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K" by(simp add: eqvts)
       moreover from \<open>\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> S \<open>A\<^sub>R \<sharp>* P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* xvec\<close> \<open>xvec \<sharp>* M\<close> 
       have "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"  
         using outputPermFrameSubject by(auto simp add: residualInject)
       with \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> S \<open>distinctPerm p\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>(p \<bullet> M)\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
         by(simp add: eqvts)
       moreover from \<open>A\<^sub>P \<sharp>* M\<close> have "(p \<bullet> A\<^sub>P) \<sharp>* (p \<bullet> M)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>P\<close> S have "A\<^sub>P \<sharp>* (p \<bullet> M)" by simp
       moreover from \<open>A\<^sub>Q \<sharp>* M\<close> have "(p \<bullet> A\<^sub>Q) \<sharp>* (p \<bullet> M)" 
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>Q\<close> S have "A\<^sub>Q \<sharp>* (p \<bullet> M)" by simp
 
       moreover from \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle>\<close>
       have "(p \<bullet> \<langle>A\<^sub>Q, \<Psi>' \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle>) \<hookrightarrow>\<^sub>F (p \<bullet> \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> (p \<bullet> \<Psi>\<^sub>R)\<rangle>)"
         by(rule FrameStatImpClosed)
       with \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* \<Psi>'\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>'\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>Q\<close>
            \<open>(p \<bullet> A\<^sub>R) \<sharp>* A\<^sub>Q\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> S \<open>distinctPerm p\<close>
       have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>" by(simp add: eqvts)
       moreover from \<open>xvec \<sharp>* M\<close> have "(p \<bullet> xvec) \<sharp>* (p \<bullet> M)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with S \<open>A\<^sub>R \<sharp>* xvec\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* xvec\<close> have "xvec \<sharp>* (p \<bullet> M)" by simp
       ultimately obtain K' where "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'" and "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         using cAlpha
         by(fastforce simp del: freshChainSimps)
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'\<close> S \<open>A\<^sub>R \<sharp>* R\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* R\<close> have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P)) \<rhd> R \<longmapsto>(p \<bullet> K')\<lparr>N\<rparr> \<prec> R'"
         by(rule_tac inputPermFrameSubject) auto
       with S \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>(p \<bullet> K')\<lparr>N\<rparr> \<prec> R'"
         by(simp add: eqvts)
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> (p \<bullet> M) \<leftrightarrow> K'\<close> have "(p \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R))\<turnstile> (p \<bullet> p \<bullet> M) \<leftrightarrow> (p \<bullet> K')"
         by(rule chanEqClosed)
       with S \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>P\<close> \<open>distinctPerm p\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<turnstile> M \<leftrightarrow> (p \<bullet> K')"
         by(simp add: eqvts)
       moreover from \<open>zvec \<sharp>* K'\<close> have "(p \<bullet> zvec) \<sharp>* (p \<bullet> K')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       with \<open>A\<^sub>R \<sharp>* zvec\<close> \<open>(p \<bullet> A\<^sub>R) \<sharp>* zvec\<close> S have "zvec \<sharp>* (p \<bullet> K')" by simp
       moreover from \<open>A\<^sub>R \<sharp>* K'\<close> have "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> K')"
         by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
       ultimately show ?case by blast
     next
       case(cInput \<Psi>' M' K xvec N Tvec R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec yvec M)
       from \<open>A\<^sub>P \<sharp>* (M'\<lparr>\<lambda>*xvec N\<rparr>.R)\<close> \<open>A\<^sub>Q \<sharp>* (M'\<lparr>\<lambda>*xvec N\<rparr>.R)\<close> \<open>zvec \<sharp>* (M'\<lparr>\<lambda>*xvec N\<rparr>.R)\<close>
       have "A\<^sub>P \<sharp>* M'" and "A\<^sub>Q \<sharp>* M'" and "zvec \<sharp>* M'" by simp+
       
       from \<open>\<Psi>' \<turnstile> M' \<leftrightarrow> K\<close>
       have "\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> K"
         by(blast intro: statEqEnt Identity AssertionStatEqSym)
       hence "\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> M'"
         by(blast intro: chanEqSym chanEqTrans)
       with \<open>A\<^sub>Q \<sharp>* M'\<close>
       have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M' \<leftrightarrow> M'"
         by(force intro: frameImpI)
       
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
       have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M' \<leftrightarrow> M'"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* M'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> M' \<leftrightarrow> M'" 
         by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> M' \<leftrightarrow> M'" by(blast intro: statEqEnt Identity)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> M'\<lparr>\<lambda>*xvec N\<rparr>.R \<longmapsto>M'\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> R[xvec::=Tvec]"
         using \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
         by(rule Input)
       
       moreover from \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> K\<close> \<open>\<Psi>' \<otimes> \<one> \<turnstile> M' \<leftrightarrow> K\<close>
       have "\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'" by(metis chanEqSym chanEqTrans)
       with \<open>A\<^sub>Q \<sharp>* M\<close> \<open>A\<^sub>Q \<sharp>* M'\<close>
       have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> M'"
         by(force intro: frameImpI)
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle> \<close>
       have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F M \<leftrightarrow> M'"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* M'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'" 
         by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity)
       ultimately show ?case using \<open>zvec \<sharp>* M'\<close>
         by force
     next
       case(cCase \<Psi>' R M' N R' \<phi> Cs A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       from \<open>guarded R\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "\<Psi>\<^sub>R \<simeq> \<one>"
         by(metis guardedStatEq)
       with \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'\<close> have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> M'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
       moreover have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
       proof -
         from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>Q,  \<Psi>' \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
         moreover from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>R  \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
       moreover from \<open>zvec \<sharp>* (Cases Cs)\<close> \<open>A\<^sub>P \<sharp>* (Cases Cs)\<close>  \<open>A\<^sub>Q \<sharp>* (Cases Cs)\<close> \<open>(\<phi>, R) mem Cs\<close>
       have "A\<^sub>P \<sharp>* R" and "A\<^sub>Q \<sharp>* R" and "zvec \<sharp>* R" and "A\<^sub>P \<sharp>* \<phi>" and "A\<^sub>Q \<sharp>* \<phi>"
         by(auto dest: memFreshChain)
       ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'\<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"  using cCase
         by(rule_tac cCase) (assumption |simp)+
       then  obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         by metis
       note RTrans \<open>(\<phi>, R) mem Cs\<close>
       moreover from \<open>\<Psi>' \<turnstile> \<phi>\<close> have "\<Psi>' \<otimes> \<one> \<turnstile> \<phi>" by(blast intro: statEqEnt Identity AssertionStatEqSym)
       with \<open>A\<^sub>Q \<sharp>* \<phi>\<close> have "(\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>" by(force intro: frameImpI)
       with \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close> have "(\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>) \<turnstile>\<^sub>F \<phi>"
         by(simp add: FrameStatImp_def)
       with \<open>A\<^sub>P \<sharp>* \<phi>\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one> \<turnstile> \<phi>"  by(force dest: frameImpE)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<turnstile> \<phi>" by(blast intro: statEqEnt Identity) 
       ultimately have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Cases Cs \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'"  using \<open>guarded R\<close> by(rule Case)
       moreover from MeqK' \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close>
         by force
     next
       case(cPar1 \<Psi>' \<Psi>\<^sub>R\<^sub>2 R\<^sub>1 M' N R\<^sub>1' A\<^sub>R\<^sub>2 R\<^sub>2 A\<^sub>R\<^sub>1 \<Psi>\<^sub>R\<^sub>1 \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       have FrR2: "extractFrame R\<^sub>2 = \<langle>A\<^sub>R\<^sub>2, \<Psi>\<^sub>R\<^sub>2\<rangle>" by fact
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'\<close> have "(\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity Composition Commutativity)
       moreover have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle>"
       proof -
         have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>\<close>
         moreover have  "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
         by(metis statEqTransition Associativity Composition Commutativity)
       moreover from \<open>A\<^sub>R\<^sub>1 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (R\<^sub>1 \<parallel> R\<^sub>2)\<close> \<open>extractFrame R\<^sub>1 = \<langle>A\<^sub>R\<^sub>1, \<Psi>\<^sub>R\<^sub>1\<rangle>\<close> FrR2 have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>1" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>2"
         by(force dest: extractFrameFreshChain)+
         moreover note \<open>distinct xvec\<close>
 
       ultimately have "\<exists>K'. (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>1 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>1' \<and> (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> K' \<and> (A\<^sub>R\<^sub>2@zvec) \<sharp>* K' \<and> A\<^sub>R\<^sub>1 \<sharp>* K'" using cPar1
         by(rule_tac cPar1(6)[where bf=xvec]) (assumption | simp | fastforce)+
       then  obtain K' where RTrans: "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>1 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>1'"
                         and MeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>2) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<turnstile> M \<leftrightarrow> K'"  and "A\<^sub>R\<^sub>2 \<sharp>* K'" and "zvec \<sharp>* K'" and "A\<^sub>R\<^sub>1 \<sharp>* K'"
         by force
       
       from RTrans have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> R\<^sub>1 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>1'"
         by(metis statEqTransition Associativity Composition Commutativity)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> (R\<^sub>1 \<parallel> R\<^sub>2) \<longmapsto>K'\<lparr>N\<rparr> \<prec> (R\<^sub>1' \<parallel> R\<^sub>2)" using FrR2 \<open>A\<^sub>R\<^sub>2 \<sharp>* \<Psi>\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* R\<^sub>1\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* N\<close>
         by(force intro: Par1)
       moreover from MeqK' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close>
         by force
     next
       case(cPar2 \<Psi>' \<Psi>\<^sub>R\<^sub>1 R\<^sub>2 M' N R\<^sub>2' A\<^sub>R\<^sub>1 R\<^sub>1 A\<^sub>R\<^sub>2 \<Psi>\<^sub>R\<^sub>2 \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       have FrR1: "extractFrame R\<^sub>1 = \<langle>A\<^sub>R\<^sub>1, \<Psi>\<^sub>R\<^sub>1\<rangle>" by fact
       from \<open>\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'\<close> have "(\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> M'"
         by(metis statEqEnt Associativity Composition Commutativity)
       moreover have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
       proof -
         have "\<langle>A\<^sub>Q, (\<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>\<close>
         moreover have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, ((\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>2\<rangle>"
           by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> have "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>R\<^sub>2 \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
         by(metis statEqTransition Associativity Composition Commutativity)
       moreover from \<open>A\<^sub>R\<^sub>1 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (R\<^sub>1 \<parallel> R\<^sub>2)\<close> FrR1 \<open>extractFrame R\<^sub>2 = \<langle>A\<^sub>R\<^sub>2, \<Psi>\<^sub>R\<^sub>2\<rangle>\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>1" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<^sub>2"
         by(force dest: extractFrameFreshChain)+
       ultimately have "\<exists>K'. (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>2 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>2' \<and> (\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K' \<and> (A\<^sub>R\<^sub>1@zvec) \<sharp>* K' \<and> A\<^sub>R\<^sub>2 \<sharp>* K'" using \<open>distinct xvec\<close> cPar2
         by(rule_tac cPar2(6)) (assumption | simp | fastforce)+
       then  obtain K' where RTrans: "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<rhd> R\<^sub>2 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>2'"
                         and MeqK': "(\<Psi> \<otimes> \<Psi>\<^sub>R\<^sub>1) \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"  and "A\<^sub>R\<^sub>1 \<sharp>* K'" and "zvec \<sharp>* K'" and "A\<^sub>R\<^sub>2 \<sharp>* K'"
         by force
       
       from RTrans have "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R\<^sub>1 \<rhd> R\<^sub>2 \<longmapsto>K'\<lparr>N\<rparr> \<prec> R\<^sub>2'"
         by(metis statEqTransition Associativity Composition Commutativity)
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> (R\<^sub>1 \<parallel> R\<^sub>2) \<longmapsto>K'\<lparr>N\<rparr> \<prec> (R\<^sub>1 \<parallel> R\<^sub>2')" using FrR1 \<open>A\<^sub>R\<^sub>1 \<sharp>* \<Psi>\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* R\<^sub>2\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* N\<close>
         by(force intro: Par2)
       moreover from MeqK' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<^sub>1 \<otimes> \<Psi>\<^sub>R\<^sub>2 \<turnstile> M \<leftrightarrow> K'"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>1 \<sharp>* K'\<close> \<open>A\<^sub>R\<^sub>2 \<sharp>* K'\<close>
         by force
     next
       case(cScope \<Psi>' R M' N R' x A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       then have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R' \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'" 
         by(rule_tac cScope(4)) (assumption | simp del: freshChainSimps)+
       then  obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         by metis
       from \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* (\<lparr>\<nu>x\<rparr>R)\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "A\<^sub>P \<sharp>* \<Psi>\<^sub>R"
         by(force dest: extractFrameFreshChain)+
       from \<open>\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>\<close> \<open>distinct A\<^sub>P\<close> \<open>x \<sharp> P\<close> \<open>zvec \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* \<Psi>\<^sub>R\<close> \<open>x \<sharp> A\<^sub>P\<close> \<open>A\<^sub>P \<sharp>* M\<close> \<open>A\<^sub>P \<sharp>* P\<close> \<open>A\<^sub>P \<sharp>* zvec\<close>  \<open>A\<^sub>P \<sharp>* \<Psi>\<close> \<open>A\<^sub>P \<sharp>* zvec\<close> \<open>A\<^sub>R \<sharp>* P\<close> \<open>A\<^sub>R \<sharp>* A\<^sub>P\<close> \<open>xvec \<sharp>* M\<close> \<open>distinct xvec\<close>
       obtain K'' where MeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>P \<turnstile> M \<leftrightarrow> K''" and "x \<sharp> K''" and "A\<^sub>R \<sharp>* K''" and "zvec \<sharp>* K''"
         by(rule_tac B="(x#A\<^sub>R@zvec)" in obtainPrefix) (assumption | simp | force | metis freshChainSym)+
       
       from MeqK'' MeqK' have KeqK'': "(\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<turnstile> K' \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
       with RTrans \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> \<open>distinct A\<^sub>R\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>P\<close> \<open>A\<^sub>R \<sharp>* K'\<close> \<open>A\<^sub>R \<sharp>* K''\<close> \<open>A\<^sub>R \<sharp>* R\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K''\<lparr>N\<rparr> \<prec> R'"
         by(rule_tac inputRenameSubject) (assumption | force)+
       hence "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> \<lparr>\<nu>x\<rparr>R \<longmapsto>K''\<lparr>N\<rparr> \<prec> \<lparr>\<nu>x\<rparr>R'" using \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> \<Psi>\<^sub>P\<close> \<open>x \<sharp> K''\<close> \<open>x \<sharp> N\<close>
         by(rule_tac Scope) (assumption | force)+
       moreover from MeqK'' have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K''"
         by(metis statEqEnt Associativity Composition Commutativity)
       ultimately show ?case using \<open>zvec \<sharp>* K''\<close> \<open>x \<sharp> K''\<close> \<open>A\<^sub>R \<sharp>* K''\<close>
         by force
     next
       case(cBang \<Psi>' R M' N R' A\<^sub>R \<Psi>\<^sub>R \<Psi> P A\<^sub>P \<Psi>\<^sub>P A\<^sub>Q zvec xvec M)
       from \<open>guarded R\<close> \<open>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>\<close> have "\<Psi>\<^sub>R \<simeq> \<one>"
         by(metis guardedStatEq)
       with \<open>\<Psi>' \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'\<close> have "\<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> M'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
       moreover have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle>"
       proof -
         from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         moreover note \<open>\<langle>A\<^sub>Q, \<Psi>' \<otimes> \<one>\<rangle> \<hookrightarrow>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle>\<close>
         moreover  from \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<one>\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>P) \<otimes> \<Psi>\<^sub>R \<otimes> \<one>\<rangle>"
           by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
         ultimately show ?thesis by(rule FrameStatEqImpCompose)
       qed
       moreover from \<open>\<Psi> \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'\<close> \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close>
       have "\<Psi> \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
       ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<parallel> !R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'\<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> K' \<and> zvec \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"  using cBang
         by(rule_tac cBang(5)) (assumption | simp del: freshChainSimps)+
       then  obtain K' where RTrans: "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<parallel> !R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'"
                         and MeqK': "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'" and "zvec \<sharp>* K'" and "A\<^sub>R \<sharp>* K'"
         by metis
       from RTrans \<open>guarded R\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> !R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R'" by(rule Bang)
       moreover from MeqK' \<open>\<Psi>\<^sub>R \<simeq> \<one>\<close> have "\<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<one> \<turnstile> M \<leftrightarrow> K'"
         by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
       ultimately show ?case using \<open>zvec \<sharp>* K'\<close>
         by force
     qed
   }
   note Goal = this
   have "\<Psi> \<otimes> \<Psi>\<^sub>Q \<simeq> \<Psi> \<otimes> \<Psi>\<^sub>Q" by(simp add: AssertionStatEqRefl)
   moreover from \<open>A\<^sub>R \<sharp>* \<Psi>\<close> \<open>A\<^sub>R \<sharp>* \<Psi>\<^sub>Q\<close> have "A\<^sub>R \<sharp>* (\<Psi> \<otimes> \<Psi>\<^sub>Q)" by force
   ultimately have "\<exists>K'. \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> R \<longmapsto>K'\<lparr>N\<rparr> \<prec> R' \<and> \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R \<turnstile> M \<leftrightarrow> K' \<and> ([]::name list) \<sharp>* K' \<and> A\<^sub>R \<sharp>* K'"
     by(rule_tac Goal) (assumption | force)+
   with Assumptions show ?thesis
     by blast
 qed
 
 end
 
 end
diff --git a/thys/Relation_Algebra/Relation_Algebra.thy b/thys/Relation_Algebra/Relation_Algebra.thy
--- a/thys/Relation_Algebra/Relation_Algebra.thy
+++ b/thys/Relation_Algebra/Relation_Algebra.thy
@@ -1,300 +1,300 @@
 (* Title:      Relation Algebra
    Author:     Alasdair Armstrong, Simon Foster, Georg Struth, Tjark Weber
    Maintainer: Georg Struth <g.struth at sheffield.ac.uk>
                Tjark Weber <tjark.weber at it.uu.se>
 *)
 
 section \<open>Relation Algebra\<close>
 
 theory Relation_Algebra
   imports More_Boolean_Algebra Kleene_Algebra.Kleene_Algebra
 begin
 
 text \<open>We follow Tarski's original article and Maddux's book, in particular we
 use their notation. In contrast to Schmidt and Str\"ohlein we do not assume
 that the Boolean algebra is complete and we do not consider the Tarski rule in
 this development.
 
 A main reason for using complete Boolean algebras seems to be that the
 Knaster-Tarski fixpoint theorem becomes available for defining notions of
 iteration. In fact, several chapters of Schmidt and Str\"ohlein's book deal
 with iteration.
 
 We capture iteration in an alternative way by linking relation algebras with
 Kleene algebras (cf.~\emph{relation-algebra-rtc}).\<close>
 
 class relation_algebra = boolean_algebra +
   fixes composition :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl ";" 75)
     and converse :: "'a \<Rightarrow> 'a" ("(_\<^sup>\<smile>)" [1000] 999)
-    and unit :: "'a" ("1'")
+    and unit :: "'a" ("1''")
   assumes comp_assoc: "(x ; y) ; z = x ; (y ; z)"
     and comp_unitr [simp]: "x ; 1' = x"
     and comp_distr: "(x + y) ; z = x ; z + y ; z"
     and conv_invol [simp]: "(x\<^sup>\<smile>)\<^sup>\<smile> = x"
     and conv_add [simp]: "(x + y)\<^sup>\<smile> = x\<^sup>\<smile> + y\<^sup>\<smile>"
     and conv_contrav [simp]: "(x ; y)\<^sup>\<smile> = y\<^sup>\<smile> ; x\<^sup>\<smile>"
     and comp_res: "x\<^sup>\<smile> ; -(x ; y) \<le> -y"
 
 text \<open>We first show that every relation algebra is a dioid. We do not yet
 treat the zero (the minimal element of the boolean reduct) since the proof of
 the annihilation laws is rather tricky to automate. Following Maddux we derive
 them from properties of Boolean algebras with operators.\<close>
 
 sublocale relation_algebra \<subseteq> dioid_one "(+)" "(;)" "(\<le>) " "(<)" "1'"
 proof
   fix x y z :: 'a
   show "x ; y ; z = x ; (y ; z)"
     by (fact comp_assoc)
   show "x + y + z = x + (y + z)"
     by (metis sup.commute sup.left_commute)
   show "x + y = y + x"
     by (fact sup.commute)
   show "(x + y) ; z = x ; z + y ; z"
     by (fact comp_distr)
   show "x + x = x"
     by (fact sup.idem)
   show "x ; (y + z) = x ; y + x ; z"
     by (metis conv_invol conv_add conv_contrav comp_distr)
   show "x ; 1' = x"
     by (fact comp_unitr)
   show "1' ; x = x"
     by (metis comp_unitr conv_contrav conv_invol)
   show "x \<le> y \<longleftrightarrow> x + y = y"
     by (metis sup.commute sup_absorb1 sup_ge1)
   show "x < y \<longleftrightarrow> x \<le> y \<and> x \<noteq> y"
     by (fact less_le)
 qed
 
 context relation_algebra
 begin
 
 text \<open>First we prove some basic facts about joins and meets.\<close>
 
 lemma meet_interchange: "(w \<cdot> x) ; (y \<cdot> z) \<le> w ; y \<cdot> x ; z"
 by (metis inf_le1 inf_le2 le_infI mult_isol_var)
 
 lemma join_interchange: "w ; x + y ; z \<le> (w + y) ; (x + z)"
 using local.mult_isol_var local.sup.bounded_iff local.sup.cobounded2 local.sup_ge1 by presburger
 
 text \<open>We now prove some simple facts about conversion.\<close>
 
 lemma conv_iso: "x \<le> y \<longleftrightarrow> x\<^sup>\<smile> \<le> y\<^sup>\<smile>"
 by (metis conv_add conv_invol le_iff_sup)
 
 lemma conv_zero [simp]: "0\<^sup>\<smile> = 0"
 by (metis conv_add conv_invol sup_bot_right sup_eq_bot_iff)
 
 lemma conv_one [simp]: "1\<^sup>\<smile> = 1"
 by (metis conv_add conv_invol sup_top_left sup_top_right)
 
 lemma conv_compl_aux: "(-x)\<^sup>\<smile> = (-x)\<^sup>\<smile> + (-x\<^sup>\<smile>)"
 by (metis aux9 conv_add conv_one double_compl galois_aux4 inf.commute less_eq_def sup.commute sup_top_left)
 
 lemma conv_compl: "(-x)\<^sup>\<smile> = -(x\<^sup>\<smile>)"
 by (metis add_commute conv_add conv_compl_aux conv_invol)
 
 lemma comp_res_aux [simp]: "x\<^sup>\<smile> ; -(x ; y) \<cdot> y = 0"
 by (metis comp_res galois_aux)
 
 lemma conv_e [simp]: "1'\<^sup>\<smile> = 1'"
 by (metis comp_unitr conv_contrav conv_invol)
 
 lemma conv_times [simp]: "(x \<cdot> y)\<^sup>\<smile> = x\<^sup>\<smile> \<cdot> y\<^sup>\<smile>"
 by (metis compl_inf double_compl conv_add conv_compl)
 
 text \<open>The next lemmas show that conversion is self-conjugate in the sense of
 Boolean algebra with operators.\<close>
 
 lemma conv_self_conjugate: "x\<^sup>\<smile> \<cdot> y = 0 \<longleftrightarrow> x \<cdot> y\<^sup>\<smile> = 0"
 by (metis conv_invol conv_times conv_zero)
 
 lemma conv_self_conjugate_var: "is_conjugation converse converse"
 by (metis conv_self_conjugate is_conjugation_def)
 
 text \<open>The following lemmas link the relative product and meet.\<close>
 
 lemma one_idem_mult [simp]: "1 ; 1 = 1"
 by (metis compl_eq_compl_iff galois_aux2 inf.commute inf_top_right mult_1_left mult_isor top_greatest)
 
 lemma mult_subdistl: "x ; (y \<cdot> z) \<le> x ; y"
 by (metis inf_le1 mult_isol)
 
 lemma mult_subdistr: "(x \<cdot> y) ; z \<le> x ; z"
 by (metis inf_le1 mult_isor)
 
 lemma mult_subdistr_var: "(x \<cdot> y) ; z \<le> x ; z \<cdot> y ; z"
 by (metis inf.commute le_inf_iff mult_subdistr)
 
 text \<open>The following lemmas deal with variants of the Peirce law, the
 Schr\"oder laws and the Dedekind law. Some of them are obtained from Boolean
 algebras with operators by instantiation, using conjugation properties.
 However, Isabelle does not always pick up this relationship.\<close>
 
 lemma peirce_1: "x ; y \<cdot> z\<^sup>\<smile> = 0 \<Longrightarrow> y ; z \<cdot> x\<^sup>\<smile> = 0"
 by (metis compl_le_swap1 conv_contrav conv_self_conjugate galois_aux comp_res conv_invol galois_aux mult_isol order_trans)
 
 lemma peirce: "x ; y \<cdot> z\<^sup>\<smile> = 0 \<longleftrightarrow> y ; z \<cdot> x\<^sup>\<smile> = 0"
 by (metis peirce_1)
 
 lemma schroeder_1: "x ; y \<cdot> z = 0 \<longleftrightarrow> y \<cdot> x\<^sup>\<smile> ; z = 0"
 by (metis conv_invol peirce conv_contrav conv_invol conv_self_conjugate inf.commute)
 
 lemma schroeder_2: "y ; x \<cdot> z = 0 \<longleftrightarrow> y \<cdot> z ; x\<^sup>\<smile> = 0"
 by (metis conv_invol peirce schroeder_1)
 
 text \<open>The following two conjugation properties between multiplication with
 elements and their converses are used for deriving modular laws of relation
 algebra from those of Boolean algebras with operators.\<close>
 
 lemma schroeder_1_var: "is_conjugation (composition x) (composition (x\<^sup>\<smile>))"
 by (metis schroeder_1 is_conjugation_def)
 
 lemma schroeder_2_var: "is_conjugation (\<lambda>x. x ; y) (\<lambda>x. x ; y\<^sup>\<smile>)"
 by (unfold is_conjugation_def, metis schroeder_2)
 
 text \<open>The following Galois connections define residuals. They link relation
 algebras with action algebras. This could be further explored and formalised.
 \<close>
 
 lemma conv_galois_1: "x ; y \<le> z \<longleftrightarrow> y \<le> -(x\<^sup>\<smile> ; -z)"
 by (metis galois_aux galois_aux2 schroeder_1)
 
 lemma conv_galois_2: "y ; x \<le> z \<longleftrightarrow> y \<le> -(-z ; x\<^sup>\<smile>)"
 by (metis galois_aux galois_aux2 schroeder_2)
 
 text \<open>Variants of the modular law for relation algebras can now be
 instantiated from Boolean algebras with operators.\<close>
 
 lemma modular_1_aux': "x ; (y \<cdot> -(x\<^sup>\<smile> ; z)) \<cdot> z = 0"
 by (metis schroeder_1_var modular_1_aux)
 
 lemma modular_2_aux': "(y \<cdot> -(z ; x\<^sup>\<smile>)) ; x \<cdot> z = 0"
 by (metis modular_1_aux schroeder_2_var)
 
 lemma modular_1': "x ; y \<cdot> z = x ; (y \<cdot> x\<^sup>\<smile> ; z) \<cdot> z"
 by (metis schroeder_1_var modular_1)
 
 lemma modular_2': "y ; x \<cdot> z = (y \<cdot> z ; x\<^sup>\<smile>) ; x \<cdot> z"
 proof -
   have "y ; x \<cdot> z = (y \<cdot> z ; x\<^sup>\<smile>) ; x \<cdot> z + (y \<cdot> -(z ; x\<^sup>\<smile>)) ; x \<cdot> z"
     by (metis aux4 distrib_right inf.commute inf_sup_distrib1)
   thus ?thesis
     by (metis sup_bot_right modular_2_aux')
 qed
 
 lemma modular_1_var: "x ; y \<cdot> z \<le> x ; (y \<cdot> x\<^sup>\<smile> ; z)"
 by (metis inf.commute inf_le2 modular_1')
 
 lemma modular_2_var: "x ; y \<cdot> z \<le> (x \<cdot> z ; y\<^sup>\<smile>) ; y"
 by (metis inf.commute inf_le2 modular_2')
 
 lemma modular_var_2: "x ; y \<le> x ; (y \<cdot> x\<^sup>\<smile> ; 1)"
 by (metis inf_top_right modular_1_var)
 
 lemma modular_var_3: "x ; y \<le> (x \<cdot> 1 ; y\<^sup>\<smile>) ; y"
 by (metis inf_top_right modular_2_var)
 
 text \<open>The modular laws are used to prove the Dedekind rule.\<close>
 
 lemma dedekind: "x ; y \<cdot> z \<le> (x \<cdot> z ; y\<^sup>\<smile>) ; (y \<cdot> x\<^sup>\<smile> ; z)"
 proof -
   have "x ; y \<cdot> z \<le> (x \<cdot> z ; y\<^sup>\<smile>) ; (y \<cdot> ((x \<cdot> z ; y\<^sup>\<smile>)\<^sup>\<smile> ; z))"
     by (metis modular_2' modular_1_var)
   also have "\<dots> \<le> (x \<cdot> z ; y\<^sup>\<smile>) ; (y \<cdot> x\<^sup>\<smile> ; z)"
     by (metis conv_iso inf_le1 inf_mono mult_isol mult_isor order_refl)
   thus ?thesis
     by (metis calculation order_trans)
 qed
 
 lemma dedekind_var_1: "x ; y \<le> (x \<cdot> 1 ; y\<^sup>\<smile>) ; (y \<cdot> x\<^sup>\<smile> ; 1)"
 by (metis dedekind inf.commute inf_top_left)
 
 end (* relation_algebra *)
 
 text \<open>The Schr\"oder laws allow us, finally, to prove the annihilation laws
 for zero. We formalise this by proving that relation algebras form dioids with
 zero.\<close>
 
 sublocale relation_algebra < dioid_one_zero "(+)" "(;)" "1'" 0 "(\<le>)" "(<)"
 proof
   fix x :: 'a
   show "0 + x = x"
     by (fact sup_bot_left)
   show "0 ; x = 0"
     by (metis f_strict schroeder_2_var)
   show "x ; 0 = 0"
     by (metis f_strict schroeder_1_var)
 qed
 
 context relation_algebra
 begin
 
 text \<open>Next we prove miscellaneous properties which we found in the books of
 Maddux and Schmidt and Str\"ohlein. Most of them do not carry any meaningful
 names.\<close>
 
 lemma ra_1: "(x \<cdot> y ; 1) ; z = x ; z \<cdot> y ; 1"
 proof (rule antisym)
   show "x ; z \<cdot> y ; 1 \<le> (x \<cdot> y ; 1) ; z"
     by (metis modular_2_var comp_assoc order_trans eq_refl inf_mono inf_top_left mult_isor mult_subdistl)
   show "(x \<cdot> y ; 1) ; z \<le> x ; z \<cdot> y ; 1"
     by (metis inf.commute inf_greatest inf_top_left mult.assoc mult_subdistl mult_subdistr order_trans)
 qed
 
 lemma ra_2: "x ; (z \<cdot> y ; 1) = (x \<cdot> (y ; 1)\<^sup>\<smile>) ; z"
 proof (rule antisym)
   have "(x \<cdot> 1 ; (z \<cdot> y ; 1)\<^sup>\<smile>) ; z \<le> (x \<cdot> (y ; 1)\<^sup>\<smile>) ; z"
     by (metis conv_contrav conv_invol conv_one conv_times inf.idem inf.left_commute le_iff_inf meet_assoc mult_isor ra_1)
   thus "x ; (z \<cdot> y ; 1) \<le> (x \<cdot> (y ; 1)\<^sup>\<smile>) ; z"
     by (metis modular_var_3 mult_subdistl order_trans)
 next
   have "x ; (z \<cdot> ((x \<cdot> (y ; 1)\<^sup>\<smile>)\<^sup>\<smile> ; 1)) \<le> x ; (z \<cdot> y ; 1)"
     by (metis conv_invol conv_times eq_refl inf_le2 inf_mono mult.assoc mult_isol mult_isor one_idem_mult)
   thus "x ; (z \<cdot> y ; 1) \<ge> (x \<cdot> (y ; 1)\<^sup>\<smile>) ; z"
     by (metis modular_var_2 mult_subdistr order_trans)
 qed
 
 lemma one_conv: "1' \<cdot> x ; 1 = 1' \<cdot> x ; x\<^sup>\<smile>"
 by (metis inf.commute inf_top_left modular_1' mult.right_neutral)
 
 lemma maddux_12: "-(y ; x) ; x\<^sup>\<smile> \<le> -y"
 by (metis galois_aux inf.commute inf_compl_bot schroeder_2)
 
 lemma maddux_141: "x ; y \<cdot> z = 0 \<longleftrightarrow> x\<^sup>\<smile> ; z \<cdot> y = 0"
 by (metis inf.commute schroeder_1)
 
 lemma maddux_142: "x\<^sup>\<smile> ; z \<cdot> y = 0 \<longleftrightarrow> z ; y\<^sup>\<smile> \<cdot> x = 0"
 by (metis inf.commute schroeder_1 schroeder_2)
 
 lemmas maddux_16 = modular_1_var
 
 lemmas maddux_17 = modular_2_var
 
 lemma maddux_20: "x \<le> x ; 1"
 by (metis inf_top_left mult.right_neutral mult_subdistl)
 
 lemma maddux_21: "x \<le> 1 ; x"
 by (metis mult_isor mult_onel top_greatest)
 
 lemma maddux_23: "x ; y \<cdot> -(x ; z) = x ; (y \<cdot> -z) \<cdot> -(x ; z)"
 apply (rule antisym)
 apply (metis local.aux6 local.aux6_var local.aux9 local.compl_inf_bot local.compl_sup_top local.compl_unique local.distrib_left local.galois_2 local.sup_ge2)
 using local.meet_iso local.mult_subdistl by blast
 
 lemma maddux_24: "-(x ; y) + x ; z = -(x ; (y \<cdot> -z)) + x ; z"
 by (metis de_morgan_3 double_compl maddux_23)
 
 lemma one_compl: "-(x ; 1) ; 1 = -(x ; 1)"
 by (metis antisym conv_one maddux_12 mult.assoc one_idem_mult maddux_20)
 
 lemma ss_p18: "x ; 1 = 0 \<longleftrightarrow> x = 0"
 by (metis annil le_bot maddux_20)
 
 end (* relation_algebra *)
 
 text \<open>This finishes our development of the basic laws of relation algebras.
 The next sections are devoted to special elements such as vectors, test or
 subidentities, and, in particular, functions.\<close>
 
 end
 
diff --git a/thys/Residuated_Lattices/Involutive_Residuated.thy b/thys/Residuated_Lattices/Involutive_Residuated.thy
--- a/thys/Residuated_Lattices/Involutive_Residuated.thy
+++ b/thys/Residuated_Lattices/Involutive_Residuated.thy
@@ -1,138 +1,138 @@
 (* Title:      Involutive Residuated Structures
    Author:     Victor Gomes
    Maintainer: Victor Gomes <vborgesferreiragomes1 at sheffield.ac.uk>
 *)
 
 section \<open>Involutive Residuated Structures\<close>
 
 theory Involutive_Residuated
   imports Residuated_Lattices
 begin
 
 class uminus' =
-  fixes uminus' :: "'a \<Rightarrow> 'a" ("-' _" [81] 80)
+  fixes uminus' :: "'a \<Rightarrow> 'a" ("-'' _" [81] 80)
 
 text \<open>
   Involutive posets is a structure where the double negation property holds for the 
   negation operations, and a Galois connection for negations exists.
 \<close>
 class involutive_order = order + uminus + uminus' +
   assumes gn: "x \<le> -'y \<longleftrightarrow> y \<le> -x"
   and dn1[simp]: "-'(-x) = x"
   and dn2[simp]: "-(-'x) = x"
 (* The involutive pair (-', -) is compatible with multiplication *)
 class involutive_pogroupoid = order + times + involutive_order +
   assumes ipg1: "x\<cdot>y \<le> z \<longleftrightarrow> (-z)\<cdot>x \<le> -y"
   and ipg2: "x\<cdot>y \<le> z \<longleftrightarrow> y\<cdot>(-'z) \<le> -'x"
 begin
 
 lemma neg_antitone: "x \<le> y \<Longrightarrow> -y \<le> -x"
   by (metis local.dn1 local.gn)
 
 lemma neg'_antitone: "x \<le> y \<Longrightarrow> -'y \<le> -'x"
   by (metis local.dn2 local.gn)
   
 subclass pogroupoid
 proof
   fix x y z assume assm: "x \<le> y"
   show "x \<cdot> z \<le> y \<cdot> z"
     by (metis assm local.ipg2 local.order_refl local.order_trans neg'_antitone)
   show "z \<cdot> x \<le> z \<cdot> y"
     by (metis assm local.dual_order.trans local.ipg1 local.order_refl neg_antitone)
 qed
 
 abbreviation inv_resl :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
   "inv_resl y x \<equiv> -(x\<cdot>(-'y))"
   
 abbreviation inv_resr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
   "inv_resr x y \<equiv> -'((-y)\<cdot>x)"
 
 sublocale residuated_pogroupoid _ _ _ inv_resl inv_resr
 proof
   fix x y z
   show "(x \<le> - (y \<cdot> -' z)) = (x \<cdot> y \<le> z)"
     by (metis local.gn local.ipg2)
   show "(x \<cdot> y \<le> z) = (y \<le> -' (- z \<cdot> x))"
     by (metis local.gn local.ipg1)
 qed
 
 end
 
 class division_order = order + residual_l_op + residual_r_op +
   assumes div_galois: "x \<le> z \<leftarrow> y \<longleftrightarrow> y \<le> x \<rightarrow> z"
   
 class involutive_division_order = division_order + involutive_order +
   assumes contraposition: "y \<rightarrow> -x = -'y \<leftarrow> x"
   
 context involutive_pogroupoid begin
   
 sublocale involutive_division_order _ _ inv_resl inv_resr 
 proof
   fix x y z
   show "(x \<le> - (y \<cdot> -' z)) = (y \<le> -' (- z \<cdot> x))"
     by (metis local.gn local.ipg1 local.ipg2)
   show "-' (- (- x) \<cdot> y) = - (x \<cdot> -' (-' y))"
     by (metis local.dn1 local.dn2 local.eq_iff local.gn local.jipsen1l local.jipsen1r local.resl_galois local.resr_galois)
 qed
 
 lemma inv_resr_neg [simp]: "inv_resr (-x) (-y) = inv_resl x y"
   by (metis local.contraposition local.dn1)
 
 lemma inv_resl_neg' [simp]: "inv_resl (-'x) (-'y) = inv_resr x y"
   by (metis local.contraposition local.dn2)
   
 lemma neg'_mult_resl: "-'((-y)\<cdot>(-x)) = inv_resl x (-'y)"
   by (metis inv_resr_neg local.dn2)
   
 lemma neg_mult_resr: "-((-'y)\<cdot>(-'x)) = inv_resr (-x) y"
   by (metis neg'_mult_resl)
   
 lemma resr_de_morgan1: "-'(inv_resr (-y) (-x)) = -'(inv_resl y x)"
   by (metis local.dn1 neg_mult_resr)
 
 lemma resr_de_morgan2: "-(inv_resl (-'x) (-'y)) = -(inv_resr x y)"
   by (metis inv_resl_neg')
   
 end
 
 text \<open>
   We prove that an involutive division poset is equivalent to an involutive po-groupoid
   by a lemma to avoid cyclic definitions
 \<close>
 lemma (in involutive_division_order) inv_pogroupoid: 
   "class.involutive_pogroupoid (\<lambda>x y. -(y \<rightarrow> -'x)) uminus uminus' (\<le>) (<)"
 proof
   fix x y z
   have "(- (y \<rightarrow> -' x) \<le> z) = (-z \<le> -y \<leftarrow> x)"
     by (metis local.contraposition local.dn1 local.dn2 local.gn local.div_galois)
   thus "(- (y \<rightarrow> -' x) \<le> z) = (- (x \<rightarrow> -' (- z)) \<le> - y)"
     by (metis local.contraposition local.div_galois local.dn1 local.dn2 local.gn)
   moreover have "(- (x \<rightarrow> -' (- z)) \<le> - y) = (- (-' z \<rightarrow> -' y) \<le> -' x)"
     apply (auto, metis local.contraposition local.div_galois local.dn1 local.dn2 local.gn)
     by (metis local.contraposition local.div_galois local.dn1 local.dn2 local.gn)
   ultimately show "(- (y \<rightarrow> -' x) \<le> z) = (- (-' z \<rightarrow> -' y) \<le> -' x)" 
     by metis
 qed
 
 context involutive_pogroupoid begin
 
 definition negation_constant :: "'a \<Rightarrow> bool" where
   "negation_constant a \<equiv> \<forall>x. -'x = inv_resr x a \<and> -x = inv_resl a x"   
   
 definition division_unit :: "'a \<Rightarrow> bool" where
   "division_unit a \<equiv> \<forall>x. x = inv_resr a x \<and> x = inv_resl x a"
   
 lemma neg_iff_div_unit: "(\<exists>a. negation_constant a) \<longleftrightarrow> (\<exists>b. division_unit b)"
   unfolding negation_constant_def division_unit_def
   apply safe
   apply (rule_tac x="-a" in exI, auto)
   apply (metis local.dn1 local.dn2)
   apply (metis local.dn2)
   apply (rule_tac x="-b" in exI, auto)
   apply (metis local.contraposition)
   apply (metis local.dn2)
 done
 
 end
 
 end
diff --git a/thys/Stone_Relation_Algebras/Relation_Algebras.thy b/thys/Stone_Relation_Algebras/Relation_Algebras.thy
--- a/thys/Stone_Relation_Algebras/Relation_Algebras.thy
+++ b/thys/Stone_Relation_Algebras/Relation_Algebras.thy
@@ -1,1817 +1,1817 @@
 (* Title:      Relation Algebras
    Author:     Walter Guttmann
    Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
 *)
 
 section \<open>Relation Algebras\<close>
 
 text \<open>
 The main structures introduced in this theory are Stone relation algebras.
 They generalise Tarski's relation algebras \cite{Tarski1941} by weakening the Boolean algebra lattice structure to a Stone algebra.
 Our motivation is to generalise relation-algebraic methods from unweighted graphs to weighted graphs.
 Unlike unweighted graphs, weighted graphs do not form a Boolean algebra because there is no complement operation on the edge weights.
 However, edge weights form a Stone algebra, and matrices over edge weights (that is, weighted graphs) form a Stone relation algebra.
 
 The development in this theory is described in our papers \cite{Guttmann2016c,Guttmann2017b}.
 Our main application there is the verification of Prim's minimum spanning tree algorithm.
 Related work about fuzzy relations \cite{Goguen1967,Winter2001b}, Dedekind categories \cite{KawaharaFurusawa2001} and rough relations \cite{Comer1993,Pawlak1996} is also discussed in these papers.
 In particular, Stone relation algebras do not assume that the underlying lattice is complete or a Heyting algebra, and they do not assume that composition has residuals.
 
 We proceed in two steps.
 First, we study the positive fragment in the form of single-object bounded distributive allegories \cite{FreydScedrov1990}.
 Second, we extend these structures by a pseudocomplement operation with additional axioms to obtain Stone relation algebras.
 
 Tarski's relation algebras are then obtained by a simple extension that imposes a Boolean algebra.
 See, for example, \cite{BirdMoor1997,HirschHodkinson2002,Maddux1996,Maddux2006,Schmidt2011,SchmidtStroehlein1993} for further details about relations and relation algebras, and \cite{AndrekaMikulas2011,BredihinSchein1978} for algebras of relations with a smaller signature.
 \<close>
 
 theory Relation_Algebras
 
 imports Stone_Algebras.P_Algebras Semirings
 
 begin
 
 subsection \<open>Single-Object Bounded Distributive Allegories\<close>
 
 text \<open>
 We start with developing bounded distributive allegories.
 The following definitions concern properties of relations that require converse in addition to lattice and semiring operations.
 \<close>
 
 class conv =
   fixes conv :: "'a \<Rightarrow> 'a" ("_\<^sup>T" [100] 100)
 
 class bounded_distrib_allegory_signature = inf + sup + times + conv + bot + top + one + ord
 begin
 
 subclass times_one_ord .
 subclass times_top .
 
 abbreviation total_var      :: "'a \<Rightarrow> bool" where "total_var x      \<equiv> 1 \<le> x * x\<^sup>T"
 abbreviation surjective_var :: "'a \<Rightarrow> bool" where "surjective_var x \<equiv> 1 \<le> x\<^sup>T * x"
 abbreviation univalent      :: "'a \<Rightarrow> bool" where "univalent x      \<equiv> x\<^sup>T * x \<le> 1"
 abbreviation injective      :: "'a \<Rightarrow> bool" where "injective x      \<equiv> x * x\<^sup>T \<le> 1"
 
 abbreviation mapping        :: "'a \<Rightarrow> bool" where "mapping x        \<equiv> univalent x \<and> total x"
 abbreviation bijective      :: "'a \<Rightarrow> bool" where "bijective x      \<equiv> injective x \<and> surjective x"
 
 abbreviation point          :: "'a \<Rightarrow> bool" where "point x          \<equiv> vector x \<and> bijective x"
 abbreviation arc            :: "'a \<Rightarrow> bool" where "arc x            \<equiv> bijective (x * top) \<and> bijective (x\<^sup>T * top)" (* earlier name: atom *)
 
 abbreviation symmetric      :: "'a \<Rightarrow> bool" where "symmetric x      \<equiv> x\<^sup>T = x"
 abbreviation antisymmetric  :: "'a \<Rightarrow> bool" where "antisymmetric x  \<equiv> x \<sqinter> x\<^sup>T \<le> 1"
 abbreviation asymmetric     :: "'a \<Rightarrow> bool" where "asymmetric x     \<equiv> x \<sqinter> x\<^sup>T = bot"
 abbreviation linear         :: "'a \<Rightarrow> bool" where "linear x         \<equiv> x \<squnion> x\<^sup>T = top"
 
 abbreviation equivalence    :: "'a \<Rightarrow> bool" where "equivalence x    \<equiv> preorder x \<and> symmetric x"
 abbreviation order          :: "'a \<Rightarrow> bool" where "order x          \<equiv> preorder x \<and> antisymmetric x"
 abbreviation linear_order   :: "'a \<Rightarrow> bool" where "linear_order x   \<equiv> order x \<and> linear x"
 
 end
 
 text \<open>
 We reuse the relation algebra axioms given in \cite{Maddux1996} except for one -- see lemma \<open>conv_complement_sub\<close> below -- which we replace with the Dedekind rule (or modular law) \<open>dedekind_1\<close>.
 The Dedekind rule or variants of it are known from \cite{BirdMoor1997,FreydScedrov1990,KawaharaFurusawaMori1999,SchmidtStroehlein1993}.
 We add \<open>comp_left_zero\<close>, which follows in relation algebras but not in the present setting.
 The main change is that only a bounded distributive lattice is required, not a Boolean algebra.
 \<close>
 
 class bounded_distrib_allegory = bounded_distrib_lattice + times + one + conv +
   assumes comp_associative      : "(x * y) * z = x * (y * z)"
   assumes comp_right_dist_sup   : "(x \<squnion> y) * z = (x * z) \<squnion> (y * z)"
   assumes comp_left_zero  [simp]: "bot * x = bot"
   assumes comp_left_one   [simp]: "1 * x = x"
   assumes conv_involutive [simp]: "x\<^sup>T\<^sup>T = x"
   assumes conv_dist_sup         : "(x \<squnion> y)\<^sup>T = x\<^sup>T \<squnion> y\<^sup>T"
   assumes conv_dist_comp        : "(x * y)\<^sup>T = y\<^sup>T * x\<^sup>T"
   assumes dedekind_1            : "x * y \<sqinter> z \<le> x * (y \<sqinter> (x\<^sup>T * z))"
 begin
 
 subclass bounded_distrib_allegory_signature .
 
 text \<open>
 Many properties of relation algebras already follow in bounded distributive allegories.
 \<close>
 
 lemma conv_isotone:
   "x \<le> y \<Longrightarrow> x\<^sup>T \<le> y\<^sup>T"
   by (metis conv_dist_sup le_iff_sup)
 
 lemma conv_order:
   "x \<le> y \<longleftrightarrow> x\<^sup>T \<le> y\<^sup>T"
   using conv_isotone by fastforce
 
 lemma conv_bot [simp]:
   "bot\<^sup>T = bot"
   using conv_order bot_unique by force
 
 lemma conv_top [simp]:
   "top\<^sup>T = top"
   by (metis conv_involutive conv_order eq_iff top_greatest)
 
 lemma conv_dist_inf:
   "(x \<sqinter> y)\<^sup>T = x\<^sup>T \<sqinter> y\<^sup>T"
   apply (rule antisym)
   using conv_order apply simp
   by (metis conv_order conv_involutive inf.boundedI inf.cobounded1 inf.cobounded2)
 
 lemma conv_inf_bot_iff:
   "bot = x\<^sup>T \<sqinter> y \<longleftrightarrow> bot = x \<sqinter> y\<^sup>T"
   using conv_dist_inf conv_bot by fastforce
 
 lemma conv_one [simp]:
   "1\<^sup>T = 1"
   by (metis comp_left_one conv_dist_comp conv_involutive)
 
 lemma comp_left_dist_sup:
   "(x * y) \<squnion> (x * z) = x * (y \<squnion> z)"
   by (metis comp_right_dist_sup conv_involutive conv_dist_sup conv_dist_comp)
 
 lemma comp_right_isotone:
   "x \<le> y \<Longrightarrow> z * x \<le> z * y"
   by (simp add: comp_left_dist_sup sup.absorb_iff1)
 
 lemma comp_left_isotone:
   "x \<le> y \<Longrightarrow> x * z \<le> y * z"
   by (metis comp_right_dist_sup le_iff_sup)
 
 lemma comp_isotone:
   "x \<le> y \<Longrightarrow> w \<le> z \<Longrightarrow> x * w \<le> y * z"
   using comp_left_isotone comp_right_isotone order.trans by blast
 
 lemma comp_left_subdist_inf:
   "(x \<sqinter> y) * z \<le> x * z \<sqinter> y * z"
   by (simp add: comp_left_isotone)
 
 lemma comp_left_increasing_sup:
   "x * y \<le> (x \<squnion> z) * y"
   by (simp add: comp_left_isotone)
 
 lemma comp_right_subdist_inf:
   "x * (y \<sqinter> z) \<le> x * y \<sqinter> x * z"
   by (simp add: comp_right_isotone)
 
 lemma comp_right_increasing_sup:
   "x * y \<le> x * (y \<squnion> z)"
   by (simp add: comp_right_isotone)
 
 lemma comp_right_zero [simp]:
   "x * bot = bot"
   by (metis comp_left_zero conv_dist_comp conv_involutive)
 
 lemma comp_right_one [simp]:
   "x * 1 = x"
   by (metis comp_left_one conv_dist_comp conv_involutive)
 
 lemma comp_left_conjugate:
   "conjugate (\<lambda>y . x * y) (\<lambda>y . x\<^sup>T * y)"
   apply (unfold conjugate_def, intro allI)
   by (metis comp_right_zero bot.extremum_unique conv_involutive dedekind_1 inf.commute)
 
 lemma comp_right_conjugate:
   "conjugate (\<lambda>y . y * x) (\<lambda>y . y * x\<^sup>T)"
   apply (unfold conjugate_def, intro allI)
   by (metis comp_left_conjugate[unfolded conjugate_def] conv_inf_bot_iff conv_dist_comp conv_involutive)
 
 text \<open>
 We still obtain a semiring structure.
 \<close>
 
 subclass bounded_idempotent_semiring
   by (unfold_locales)
   (auto simp: comp_right_isotone comp_right_dist_sup comp_associative comp_left_dist_sup)
 
 sublocale inf: semiring_0 sup bot inf
   by (unfold_locales, auto simp: inf_sup_distrib2 inf_sup_distrib1 inf_assoc)
 
 lemma schroeder_1:
   "x * y \<sqinter> z = bot \<longleftrightarrow> x\<^sup>T * z \<sqinter> y = bot"
   using abel_semigroup.commute comp_left_conjugate conjugate_def inf.abel_semigroup_axioms by fastforce
 
 lemma schroeder_2:
   "x * y \<sqinter> z = bot \<longleftrightarrow> z * y\<^sup>T \<sqinter> x = bot"
   by (metis comp_right_conjugate conjugate_def inf_commute)
 
 lemma comp_additive:
   "additive (\<lambda>y . x * y) \<and> additive (\<lambda>y . x\<^sup>T * y) \<and> additive (\<lambda>y . y * x) \<and> additive (\<lambda>y . y * x\<^sup>T)"
   by (simp add: comp_left_dist_sup additive_def comp_right_dist_sup)
 
 lemma dedekind_2:
   "y * x \<sqinter> z \<le> (y \<sqinter> (z * x\<^sup>T)) * x"
   by (metis conv_dist_inf conv_order conv_dist_comp dedekind_1)
 
 text \<open>
 The intersection with a vector can still be exported from the first argument of a composition, and many other properties of vectors and covectors continue to hold.
 \<close>
 
 lemma vector_inf_comp:
   "vector x \<Longrightarrow> (x \<sqinter> y) * z = x \<sqinter> (y * z)"
   apply (rule antisym)
   apply (metis comp_left_subdist_inf comp_right_isotone inf.sup_left_isotone order_lesseq_imp top_greatest)
   by (metis comp_left_isotone comp_right_isotone dedekind_2 inf_commute inf_mono order_refl order_trans top_greatest)
 
 lemma vector_inf_closed:
   "vector x \<Longrightarrow> vector y \<Longrightarrow> vector (x \<sqinter> y)"
   by (simp add: vector_inf_comp)
 
 lemma vector_inf_one_comp:
   "vector x \<Longrightarrow> (x \<sqinter> 1) * y = x \<sqinter> y"
   by (simp add: vector_inf_comp)
 
 lemma covector_inf_comp_1:
   assumes "vector x"
     shows "(y \<sqinter> x\<^sup>T) * z = (y \<sqinter> x\<^sup>T) * (x \<sqinter> z)"
 proof -
   have "(y \<sqinter> x\<^sup>T) * z \<le> (y \<sqinter> x\<^sup>T) * (z \<sqinter> ((y\<^sup>T \<sqinter> x) * top))"
     by (metis inf_top_right dedekind_1 conv_dist_inf conv_involutive)
   also have "... \<le> (y \<sqinter> x\<^sup>T) * (x \<sqinter> z)"
     by (metis assms comp_left_isotone comp_right_isotone inf_le2 inf_mono order_refl inf_commute)
   finally show ?thesis
     by (simp add: comp_right_isotone antisym)
 qed
 
 lemma covector_inf_comp_2:
   assumes "vector x"
     shows "y * (x \<sqinter> z) = (y \<sqinter> x\<^sup>T) * (x \<sqinter> z)"
 proof -
   have "y * (x \<sqinter> z) \<le> (y \<sqinter> (top * (x \<sqinter> z)\<^sup>T)) * (x \<sqinter> z)"
     by (metis dedekind_2 inf_top_right)
   also have "... \<le> (y \<sqinter> x\<^sup>T) * (x \<sqinter> z)"
     by (metis assms comp_left_isotone conv_dist_comp conv_order conv_top eq_refl inf_le1 inf_mono)
   finally show ?thesis
     using comp_left_subdist_inf antisym by auto
 qed
 
 lemma covector_inf_comp_3:
   "vector x \<Longrightarrow> (y \<sqinter> x\<^sup>T) * z = y * (x \<sqinter> z)"
   by (metis covector_inf_comp_1 covector_inf_comp_2)
 
 lemma covector_inf_closed:
   "covector x \<Longrightarrow> covector y \<Longrightarrow> covector (x \<sqinter> y)"
   by (metis comp_right_subdist_inf inf.antisym top_left_mult_increasing)
 
 lemma vector_conv_covector:
   "vector v \<longleftrightarrow> covector (v\<^sup>T)"
   by (metis conv_dist_comp conv_involutive conv_top)
 
 lemma covector_conv_vector:
   "covector v \<longleftrightarrow> vector (v\<^sup>T)"
   by (simp add: vector_conv_covector)
 
 lemma covector_comp_inf:
   "covector z \<Longrightarrow> x * (y \<sqinter> z) = x * y \<sqinter> z"
   apply (rule antisym)
   apply (metis comp_isotone comp_right_subdist_inf inf.boundedE inf.boundedI inf.cobounded2 top.extremum)
   by (metis comp_left_isotone comp_right_isotone dedekind_1 inf_commute inf_mono order_refl order_trans top_greatest)
 
 lemma vector_restrict_comp_conv:
   "vector x \<Longrightarrow> x \<sqinter> y \<le> x\<^sup>T * y"
   by (metis covector_inf_comp_3 eq_refl inf.sup_monoid.add_commute inf_top_right le_supE sup.orderE top_left_mult_increasing)
 
 lemma covector_restrict_comp_conv:
   "covector x \<Longrightarrow> y \<sqinter> x \<le> y * x\<^sup>T"
   by (metis conv_dist_comp conv_dist_inf conv_order conv_top inf.sup_monoid.add_commute vector_restrict_comp_conv)
 
 lemma covector_comp_inf_1:
   "covector x \<Longrightarrow> (y \<sqinter> x) * z = y * (x\<^sup>T \<sqinter> z)"
   using covector_conv_vector covector_inf_comp_3 by fastforce
 
 text \<open>
 We still have two ways to represent surjectivity and totality.
 \<close>
 
 lemma surjective_var:
   "surjective x \<longleftrightarrow> surjective_var x"
 proof
   assume "surjective x"
   thus "surjective_var x"
     by (metis dedekind_2 comp_left_one inf_absorb2 top_greatest)
 next
   assume "surjective_var x"
   hence "x\<^sup>T * (x * top) = top"
     by (metis comp_left_isotone comp_associative comp_left_one top_le)
   thus "surjective x"
     by (metis comp_right_isotone conv_top conv_dist_comp conv_involutive top_greatest top_le)
 qed
 
 lemma total_var:
   "total x \<longleftrightarrow> total_var x"
   by (metis conv_top conv_dist_comp conv_involutive surjective_var)
 
 lemma surjective_conv_total:
   "surjective x \<longleftrightarrow> total (x\<^sup>T)"
   by (metis conv_top conv_dist_comp conv_involutive)
 
 lemma total_conv_surjective:
   "total x \<longleftrightarrow> surjective (x\<^sup>T)"
   by (simp add: surjective_conv_total)
 
 lemma injective_conv_univalent:
   "injective x \<longleftrightarrow> univalent (x\<^sup>T)"
   by simp
 
 lemma univalent_conv_injective:
   "univalent x \<longleftrightarrow> injective (x\<^sup>T)"
   by simp
 
 text \<open>
 We continue with studying further closure properties.
 \<close>
 
 lemma univalent_bot_closed:
   "univalent bot"
   by simp
 
 lemma univalent_one_closed:
   "univalent 1"
   by simp
 
 lemma univalent_inf_closed:
   "univalent x \<Longrightarrow> univalent (x \<sqinter> y)"
   by (metis comp_left_subdist_inf comp_right_subdist_inf conv_dist_inf inf.cobounded1 order_lesseq_imp)
 
 lemma univalent_mult_closed:
   assumes "univalent x"
       and "univalent y"
     shows "univalent (x * y)"
 proof -
   have "(x * y)\<^sup>T * x \<le> y\<^sup>T"
     by (metis assms(1) comp_left_isotone comp_right_one conv_one conv_order comp_associative conv_dist_comp conv_involutive)
   thus ?thesis
     by (metis assms(2) comp_left_isotone comp_associative dual_order.trans)
 qed
 
 lemma injective_bot_closed:
   "injective bot"
   by simp
 
 lemma injective_one_closed:
   "injective 1"
   by simp
 
 lemma injective_inf_closed:
   "injective x \<Longrightarrow> injective (x \<sqinter> y)"
   by (metis conv_dist_inf injective_conv_univalent univalent_inf_closed)
 
 lemma injective_mult_closed:
   "injective x \<Longrightarrow> injective y \<Longrightarrow> injective (x * y)"
   by (metis injective_conv_univalent conv_dist_comp univalent_mult_closed)
 
 lemma mapping_one_closed:
   "mapping 1"
   by simp
 
 lemma mapping_mult_closed:
   "mapping x \<Longrightarrow> mapping y \<Longrightarrow> mapping (x * y)"
   by (simp add: comp_associative univalent_mult_closed)
 
 lemma bijective_one_closed:
   "bijective 1"
   by simp
 
 lemma bijective_mult_closed:
   "bijective x \<Longrightarrow> bijective y \<Longrightarrow> bijective (x * y)"
   by (metis injective_mult_closed comp_associative)
 
 lemma bijective_conv_mapping:
   "bijective x \<longleftrightarrow> mapping (x\<^sup>T)"
   by (simp add: surjective_conv_total)
 
 lemma mapping_conv_bijective:
   "mapping x \<longleftrightarrow> bijective (x\<^sup>T)"
   by (simp add: total_conv_surjective)
 
 lemma reflexive_inf_closed:
   "reflexive x \<Longrightarrow> reflexive y \<Longrightarrow> reflexive (x \<sqinter> y)"
   by simp
 
 lemma reflexive_conv_closed:
   "reflexive x \<Longrightarrow> reflexive (x\<^sup>T)"
   using conv_isotone by force
 
 lemma coreflexive_inf_closed:
   "coreflexive x \<Longrightarrow> coreflexive (x \<sqinter> y)"
   by (simp add: le_infI1)
 
 lemma coreflexive_conv_closed:
   "coreflexive x \<Longrightarrow> coreflexive (x\<^sup>T)"
   using conv_order by force
 
 lemma coreflexive_symmetric:
   "coreflexive x \<Longrightarrow> symmetric x"
   by (metis comp_right_one comp_right_subdist_inf conv_dist_inf conv_dist_comp conv_involutive dedekind_1 inf.absorb1 inf_absorb2)
 
 lemma transitive_inf_closed:
   "transitive x \<Longrightarrow> transitive y \<Longrightarrow> transitive (x \<sqinter> y)"
   by (meson comp_left_subdist_inf inf.cobounded1 inf.sup_mono inf_le2 mult_right_isotone order.trans)
 
 lemma transitive_conv_closed:
   "transitive x \<Longrightarrow> transitive (x\<^sup>T)"
   using conv_order conv_dist_comp by fastforce
 
 lemma dense_conv_closed:
   "dense_rel x \<Longrightarrow> dense_rel (x\<^sup>T)"
   using conv_order conv_dist_comp by fastforce
 
 lemma idempotent_conv_closed:
   "idempotent x \<Longrightarrow> idempotent (x\<^sup>T)"
   by (metis conv_dist_comp)
 
 lemma preorder_inf_closed:
   "preorder x \<Longrightarrow> preorder y \<Longrightarrow> preorder (x \<sqinter> y)"
   using transitive_inf_closed by auto
 
 lemma preorder_conv_closed:
   "preorder x \<Longrightarrow> preorder (x\<^sup>T)"
   by (simp add: reflexive_conv_closed transitive_conv_closed)
 
 lemma symmetric_bot_closed:
   "symmetric bot"
   by simp
 
 lemma symmetric_one_closed:
   "symmetric 1"
   by simp
 
 lemma symmetric_top_closed:
   "symmetric top"
   by simp
 
 lemma symmetric_inf_closed:
   "symmetric x \<Longrightarrow> symmetric y \<Longrightarrow> symmetric (x \<sqinter> y)"
   by (simp add: conv_dist_inf)
 
 lemma symmetric_sup_closed:
   "symmetric x \<Longrightarrow> symmetric y \<Longrightarrow> symmetric (x \<squnion> y)"
   by (simp add: conv_dist_sup)
 
 lemma symmetric_conv_closed:
   "symmetric x \<Longrightarrow> symmetric (x\<^sup>T)"
   by simp
 
 lemma one_inf_conv:
   "1 \<sqinter> x = 1 \<sqinter> x\<^sup>T"
   by (metis conv_dist_inf coreflexive_symmetric inf.cobounded1 symmetric_one_closed)
 
 lemma antisymmetric_bot_closed:
   "antisymmetric bot"
   by simp
 
 lemma antisymmetric_one_closed:
   "antisymmetric 1"
   by simp
 
 lemma antisymmetric_inf_closed:
   "antisymmetric x \<Longrightarrow> antisymmetric (x \<sqinter> y)"
   by (rule order_trans[where y="x \<sqinter> x\<^sup>T"]) (simp_all add: conv_isotone inf.coboundedI2 inf.sup_assoc)
 
 lemma antisymmetric_conv_closed:
   "antisymmetric x \<Longrightarrow> antisymmetric (x\<^sup>T)"
   by (simp add: inf_commute)
 
 lemma asymmetric_bot_closed:
   "asymmetric bot"
   by simp
 
 lemma asymmetric_inf_closed:
   "asymmetric x \<Longrightarrow> asymmetric (x \<sqinter> y)"
   by (metis conv_dist_inf inf.mult_zero_left inf.left_commute inf_assoc)
 
 lemma asymmetric_conv_closed:
   "asymmetric x \<Longrightarrow> asymmetric (x\<^sup>T)"
   by (simp add: inf_commute)
 
 lemma linear_top_closed:
   "linear top"
   by simp
 
 lemma linear_sup_closed:
   "linear x \<Longrightarrow> linear (x \<squnion> y)"
   by (metis conv_dist_sup sup_assoc sup_commute sup_top_right)
 
 lemma linear_reflexive:
   "linear x \<Longrightarrow> reflexive x"
   by (metis one_inf_conv inf.distrib_left inf.cobounded2 inf.orderE reflexive_top_closed sup.idem)
 
 lemma linear_conv_closed:
   "linear x \<Longrightarrow> linear (x\<^sup>T)"
   by (simp add: sup_commute)
 
 lemma linear_comp_closed:
   assumes "linear x"
       and "linear y"
     shows "linear (x * y)"
 proof -
   have "reflexive y"
     by (simp add: assms(2) linear_reflexive)
   hence "x \<squnion> x\<^sup>T \<le> x * y \<squnion> y\<^sup>T * x\<^sup>T"
     by (metis case_split_left case_split_right le_supI sup.cobounded1 sup.cobounded2 sup.idem reflexive_conv_closed)
   thus ?thesis
     by (simp add: assms(1) conv_dist_comp top_le)
 qed
 
 lemma equivalence_one_closed:
   "equivalence 1"
   by simp
 
 lemma equivalence_top_closed:
   "equivalence top"
   by simp
 
 lemma equivalence_inf_closed:
   "equivalence x \<Longrightarrow> equivalence y \<Longrightarrow> equivalence (x \<sqinter> y)"
   using conv_dist_inf preorder_inf_closed by auto
 
 lemma equivalence_conv_closed:
   "equivalence x \<Longrightarrow> equivalence (x\<^sup>T)"
   by simp
 
 lemma order_one_closed:
   "order 1"
   by simp
 
 lemma order_inf_closed:
   "order x \<Longrightarrow> order y \<Longrightarrow> order (x \<sqinter> y)"
   using antisymmetric_inf_closed transitive_inf_closed by auto
 
 lemma order_conv_closed:
   "order x \<Longrightarrow> order (x\<^sup>T)"
   by (simp add: inf_commute reflexive_conv_closed transitive_conv_closed)
 
 lemma linear_order_conv_closed:
   "linear_order x \<Longrightarrow> linear_order (x\<^sup>T)"
   using equivalence_top_closed conv_dist_sup inf_commute reflexive_conv_closed transitive_conv_closed by force
 
 text \<open>
 We show a fact about equivalences.
 \<close>
 
 lemma equivalence_comp_dist_inf:
   "equivalence x \<Longrightarrow> x * y \<sqinter> x * z = x * (y \<sqinter> x * z)"
   by (metis antisym comp_right_subdist_inf dedekind_1 eq_iff inf.absorb1 inf.absorb2 mult_1_right mult_assoc)
 
 text \<open>
 The following result generalises the fact that composition with a test amounts to intersection with the corresponding vector.
 Both tests and vectors can be used to represent sets as relations.
 \<close>
 
 lemma coreflexive_comp_top_inf:
   "coreflexive x \<Longrightarrow> x * top \<sqinter> y = x * y"
   apply (rule antisym)
   apply (metis comp_left_isotone comp_left_one coreflexive_symmetric dedekind_1 inf_top_left order_trans)
   using comp_left_isotone comp_right_isotone by fastforce
 
 lemma coreflexive_comp_top_inf_one:
   "coreflexive x \<Longrightarrow> x * top \<sqinter> 1 = x"
   by (simp add: coreflexive_comp_top_inf)
 
 lemma coreflexive_comp_inf:
   "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> x * y = x \<sqinter> y"
   by (metis (full_types) coreflexive_comp_top_inf coreflexive_comp_top_inf_one inf.mult_assoc inf.absorb2)
 
 lemma coreflexive_comp_inf_comp:
   assumes "coreflexive x"
       and "coreflexive y"
     shows "(x * z) \<sqinter> (y * z) = (x \<sqinter> y) * z"
 proof -
   have "(x * z) \<sqinter> (y * z) = x * top \<sqinter> z \<sqinter> y * top \<sqinter> z"
     using assms coreflexive_comp_top_inf inf_assoc by auto
   also have "... = x * top \<sqinter> y * top \<sqinter> z"
     by (simp add: inf.commute inf.left_commute)
   also have "... = (x \<sqinter> y) * top \<sqinter> z"
     by (metis assms coreflexive_comp_inf coreflexive_comp_top_inf mult_assoc)
   also have "... = (x \<sqinter> y) * z"
     by (simp add: assms(1) coreflexive_comp_top_inf coreflexive_inf_closed)
   finally show ?thesis
     .
 qed
 
 lemma coreflexive_idempotent:
   "coreflexive x \<Longrightarrow> idempotent x"
   by (simp add: coreflexive_comp_inf)
 
 lemma coreflexive_univalent:
   "coreflexive x \<Longrightarrow> univalent x"
   by (simp add: coreflexive_idempotent coreflexive_symmetric)
 
 lemma coreflexive_injective:
   "coreflexive x \<Longrightarrow> injective x"
   by (simp add: coreflexive_idempotent coreflexive_symmetric)
 
 lemma coreflexive_commutative:
   "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> x * y = y * x"
   by (simp add: coreflexive_comp_inf inf.commute)
 
 lemma coreflexive_dedekind:
   "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> coreflexive z \<Longrightarrow> x * y \<sqinter> z \<le> x * (y \<sqinter> x * z)"
   by (simp add: coreflexive_comp_inf inf.coboundedI1 inf.left_commute)
 
 text \<open>
 Also the equational version of the Dedekind rule continues to hold.
 \<close>
 
 lemma dedekind_eq:
   "x * y \<sqinter> z = (x \<sqinter> (z * y\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z"
 proof (rule antisym)
   have "x * y \<sqinter> z \<le> x * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z"
     by (simp add: dedekind_1)
   also have "... \<le> (x \<sqinter> (z * (y \<sqinter> (x\<^sup>T * z))\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z"
     by (simp add: dedekind_2)
   also have "... \<le> (x \<sqinter> (z * y\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z"
     by (metis comp_left_isotone comp_right_isotone inf_mono conv_order inf.cobounded1 order_refl)
   finally show "x * y \<sqinter> z \<le> (x \<sqinter> (z * y\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z"
     .
 next
   show "(x \<sqinter> (z * y\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z)) \<sqinter> z \<le> x * y \<sqinter> z"
     using comp_isotone inf.sup_left_isotone by auto
 qed
 
 lemma dedekind:
   "x * y \<sqinter> z \<le> (x \<sqinter> (z * y\<^sup>T)) * (y \<sqinter> (x\<^sup>T * z))"
   by (metis dedekind_eq inf.cobounded1)
 
 lemma vector_export_comp:
   "(x * top \<sqinter> y) * z = x * top \<sqinter> y * z"
 proof -
   have "vector (x * top)"
     by (simp add: comp_associative)
   thus ?thesis
     by (simp add: vector_inf_comp)
 qed
 
 lemma vector_export_comp_unit:
   "(x * top \<sqinter> 1) * y = x * top \<sqinter> y"
   by (simp add: vector_export_comp)
 
 text \<open>
 We solve a few exercises from \cite{SchmidtStroehlein1993}.
 \<close>
 
 lemma ex231a [simp]:
   "(1 \<sqinter> x * x\<^sup>T) * x = x"
   by (metis inf.cobounded1 inf.idem inf_right_idem comp_left_one conv_one coreflexive_comp_top_inf dedekind_eq)
 
 lemma ex231b [simp]:
   "x * (1 \<sqinter> x\<^sup>T * x) = x"
   by (metis conv_dist_comp conv_dist_inf conv_involutive conv_one ex231a)
 
 lemma ex231c:
   "x \<le> x * x\<^sup>T * x"
   by (metis comp_left_isotone ex231a inf_le2)
 
 lemma ex231d:
   "x \<le> x * top * x"
   by (metis comp_left_isotone comp_right_isotone top_greatest order_trans ex231c)
 
 lemma ex231e [simp]:
   "x * top * x * top = x * top"
   by (metis ex231d antisym comp_associative mult_right_isotone top.extremum)
 
 lemma arc_injective:
   "arc x \<Longrightarrow> injective x"
   by (metis conv_dist_inf conv_involutive inf.absorb2 top_right_mult_increasing univalent_inf_closed)
 
 lemma arc_conv_closed:
   "arc x \<Longrightarrow> arc (x\<^sup>T)"
   by simp
 
 lemma arc_univalent:
   "arc x \<Longrightarrow> univalent x"
   using arc_conv_closed arc_injective univalent_conv_injective by blast
 
 text \<open>
 The following result generalises \cite[Exercise 2]{Oliveira2009}.
 It is used to show that the while-loop preserves injectivity of the constructed tree.
 \<close>
 
 lemma injective_sup:
   assumes "injective t"
       and "e * t\<^sup>T \<le> 1"
       and "injective e"
     shows "injective (t \<squnion> e)"
 proof -
   have "(t \<squnion> e) * (t \<squnion> e)\<^sup>T = t * t\<^sup>T \<squnion> t * e\<^sup>T \<squnion> e * t\<^sup>T \<squnion> e * e\<^sup>T"
     by (simp add: comp_left_dist_sup conv_dist_sup semiring.distrib_right sup.assoc)
   thus ?thesis
     using assms coreflexive_symmetric conv_dist_comp by fastforce
 qed
 
 lemma injective_inv:
   "injective t \<Longrightarrow> e * t\<^sup>T = bot \<Longrightarrow> arc e \<Longrightarrow> injective (t \<squnion> e)"
   using arc_injective injective_sup bot_least by blast
 
 lemma univalent_sup:
   "univalent t \<Longrightarrow> e\<^sup>T * t \<le> 1 \<Longrightarrow> univalent e \<Longrightarrow> univalent (t \<squnion> e)"
   by (metis injective_sup conv_dist_sup conv_involutive)
 
 lemma point_injective:
   "arc x \<Longrightarrow> x\<^sup>T * top * x \<le> 1"
   by (metis conv_top comp_associative conv_dist_comp conv_involutive vector_top_closed)
 
 lemma vv_transitive:
   "vector v \<Longrightarrow> (v * v\<^sup>T) * (v * v\<^sup>T) \<le> v * v\<^sup>T"
   by (metis comp_associative comp_left_isotone comp_right_isotone top_greatest)
 
 lemma epm_3:
   assumes "e \<le> w"
       and "injective w"
     shows "e = w \<sqinter> top * e"
 proof -
   have "w \<sqinter> top * e \<le> w * e\<^sup>T * e"
     by (metis (no_types, lifting) inf.absorb2 top.extremum dedekind_2 inf.commute)
   also have "... \<le> w * w\<^sup>T * e"
     by (simp add: assms(1) conv_isotone mult_left_isotone mult_right_isotone)
   also have "... \<le> e"
     using assms(2) coreflexive_comp_top_inf inf.sup_right_divisibility by blast
   finally show ?thesis
     by (simp add: assms(1) top_left_mult_increasing antisym)
 qed
 
 lemma comp_inf_vector:
   "x * (y \<sqinter> z * top) = (x \<sqinter> top * z\<^sup>T) * y"
   by (metis conv_top covector_inf_comp_3 comp_associative conv_dist_comp inf.commute vector_top_closed)
 
 lemma inf_vector_comp:
   "(x \<sqinter> y * top) * z = y * top \<sqinter> x * z"
   using inf.commute vector_export_comp by auto
 
 lemma comp_inf_covector:
   "x * (y \<sqinter> top * z) = x * y \<sqinter> top * z"
   by (simp add: covector_comp_inf covector_mult_closed)
 
 text \<open>
 Well-known distributivity properties of univalent and injective relations over meet continue to hold.
 \<close>
 
 lemma univalent_comp_left_dist_inf:
   assumes "univalent x"
     shows "x * (y \<sqinter> z) = x * y \<sqinter> x * z"
 proof (rule antisym)
   show "x * (y \<sqinter> z) \<le> x * y \<sqinter> x * z"
     by (simp add: comp_right_isotone)
 next
   have "x * y \<sqinter> x * z \<le> (x \<sqinter> x * z * y\<^sup>T) * (y \<sqinter> x\<^sup>T * x * z)"
     by (metis comp_associative dedekind)
   also have "... \<le> x * (y \<sqinter> x\<^sup>T * x * z)"
     by (simp add: comp_left_isotone)
   also have "... \<le> x * (y \<sqinter> 1 * z)"
     using assms comp_left_isotone comp_right_isotone inf.sup_right_isotone by blast
   finally show "x * y \<sqinter> x * z \<le> x * (y \<sqinter> z)"
     by simp
 qed
 
 lemma injective_comp_right_dist_inf:
   "injective z \<Longrightarrow> (x \<sqinter> y) * z = x * z \<sqinter> y * z"
   by (metis univalent_comp_left_dist_inf conv_dist_comp conv_involutive conv_dist_inf)
 
 lemma vector_covector:
   "vector v \<Longrightarrow> vector w \<Longrightarrow> v \<sqinter> w\<^sup>T = v * w\<^sup>T"
   by (metis covector_comp_inf inf_top_left vector_conv_covector)
 
 lemma comp_inf_vector_1:
   "(x \<sqinter> top * y) * z = x * (z \<sqinter> (top * y)\<^sup>T)"
   by (simp add: comp_inf_vector conv_dist_comp)
 
 text \<open>
 The shunting properties for bijective relations and mappings continue to hold.
 \<close>
 
 lemma shunt_bijective:
   assumes "bijective z"
     shows "x \<le> y * z \<longleftrightarrow> x * z\<^sup>T \<le> y"
 proof
   assume "x \<le> y * z"
   hence "x * z\<^sup>T \<le> y * z * z\<^sup>T"
     by (simp add: mult_left_isotone)
   also have "... \<le> y"
     using assms comp_associative mult_right_isotone by fastforce
   finally show "x * z\<^sup>T \<le> y"
     .
 next
   assume 1: "x * z\<^sup>T \<le> y"
   have "x = x \<sqinter> top * z"
     by (simp add: assms)
   also have "... \<le> x * z\<^sup>T * z"
     by (metis dedekind_2 inf_commute inf_top.right_neutral)
   also have "... \<le> y * z"
     using 1 by (simp add: mult_left_isotone)
   finally show "x \<le> y * z"
     .
 qed
 
 lemma shunt_mapping:
   "mapping z \<Longrightarrow> x \<le> z * y \<longleftrightarrow> z\<^sup>T * x \<le> y"
   by (metis shunt_bijective mapping_conv_bijective conv_order conv_dist_comp conv_involutive)
 
 lemma bijective_reverse:
   assumes "bijective p"
       and "bijective q"
     shows "p \<le> r * q \<longleftrightarrow> q \<le> r\<^sup>T * p"
 proof -
   have "p \<le> r * q \<longleftrightarrow> p * q\<^sup>T \<le> r"
     by (simp add: assms(2) shunt_bijective)
   also have "... \<longleftrightarrow> q\<^sup>T \<le> p\<^sup>T * r"
     by (metis assms(1) conv_dist_comp conv_involutive conv_order shunt_bijective)
   also have "... \<longleftrightarrow> q \<le> r\<^sup>T * p"
     using conv_dist_comp conv_isotone by fastforce
   finally show ?thesis
     by simp
 qed
 
 lemma arc_expanded:
   "arc x \<longleftrightarrow> x * top * x\<^sup>T \<le> 1 \<and> x\<^sup>T * top * x \<le> 1 \<and> top * x * top = top"
   by (metis conv_top comp_associative conv_dist_comp conv_involutive vector_top_closed)
 
 lemma arc_top_arc:
   assumes "arc x"
     shows "x * top * x = x"
   by (metis assms epm_3 top_right_mult_increasing vector_inf_comp vector_mult_closed vector_top_closed)
 
 lemma arc_top_edge:
   assumes "arc x"
     shows "x\<^sup>T * top * x = x\<^sup>T * x"
 proof -
   have "x\<^sup>T = x\<^sup>T * top \<sqinter> top * x\<^sup>T"
     using assms epm_3 top_right_mult_increasing by simp
   thus ?thesis
     by (metis comp_inf_vector_1 conv_dist_comp conv_involutive conv_top inf.absorb1 top_right_mult_increasing)
 qed
 
 end
 
 subsection \<open>Single-Object Pseudocomplemented Distributive Allegories\<close>
 
 text \<open>
 We extend single-object bounded distributive allegories by a pseudocomplement operation.
 The following definitions concern properties of relations that require a pseudocomplement.
 \<close>
 
 class relation_algebra_signature = bounded_distrib_allegory_signature + uminus
 begin
 
 abbreviation irreflexive         :: "'a \<Rightarrow> bool" where "irreflexive x         \<equiv> x \<le> -1"
 abbreviation strict_linear       :: "'a \<Rightarrow> bool" where "strict_linear x       \<equiv> x \<squnion> x\<^sup>T = -1"
 
 abbreviation strict_order        :: "'a \<Rightarrow> bool" where "strict_order x        \<equiv> irreflexive x \<and> transitive x"
 abbreviation linear_strict_order :: "'a \<Rightarrow> bool" where "linear_strict_order x \<equiv> strict_order x \<and> strict_linear x"
 
 text \<open>
 The following variants are useful for the graph model.
 \<close>
 
 abbreviation pp_mapping          :: "'a \<Rightarrow> bool" where "pp_mapping x          \<equiv> univalent x \<and> total (--x)"
 abbreviation pp_bijective        :: "'a \<Rightarrow> bool" where "pp_bijective x        \<equiv> injective x \<and> surjective (--x)"
 
 abbreviation pp_point            :: "'a \<Rightarrow> bool" where "pp_point x            \<equiv> vector x \<and> pp_bijective x"
 abbreviation pp_arc              :: "'a \<Rightarrow> bool" where "pp_arc x              \<equiv> pp_bijective (x * top) \<and> pp_bijective (x\<^sup>T * top)"
 
 end
 
 class pd_allegory = bounded_distrib_allegory + p_algebra
 begin
 
 subclass relation_algebra_signature .
 
 subclass pd_algebra ..
 
 lemma conv_complement_1:
   "-(x\<^sup>T) \<squnion> (-x)\<^sup>T = (-x)\<^sup>T"
   by (metis conv_dist_inf conv_order bot_least conv_involutive pseudo_complement sup.absorb2 sup.cobounded2)
 
 lemma conv_complement:
   "(-x)\<^sup>T = -(x\<^sup>T)"
   by (metis conv_complement_1 conv_dist_sup conv_involutive sup_commute)
 
 lemma conv_complement_sub_inf [simp]:
   "x\<^sup>T * -(x * y) \<sqinter> y = bot"
   by (metis comp_left_zero conv_dist_comp conv_involutive dedekind_1 inf_import_p inf_p inf_right_idem ppp pseudo_complement regular_closed_bot)
 
 lemma conv_complement_sub_leq:
   "x\<^sup>T * -(x * y) \<le> -y"
   using pseudo_complement conv_complement_sub_inf by blast
 
 lemma conv_complement_sub [simp]:
   "x\<^sup>T * -(x * y) \<squnion> -y = -y"
   by (simp add: conv_complement_sub_leq sup.absorb2)
 
 lemma complement_conv_sub:
   "-(y * x) * x\<^sup>T \<le> -y"
   by (metis conv_complement conv_complement_sub_leq conv_order conv_dist_comp)
 
 text \<open>
 The following so-called Schr\"oder equivalences, or De Morgan's Theorem K, hold only with a pseudocomplemented element on both right-hand sides.
 \<close>
 
 lemma schroeder_3_p:
   "x * y \<le> -z \<longleftrightarrow> x\<^sup>T * z \<le> -y"
   using pseudo_complement schroeder_1 by auto
 
 lemma schroeder_4_p:
   "x * y \<le> -z \<longleftrightarrow> z * y\<^sup>T \<le> -x"
   using pseudo_complement schroeder_2 by auto
 
 lemma comp_pp_semi_commute:
   "x * --y \<le> --(x * y)"
   using conv_complement_sub_leq schroeder_3_p by fastforce
 
 text \<open>
 The following result looks similar to a property of (anti)domain.
 \<close>
 
 lemma p_comp_pp [simp]:
   "-(x * --y) = -(x * y)"
   using comp_pp_semi_commute comp_right_isotone inf.eq_iff p_antitone pp_increasing by fastforce
 
 lemma pp_comp_semi_commute:
   "--x * y \<le> --(x * y)"
   using complement_conv_sub schroeder_4_p by fastforce
 
 lemma p_pp_comp [simp]:
   "-(--x * y) = -(x * y)"
   using pp_comp_semi_commute comp_left_isotone inf.eq_iff p_antitone pp_increasing by fastforce
 
 lemma pp_comp_subdist:
   "--x * --y \<le> --(x * y)"
   by (simp add: p_antitone_iff)
 
 lemma theorem24xxiii:
   "x * y \<sqinter> -(x * z) = x * (y \<sqinter> -z) \<sqinter> -(x * z)"
 proof -
   have "x * y \<sqinter> -(x * z) \<le> x * (y \<sqinter> (x\<^sup>T * -(x * z)))"
     by (simp add: dedekind_1)
   also have "... \<le> x * (y \<sqinter> -z)"
     using comp_right_isotone conv_complement_sub_leq inf.sup_right_isotone by auto
   finally show ?thesis
     using comp_right_subdist_inf antisym inf.coboundedI2 inf.commute by auto
 qed
 
 text \<open>
 Even in Stone relation algebras, we do not obtain the backward implication in the following result.
 \<close>
 
 lemma vector_complement_closed:
   "vector x \<Longrightarrow> vector (-x)"
   by (metis complement_conv_sub conv_top eq_iff top_right_mult_increasing)
 
 lemma covector_complement_closed:
   "covector x \<Longrightarrow> covector (-x)"
   by (metis conv_complement_sub_leq conv_top eq_iff top_left_mult_increasing)
 
 lemma covector_vector_comp:
   "vector v \<Longrightarrow> -v\<^sup>T * v = bot"
   by (metis conv_bot conv_complement conv_complement_sub_inf conv_dist_comp conv_involutive inf_top.right_neutral)
 
 lemma irreflexive_bot_closed:
   "irreflexive bot"
   by simp
 
 lemma irreflexive_inf_closed:
   "irreflexive x \<Longrightarrow> irreflexive (x \<sqinter> y)"
   by (simp add: le_infI1)
 
 lemma irreflexive_sup_closed:
   "irreflexive x \<Longrightarrow> irreflexive y \<Longrightarrow> irreflexive (x \<squnion> y)"
   by simp
 
 lemma irreflexive_conv_closed:
   "irreflexive x \<Longrightarrow> irreflexive (x\<^sup>T)"
   using conv_complement conv_isotone by fastforce
 
 lemma reflexive_complement_irreflexive:
   "reflexive x \<Longrightarrow> irreflexive (-x)"
   by (simp add: p_antitone)
 
 lemma irreflexive_complement_reflexive:
   "irreflexive x \<longleftrightarrow> reflexive (-x)"
   by (simp add: p_antitone_iff)
 
 lemma symmetric_complement_closed:
   "symmetric x \<Longrightarrow> symmetric (-x)"
   by (simp add: conv_complement)
 
 lemma asymmetric_irreflexive:
   "asymmetric x \<Longrightarrow> irreflexive x"
   by (metis inf.mult_not_zero inf.left_commute inf.right_idem inf.sup_monoid.add_commute pseudo_complement one_inf_conv)
 
 lemma linear_asymmetric:
   "linear x \<Longrightarrow> asymmetric (-x)"
   using conv_complement p_top by force
 
 lemma strict_linear_sup_closed:
   "strict_linear x \<Longrightarrow> strict_linear y \<Longrightarrow> strict_linear (x \<squnion> y)"
   by (metis (mono_tags, hide_lams) conv_dist_sup sup.right_idem sup_assoc sup_commute)
 
 lemma strict_linear_irreflexive:
   "strict_linear x \<Longrightarrow> irreflexive x"
   using sup_left_divisibility by blast
 
 lemma strict_linear_conv_closed:
   "strict_linear x \<Longrightarrow> strict_linear (x\<^sup>T)"
   by (simp add: sup_commute)
 
 lemma strict_order_var:
   "strict_order x \<longleftrightarrow> asymmetric x \<and> transitive x"
   by (metis asymmetric_irreflexive comp_right_one irreflexive_conv_closed conv_dist_comp dual_order.trans pseudo_complement schroeder_3_p)
 
 lemma strict_order_bot_closed:
   "strict_order bot"
   by simp
 
 lemma strict_order_inf_closed:
   "strict_order x \<Longrightarrow> strict_order y \<Longrightarrow> strict_order (x \<sqinter> y)"
   using inf.coboundedI1 transitive_inf_closed by auto
 
 lemma strict_order_conv_closed:
   "strict_order x \<Longrightarrow> strict_order (x\<^sup>T)"
   using irreflexive_conv_closed transitive_conv_closed by blast
 
 lemma order_strict_order:
   assumes "order x"
   shows "strict_order (x \<sqinter> -1)"
 proof (rule conjI)
   show 1: "irreflexive (x \<sqinter> -1)"
     by simp
   have "antisymmetric (x \<sqinter> -1)"
     using antisymmetric_inf_closed assms by blast
   hence "(x \<sqinter> -1) * (x \<sqinter> -1) \<sqinter> 1 \<le> (x \<sqinter> -1 \<sqinter> (x \<sqinter> -1)\<^sup>T) * (x \<sqinter> -1 \<sqinter> (x \<sqinter> -1)\<^sup>T)"
     using 1 by (metis (no_types) coreflexive_symmetric irreflexive_inf_closed coreflexive_transitive dedekind_1 inf_idem mult_1_right semiring.mult_not_zero strict_order_var)
   also have "... = (x \<sqinter> x\<^sup>T \<sqinter> -1) * (x \<sqinter> x\<^sup>T \<sqinter> -1)"
     by (simp add: conv_complement conv_dist_inf inf.absorb2 inf.sup_monoid.add_assoc)
   also have "... = bot"
     using assms inf.antisym reflexive_conv_closed by fastforce
   finally have "(x \<sqinter> -1) * (x \<sqinter> -1) \<le> -1"
     using le_bot pseudo_complement by blast
   thus "transitive (x \<sqinter> -1)"
     by (meson assms comp_isotone inf.boundedI inf.cobounded1 inf.order_lesseq_imp)
 qed
 
 lemma strict_order_order:
   "strict_order x \<Longrightarrow> order (x \<squnion> 1)"
   apply (unfold strict_order_var, intro conjI)
   apply simp
   apply (simp add: mult_left_dist_sup mult_right_dist_sup sup.absorb2)
   using conv_dist_sup coreflexive_bot_closed sup.absorb2 sup_inf_distrib2 by fastforce
 
 lemma linear_strict_order_conv_closed:
   "linear_strict_order x \<Longrightarrow> linear_strict_order (x\<^sup>T)"
   by (simp add: irreflexive_conv_closed sup_monoid.add_commute transitive_conv_closed)
 
 lemma linear_order_strict_order:
   "linear_order x \<Longrightarrow> linear_strict_order (x \<sqinter> -1)"
   apply (rule conjI)
   using order_strict_order apply simp
   by (metis conv_complement conv_dist_inf coreflexive_symmetric eq_iff inf.absorb2 inf.distrib_left inf.sup_monoid.add_commute top.extremum)
 
 lemma regular_conv_closed:
   "regular x \<Longrightarrow> regular (x\<^sup>T)"
   by (metis conv_complement)
 
 text \<open>
 We show a number of facts about equivalences.
 \<close>
 
 lemma equivalence_comp_left_complement:
   "equivalence x \<Longrightarrow> x * -x = -x"
   apply (rule antisym)
   apply (metis conv_complement_sub_leq preorder_idempotent)
   using mult_left_isotone by fastforce
 
 lemma equivalence_comp_right_complement:
   "equivalence x \<Longrightarrow> -x * x = -x"
   by (metis equivalence_comp_left_complement conv_complement conv_dist_comp)
 
 text \<open>
 The pseudocomplement of tests is given by the following operation.
 \<close>
 
-abbreviation coreflexive_complement :: "'a \<Rightarrow> 'a" ("_ '" [80] 80)
+abbreviation coreflexive_complement :: "'a \<Rightarrow> 'a" ("_ ''" [80] 80)
   where "x ' \<equiv> -x \<sqinter> 1"
 
 lemma coreflexive_comp_top_coreflexive_complement:
   "coreflexive x \<Longrightarrow> (x * top)' = x '"
   by (metis coreflexive_comp_top_inf_one inf.commute inf_import_p)
 
 lemma coreflexive_comp_inf_complement:
   "coreflexive x \<Longrightarrow> (x * y) \<sqinter> -z = (x * y) \<sqinter> -(x * z)"
   by (metis coreflexive_comp_top_inf inf.sup_relative_same_increasing inf_import_p inf_le1)
 
 lemma double_coreflexive_complement:
   "x '' = (-x)'"
   using inf.sup_monoid.add_commute inf_import_p by auto
 
 lemma coreflexive_pp_dist_comp:
   assumes "coreflexive x"
       and "coreflexive y"
     shows "(x * y)'' = x '' * y ''"
 proof -
   have "(x * y)'' = --(x * y) \<sqinter> 1"
     by (simp add: double_coreflexive_complement)
   also have "... = --x \<sqinter> --y \<sqinter> 1"
     by (simp add: assms coreflexive_comp_inf)
   also have "... = (--x \<sqinter> 1) * (--y \<sqinter> 1)"
     by (simp add: coreflexive_comp_inf inf.left_commute inf.sup_monoid.add_assoc)
   also have "... = x '' * y ''"
     by (simp add: double_coreflexive_complement)
   finally show ?thesis
     .
 qed
 
 lemma coreflexive_pseudo_complement:
   "coreflexive x \<Longrightarrow> x \<sqinter> y = bot \<longleftrightarrow> x \<le> y '"
   by (simp add: pseudo_complement)
 
 lemma pp_bijective_conv_mapping:
   "pp_bijective x \<longleftrightarrow> pp_mapping (x\<^sup>T)"
   by (simp add: conv_complement surjective_conv_total)
 
 lemma pp_arc_expanded:
   "pp_arc x \<longleftrightarrow> x * top * x\<^sup>T \<le> 1 \<and> x\<^sup>T * top * x \<le> 1 \<and> top * --x * top = top"
 proof
   assume 1: "pp_arc x"
   have 2: "x * top * x\<^sup>T \<le> 1"
     using 1 by (metis comp_associative conv_dist_comp equivalence_top_closed vector_top_closed)
   have 3: "x\<^sup>T * top * x \<le> 1"
     using 1 by (metis conv_dist_comp conv_involutive equivalence_top_closed vector_top_closed mult_assoc)
   have 4: "x\<^sup>T \<le> x\<^sup>T * x * x\<^sup>T"
     by (metis conv_involutive ex231c)
   have "top = --(top * x) * top"
     using 1 by (metis conv_complement conv_dist_comp conv_involutive equivalence_top_closed)
   also have "... \<le> --(top * x\<^sup>T * top * x) * top"
     using 1 by (metis eq_refl mult_assoc p_comp_pp p_pp_comp)
   also have "... = (top * --(x * top) \<sqinter> --(top * x\<^sup>T * top * x)) * top"
     using 1 by simp
   also have "... = top * (--(x * top) \<sqinter> --(top * x\<^sup>T * top * x)) * top"
     by (simp add: covector_complement_closed covector_comp_inf covector_mult_closed)
   also have "... = top * --(x * top \<sqinter> top * x\<^sup>T * top * x) * top"
     by simp
   also have "... = top * --(x * top * x\<^sup>T * top * x) * top"
     by (metis comp_associative comp_inf_covector inf_top.left_neutral)
   also have "... \<le> top * --(x * top * x\<^sup>T * x * x\<^sup>T * top * x) * top"
     using 4 by (metis comp_associative comp_left_isotone comp_right_isotone pp_isotone)
   also have "... \<le> top * --(x * x\<^sup>T * top * x) * top"
     using 2 by (metis comp_associative comp_left_isotone comp_right_isotone pp_isotone comp_left_one)
   also have "... \<le> top * --x * top"
     using 3 by (metis comp_associative comp_left_isotone comp_right_isotone pp_isotone comp_right_one)
   finally show "x * top * x\<^sup>T \<le> 1 \<and> x\<^sup>T * top * x \<le> 1 \<and> top * --x * top = top"
     using 2 3 top_le by blast
 next
   assume "x * top * x\<^sup>T \<le> 1 \<and> x\<^sup>T * top * x \<le> 1 \<and> top * --x * top = top"
   thus "pp_arc x"
     apply (intro conjI)
     apply (metis comp_associative conv_dist_comp equivalence_top_closed vector_top_closed)
     apply (metis comp_associative mult_right_isotone top_le pp_comp_semi_commute)
     apply (metis conv_dist_comp coreflexive_symmetric vector_conv_covector vector_top_closed mult_assoc)
     by (metis conv_complement conv_dist_comp equivalence_top_closed inf.orderE inf_top.left_neutral mult_right_isotone pp_comp_semi_commute)
 qed
 
 text \<open>
 The following operation represents states with infinite executions of non-strict computations.
 \<close>
 
 abbreviation N :: "'a \<Rightarrow> 'a"
   where "N x \<equiv> -(-x * top) \<sqinter> 1"
 
 lemma N_comp:
   "N x * y = -(-x * top) \<sqinter> y"
   by (simp add: vector_mult_closed vector_complement_closed vector_inf_one_comp)
 
 lemma N_comp_top [simp]:
   "N x * top = -(-x * top)"
   by (simp add: N_comp)
 
 lemma vector_N_pp:
   "vector x \<Longrightarrow> N x = --x \<sqinter> 1"
   by (simp add: vector_complement_closed)
 
 lemma N_vector_pp [simp]:
   "N (x * top) = --(x * top) \<sqinter> 1"
   by (simp add: comp_associative vector_complement_closed)
 
 lemma N_vector_top_pp [simp]:
   "N (x * top) * top = --(x * top)"
   by (metis N_comp_top comp_associative vector_top_closed vector_complement_closed)
 
 lemma N_below_inf_one_pp:
   "N x \<le> --x \<sqinter> 1"
   using inf.sup_left_isotone p_antitone top_right_mult_increasing by auto
 
 lemma N_below_pp:
   "N x \<le> --x"
   using N_below_inf_one_pp by auto
 
 lemma N_comp_N:
   "N x * N y = -(-x * top) \<sqinter> -(-y * top) \<sqinter> 1"
   by (simp add: N_comp inf.mult_assoc)
 
 lemma N_bot [simp]:
   "N bot = bot"
   by simp
 
 lemma N_top [simp]:
   "N top = 1"
   by simp
 
 lemma n_split_omega_mult_pp:
   "xs * --xo = xo \<Longrightarrow> vector xo \<Longrightarrow> N top * xo = xs * N xo * top"
   by (metis N_top N_vector_top_pp comp_associative comp_left_one)
 
 text \<open>
 Many of the following results have been derived for verifying Prim's minimum spanning tree algorithm.
 \<close>
 
 lemma ee:
   assumes "vector v"
       and "e \<le> v * -v\<^sup>T"
     shows "e * e = bot"
 proof -
   have "e * v \<le> bot"
     by (metis assms covector_vector_comp comp_associative mult_left_isotone mult_right_zero)
   thus ?thesis
     by (metis assms(2) bot_unique comp_associative mult_right_isotone semiring.mult_not_zero)
 qed
 
 lemma et:
   assumes "vector v"
       and "e \<le> v * -v\<^sup>T"
       and "t \<le> v * v\<^sup>T"
     shows "e * t = bot"
       and "e * t\<^sup>T = bot"
 proof -
   have "e * t \<le> v * -v\<^sup>T * v * v\<^sup>T"
     using assms(2-3) comp_isotone mult_assoc by fastforce
   thus "e * t = bot"
     by (simp add: assms(1) covector_vector_comp le_bot mult_assoc)
 next
   have "t\<^sup>T \<le> v * v\<^sup>T"
     using assms(3) conv_order conv_dist_comp by fastforce
   hence "e * t\<^sup>T \<le> v * -v\<^sup>T * v * v\<^sup>T"
     by (metis assms(2) comp_associative comp_isotone)
   thus "e * t\<^sup>T = bot"
     by (simp add: assms(1) covector_vector_comp le_bot mult_assoc)
 qed
 
 lemma ve_dist:
   assumes "e \<le> v * -v\<^sup>T"
       and "vector v"
       and "arc e"
     shows "(v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T = v * v\<^sup>T \<squnion> v * v\<^sup>T * e \<squnion> e\<^sup>T * v * v\<^sup>T \<squnion> e\<^sup>T * e"
 proof -
   have "e \<le> v * top"
     using assms(1) comp_right_isotone dual_order.trans top_greatest by blast
   hence "v * top * e = v * top * (v * top \<sqinter> e)"
     by (simp add: inf.absorb2)
   also have "... = (v * top \<sqinter> top * v\<^sup>T) * e"
     using assms(2) covector_inf_comp_3 vector_conv_covector by force
   also have "... = v * top * v\<^sup>T * e"
     by (metis assms(2) inf_top_right vector_inf_comp)
   also have "... = v * v\<^sup>T * e"
     by (simp add: assms(2))
   finally have 1: "v * top * e = v * v\<^sup>T * e"
     .
   have "e\<^sup>T * top * e \<le> e\<^sup>T * top * e * e\<^sup>T * e"
     using ex231c comp_associative mult_right_isotone by auto
   also have "... \<le> e\<^sup>T * e"
     by (metis assms(3) coreflexive_comp_top_inf le_infE mult_semi_associative point_injective)
   finally have 2: "e\<^sup>T * top * e = e\<^sup>T * e"
     by (simp add: inf.antisym mult_left_isotone top_right_mult_increasing)
   have "(v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T = (v \<squnion> e\<^sup>T * top) * (v\<^sup>T \<squnion> top * e)"
     by (simp add: conv_dist_comp conv_dist_sup)
   also have "... = v * v\<^sup>T \<squnion> v * top * e \<squnion> e\<^sup>T * top * v\<^sup>T \<squnion> e\<^sup>T * top * top * e"
     by (metis semiring.distrib_left semiring.distrib_right sup_assoc mult_assoc)
   also have "... = v * v\<^sup>T \<squnion> v * top * e \<squnion> (v * top * e)\<^sup>T \<squnion> e\<^sup>T * top * e"
     by (simp add: comp_associative conv_dist_comp)
   also have "... = v * v\<^sup>T \<squnion> v * v\<^sup>T * e \<squnion> (v * v\<^sup>T * e)\<^sup>T \<squnion> e\<^sup>T * e"
     using 1 2 by simp
   finally show ?thesis
     by (simp add: comp_associative conv_dist_comp)
 qed
 
 lemma ev:
   "vector v \<Longrightarrow> e \<le> v * -v\<^sup>T \<Longrightarrow> e * v = bot"
   by (metis covector_vector_comp antisym bot_least comp_associative mult_left_isotone mult_right_zero)
 
 lemma vTeT:
   "vector v \<Longrightarrow> e \<le> v * -v\<^sup>T \<Longrightarrow> v\<^sup>T * e\<^sup>T = bot"
   using conv_bot ev conv_dist_comp by fastforce
 
 text \<open>
 The following result is used to show that the while-loop of Prim's algorithm preserves that the constructed tree is a subgraph of g.
 \<close>
 
 lemma prim_subgraph_inv:
   assumes "e \<le> v * -v\<^sup>T \<sqinter> g"
       and "t \<le> v * v\<^sup>T \<sqinter> g"
     shows "t \<squnion> e \<le> ((v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T) \<sqinter> g"
 proof (rule sup_least)
   have "t \<le> ((v \<squnion> e\<^sup>T * top) * v\<^sup>T) \<sqinter> g"
     using assms(2) le_supI1 mult_right_dist_sup by auto
   also have "... \<le> ((v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T) \<sqinter> g"
     using comp_right_isotone conv_dist_sup inf.sup_left_isotone by auto
   finally show "t \<le> ((v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T) \<sqinter> g"
     .
 next
   have "e \<le> v * top"
     by (meson assms(1) inf.boundedE mult_right_isotone order.trans top.extremum)
   hence "e \<le> v * top \<sqinter> top * e"
     by (simp add: top_left_mult_increasing)
   also have "... = v * top * e"
     by (metis inf_top_right vector_export_comp)
   finally have "e \<le> v * top * e \<sqinter> g"
     using assms(1) by auto
   also have "... = v * (e\<^sup>T * top)\<^sup>T \<sqinter> g"
     by (simp add: comp_associative conv_dist_comp)
   also have "... \<le> v * (v \<squnion> e\<^sup>T * top)\<^sup>T \<sqinter> g"
     by (simp add: conv_dist_sup mult_left_dist_sup sup.assoc sup.orderI)
   also have "... \<le> (v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T \<sqinter> g"
     using inf.sup_left_isotone mult_right_sub_dist_sup_left by auto
   finally show "e \<le> ((v \<squnion> e\<^sup>T * top) * (v \<squnion> e\<^sup>T * top)\<^sup>T) \<sqinter> g"
     .
 qed
 
 text \<open>
 The following result shows how to apply the Schr\"oder equivalence to the middle factor in a composition of three relations.
 Again the elements on the right-hand side need to be pseudocomplemented.
 \<close>
 
 lemma triple_schroeder_p:
   "x * y * z \<le> -w \<longleftrightarrow> x\<^sup>T * w * z\<^sup>T \<le> -y"
   using mult_assoc p_antitone_iff schroeder_3_p schroeder_4_p by auto
 
 text \<open>
 The rotation versions of the Schr\"oder equivalences continue to hold, again with pseudocomplemented elements on the right-hand side.
 \<close>
 
 lemma schroeder_5_p:
   "x * y \<le> -z \<longleftrightarrow> y * z\<^sup>T \<le> -x\<^sup>T"
   using schroeder_3_p schroeder_4_p by auto
 
 lemma schroeder_6_p:
   "x * y \<le> -z \<longleftrightarrow> z\<^sup>T * x \<le> -y\<^sup>T"
   using schroeder_3_p schroeder_4_p by auto
 
 lemma vector_conv_compl:
   "vector v \<Longrightarrow> top * -v\<^sup>T = -v\<^sup>T"
   by (simp add: covector_complement_closed vector_conv_covector)
 
 text \<open>
 Composition commutes, relative to the diversity relation.
 \<close>
 
 lemma comp_commute_below_diversity:
   "x * y \<le> -1 \<longleftrightarrow> y * x \<le> -1"
   by (metis comp_right_one conv_dist_comp conv_one schroeder_3_p schroeder_4_p)
 
 lemma comp_injective_below_complement:
   "injective y \<Longrightarrow> -x * y \<le> -(x * y)"
   by (metis p_antitone_iff comp_associative comp_right_isotone comp_right_one schroeder_4_p)
 
 lemma comp_univalent_below_complement:
   "univalent x \<Longrightarrow> x * -y \<le> -(x * y)"
   by (metis p_inf pseudo_complement semiring.mult_zero_right univalent_comp_left_dist_inf)
 
 text \<open>
 Bijective relations and mappings can be exported from a pseudocomplement.
 \<close>
 
 lemma comp_bijective_complement:
   "bijective y \<Longrightarrow> -x * y = -(x * y)"
   using comp_injective_below_complement complement_conv_sub antisym shunt_bijective by blast
 
 lemma comp_mapping_complement:
   "mapping x \<Longrightarrow> x * -y = -(x * y)"
   by (metis (full_types) comp_bijective_complement conv_complement conv_dist_comp conv_involutive total_conv_surjective)
 
 text \<open>
 The following facts are used in the correctness proof of Kruskal's minimum spanning tree algorithm.
 \<close>
 
 lemma kruskal_injective_inv:
   assumes "injective f"
       and "covector q"
       and "q * f\<^sup>T \<le> q"
       and "e \<le> q"
       and "q * f\<^sup>T \<le> -e"
       and "injective e"
       and "q\<^sup>T * q \<sqinter> f\<^sup>T * f \<le> 1"
     shows "injective ((f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T \<squnion> e)"
 proof -
   have 1: "(f \<sqinter> -q) * (f \<sqinter> -q)\<^sup>T \<le> 1"
     by (simp add: assms(1) injective_inf_closed)
   have 2: "(f \<sqinter> -q) * (f \<sqinter> q) \<le> 1"
   proof -
     have 21: "bot = q * f\<^sup>T \<sqinter> - q"
       by (metis assms(3) inf.sup_monoid.add_assoc inf.sup_right_divisibility inf_import_p inf_p)
     have "(f \<sqinter> -q) * (f \<sqinter> q) \<le> -q * f \<sqinter> q"
       by (metis assms(2) comp_inf_covector comp_isotone inf.cobounded2 inf.left_idem)
     also have "... = bot"
       using 21 schroeder_2 by auto
     finally show ?thesis
       by (simp add: bot_unique)
   qed
   have 3: "(f \<sqinter> -q) * e\<^sup>T \<le> 1"
   proof -
     have "(f \<sqinter> -q) * e\<^sup>T \<le> -q * e\<^sup>T"
       by (simp add: mult_left_isotone)
     also have "... = bot"
       by (metis assms(2,4) bot_unique conv_bot conv_complement covector_complement_closed p_antitone p_bot regular_closed_bot schroeder_5_p)
     finally show ?thesis
       by (simp add: bot_unique)
   qed
   have 4: "(f \<sqinter> q)\<^sup>T * (f \<sqinter> -q)\<^sup>T \<le> 1"
     using 2 conv_dist_comp conv_isotone by force
   have 5: "(f \<sqinter> q)\<^sup>T * (f \<sqinter> q) \<le> 1"
   proof -
     have "(f \<sqinter> q)\<^sup>T * (f \<sqinter> q) \<le> q\<^sup>T * q \<sqinter> f\<^sup>T * f"
       by (simp add: conv_isotone mult_isotone)
     also have "... \<le> 1"
       by (simp add: assms(7))
     finally show ?thesis
       by simp
   qed
   have 6: "(f \<sqinter> q)\<^sup>T * e\<^sup>T \<le> 1"
   proof -
     have "f\<^sup>T * e\<^sup>T \<le> -q\<^sup>T"
       using assms(5) schroeder_5_p by simp
     hence "(f \<sqinter> q)\<^sup>T * e\<^sup>T = bot"
       by (metis assms(2,5) conv_bot conv_dist_comp covector_comp_inf inf.absorb1 inf.cobounded2 inf.sup_monoid.add_commute inf_left_commute inf_p schroeder_4_p)
     thus ?thesis
       by (simp add: bot_unique)
   qed
   have 7: "e * (f \<sqinter> -q)\<^sup>T \<le> 1"
     using 3 conv_dist_comp coreflexive_symmetric by fastforce
   have 8: "e * (f \<sqinter> q) \<le> 1"
     using 6 conv_dist_comp coreflexive_symmetric by fastforce
   have 9: "e * e\<^sup>T \<le> 1"
     by (simp add: assms(6))
   have "((f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T \<squnion> e) * ((f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T \<squnion> e)\<^sup>T = (f \<sqinter> -q) * (f \<sqinter> -q)\<^sup>T \<squnion> (f \<sqinter> -q) * (f \<sqinter> q) \<squnion> (f \<sqinter> -q) * e\<^sup>T \<squnion> (f \<sqinter> q)\<^sup>T * (f \<sqinter> -q)\<^sup>T \<squnion> (f \<sqinter> q)\<^sup>T * (f \<sqinter> q) \<squnion> (f \<sqinter> q)\<^sup>T * e\<^sup>T \<squnion> e * (f \<sqinter> -q)\<^sup>T \<squnion> e * (f \<sqinter> q) \<squnion> e * e\<^sup>T"
     using comp_left_dist_sup comp_right_dist_sup conv_dist_sup sup.assoc by simp
   also have "... \<le> 1"
     using 1 2 3 4 5 6 7 8 9 by simp
   finally show ?thesis
     by simp
 qed
 
 lemma kruskal_exchange_injective_inv_1:
   assumes "injective f"
       and "covector q"
       and "q * f\<^sup>T \<le> q"
       and "q\<^sup>T * q \<sqinter> f\<^sup>T * f \<le> 1"
     shows "injective ((f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T)"
   using kruskal_injective_inv[where e=bot] by (simp add: assms)
 
 lemma kruskal_exchange_acyclic_inv_3:
   assumes "injective w"
       and "d \<le> w"
     shows "(w \<sqinter> -d) * d\<^sup>T * top = bot"
 proof -
   have "(w \<sqinter> -d) * d\<^sup>T * top = (w \<sqinter> -d \<sqinter> (d\<^sup>T * top)\<^sup>T) * top"
     by (simp add: comp_associative comp_inf_vector_1 conv_dist_comp)
   also have "... = (w \<sqinter> top * d \<sqinter> -d) * top"
     by (simp add: conv_dist_comp inf_commute inf_left_commute)
   finally show ?thesis
     using assms epm_3 by simp
 qed
 
 lemma kruskal_subgraph_inv:
   assumes "f \<le> --(-h \<sqinter> g)"
       and "e \<le> --g"
       and "symmetric h"
       and "symmetric g"
     shows "(f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T \<squnion> e \<le> --(-(h \<sqinter> -e \<sqinter> -e\<^sup>T) \<sqinter> g)"
 proof -
   let ?f = "(f \<sqinter> -q) \<squnion> (f \<sqinter> q)\<^sup>T \<squnion> e"
   let ?h = "h \<sqinter> -e \<sqinter> -e\<^sup>T"
   have 1: "f \<sqinter> -q \<le> -h \<sqinter> --g"
     using assms(1) inf.coboundedI1 by simp
   have "(f \<sqinter> q)\<^sup>T \<le> (-h \<sqinter> --g)\<^sup>T"
     using assms(1) inf.coboundedI1 conv_isotone by simp
   also have "... = -h \<sqinter> --g"
     using assms(3,4) conv_complement conv_dist_inf by simp
   finally have "?f \<le> (-h \<sqinter> --g) \<squnion> (e \<sqinter> --g)"
     using 1 assms(2) inf.absorb1 semiring.add_right_mono by simp
   also have "... \<le> (-h \<squnion> --e) \<sqinter> --g"
     by (simp add: inf.coboundedI1 le_supI2 pp_increasing)
   also have "... \<le> -?h \<sqinter> --g"
     using inf.sup_left_isotone order_trans p_antitone_inf p_supdist_inf by blast
   finally show "?f \<le> --(-?h \<sqinter> g)"
     using inf_pp_semi_commute order_lesseq_imp by blast
 qed
 
 end
 
 subsection \<open>Stone Relation Algebras\<close>
 
 text \<open>
 We add \<open>pp_dist_comp\<close> and \<open>pp_one\<close>, which follow in relation algebras but not in the present setting.
 The main change is that only a Stone algebra is required, not a Boolean algebra.
 \<close>
 
 class stone_relation_algebra = pd_allegory + stone_algebra +
   assumes pp_dist_comp : "--(x * y) = --x * --y"
   assumes pp_one [simp]: "--1 = 1"
 begin
 
 text \<open>
 The following property is a simple consequence of the Stone axiom.
 We cannot hope to remove the double complement in it.
 \<close>
 
 lemma conv_complement_0_p [simp]:
   "(-x)\<^sup>T \<squnion> (--x)\<^sup>T = top"
   by (metis conv_top conv_dist_sup stone)
 
 lemma theorem24xxiv_pp:
   "-(x * y) \<squnion> --(x * z) = -(x * (y \<sqinter> -z)) \<squnion> --(x * z)"
   by (metis p_dist_inf theorem24xxiii)
 
 lemma asymmetric_linear:
   "asymmetric x \<longleftrightarrow> linear (-x)"
   by (metis conv_complement inf.distrib_left inf_p maddux_3_11_pp p_bot p_dist_inf)
 
 lemma strict_linear_asymmetric:
   "strict_linear x \<Longrightarrow> antisymmetric (-x)"
   by (metis conv_complement eq_refl p_dist_sup pp_one)
 
 lemma regular_complement_top:
   "regular x \<Longrightarrow> x \<squnion> -x = top"
   by (metis stone)
 
 lemma regular_mult_closed:
   "regular x \<Longrightarrow> regular y \<Longrightarrow> regular (x * y)"
   by (simp add: pp_dist_comp)
 
 lemma regular_one_closed:
   "regular 1"
   by simp
 
 text \<open>
 The following variants of total and surjective are useful for graphs.
 \<close>
 
 lemma pp_total:
   "total (--x) \<longleftrightarrow> -(x*top) = bot"
   by (simp add: dense_pp pp_dist_comp)
 
 lemma pp_surjective:
   "surjective (--x) \<longleftrightarrow> -(top*x) = bot"
   by (metis p_bot p_comp_pp p_top pp_dist_comp)
 
 text \<open>
 Bijective elements and mappings are necessarily regular, that is, invariant under double-complement.
 This implies that points are regular.
 Moreover, also arcs are regular.
 \<close>
 
 lemma bijective_regular:
   "bijective x \<Longrightarrow> regular x"
   by (metis comp_bijective_complement mult_left_one regular_one_closed)
 
 lemma mapping_regular:
   "mapping x \<Longrightarrow> regular x"
   by (metis bijective_regular conv_complement conv_involutive total_conv_surjective)
 
 lemma arc_regular:
   assumes "arc x"
     shows "regular x"
 proof -
   have "--x \<le> --(x * top \<sqinter> top * x)"
     by (simp add: pp_isotone top_left_mult_increasing top_right_mult_increasing)
   also have "... = --(x * top) \<sqinter> --(top * x)"
     by simp
   also have "... = x * top \<sqinter> top * x"
     by (metis assms bijective_regular conv_top conv_dist_comp conv_involutive mapping_regular)
   also have "... \<le> x * x\<^sup>T * top * x"
     by (metis comp_associative dedekind_1 inf.commute inf_top.right_neutral)
   also have "... \<le> x"
     by (metis assms comp_right_one conv_top comp_associative conv_dist_comp conv_involutive mult_right_isotone vector_top_closed)
   finally show ?thesis
     by (simp add: antisym pp_increasing)
 qed
 
 (*
 lemma conv_complement_0 [simp]: "x\<^sup>T \<squnion> (-x)\<^sup>T = top" nitpick [expect=genuine] oops
 lemma schroeder_3: "x * y \<le> z \<longleftrightarrow> x\<^sup>T * -z \<le> -y" nitpick [expect=genuine] oops
 lemma schroeder_4: "x * y \<le> z \<longleftrightarrow> -z * y\<^sup>T \<le> -x" nitpick [expect=genuine] oops
 lemma theorem24xxiv: "-(x * y) \<squnion> (x * z) = -(x * (y \<sqinter> -z)) \<squnion> (x * z)" nitpick [expect=genuine] oops
 lemma vector_N: "x = x * top \<longrightarrow> N(x) = x \<sqinter> 1" nitpick [expect=genuine] oops
 lemma N_vector [simp]: "N(x * top) = x * top \<sqinter> 1" nitpick [expect=genuine] oops
 lemma N_vector_top [simp]: "N(x * top) * top = x * top" nitpick [expect=genuine] oops
 lemma N_below_inf_one: "N(x) \<le> x \<sqinter> 1" nitpick [expect=genuine] oops
 lemma N_below: "N(x) \<le> x" nitpick [expect=genuine] oops
 lemma n_split_omega_mult: "xs * xo = xo \<and> xo * top = xo \<longrightarrow> N(top) * xo = xs * N(xo) * top" nitpick [expect=genuine] oops
 lemma complement_vector: "vector v \<longleftrightarrow> vector (-v)" nitpick [expect=genuine] oops
 lemma complement_covector: "covector v \<longleftrightarrow> covector (-v)" nitpick [expect=genuine] oops
 lemma triple_schroeder: "x * y * z \<le> w \<longleftrightarrow> x\<^sup>T * -w * z\<^sup>T \<le> -y" nitpick [expect=genuine] oops
 lemma schroeder_5: "x * y \<le> z \<longleftrightarrow> y * -z\<^sup>T \<le> -x\<^sup>T" nitpick [expect=genuine] oops
 lemma schroeder_6: "x * y \<le> z \<longleftrightarrow> -z\<^sup>T * x \<le> -y\<^sup>T" nitpick [expect=genuine] oops
 *)
 
 end
 
 text \<open>
 Every Stone algebra can be expanded to a Stone relation algebra by identifying the semiring and lattice structures and taking identity as converse.
 \<close>
 
 sublocale stone_algebra < comp_inf: stone_relation_algebra where one = top and times = inf and conv = id
 proof (unfold_locales, goal_cases)
   case 7
   show ?case by (simp add: inf_commute)
 qed (auto simp: inf.assoc inf_sup_distrib2 inf_left_commute)
 
 text \<open>
 Every bounded linear order can be expanded to a Stone algebra, which can be expanded to a Stone relation algebra by reusing some of the operations.
 In particular, composition is meet, its identity is \<open>top\<close> and converse is the identity function.
 \<close>
 
 class linorder_stone_relation_algebra_expansion = linorder_stone_algebra_expansion + times + conv + one +
   assumes times_def [simp]: "x * y = min x y"
   assumes conv_def [simp]: "x\<^sup>T = x"
   assumes one_def [simp]: "1 = top"
 begin
 
 lemma times_inf [simp]:
   "x * y = x \<sqinter> y"
   by simp
 
 subclass stone_relation_algebra
   apply unfold_locales
   using comp_inf.mult_right_dist_sup inf_commute inf_assoc inf_left_commute pp_dist_inf min_def by simp_all
 
 lemma times_dense:
   "x \<noteq> bot \<Longrightarrow> y \<noteq> bot \<Longrightarrow> x * y \<noteq> bot"
   using inf_dense min_inf times_def by presburger
 
 end
 
 subsection \<open>Relation Algebras\<close>
 
 text \<open>
 For a relation algebra, we only require that the underlying lattice is a Boolean algebra.
 In fact, the only missing axiom is that double-complement is the identity.
 \<close>
 
 class relation_algebra = boolean_algebra + stone_relation_algebra
 begin
 
 lemma conv_complement_0 [simp]:
   "x\<^sup>T \<squnion> (-x)\<^sup>T = top"
   by (simp add: conv_complement)
 
 text \<open>
 We now obtain the original formulations of the Schr\"oder equivalences.
 \<close>
 
 lemma schroeder_3:
   "x * y \<le> z \<longleftrightarrow> x\<^sup>T * -z \<le> -y"
   by (simp add: schroeder_3_p)
 
 lemma schroeder_4:
   "x * y \<le> z \<longleftrightarrow> -z * y\<^sup>T \<le> -x"
   by (simp add: schroeder_4_p)
 
 lemma theorem24xxiv:
   "-(x * y) \<squnion> (x * z) = -(x * (y \<sqinter> -z)) \<squnion> (x * z)"
   using theorem24xxiv_pp by auto
 
 lemma vector_N:
   "vector x \<Longrightarrow> N(x) = x \<sqinter> 1"
   by (simp add: vector_N_pp)
 
 lemma N_vector [simp]:
   "N(x * top) = x * top \<sqinter> 1"
   by simp
 
 lemma N_vector_top [simp]:
   "N(x * top) * top = x * top"
   using N_vector_top_pp by simp
 
 lemma N_below_inf_one:
   "N(x) \<le> x \<sqinter> 1"
   using N_below_inf_one_pp by simp
 
 lemma N_below:
   "N(x) \<le> x"
   using N_below_pp by simp
 
 lemma n_split_omega_mult:
   "xs * xo = xo \<Longrightarrow> xo * top = xo \<Longrightarrow> N(top) * xo = xs * N(xo) * top"
   using n_split_omega_mult_pp by simp
 
 lemma complement_vector:
   "vector v \<longleftrightarrow> vector (-v)"
   using vector_complement_closed by fastforce
 
 lemma complement_covector:
   "covector v \<longleftrightarrow> covector (-v)"
   using covector_complement_closed by force
 
 lemma triple_schroeder:
   "x * y * z \<le> w \<longleftrightarrow> x\<^sup>T * -w * z\<^sup>T \<le> -y"
   by (simp add: triple_schroeder_p)
 
 lemma schroeder_5:
   "x * y \<le> z \<longleftrightarrow> y * -z\<^sup>T \<le> -x\<^sup>T"
   by (simp add: conv_complement schroeder_5_p)
 
 lemma schroeder_6:
   "x * y \<le> z \<longleftrightarrow> -z\<^sup>T * x \<le> -y\<^sup>T"
   by (simp add: conv_complement schroeder_5_p)
 
 end
 
 text \<open>
 We briefly look at the so-called Tarski rule.
 In some models of Stone relation algebras it only holds for regular elements, so we add this as an assumption.
 \<close>
 
 class stone_relation_algebra_tarski = stone_relation_algebra +
   assumes tarski: "regular x \<Longrightarrow> x \<noteq> bot \<Longrightarrow> top * x * top = top"
 begin
 
 text \<open>
 We can then show, for example, that every arc is contained in a pseudocomplemented relation or its pseudocomplement.
 \<close>
 
 lemma arc_in_partition:
   assumes "arc x"
     shows "x \<le> -y \<or> x \<le> --y"
 proof -
   have 1: "x * top * x\<^sup>T \<le> 1 \<and> x\<^sup>T * top * x \<le> 1"
     using assms arc_expanded by auto
   have "\<not> x \<le> --y \<longrightarrow> x \<le> -y"
   proof
     assume "\<not> x \<le> --y"
     hence "x \<sqinter> -y \<noteq> bot"
       using pseudo_complement by simp
     hence "top * (x \<sqinter> -y) * top = top"
       using assms arc_regular tarski by auto
     hence "x = x \<sqinter> top * (x \<sqinter> -y) * top"
       by simp
     also have "... \<le> x \<sqinter> x * ((x \<sqinter> -y) * top)\<^sup>T * (x \<sqinter> -y) * top"
       by (metis dedekind_2 inf.cobounded1 inf.boundedI inf_commute mult_assoc inf.absorb2 top.extremum)
     also have "... = x \<sqinter> x * top * (x\<^sup>T \<sqinter> -y\<^sup>T) * (x \<sqinter> -y) * top"
       by (simp add: comp_associative conv_complement conv_dist_comp conv_dist_inf)
     also have "... \<le> x \<sqinter> x * top * x\<^sup>T * (x \<sqinter> -y) * top"
       using inf.sup_right_isotone mult_left_isotone mult_right_isotone by auto
     also have "... \<le> x \<sqinter> 1 * (x \<sqinter> -y) * top"
       using 1 by (metis comp_associative comp_isotone inf.sup_right_isotone mult_1_left mult_semi_associative)
     also have "... = x \<sqinter> (x \<sqinter> -y) * top"
       by simp
     also have "... \<le> (x \<sqinter> -y) * ((x \<sqinter> -y)\<^sup>T * x)"
       by (metis dedekind_1 inf_commute inf_top_right)
     also have "... \<le> (x \<sqinter> -y) * (x\<^sup>T * x)"
       by (simp add: conv_dist_inf mult_left_isotone mult_right_isotone)
     also have "... \<le> (x \<sqinter> -y) * (x\<^sup>T * top * x)"
       by (simp add: mult_assoc mult_right_isotone top_left_mult_increasing)
     also have "... \<le> x \<sqinter> -y"
       using 1 by (metis mult_right_isotone mult_1_right)
     finally show "x \<le> -y"
       by simp
   qed
   thus ?thesis
     by auto
 qed
 
 lemma non_bot_arc_in_partition_xor:
   assumes "arc x"
       and "x \<noteq> bot"
     shows "(x \<le> -y \<and> \<not> x \<le> --y) \<or> (\<not> x \<le> -y \<and> x \<le> --y)"
 proof -
   have "x \<le> -y \<and> x \<le> --y \<longrightarrow> False"
     by (simp add: assms(2) inf_absorb1 shunting_1_pp)
   thus ?thesis
     using assms(1) arc_in_partition by auto
 qed
 
 end
 
 class relation_algebra_tarski = relation_algebra + stone_relation_algebra_tarski
 
 text \<open>
 Finally, the above axioms of relation algebras do not imply that they contain at least two elements.
 This is necessary, for example, to show that arcs are not empty.
 \<close>
 
 class stone_relation_algebra_consistent = stone_relation_algebra +
   assumes consistent: "bot \<noteq> top"
 begin
 
 lemma arc_not_bot:
   "arc x \<Longrightarrow> x \<noteq> bot"
   using consistent mult_right_zero by auto
 
 end
 
 class relation_algebra_consistent = relation_algebra + stone_relation_algebra_consistent
 
 class stone_relation_algebra_tarski_consistent = stone_relation_algebra_tarski + stone_relation_algebra_consistent
 begin
 
 lemma arc_in_partition_xor:
   "arc x \<Longrightarrow> (x \<le> -y \<and> \<not> x \<le> --y) \<or> (\<not> x \<le> -y \<and> x \<le> --y)"
   by (simp add: non_bot_arc_in_partition_xor arc_not_bot)
 
 end
 
 end