diff --git a/thys/JinjaThreads/Basic/Auxiliary.thy b/thys/JinjaThreads/Basic/Auxiliary.thy
--- a/thys/JinjaThreads/Basic/Auxiliary.thy
+++ b/thys/JinjaThreads/Basic/Auxiliary.thy
@@ -1,864 +1,803 @@
 (*  Title:      JinjaThreads/Basic/Aux.thy
     Author:     Andreas Lochbihler, David von Oheimb, Tobias Nipkow
 
     Based on the Jinja theory Common/Aux.thy by David von Oheimb and Tobias Nipkow
 *)
 
 section \<open>Auxiliary Definitions and Lemmata\<close>
 
 theory Auxiliary
 imports
   Complex_Main
   "HOL-Library.Transitive_Closure_Table"
   "HOL-Library.Predicate_Compile_Alternative_Defs"
   "HOL-Library.Monad_Syntax"
   "HOL-Library.Infinite_Set"
   FinFun.FinFun
 begin
 
 unbundle finfun_syntax
 
 (* FIXME move and possibly turn into a general simproc *)
 lemma nat_add_max_le[simp]:
   "((n::nat) + max i j \<le> m) = (n + i \<le> m \<and> n + j \<le> m)"
  (*<*)by arith(*>*)
 
 lemma Suc_add_max_le[simp]:
   "(Suc(n + max i j) \<le> m) = (Suc(n + i) \<le> m \<and> Suc(n + j) \<le> m)"
 (*<*)by arith(*>*)
 
 lemma less_min_eq1:
   "(a :: 'a :: order) < b \<Longrightarrow> min a b = a"
 by(auto simp add: min_def order_less_imp_le)
 
 lemma less_min_eq2:
   "(a :: 'a :: order) > b \<Longrightarrow> min a b = b"
 by(auto simp add: min_def order_less_imp_le)
 
 no_notation floor ("\<lfloor>_\<rfloor>")
 notation Some ("(\<lfloor>_\<rfloor>)")
 
 (*<*)
 declare
  option.splits[split]
  Let_def[simp]
  subset_insertI2 [simp]
 (*>*)
 
 declare not_Cons_self [no_atp] 
 
 lemma Option_bind_eq_None_conv:
   "x \<bind> y = None \<longleftrightarrow> x = None \<or> (\<exists>x'. x = Some x' \<and> y x' = None)"
 by(cases x) simp_all
 
-lemma Option_bind_eq_Some_conv:
-  "x \<bind> y = Some z \<longleftrightarrow> (\<exists>x'. x = Some x' \<and> y x' = Some z)"
-by(cases x) simp_all
-
 lemma map_upds_xchg_snd:
   "\<lbrakk> length xs \<le> length ys; length xs \<le> length zs; \<forall>i. i < length xs \<longrightarrow> ys ! i = zs ! i \<rbrakk>
   \<Longrightarrow> f(xs [\<mapsto>] ys) = f(xs [\<mapsto>] zs)"
 proof(induct xs arbitrary: ys zs f)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   note IH = \<open>\<And>f ys zs. \<lbrakk> length xs \<le> length ys; length xs \<le> length zs; \<forall>i<length xs. ys ! i = zs ! i\<rbrakk>
              \<Longrightarrow> f(xs [\<mapsto>] ys) = f(xs [\<mapsto>] zs)\<close>
   note leny = \<open>length (x # xs) \<le> length ys\<close>
   note lenz = \<open>length (x # xs) \<le> length zs\<close>
   note nth = \<open>\<forall>i<length (x # xs). ys ! i = zs ! i\<close>
   from lenz obtain z zs' where zs [simp]: "zs = z # zs'" by(cases zs, auto)
   from leny obtain y ys' where ys [simp]: "ys = y # ys'" by(cases ys, auto)
   from lenz leny nth have "(f(x \<mapsto> y))(xs [\<mapsto>] ys') = (f(x \<mapsto> y))(xs [\<mapsto>] zs')"
     by-(rule IH, auto)
   moreover from nth have "y = z" by auto
   ultimately show ?case by(simp add: map_upds_def)
 qed
 
 subsection \<open>\<open>distinct_fst\<close>\<close>
  
 definition
   distinct_fst  :: "('a \<times> 'b) list \<Rightarrow> bool"
 where
   "distinct_fst  \<equiv>  distinct \<circ> map fst"
 
 lemma distinct_fst_Nil [simp]:
   "distinct_fst []"
  (*<*)
 apply (unfold distinct_fst_def)
 apply (simp (no_asm))
 done
 (*>*)
 
 lemma distinct_fst_Cons [simp]:
   "distinct_fst ((k,x)#kxs) = (distinct_fst kxs \<and> (\<forall>y. (k,y) \<notin> set kxs))"
 (*<*)
 apply (unfold distinct_fst_def)
 apply (auto simp:image_def)
 done
 (*>*)
 
 lemma distinct_fstD: "\<lbrakk> distinct_fst xs; (x, y) \<in> set xs; (x, z) \<in> set xs \<rbrakk> \<Longrightarrow> y = z"
 by(induct xs) auto
 
 lemma map_of_SomeI:
   "\<lbrakk> distinct_fst kxs; (k,x) \<in> set kxs \<rbrakk> \<Longrightarrow> map_of kxs k = Some x"
-(*<*)by (induct kxs) (auto simp:fun_upd_apply)(*>*)
-
-lemma rel_option_Some1:
-  "rel_option R (Some x) y \<longleftrightarrow> (\<exists>y'. y = Some y' \<and> R x y')"
-by(cases y) simp_all
-
-lemma rel_option_Some2:
-  "rel_option R x (Some y) \<longleftrightarrow> (\<exists>x'. x = Some x' \<and> R x' y)"
-by(cases x) simp_all
+(*<*)by (induct kxs) (auto)(*>*)
 
 subsection \<open>Using @{term list_all2} for relations\<close>
 
 definition
   fun_of :: "('a \<times> 'b) set \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
 where
   "fun_of S \<equiv> \<lambda>x y. (x,y) \<in> S"
 
 text \<open>Convenience lemmas\<close>
 (*<*)
 declare fun_of_def [simp]
 (*>*)
 lemma rel_list_all2_Cons [iff]:
   "list_all2 (fun_of S) (x#xs) (y#ys) = 
    ((x,y) \<in> S \<and> list_all2 (fun_of S) xs ys)"
   (*<*)by simp(*>*)
 
 lemma rel_list_all2_Cons1:
   "list_all2 (fun_of S) (x#xs) ys = 
   (\<exists>z zs. ys = z#zs \<and> (x,z) \<in> S \<and> list_all2 (fun_of S) xs zs)"
   (*<*)by (cases ys) auto(*>*)
 
 lemma rel_list_all2_Cons2:
   "list_all2 (fun_of S) xs (y#ys) = 
   (\<exists>z zs. xs = z#zs \<and> (z,y) \<in> S \<and> list_all2 (fun_of S) zs ys)"
   (*<*)by (cases xs) auto(*>*)
 
 lemma rel_list_all2_refl:
   "(\<And>x. (x,x) \<in> S) \<Longrightarrow> list_all2 (fun_of S) xs xs"
   (*<*)by (simp add: list_all2_refl)(*>*)
 
 lemma rel_list_all2_antisym:
   "\<lbrakk> (\<And>x y. \<lbrakk>(x,y) \<in> S; (y,x) \<in> T\<rbrakk> \<Longrightarrow> x = y); 
      list_all2 (fun_of S) xs ys; list_all2 (fun_of T) ys xs \<rbrakk> \<Longrightarrow> xs = ys"
   (*<*)by (rule list_all2_antisym) auto(*>*)
 
 lemma rel_list_all2_trans: 
   "\<lbrakk> \<And>a b c. \<lbrakk>(a,b) \<in> R; (b,c) \<in> S\<rbrakk> \<Longrightarrow> (a,c) \<in> T;
     list_all2 (fun_of R) as bs; list_all2 (fun_of S) bs cs\<rbrakk> 
   \<Longrightarrow> list_all2 (fun_of T) as cs"
   (*<*)by (rule list_all2_trans) auto(*>*)
 
 lemma rel_list_all2_update_cong:
   "\<lbrakk> i<size xs; list_all2 (fun_of S) xs ys; (x,y) \<in> S \<rbrakk> 
   \<Longrightarrow> list_all2 (fun_of S) (xs[i:=x]) (ys[i:=y])"
   (*<*)by (simp add: list_all2_update_cong)(*>*)
 
 lemma rel_list_all2_nthD:
   "\<lbrakk> list_all2 (fun_of S) xs ys; p < size xs \<rbrakk> \<Longrightarrow> (xs!p,ys!p) \<in> S"
   (*<*)by (drule list_all2_nthD) auto(*>*)
 
 lemma rel_list_all2I:
   "\<lbrakk> length a = length b; \<And>n. n < length a \<Longrightarrow> (a!n,b!n) \<in> S \<rbrakk> \<Longrightarrow> list_all2 (fun_of S) a b"
   (*<*)by (erule list_all2_all_nthI) simp(*>*)
 
 (*<*)declare fun_of_def [simp del](*>*)
 
 
-lemma list_all2_induct[consumes 1, case_names Nil Cons]:
-  assumes major: "list_all2 P xs ys"
-  and Nil: "Q [] []"
-  and Cons: "\<And>x xs y ys. \<lbrakk> P x y; list_all2 P xs ys; Q xs ys \<rbrakk> \<Longrightarrow> Q (x # xs) (y # ys)"
-  shows "Q xs ys"
-using major
-by(induct xs arbitrary: ys)(auto simp add: list_all2_Cons1 Nil intro!: Cons)
-
 lemma list_all2_split:
   assumes major: "list_all2 P xs ys"
   and split: "\<And>x y. P x y \<Longrightarrow> \<exists>z. Q x z \<and> R z y"
   shows "\<exists>zs. list_all2 Q xs zs \<and> list_all2 R zs ys"
 using major
 by(induct rule: list_all2_induct)(auto dest: split)
 
-lemma list_all2_refl_conv:
-  "list_all2 P xs xs \<longleftrightarrow> (\<forall>x\<in>set xs. P x x)"
-unfolding list_all2_conv_all_nth Ball_def in_set_conv_nth
-by auto
-
 lemma list_all2_op_eq [simp]:
   "list_all2 (=) xs ys \<longleftrightarrow> xs = ys"
 by(induct xs arbitrary: ys)(auto simp add: list_all2_Cons1)
 
 lemmas filter_replicate_conv = filter_replicate
 
 lemma length_greater_Suc_0_conv: "Suc 0 < length xs \<longleftrightarrow> (\<exists>x x' xs'. xs = x # x' # xs')"
 by(cases xs, auto simp add: neq_Nil_conv)
 
 lemmas zip_same_conv = zip_same_conv_map
 
-lemma nth_Cons_subtract: "0 < n \<Longrightarrow> (x # xs) ! n = xs ! (n - 1)"
-by(auto simp add: nth_Cons split: nat.split)
-
 lemma f_nth_set:
   "\<lbrakk> f (xs ! n) = v; n < length xs \<rbrakk> \<Longrightarrow> v \<in> f ` set xs"
 unfolding set_conv_nth by auto
 
 lemma nth_concat_eqI:
   "\<lbrakk> n = sum_list (map length (take i xss)) + k; i < length xss; k < length (xss ! i); x = xss ! i ! k \<rbrakk>
   \<Longrightarrow> concat xss ! n = x"
 apply(induct xss arbitrary: n i k)
  apply simp
 apply simp
 apply(case_tac i)
  apply(simp add: nth_append)
 apply(simp add: nth_append)
 done
 
 lemma replicate_eq_append_conv: 
   "(replicate n x = xs @ ys) = (\<exists>m\<le>n. xs = replicate m x \<and> ys = replicate (n-m) x)"
 proof(induct n arbitrary: xs ys)
   case 0 thus ?case by simp
 next
   case (Suc n xs ys)
   have IH: "\<And>xs ys. (replicate n x = xs @ ys) = (\<exists>m\<le>n. xs = replicate m x \<and> ys = replicate (n - m) x)" by fact
   show ?case
   proof(unfold replicate_Suc, rule iffI)
     assume a: "x # replicate n x = xs @ ys"
     show "\<exists>m\<le>Suc n. xs = replicate m x \<and> ys = replicate (Suc n - m) x"
     proof(cases xs)
       case Nil
       thus ?thesis using a
         by(auto)
     next
       case (Cons X XS)
       with a have x: "x = X" and "replicate n x = XS @ ys" by auto
       hence "\<exists>m\<le>n. XS = replicate m x \<and> ys = replicate (n - m) x"
         by -(rule IH[THEN iffD1])
       then obtain m where "m \<le> n" and XS: "XS = replicate m x" and ys: "ys = replicate (n - m) x" by blast
       with x Cons show ?thesis
         by(fastforce)
     qed
   next
     assume "\<exists>m\<le>Suc n. xs = replicate m x \<and> ys = replicate (Suc n - m) x"
     then obtain m where m: "m \<le> Suc n" and xs: "xs = replicate m x" and ys: "ys = replicate (Suc n - m) x" by blast
     thus "x # replicate n x = xs @ ys"
       by(simp add: replicate_add[THEN sym])
   qed
 qed
 
 lemma replicate_Suc_snoc:
   "replicate (Suc n) x = replicate n x @ [x]"
 by (metis replicate_Suc replicate_append_same)
 
 lemma map_eq_append_conv:
   "map f xs = ys @ zs \<longleftrightarrow> (\<exists>ys' zs'. map f ys' = ys \<and> map f zs' = zs \<and> xs = ys' @ zs')"
 apply(rule iffI)
  apply(metis append_eq_conv_conj append_take_drop_id drop_map take_map)
 by(clarsimp)
 
 lemma append_eq_map_conv:
   "ys @ zs = map f xs \<longleftrightarrow> (\<exists>ys' zs'. map f ys' = ys \<and> map f zs' = zs \<and> xs = ys' @ zs')"
 unfolding map_eq_append_conv[symmetric]
 by auto
 
 lemma map_eq_map_conv:
   "map f xs = map g ys \<longleftrightarrow> list_all2 (\<lambda>x y. f x = g y) xs ys"
 apply(induct xs arbitrary: ys)
 apply(auto simp add: list_all2_Cons1 Cons_eq_map_conv)
 done
 
 lemma map_eq_all_nth_conv:
   "map f xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>n < length xs. f (xs ! n) = ys ! n)"
 apply(induct xs arbitrary: ys)
 apply(fastforce simp add: nth_Cons Suc_length_conv split: nat.splits)+
 done
 
 
 
 lemma take_eq_take_le_eq:
   "\<lbrakk> take n xs = take n ys; m \<le> n \<rbrakk> \<Longrightarrow> take m xs = take m ys"
 by(metis min.absorb_iff1 take_take)
 
-lemma take_list_update_beyond:
-  "n \<le> m \<Longrightarrow> take n (xs[m := x]) = take n xs"
-by(cases "n \<le> length xs")(rule nth_take_lemma, simp_all)
-
-lemma hd_drop_conv_nth:
-  "n < length xs \<Longrightarrow> hd (drop n xs) = xs ! n"
-by(rule hd_drop_conv_nth) (metis list.size(3) not_less0)
-
 lemma set_tl_subset: "set (tl xs) \<subseteq> set xs"
 by(cases xs) auto
 
 lemma tl_conv_drop: "tl xs = drop 1 xs"
 by(cases xs) simp_all
 
 lemma takeWhile_eq_Nil_dropWhile_eq_Nil_imp_Nil:
   "\<lbrakk> takeWhile P xs = []; dropWhile P xs = [] \<rbrakk> \<Longrightarrow> xs = []"
 by (metis dropWhile_eq_drop drop_0 list.size(3))
 
-lemma takeWhile_eq_Nil_conv:
-  "takeWhile P xs = [] \<longleftrightarrow> (xs = [] \<or> \<not> P (hd xs))"
-by(cases xs) simp_all
-
 lemma dropWhile_append1': "dropWhile P xs \<noteq> [] \<Longrightarrow> dropWhile P (xs @ ys) = dropWhile P xs @ ys"
 by(cases xs) auto
 
 lemma dropWhile_append2': "dropWhile P xs = [] \<Longrightarrow> dropWhile P (xs @ ys) = dropWhile P ys"
 by(simp)
 
 lemma takeWhile_append1': "dropWhile P xs \<noteq> [] \<Longrightarrow> takeWhile P (xs @ ys) = takeWhile P xs"
 by auto
 
-lemma takeWhile_takeWhile: "takeWhile P (takeWhile Q xs) = takeWhile (\<lambda>x. P x \<and> Q x) xs"
-by(induct xs) simp_all
-
 lemma dropWhile_eq_ConsD:
   "dropWhile P xs = y # ys \<Longrightarrow> y \<in> set xs \<and> \<not> P y"
 by(induct xs)(auto split: if_split_asm)
 
 lemma dropWhile_eq_hd_conv: "dropWhile P xs = hd xs # rest \<longleftrightarrow> xs \<noteq> [] \<and> rest = tl xs \<and> \<not> P (hd xs)"
-by (metis append_Nil append_is_Nil_conv dropWhile_eq_Cons_conv list.sel(1) neq_Nil_conv takeWhile_dropWhile_id takeWhile_eq_Nil_conv list.sel(3))
-
-lemma dropWhile_eq_same_conv: "dropWhile P xs = xs \<longleftrightarrow> (xs = [] \<or> \<not> P (hd xs))"
-by (metis dropWhile.simps(1) eq_Nil_appendI hd_dropWhile takeWhile_dropWhile_id takeWhile_eq_Nil_conv)
+by (metis append_Nil dropWhile_eq_Cons_conv list.sel(1) neq_Nil_conv takeWhile_dropWhile_id takeWhile_eq_Nil_iff list.sel(3))
 
 lemma subset_code [code_unfold]:
   "set xs \<subseteq> set ys \<longleftrightarrow> (\<forall>x \<in> set xs. x \<in> set ys)"
 by(rule Set.subset_eq)
 
 lemma eval_bot [simp]:
   "Predicate.eval bot = (\<lambda>_. False)"
 by(auto simp add: fun_eq_iff)
 
 lemma not_is_emptyE:
   assumes "\<not> Predicate.is_empty P"
   obtains x where "Predicate.eval P x"
 using assms
 by(fastforce simp add: Predicate.is_empty_def bot_pred_def intro!: pred_iffI)
 
 lemma is_emptyD:
   assumes "Predicate.is_empty P"
   shows "Predicate.eval P x \<Longrightarrow> False"
 using assms
 by(simp add: Predicate.is_empty_def bot_pred_def bot_apply Set.empty_def)
 
 lemma eval_bind_conv:
   "Predicate.eval (P \<bind> R) y = (\<exists>x. Predicate.eval P x \<and> Predicate.eval (R x) y)"
 by(blast elim: bindE intro: bindI)
 
 lemma eval_single_conv: "Predicate.eval (Predicate.single a) b \<longleftrightarrow> a = b"
 by(blast intro: singleI elim: singleE)
 
 
 lemma conj_asm_conv_imp:
   "(A \<and> B \<Longrightarrow> PROP C) \<equiv> (A \<Longrightarrow> B \<Longrightarrow> PROP C)" 
 apply(rule equal_intr_rule)
  apply(erule meta_mp)
  apply(erule (1) conjI)
 apply(erule meta_impE)
  apply(erule conjunct1)
 apply(erule meta_mp)
 apply(erule conjunct2)
 done
 
 lemma meta_all_eq_conv: "(\<And>a. a = b \<Longrightarrow> PROP P a) \<equiv> PROP P b"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)
  apply(erule meta_mp)
  apply(rule refl)
 apply(hypsubst)
 apply assumption
 done
 
 lemma meta_all_eq_conv2: "(\<And>a. b = a \<Longrightarrow> PROP P a) \<equiv> PROP P b"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)
  apply(erule meta_mp)
  apply(rule refl)
 apply(hypsubst)
 apply assumption
 done
 
 lemma disj_split:
   "P (a \<or> b) \<longleftrightarrow> (a \<longrightarrow> P True) \<and> (b \<longrightarrow> P True) \<and> (\<not> a \<and> \<not> b \<longrightarrow> P False)"
 apply(cases a)
 apply(case_tac [!] b)
 apply auto
 done
 
 lemma disj_split_asm:
   "P (a \<or> b) \<longleftrightarrow> \<not> (a \<and> \<not> P True \<or> b \<and> \<not> P True \<or> \<not> a \<and> \<not> b \<and> \<not> P False)"
 apply(auto simp add: disj_split[of P])
 done
 
 lemma disjCE:
   assumes "P \<or> Q"
   obtains P | "Q" "\<not> P"
 using assms by blast
 
 lemma case_option_conv_if:
   "(case v of None \<Rightarrow> f | Some x \<Rightarrow> g x) = (if \<exists>a. v = Some a then g (the v) else f)"
 by(simp)
 
 lemma LetI: "(\<And>x. x = t \<Longrightarrow> P x) \<Longrightarrow> let x = t in P x"
 by(simp)
 
 (* rearrange parameters and premises to allow application of one-point-rules *)
 (* adapted from Tools/induct.ML and Isabelle Developer Workshop 2010 *)
 
 simproc_setup rearrange_eqs ("Pure.all t") = \<open>
 let
   fun swap_params_conv ctxt i j cv =
     let
       fun conv1 0 ctxt = Conv.forall_conv (cv o snd) ctxt
         | conv1 k ctxt =
             Conv.rewr_conv @{thm swap_params} then_conv
             Conv.forall_conv (conv1 (k - 1) o snd) ctxt
       fun conv2 0 ctxt = conv1 j ctxt
         | conv2 k ctxt = Conv.forall_conv (conv2 (k - 1) o snd) ctxt
     in conv2 i ctxt end;
 
   fun swap_prems_conv 0 = Conv.all_conv
     | swap_prems_conv i =
         Conv.implies_concl_conv (swap_prems_conv (i - 1)) then_conv
         Conv.rewr_conv Drule.swap_prems_eq;
 
   fun find_eq ctxt t =
     let
       val l = length (Logic.strip_params t);
       val Hs = Logic.strip_assums_hyp t;
       fun find (i, (_ $ (Const ("HOL.eq", _) $ Bound j $ _))) = SOME (i, j)
         | find (i, (_ $ (Const ("HOL.eq", _) $ _ $ Bound j))) = SOME (i, j)
         | find _ = NONE
     in
       (case get_first find (map_index I Hs) of
         NONE => NONE
       | SOME (0, 0) => NONE
       | SOME (i, j) => SOME (i, l - j - 1, j))
     end;
 
   fun mk_swap_rrule ctxt ct =
     (case find_eq ctxt (Thm.term_of ct) of
       NONE => NONE
     | SOME (i, k, j) => SOME (swap_params_conv ctxt k j (K (swap_prems_conv i)) ct))
 in
   fn _ => mk_swap_rrule
 end
 \<close>
 declare [[simproc del: rearrange_eqs]]
 lemmas meta_onepoint = meta_all_eq_conv meta_all_eq_conv2
 
 lemma meta_all2_eq_conv: "(\<And>a b. a = c \<Longrightarrow> PROP P a b) \<equiv> (\<And>b. PROP P c b)"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)+
  apply(erule meta_mp)
  apply(rule refl)
 apply(erule meta_allE)
 apply simp
 done
 
 lemma meta_all3_eq_conv: "(\<And>a b c. a = d \<Longrightarrow> PROP P a b c) \<equiv> (\<And>b c. PROP P d b c)"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)+
  apply(erule meta_mp)
  apply(rule refl)
 apply(erule meta_allE)+
 apply simp
 done
 
 lemma meta_all4_eq_conv: "(\<And>a b c d. a = e \<Longrightarrow> PROP P a b c d) \<equiv> (\<And>b c d. PROP P e b c d)"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)+
  apply(erule meta_mp)
  apply(rule refl)
 apply(erule meta_allE)+
 apply simp
 done
 
 lemma meta_all5_eq_conv: "(\<And>a b c d e. a = f \<Longrightarrow> PROP P a b c d e) \<equiv> (\<And>b c d e. PROP P f b c d e)"
 apply(rule equal_intr_rule)
  apply(erule meta_allE)+
  apply(erule meta_mp)
  apply(rule refl)
 apply(erule meta_allE)+
 apply simp
 done
 
-lemma inj_on_image_mem_iff:
-  "\<lbrakk> inj_on f A; B \<subseteq> A; a \<in> A \<rbrakk> \<Longrightarrow> f a \<in> f ` B \<longleftrightarrow> a \<in> B"
-by(metis inv_into_f_eq inv_into_image_cancel rev_image_eqI)
-
-lemma sum_hom:
-  assumes hom_add [simp]: "\<And>a b. f (a + b) = f a + f b"
-  and hom_0 [simp]: "f 0 = 0"
-  shows "sum (f \<circ> h) A = f (sum h A)"
-proof(cases "finite A")
-  case False thus ?thesis by simp
-next
-  case True thus ?thesis
-    by(induct) simp_all
-qed
-
 lemma sum_upto_add_nat:
   "a \<le> b \<Longrightarrow> sum f {..<(a :: nat)} + sum f {a..<b} = sum f {..<b}"
 by (metis atLeast0LessThan le0 sum.atLeastLessThan_concat)
 
 lemma nat_fun_sum_eq_conv:
   fixes f :: "'a \<Rightarrow> nat"
   shows "(\<lambda>a. f a + g a) = (\<lambda>a. 0) \<longleftrightarrow> f = (\<lambda>a .0) \<and> g = (\<lambda>a. 0)"
 by(auto simp add: fun_eq_iff)
 
 
 lemma in_ran_conv: "v \<in> ran m \<longleftrightarrow> (\<exists>k. m k = Some v)"
 by(simp add: ran_def)
 
 lemma map_le_dom_eq_conv_eq:
   "\<lbrakk> m \<subseteq>\<^sub>m m'; dom m = dom m' \<rbrakk> \<Longrightarrow> m = m'"
 by (metis map_le_antisym map_le_def)
 
 lemma map_leI:
   "(\<And>k v. f k = Some v \<Longrightarrow> g k = Some v) \<Longrightarrow> f \<subseteq>\<^sub>m g"
 unfolding map_le_def by auto
 
 lemma map_le_SomeD: "\<lbrakk> m \<subseteq>\<^sub>m m'; m x = \<lfloor>y\<rfloor> \<rbrakk> \<Longrightarrow> m' x = \<lfloor>y\<rfloor>"
 by(auto simp add: map_le_def dest: bspec)
 
 lemma map_le_same_upd:
   "f x = None \<Longrightarrow> f \<subseteq>\<^sub>m f(x \<mapsto> y)"
 by(auto simp add: map_le_def)
 
 lemma map_upd_map_add: "X(V \<mapsto> v) = (X ++ [V \<mapsto> v])"
 by(simp)
 
 
 
 
 lemma foldr_filter_conv:
   "foldr f (filter P xs) = foldr (\<lambda>x s. if P x then f x s else s) xs"
 by(induct xs)(auto intro: ext)
 
 lemma foldr_insert_conv_set:
   "foldr insert xs A = A \<union> set xs"
 by(induct xs arbitrary: A) auto
 
 lemma snd_o_Pair_conv_id: "snd o Pair a = id"
 by(simp add: o_def id_def)
 
 lemma if_intro:
   "\<lbrakk> P \<Longrightarrow> A; \<not> P \<Longrightarrow> B \<rbrakk> \<Longrightarrow> if P then A else B"
 by(auto)
 
 lemma ex_set_conv: "(\<exists>x. x \<in> set xs) \<longleftrightarrow> xs \<noteq> []"
 apply(auto)
 apply(auto simp add: neq_Nil_conv)
 done
 
 lemma subset_Un1: "A \<subseteq> B \<Longrightarrow> A \<subseteq> B \<union> C" by blast
 lemma subset_Un2: "A \<subseteq> C \<Longrightarrow> A \<subseteq> B \<union> C" by blast
 lemma subset_insert: "A \<subseteq> B \<Longrightarrow> A \<subseteq> insert a B" by blast
 lemma UNION_subsetD: "\<lbrakk> (\<Union>x\<in>A. f x) \<subseteq> B; a \<in> A \<rbrakk> \<Longrightarrow> f a \<subseteq> B" by blast
 
 lemma Collect_eq_singleton_conv:
   "{a. P a} = {a} \<longleftrightarrow> P a \<and> (\<forall>a'. P a' \<longrightarrow> a = a')"
 by(auto)
 
 lemma Collect_conv_UN_singleton: "{f x|x. x \<in> P} = (\<Union>x\<in>P. {f x})"
 by blast
 
 lemma if_else_if_else_eq_if_else [simp]:
   "(if b then x else if b then y else z) = (if b then x else z)"
 by(simp)
 
 lemma rec_prod_split [simp]: "old.rec_prod = case_prod"
 by(simp add: fun_eq_iff)
 
 lemma inj_Pair_snd [simp]: "inj (Pair x)"
 by(rule injI) auto
 
 lemma rtranclp_False [simp]: "(\<lambda>a b. False)\<^sup>*\<^sup>* = (=)"
 by(auto simp add: fun_eq_iff elim: rtranclp_induct)
 
 lemmas rtranclp_induct3 =
   rtranclp_induct[where a="(ax, ay, az)" and b="(bx, by, bz)", split_rule, consumes 1, case_names refl step]
 
 lemmas tranclp_induct3 =
   tranclp_induct[where a="(ax, ay, az)" and b="(bx, by, bz)", split_rule, consumes 1, case_names refl step]
 
 lemmas rtranclp_induct4 =
   rtranclp_induct[where a="(ax, ay, az, aw)" and b="(bx, by, bz, bw)", split_rule, consumes 1, case_names refl step]
 
 lemmas tranclp_induct4 =
   tranclp_induct[where a="(ax, ay, az, aw)" and b="(bx, by, bz, bw)", split_rule, consumes 1, case_names refl step]
 
 lemmas converse_tranclp_induct2 =
   converse_tranclp_induct [of _ "(ax,ay)" "(bx,by)", split_rule,
                  consumes 1, case_names base step]
 
 lemma wfP_induct' [consumes 1, case_names wfP]:
   "\<lbrakk>wfP r; \<And>x. (\<And>y. r y x \<Longrightarrow> P y) \<Longrightarrow> P x\<rbrakk> \<Longrightarrow> P a"
 by(blast intro: wfP_induct)
 
 lemma wfP_induct2 [consumes 1, case_names wfP]:
   "\<lbrakk>wfP r; \<And>x x'. (\<And>y y'. r (y, y') (x, x') \<Longrightarrow> P y y') \<Longrightarrow> P x x' \<rbrakk> \<Longrightarrow> P x x'"
 by(drule wfP_induct'[where P="\<lambda>(x, y). P x y"]) blast+
 
 lemma wfP_minimalE:
   assumes "wfP r"
   and "P x"
   obtains z where "P z" "r^** z x" "\<And>y. r y z \<Longrightarrow> \<not> P y"
 proof -
   let ?Q = "\<lambda>x'. P x' \<and> r^** x' x"
   from \<open>P x\<close> have "?Q x" by blast
   from \<open>wfP r\<close> have "\<And>Q. x \<in> Q \<longrightarrow> (\<exists>z\<in>Q. \<forall>y. r y z \<longrightarrow> y \<notin> Q)"
     unfolding wfP_eq_minimal by blast
   from this[rule_format, of "Collect ?Q"] \<open>?Q x\<close>
   obtain z where "?Q z" and min: "\<And>y. r y z \<Longrightarrow> \<not> ?Q y" by auto
   from \<open>?Q z\<close> have "P z" "r^** z x" by auto
   moreover
   { fix y
     assume "r y z"
     hence "\<not> ?Q y" by(rule min)
     moreover from \<open>r y z\<close> \<open>r^** z x\<close> have "r^** y x"
       by(rule converse_rtranclp_into_rtranclp)
     ultimately have "\<not> P y" by blast }
   ultimately show thesis ..
 qed
 
 lemma coinduct_set_wf [consumes 3, case_names coinduct, case_conclusion coinduct wait step]: 
   assumes "mono f" "wf r" "(a, b) \<in> X"
   and step: "\<And>x b. (x, b) \<in> X \<Longrightarrow> (\<exists>b'. (b', b) \<in> r \<and> (x, b') \<in> X) \<or> (x \<in> f (fst ` X \<union> gfp f))"
   shows "a \<in> gfp f"
 proof -
   from \<open>(a, b) \<in> X\<close> have "a \<in> fst ` X" by(auto intro: rev_image_eqI)
   moreover
   { fix a b
     assume "(a, b) \<in> X"
     with \<open>wf r\<close> have "a \<in> f (fst ` X \<union> gfp f)"
       by(induct)(blast dest: step) }
   hence "fst ` X \<subseteq> f (fst ` X \<union> gfp f)" by(auto)
   ultimately show ?thesis by(rule coinduct_set[OF \<open>mono f\<close>])
 qed
 
 subsection \<open>reflexive transitive closure for label relations\<close>
 
 inductive converse3p :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> 'c \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> bool"
   for r :: "'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> bool"
 where
   converse3pI: "r a b c \<Longrightarrow> converse3p r c b a"
 
 lemma converse3p_converse3p: "converse3p (converse3p r) = r"
 by(auto intro: converse3pI intro!: ext elim: converse3p.cases)
 
 lemma converse3pD: "converse3p r c b a \<Longrightarrow> r a b c"
 by(auto elim: converse3p.cases)
 
 inductive rtrancl3p :: "('a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'b list \<Rightarrow> 'a \<Rightarrow> bool"
   for r :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> bool"
   where 
   rtrancl3p_refl [intro!, simp]: "rtrancl3p r a [] a"
 | rtrancl3p_step: "\<lbrakk> rtrancl3p r a bs a'; r a' b a'' \<rbrakk> \<Longrightarrow> rtrancl3p r a (bs @ [b]) a''"
 
 lemmas rtrancl3p_induct3 =
   rtrancl3p.induct[of _ "(ax,ay,az)" _ "(cx,cy,cz)", split_format (complete),
                  consumes 1, case_names refl step]
 
 lemmas rtrancl3p_induct4 = 
   rtrancl3p.induct[of _ "(ax,ay,az,aw)" _ "(cx,cy,cz,cw)", split_format (complete),
                  consumes 1, case_names refl step]
 
 lemma rtrancl3p_induct4' [consumes 1, case_names refl step]:
   assumes major: "rtrancl3p r (ax, (ay, az), aw) bs (cx, (cy, cz), cw)"
   and refl: "\<And>a aa b ba. P a aa b ba [] a aa b ba"
   and step: "\<And>a aa b ba bs ab ac bb bc bd ad ae be bf.
        \<lbrakk> rtrancl3p r (a, (aa, b), ba) bs (ab, (ac, bb), bc);
          P a aa b ba bs ab ac bb bc; r (ab, (ac, bb), bc) bd (ad, (ae, be), bf) \<rbrakk>
        \<Longrightarrow> P a aa b ba (bs @ [bd]) ad ae be bf"
   shows "P ax ay az aw bs cx cy cz cw"
 using major
 apply -
 apply(drule_tac P="\<lambda>(a, (aa, b), ba) bs (cx, (cy, cz), cw). P a aa b ba bs cx cy cz cw" in rtrancl3p.induct)
 by(auto intro: refl step)
 
 lemma rtrancl3p_induct1:
   "\<lbrakk> rtrancl3p r a bs c; P a; \<And>bs c b d. \<lbrakk> rtrancl3p r a bs c; r c b d; P c \<rbrakk> \<Longrightarrow> P d \<rbrakk> \<Longrightarrow> P c"
 apply(induct rule: rtrancl3p.induct)
 apply(auto)
 done
 
 inductive_cases rtrancl3p_cases:
   "rtrancl3p r x [] y"
   "rtrancl3p r x (b # bs) y"
 
 lemma rtrancl3p_trans [trans]:
   assumes one: "rtrancl3p r a bs a'"
   and two: "rtrancl3p r a' bs' a''"
   shows "rtrancl3p r a (bs @ bs') a''"
 using two one
 proof(induct rule: rtrancl3p.induct)
   case rtrancl3p_refl thus ?case by simp
 next
   case rtrancl3p_step thus ?case
     by(auto simp only: append_assoc[symmetric] intro: rtrancl3p.rtrancl3p_step)
 qed
 
 lemma rtrancl3p_step_converse:
   assumes step: "r a b a'"
   and stepify: "rtrancl3p r a' bs a''"
   shows "rtrancl3p r a (b # bs) a''"
 using stepify step
 proof(induct rule: rtrancl3p.induct)
   case rtrancl3p_refl 
   with rtrancl3p.rtrancl3p_refl[where r=r and a=a] show ?case 
     by(auto dest: rtrancl3p.rtrancl3p_step simp del: rtrancl3p.rtrancl3p_refl)
 next
   case rtrancl3p_step thus ?case
     unfolding append_Cons[symmetric]
     by -(rule rtrancl3p.rtrancl3p_step)
 qed
 
 lemma converse_rtrancl3p_step:
   "rtrancl3p r a (b # bs) a'' \<Longrightarrow> \<exists>a'. r a b a' \<and> rtrancl3p r a' bs a''"
 apply(induct bs arbitrary: a'' rule: rev_induct)
  apply(erule rtrancl3p.cases)
   apply(clarsimp)+
  apply(erule rtrancl3p.cases)
   apply(clarsimp)
   apply(rule_tac x="a''a" in exI)
   apply(clarsimp)
  apply(clarsimp)
 apply(erule rtrancl3p.cases)
  apply(clarsimp)
 apply(clarsimp)
 by(fastforce intro: rtrancl3p_step)
 
 lemma converse_rtrancl3pD:
   "rtrancl3p (converse3p r) a' bs a \<Longrightarrow> rtrancl3p r a (rev bs) a'"
 apply(induct rule: rtrancl3p.induct)
  apply(fastforce intro: rtrancl3p.intros)
 apply(auto dest: converse3pD intro: rtrancl3p_step_converse)
 done
 
 lemma rtrancl3p_converseD:
   "rtrancl3p r a bs a' \<Longrightarrow> rtrancl3p (converse3p r) a' (rev bs) a"
 proof(induct rule: rtrancl3p.induct)
   case rtrancl3p_refl thus ?case
     by(auto intro: rtrancl3p.intros)
 next
   case rtrancl3p_step thus ?case
     by(auto intro: rtrancl3p_step_converse converse3p.intros)
 qed
 
 lemma rtrancl3p_converse_induct [consumes 1, case_names refl step]:
   assumes ih: "rtrancl3p r a bs a''"
   and refl: "\<And>a. P a [] a"
   and step: "\<And>a b a' bs a''. \<lbrakk> rtrancl3p r a' bs a''; r a b a'; P a' bs a'' \<rbrakk> \<Longrightarrow> P a (b # bs) a''"
   shows "P a bs a''"
   using ih
 proof(induct bs arbitrary: a a'')
   case Nil thus ?case
     by(auto elim: rtrancl3p.cases intro: refl)
 next
   case Cons thus ?case
     by(auto dest!: converse_rtrancl3p_step intro: step)
 qed  
 
 lemma rtrancl3p_converse_induct' [consumes 1, case_names refl step]:
   assumes ih: "rtrancl3p r a bs a''"
   and refl: "P a'' []"
   and step: "\<And>a b a' bs. \<lbrakk> rtrancl3p r a' bs a''; r a b a'; P a' bs \<rbrakk> \<Longrightarrow> P a (b # bs)"
   shows "P a bs"
 using rtrancl3p_converse_induct[OF ih, where P="\<lambda>a bs a'. a' = a'' \<longrightarrow> P a bs"]
 by(auto intro: refl step)
 
 lemma rtrancl3p_converseE[consumes 1, case_names refl step]:
   "\<lbrakk> rtrancl3p r a bs a'';
      \<lbrakk> a = a''; bs = [] \<rbrakk> \<Longrightarrow> thesis;
      \<And>bs' b a'. \<lbrakk> bs = b # bs'; r a b a'; rtrancl3p r a' bs' a'' \<rbrakk> \<Longrightarrow> thesis \<rbrakk>
   \<Longrightarrow> thesis"
 by(induct rule: rtrancl3p_converse_induct)(auto)
 
 
 lemma rtrancl3p_induct' [consumes 1, case_names refl step]:
   assumes major: "rtrancl3p r a bs c"
   and refl: "P a [] a"
   and step: "\<And>bs a' b a''. \<lbrakk> rtrancl3p r a bs a'; P a bs a'; r a' b a'' \<rbrakk>
              \<Longrightarrow> P a (bs @ [b]) a''"
   shows "P a bs c"
 proof -
   from major have "(P a [] a \<and> (\<forall>bs a' b a''. rtrancl3p r a bs a' \<and> P a bs a' \<and> r a' b a'' \<longrightarrow> P a (bs @ [b]) a'')) \<longrightarrow> P a bs c"
     by-(erule rtrancl3p.induct, blast+)
   with refl step show ?thesis by blast
 qed
 
 lemma r_into_rtrancl3p:
   "r a b a' \<Longrightarrow> rtrancl3p r a [b] a'"
 by(rule rtrancl3p_step_converse) auto
 
 lemma rtrancl3p_appendE:
   assumes "rtrancl3p r a (bs @ bs') a''"
   obtains a' where "rtrancl3p r a bs a'" "rtrancl3p r a' bs' a''"
 using assms
 apply(induct a "bs @ bs'" arbitrary: bs rule: rtrancl3p_converse_induct')
 apply(fastforce intro: rtrancl3p_step_converse simp add: Cons_eq_append_conv)+
 done
 
 lemma rtrancl3p_Cons:
   "rtrancl3p r a (b # bs) a' \<longleftrightarrow> (\<exists>a''. r a b a'' \<and> rtrancl3p r a'' bs a')"
 by(auto intro: rtrancl3p_step_converse converse_rtrancl3p_step)
 
 lemma rtrancl3p_Nil:
   "rtrancl3p r a [] a' \<longleftrightarrow> a = a'"
 by(auto elim: rtrancl3p_cases)
 
 definition invariant3p :: "('a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
 where "invariant3p r I \<longleftrightarrow> (\<forall>s tl s'. s \<in> I \<longrightarrow> r s tl s' \<longrightarrow> s' \<in> I)"
 
 lemma invariant3pI: "(\<And>s tl s'. \<lbrakk> s \<in> I; r s tl s' \<rbrakk> \<Longrightarrow> s' \<in> I) \<Longrightarrow> invariant3p r I"
 unfolding invariant3p_def by blast
 
 lemma invariant3pD: "\<And>tl. \<lbrakk> invariant3p r I; r s tl s'; s \<in> I \<rbrakk> \<Longrightarrow> s' \<in> I"
 unfolding invariant3p_def by(blast)
 
 lemma invariant3p_rtrancl3p: 
   assumes inv: "invariant3p r I"
   and rtrancl: "rtrancl3p r a bs a'"
   and start: "a \<in> I"
   shows "a' \<in> I"
 using rtrancl start by(induct)(auto dest: invariant3pD[OF inv])
 
 lemma invariant3p_UNIV [simp, intro!]:
   "invariant3p r UNIV"
 by(blast intro: invariant3pI)
 
 lemma invarinat3p_empty [simp, intro!]:
   "invariant3p r {}"
 by(blast intro: invariant3pI)
 
 lemma invariant3p_IntI [simp, intro]:
   "\<lbrakk> invariant3p r I; invariant3p r J \<rbrakk> \<Longrightarrow> invariant3p r (I \<inter> J)"
 by(blast dest: invariant3pD intro: invariant3pI)
 
 subsection \<open>Concatenation for @{typ String.literal}\<close>
 
 definition concat :: "String.literal list \<Rightarrow> String.literal"
   where [code_abbrev, code del]: "concat = sum_list"
 
 lemma explode_add [simp]:
   "String.explode (s + t) = String.explode s @ String.explode t"
   by (fact plus_literal.rep_eq)
 
 code_printing
   constant concat \<rightharpoonup>
     (SML) "String.concat"
     and (Haskell) "concat"
     and (OCaml) "String.concat \"\""
 
 hide_const (open) concat
 
 end
diff --git a/thys/JinjaThreads/Common/ExternalCallWF.thy b/thys/JinjaThreads/Common/ExternalCallWF.thy
--- a/thys/JinjaThreads/Common/ExternalCallWF.thy
+++ b/thys/JinjaThreads/Common/ExternalCallWF.thy
@@ -1,765 +1,765 @@
 (*  Title:      JinjaThreads/Common/ExternalCallWF.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Properties of external calls in well-formed programs\<close>
 
 theory ExternalCallWF
 imports
   WellForm
   "../Framework/FWSemantics"
 begin
 
 lemma external_WT_defs_is_type:
   assumes "wf_prog wf_md P" and "C\<bullet>M(Ts) :: T"
   shows "is_class P C" and "is_type P T" "set Ts \<subseteq> types P"
 using assms by(auto elim: external_WT_defs.cases)
 
 context heap_base begin
 
 lemma WT_red_external_aggr_imp_red_external:
   "\<lbrakk> wf_prog wf_md P; (ta, va, h') \<in> red_external_aggr P t a M vs h; P,h \<turnstile> a\<bullet>M(vs) : U; P,h \<turnstile> t \<surd>t \<rbrakk>
   \<Longrightarrow> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
 apply(drule tconfD)
 apply(erule external_WT'.cases)
 apply(clarsimp)
 apply(drule (1) sees_wf_native)
 apply(erule external_WT_defs.cases)
 apply(case_tac [!] hT)
 apply(auto 4 4 simp add: red_external_aggr_def widen_Class intro: red_external.intros heap_base.red_external.intros[where addr2thread_id=addr2thread_id and thread_id2addr=thread_id2addr and spurious_wakeups=True and empty_heap=empty_heap and allocate=allocate and typeof_addr=typeof_addr and heap_read=heap_read and heap_write=heap_write] heap_base.red_external.intros[where addr2thread_id=addr2thread_id and thread_id2addr=thread_id2addr and spurious_wakeups=False and empty_heap=empty_heap and allocate=allocate and typeof_addr=typeof_addr and heap_read=heap_read and heap_write=heap_write] split: if_split_asm dest: sees_method_decl_above)
 done
 
 lemma WT_red_external_list_conv:
   "\<lbrakk> wf_prog wf_md P; P,h \<turnstile> a\<bullet>M(vs) : U; P,h \<turnstile> t \<surd>t \<rbrakk>
   \<Longrightarrow> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle> \<longleftrightarrow> (ta, va, h') \<in> red_external_aggr P t a M vs h"
 by(blast intro: WT_red_external_aggr_imp_red_external red_external_imp_red_external_aggr)
 
 lemma red_external_new_thread_sees:
   "\<lbrakk> wf_prog wf_md P; P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; NewThread t' (C, M', a') h'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> typeof_addr h' a' = \<lfloor>Class_type C\<rfloor> \<and> (\<exists>T meth D. P \<turnstile> C sees M':[]\<rightarrow>T = \<lfloor>meth\<rfloor> in D)"
 by(fastforce elim!: red_external.cases simp add: widen_Class ta_upd_simps dest: sub_Thread_sees_run)
 
 end
 
 subsection \<open>Preservation of heap conformance\<close>
 
 context heap_conf_read begin
 
 lemma hconf_heap_copy_loc_mono:
   assumes "heap_copy_loc a a' al h obs h'"
   and "hconf h"
   and "P,h \<turnstile> a@al : T" "P,h \<turnstile> a'@al : T"
   shows "hconf h'"
 proof -
   from \<open>heap_copy_loc a a' al h obs h'\<close> obtain v
     where read: "heap_read h a al v"
     and "write": "heap_write h a' al v h'" by cases auto
   from read \<open>P,h \<turnstile> a@al : T\<close> \<open>hconf h\<close> have "P,h \<turnstile> v :\<le> T"
     by(rule heap_read_conf)
   with "write" \<open>hconf h\<close> \<open>P,h \<turnstile> a'@al : T\<close> show ?thesis
     by(rule hconf_heap_write_mono)
 qed
 
 lemma hconf_heap_copies_mono:
   assumes "heap_copies a a' als h obs h'"
   and "hconf h"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts"
   shows "hconf h'"
 using assms
 proof(induct arbitrary: Ts)
   case Nil thus ?case by simp
 next
   case (Cons al h ob h' als obs h'')
   note step = \<open>heap_copy_loc a a' al h ob h'\<close>
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) (al # als) Ts\<close>
   obtain T Ts' where [simp]: "Ts = T # Ts'"
     and "P,h \<turnstile> a@al : T" "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) (al # als) Ts\<close>
   have "P,h \<turnstile> a'@al : T" "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts'" by simp_all
   from step \<open>hconf h\<close> \<open>P,h \<turnstile> a@al : T\<close> \<open>P,h \<turnstile> a'@al : T\<close>
   have "hconf h'" by(rule hconf_heap_copy_loc_mono)
   moreover from step have "h \<unlhd> h'" by(rule hext_heap_copy_loc)
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'\<close>
   have "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) als Ts'"
     by(rule list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>])
   moreover from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts'\<close>
   have "list_all2 (\<lambda>al T. P,h' \<turnstile> a'@al : T) als Ts'"
     by(rule list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>])
   ultimately show ?case by(rule Cons)
 qed
 
 lemma hconf_heap_clone_mono:
   assumes "heap_clone P h a h' res"
   and "hconf h"
   shows "hconf h'"
 using \<open>heap_clone P h a h' res\<close>
 proof cases
   case CloneFail thus ?thesis using \<open>hconf h\<close>
     by(fastforce intro: hconf_heap_ops_mono dest: typeof_addr_is_type)
 next
   case (ObjClone C h'' a' FDTs obs)
   note FDTs = \<open>P \<turnstile> C has_fields FDTs\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
   note \<open>heap_copies a a' ?als h'' obs h'\<close>
   moreover from \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close> \<open>hconf h\<close> have "is_class P C"
     by(auto dest: typeof_addr_is_type)
   from \<open>(h'', a') \<in> allocate h (Class_type C)\<close> have "h \<unlhd> h''" "hconf h''"
     by(rule hext_heap_ops hconf_allocate_mono)+(simp_all add: \<open>hconf h\<close> \<open>is_class P C\<close>)
   note \<open>hconf h''\<close>
   moreover
   from \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close> FDTs
   have "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   hence "list_all2 (\<lambda>al T. P,h'' \<turnstile> a@al : T) ?als ?Ts"
     by(rule list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h''\<close>])
   moreover from \<open>(h'', a') \<in> allocate h (Class_type C)\<close> \<open>is_class P C\<close>
   have "typeof_addr h'' a' = \<lfloor>Class_type C\<rfloor>" by(auto dest: allocate_SomeD)
   with FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> a'@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   ultimately have "hconf h'" by(rule hconf_heap_copies_mono)
   thus ?thesis using ObjClone by simp
 next
   case (ArrClone T n h'' a' FDTs obs)
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate n T"
   note \<open>heap_copies a a' ?als h'' obs h'\<close>
   moreover from \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close> \<open>hconf h\<close> have "is_type P (T\<lfloor>\<rceil>)"
     by(auto dest: typeof_addr_is_type)
   from \<open>(h'', a') \<in> allocate h (Array_type T n)\<close> have "h \<unlhd> h''" "hconf h''"
     by(rule hext_heap_ops hconf_allocate_mono)+(simp_all add: \<open>hconf h\<close> \<open>is_type P (T\<lfloor>\<rceil>)\<close>[simplified])
   note \<open>hconf h''\<close>
   moreover from \<open>h \<unlhd> h''\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have type'a: "typeof_addr h'' a = \<lfloor>Array_type T n\<rfloor>" by(auto intro: hext_arrD)
   note FDTs = \<open>P \<turnstile> Object has_fields FDTs\<close>
   from type'a FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> a@al : T) ?als ?Ts"
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def distinct_fst_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def distinct_fst_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   moreover from \<open>(h'', a') \<in> allocate h (Array_type T n)\<close> \<open>is_type P (T\<lfloor>\<rceil>)\<close>
   have "typeof_addr h'' a' = \<lfloor>Array_type T n\<rfloor>" by(auto dest: allocate_SomeD)
   hence "list_all2 (\<lambda>al T. P,h'' \<turnstile> a'@al : T) ?als ?Ts" using FDTs
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def distinct_fst_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def distinct_fst_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   ultimately have "hconf h'" by(rule hconf_heap_copies_mono)
   thus ?thesis using ArrClone by simp
 qed
 
 theorem external_call_hconf:
   assumes major: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   and minor: "P,h \<turnstile> a\<bullet>M(vs) : U" "hconf h"
   shows "hconf h'"
 using major minor
 by cases(fastforce intro: hconf_heap_clone_mono)+
 
 end
 
 context heap_base begin
 
 primrec conf_extRet :: "'m prog \<Rightarrow> 'heap \<Rightarrow> 'addr extCallRet \<Rightarrow> ty \<Rightarrow> bool" where
   "conf_extRet P h (RetVal v) T = (P,h \<turnstile> v :\<le> T)"
 | "conf_extRet P h (RetExc a) T = (P,h \<turnstile> Addr a :\<le> Class Throwable)"
 | "conf_extRet P h RetStaySame T = True"
 
 end
 
 context heap_conf begin
 
 lemma red_external_conf_extRet:
   assumes wf: "wf_prog wf_md P"
   shows "\<lbrakk>P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; P,h \<turnstile> a\<bullet>M(vs) : U; hconf h; preallocated h; P,h \<turnstile> t \<surd>t \<rbrakk>
   \<Longrightarrow> conf_extRet P h' va U"
 using wf apply -
 apply(frule red_external_hext)
 apply(drule (1) preallocated_hext)
 apply(auto elim!: red_external.cases external_WT'.cases external_WT_defs_cases dest!: sees_wf_native[OF wf])
 apply(auto simp add: conf_def tconf_def intro: xcpt_subcls_Throwable dest!: hext_heap_write)
 apply(case_tac hT)
 apply(auto 4 4 dest!: typeof_addr_heap_clone dest: typeof_addr_is_type intro: widen_array_object subcls_C_Object)
 done
 
 end
 
 subsection \<open>Progress theorems for external calls\<close>
 
 context heap_progress begin
 
 lemma heap_copy_loc_progress:
   assumes hconf: "hconf h"
   and alconfa: "P,h \<turnstile> a@al : T"
   and alconfa': "P,h \<turnstile> a'@al : T"
   shows "\<exists>v h'. heap_copy_loc a a' al h ([ReadMem a al v, WriteMem a' al v]) h' \<and> P,h \<turnstile> v :\<le> T \<and> hconf h'"
 proof -
   from heap_read_total[OF hconf alconfa]
   obtain v where "heap_read h a al v" "P,h \<turnstile> v :\<le> T" by blast
   moreover from heap_write_total[OF hconf alconfa' \<open>P,h \<turnstile> v :\<le> T\<close>] obtain h' where "heap_write h a' al v h'" ..
   moreover hence "hconf h'" using hconf alconfa' \<open>P,h \<turnstile> v :\<le> T\<close> by(rule hconf_heap_write_mono)
   ultimately show ?thesis by(blast intro: heap_copy_loc.intros)
 qed
 
 lemma heap_copies_progress:
   assumes "hconf h"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts"
   shows "\<exists>vs h'. heap_copies a a' als h (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip als vs))) h' \<and> hconf h'"
 using assms
 proof(induct als arbitrary: h Ts)
   case Nil thus ?case by(auto intro: heap_copies.Nil)
 next
   case (Cons al als)
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) (al # als) Ts\<close>
   obtain T' Ts' where [simp]: "Ts = T' # Ts'"
     and "P,h \<turnstile> a@al : T'" "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) (al # als) Ts\<close>
   have "P,h \<turnstile> a'@al : T'" and "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts'" by simp_all
   from \<open>hconf h\<close> \<open>P,h \<turnstile> a@al : T'\<close> \<open>P,h \<turnstile> a'@al : T'\<close>
   obtain v h' where "heap_copy_loc a a' al h [ReadMem a al v, WriteMem a' al v] h'"
     and "hconf h'" by(fastforce dest: heap_copy_loc_progress)
   moreover hence "h \<unlhd> h'" by-(rule hext_heap_copy_loc)
   {
     note \<open>hconf h'\<close>
     moreover from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'\<close>
     have "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) als Ts'"
       by(rule list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>])
     moreover from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts'\<close>
     have "list_all2 (\<lambda>al T. P,h' \<turnstile> a'@al : T) als Ts'"
       by(rule list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>])
     ultimately have "\<exists>vs h''. heap_copies a a' als h' (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip als vs))) h'' \<and> hconf h''"
       by(rule Cons) }
   then obtain vs h''
     where "heap_copies a a' als h' (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip als vs))) h''"
     and "hconf h''" by blast
   ultimately
   have "heap_copies a a' (al # als) h ([ReadMem a al v, WriteMem a' al v] @ (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip als vs)))) h''"
     by- (rule heap_copies.Cons)
   also have "[ReadMem a al v, WriteMem a' al v] @ (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip als vs))) =
             (concat (map (\<lambda>(al, v). [ReadMem a al v, WriteMem a' al v]) (zip (al # als) (v # vs))))" by simp
   finally show ?case using \<open>hconf h''\<close> by blast
 qed
 
 lemma heap_clone_progress:
   assumes wf: "wf_prog wf_md P"
   and typea: "typeof_addr h a = \<lfloor>hT\<rfloor>"
   and hconf: "hconf h"
   shows "\<exists>h' res. heap_clone P h a h' res"
 proof -
   from typea hconf have "is_htype P hT" by(rule typeof_addr_is_type)
   show ?thesis
   proof(cases "allocate h hT = {}")
     case True
     with typea CloneFail[of h a hT P]
     show ?thesis by auto
   next
     case False
     then obtain h' a' where new: "(h', a') \<in> allocate h hT" by(rule not_empty_pairE)
     hence "h \<unlhd> h'" by(rule hext_allocate)
     have "hconf h'" using new hconf \<open>is_htype P hT\<close> by(rule hconf_allocate_mono)
     show ?thesis
     proof(cases hT)
       case [simp]: (Class_type C)
       from \<open>is_htype P hT\<close> have "is_class P C" by simp
       from wf_Fields_Ex[OF wf this]
       obtain FDTs where FDTs: "P \<turnstile> C has_fields FDTs" ..
       let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs"
       let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
       from typea FDTs have "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) ?als ?Ts"
-        unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+        unfolding list_all2_map1 list_all2_map2 list_all2_same
         by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
       hence "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) ?als ?Ts"
         by(rule list_all2_mono)(simp add: addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>] split_def)
       moreover from new \<open>is_class P C\<close>
       have "typeof_addr h' a' = \<lfloor>Class_type C\<rfloor>" by(auto dest: allocate_SomeD)
       with FDTs have "list_all2 (\<lambda>al T. P,h' \<turnstile> a'@al : T) ?als ?Ts"
-        unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+        unfolding list_all2_map1 list_all2_map2 list_all2_same
         by(fastforce intro: addr_loc_type.intros map_of_SomeI simp add: has_field_def dest: weak_map_of_SomeI)
       ultimately obtain obs h'' where "heap_copies a a' ?als h' obs h''" "hconf h''"
         by(blast dest: heap_copies_progress[OF \<open>hconf h'\<close>])
       with typea new FDTs ObjClone[of h a C h' a' P FDTs obs h'']
       show ?thesis by auto
     next
       case [simp]: (Array_type T n)
       from wf obtain FDTs where FDTs: "P \<turnstile> Object has_fields FDTs"
         by(blast dest: wf_Fields_Ex is_class_Object)
       let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]"
       let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate n T"
       from \<open>h \<unlhd> h'\<close> typea have type'a: "typeof_addr h' a = \<lfloor>Array_type T n\<rfloor>"
         by(auto intro: hext_arrD)
       from type'a FDTs have "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) ?als ?Ts"
-        by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+        by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
       moreover from new \<open>is_htype P hT\<close>
       have "typeof_addr h' a' = \<lfloor>Array_type T n\<rfloor>"
         by(auto dest: allocate_SomeD)
       hence "list_all2 (\<lambda>al T. P,h' \<turnstile> a'@al : T) ?als ?Ts" using FDTs
-        by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+        by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
       ultimately obtain obs h'' where "heap_copies a a' ?als h' obs h''" "hconf h''"
         by(blast dest: heap_copies_progress[OF \<open>hconf h'\<close>])
       with typea new FDTs ArrClone[of h a T n h' a' P FDTs obs h'']
       show ?thesis by auto
     qed
   qed
 qed
 
 theorem external_call_progress:
   assumes wf: "wf_prog wf_md P"
   and wt: "P,h \<turnstile> a\<bullet>M(vs) : U"
   and hconf: "hconf h"
   shows "\<exists>ta va h'. P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
 proof -
   note [simp del] = split_paired_Ex
   from wt obtain hT Ts Ts' D
     where T: "typeof_addr h a = \<lfloor>hT\<rfloor>" and Ts: "map typeof\<^bsub>h\<^esub> vs = map Some Ts"
     and "P \<turnstile> class_type_of hT sees M:Ts'\<rightarrow>U = Native in D" and subTs: "P \<turnstile> Ts [\<le>] Ts'"
     unfolding external_WT'_iff by blast
   from wf \<open>P \<turnstile> class_type_of hT sees M:Ts'\<rightarrow>U = Native in D\<close>
   have "D\<bullet>M(Ts') :: U" by(rule sees_wf_native)
   moreover from \<open>P \<turnstile> class_type_of hT sees M:Ts'\<rightarrow>U = Native in D\<close>
   have "P \<turnstile> ty_of_htype hT \<le> Class D"
     by(cases hT)(auto dest: sees_method_decl_above intro: widen_trans widen_array_object)
   ultimately show ?thesis using T Ts subTs
   proof cases
     assume [simp]: "D = Object" "M = clone" "Ts' = []" "U = Class Object"
     from heap_clone_progress[OF wf T hconf] obtain h' res where "heap_clone P h a h' res" by blast
     thus ?thesis using subTs Ts by(cases res)(auto intro: red_external.intros)
   qed(auto simp add: widen_Class intro: red_external.intros)
 qed
 
 end
 
 subsection \<open>Lemmas for preservation of deadlocked threads\<close>
 
 context heap_progress begin
 
 lemma red_external_wt_hconf_hext:
   assumes wf: "wf_prog wf_md P"
   and red: "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>"
   and hext: "h'' \<unlhd> h"
   and wt: "P,h'' \<turnstile> a\<bullet>M(vs) : U"
   and tconf: "P,h'' \<turnstile> t \<surd>t"
   and hconf: "hconf h''"
   shows "\<exists>ta' va' h'''. P,t \<turnstile> \<langle>a\<bullet>M(vs),h''\<rangle> -ta'\<rightarrow>ext \<langle>va', h'''\<rangle> \<and>
                         collect_locks \<lbrace>ta\<rbrace>\<^bsub>l\<^esub> = collect_locks \<lbrace>ta'\<rbrace>\<^bsub>l\<^esub> \<and>
                         collect_cond_actions \<lbrace>ta\<rbrace>\<^bsub>c\<^esub> = collect_cond_actions \<lbrace>ta'\<rbrace>\<^bsub>c\<^esub> \<and>
                         collect_interrupts \<lbrace>ta\<rbrace>\<^bsub>i\<^esub> = collect_interrupts \<lbrace>ta'\<rbrace>\<^bsub>i\<^esub>"
 using red wt hext
 proof cases
   case (RedClone obs a')
   from wt obtain hT C Ts Ts' D
     where T: "typeof_addr h'' a = \<lfloor>hT\<rfloor>"
     unfolding external_WT'_iff by blast
   from heap_clone_progress[OF wf T hconf]
   obtain h''' res where "heap_clone P h'' a h''' res" by blast
   thus ?thesis using RedClone
     by(cases res)(fastforce intro: red_external.intros)+
 next
   case RedCloneFail
   from wt obtain hT Ts Ts'
     where T: "typeof_addr h'' a = \<lfloor>hT\<rfloor>"
     unfolding external_WT'_iff by blast
   from heap_clone_progress[OF wf T hconf]
   obtain h''' res where "heap_clone P h'' a h''' res" by blast
   thus ?thesis using RedCloneFail
     by(cases res)(fastforce intro: red_external.intros)+
 qed(fastforce simp add: ta_upd_simps elim!: external_WT'.cases intro: red_external.intros[simplified] dest: typeof_addr_hext_mono)+
 
 lemma red_external_wf_red:
   assumes wf: "wf_prog wf_md P"
   and red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   and tconf: "P,h \<turnstile> t \<surd>t"
   and hconf: "hconf h"
   and wst: "wset s t = None \<or> (M = wait \<and> (\<exists>w. wset s t = \<lfloor>PostWS w\<rfloor>))"
   obtains ta' va' h''
   where "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta'\<rightarrow>ext \<langle>va', h''\<rangle>"
   and "final_thread.actions_ok final s t ta' \<or> final_thread.actions_ok' s t ta' \<and> final_thread.actions_subset ta' ta"
 proof(atomize_elim)
   let ?a_t = "thread_id2addr t"
   let ?t_a = "addr2thread_id a"
 
   from tconf obtain C where ht: "typeof_addr h ?a_t = \<lfloor>Class_type C\<rfloor>"
     and sub: "P \<turnstile> C \<preceq>\<^sup>* Thread" by(fastforce dest: tconfD)
 
   show "\<exists>ta' va' h'. P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta'\<rightarrow>ext \<langle>va', h'\<rangle> \<and> (final_thread.actions_ok final s t ta' \<or> final_thread.actions_ok' s t ta' \<and> final_thread.actions_subset ta' ta)"
   proof(cases "final_thread.actions_ok' s t ta")
     case True
     have "final_thread.actions_subset ta ta" by(rule final_thread.actions_subset_refl)
     with True red show ?thesis by blast
   next
     case False
     note [simp] = final_thread.actions_ok'_iff lock_ok_las'_def final_thread.cond_action_oks'_subset_Join
       final_thread.actions_subset_iff ta_upd_simps collect_cond_actions_def collect_interrupts_def
     note [rule del] = subsetI
     note [intro] = collect_locks'_subset_collect_locks red_external.intros[simplified]
 
     show ?thesis
     proof(cases "wset s t")
       case [simp]: (Some w)
       with wst obtain w' where [simp]: "w = PostWS w'" "M = wait" by auto
       from red have [simp]: "vs = []" by(auto elim: red_external.cases)
       show ?thesis
       proof(cases w')
         case [simp]: WSWokenUp
         let ?ta' = "\<lbrace>WokenUp, ClearInterrupt t, ObsInterrupted t\<rbrace>"
         have "final_thread.actions_ok' s t ?ta'" by(simp add: wset_actions_ok_def)
         moreover have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedWaitInterrupted
         have "\<exists>va h'. P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
         ultimately show ?thesis by blast
       next
         case [simp]: WSNotified
         let ?ta' = "\<lbrace>Notified\<rbrace>"
         have "final_thread.actions_ok' s t ?ta'" by(simp add: wset_actions_ok_def)
         moreover have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedWaitNotified
         have "\<exists>va h'. P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
         ultimately show ?thesis by blast
       qed
     next
       case None
 
       from red False show ?thesis
       proof cases
         case (RedNewThread C)
         note ta = \<open>ta = \<lbrace>NewThread ?t_a (C, run, a) h, ThreadStart ?t_a\<rbrace>\<close>
         let ?ta' = "\<lbrace>ThreadExists ?t_a True\<rbrace>"
         from ta False None have "final_thread.actions_ok' s t ?ta'" by(auto)
         moreover from ta have "final_thread.actions_subset ?ta' ta" by(auto)
         ultimately show ?thesis using RedNewThread by(fastforce)
       next
         case RedNewThreadFail
         then obtain va' h' x where "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -\<lbrace>NewThread ?t_a x h', ThreadStart ?t_a\<rbrace>\<rightarrow>ext \<langle>va', h'\<rangle>"
           by(fastforce)
         moreover from \<open>ta = \<lbrace>ThreadExists ?t_a True\<rbrace>\<close> False None
         have "final_thread.actions_ok' s t \<lbrace>NewThread ?t_a x h', ThreadStart ?t_a\<rbrace>" by(auto)
         moreover from \<open>ta = \<lbrace>ThreadExists ?t_a True\<rbrace>\<close>
         have "final_thread.actions_subset \<lbrace>NewThread ?t_a x h', ThreadStart ?t_a\<rbrace> ta" by(auto)
         ultimately show ?thesis by blast
       next
         case RedJoin
         let ?ta = "\<lbrace>IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>"
         from \<open>ta = \<lbrace>Join (addr2thread_id a), IsInterrupted t False, ThreadJoin (addr2thread_id a)\<rbrace>\<close> None False
         have "t \<in> interrupts s" by(auto)
         hence "final_thread.actions_ok final s t ?ta"
           using None by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta\<rightarrow>ext \<langle>va,h'\<rangle>" using RedJoinInterrupt RedJoin by auto
         ultimately show ?thesis by blast
       next
         case RedJoinInterrupt
         hence False using False None by(auto)
         thus ?thesis ..
       next
         case RedInterrupt
         let ?ta = "\<lbrace>ThreadExists (addr2thread_id a) False\<rbrace>"
         from RedInterrupt None False
         have "free_thread_id (thr s) (addr2thread_id a)" by(auto simp add: wset_actions_ok_def)
         hence "final_thread.actions_ok final s t ?ta" using None
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta\<rightarrow>ext \<langle>va,h'\<rangle>" using RedInterruptInexist RedInterrupt by auto
         ultimately show ?thesis by blast
       next
         case RedInterruptInexist
         let ?ta = "\<lbrace>ThreadExists (addr2thread_id a) True, WakeUp (addr2thread_id a), Interrupt (addr2thread_id a), ObsInterrupt (addr2thread_id a)\<rbrace>"
         from RedInterruptInexist None False
         have "\<not> free_thread_id (thr s) (addr2thread_id a)" by(auto simp add: wset_actions_ok_def)
         hence "final_thread.actions_ok final s t ?ta" using None
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps wset_actions_ok_def)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta\<rightarrow>ext \<langle>va,h'\<rangle>" using RedInterruptInexist RedInterrupt by auto
         ultimately show ?thesis by blast
       next
         case (RedIsInterruptedTrue C)
         let ?ta' = "\<lbrace>IsInterrupted ?t_a False\<rbrace>"
         from RedIsInterruptedTrue False None have "?t_a \<notin> interrupts s" by(auto)
         hence "final_thread.actions_ok' s t ?ta'" using None by auto
         moreover from RedIsInterruptedTrue have "final_thread.actions_subset ?ta' ta" by auto
         moreover from RedIsInterruptedTrue RedIsInterruptedFalse obtain va h'
           where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
         ultimately show ?thesis by blast
       next
         case (RedIsInterruptedFalse C)
         let ?ta' = "\<lbrace>IsInterrupted ?t_a True, ObsInterrupted ?t_a\<rbrace>"
         from RedIsInterruptedFalse have "?t_a \<in> interrupts s"
           using False None by(auto)
         hence "final_thread.actions_ok final s t ?ta'"
           using None by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>"
           using RedIsInterruptedFalse RedIsInterruptedTrue by auto
         ultimately show ?thesis by blast
       next
         case RedWaitInterrupt
         note ta = \<open>ta = \<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>\<close>
         from ta False None have hli: "\<not> has_lock (locks s $ a) t \<or> t \<notin> interrupts s"
           by(fastforce simp add: lock_actions_ok'_iff finfun_upd_apply split: if_split_asm dest: may_lock_t_may_lock_unlock_lock_t dest: has_lock_may_lock)
         show ?thesis
         proof(cases "has_lock (locks s $ a) t")
           case True
           let ?ta' = "\<lbrace>Suspend a, Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a \<rbrace>"
           from True hli have "t \<notin> interrupts s" by simp
           with True False have "final_thread.actions_ok' s t ?ta'" using None
             by(auto simp add: lock_actions_ok'_iff finfun_upd_apply wset_actions_ok_def Cons_eq_append_conv)
           moreover from ta have "final_thread.actions_subset ?ta' ta"
             by(auto simp add: collect_locks'_def finfun_upd_apply)
           moreover from RedWait RedWaitInterrupt obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
           ultimately show ?thesis by blast
         next
           case False
           let ?ta' = "\<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
           from False have "final_thread.actions_ok' s t ?ta'" using None
             by(auto simp add: lock_actions_ok'_iff finfun_upd_apply)
           moreover from ta have "final_thread.actions_subset ?ta' ta"
             by(auto simp add: collect_locks'_def finfun_upd_apply)
           moreover from RedWaitInterrupt obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
           ultimately show ?thesis by blast
         qed
       next
         case RedWait
         note ta = \<open>ta = \<lbrace>Suspend a, Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a\<rbrace>\<close>
 
         from ta False None have hli: "\<not> has_lock (locks s $ a) t \<or> t \<in> interrupts s"
           by(auto simp add: lock_actions_ok'_iff finfun_upd_apply wset_actions_ok_def Cons_eq_append_conv split: if_split_asm dest: may_lock_t_may_lock_unlock_lock_t dest: has_lock_may_lock)
         show ?thesis
         proof(cases "has_lock (locks s $ a) t")
           case True
           let ?ta' = "\<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>"
           from True hli have "t \<in> interrupts s" by simp
           with True False have "final_thread.actions_ok final s t ?ta'" using None
             by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps lock_ok_las_def finfun_upd_apply has_lock_may_lock)
           moreover from RedWait RedWaitInterrupt obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
           ultimately show ?thesis by blast
         next
           case False
           let ?ta' = "\<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
           from False have "final_thread.actions_ok' s t ?ta'" using None
             by(auto simp add: lock_actions_ok'_iff finfun_upd_apply)
           moreover from ta have "final_thread.actions_subset ?ta' ta"
             by(auto simp add: collect_locks'_def finfun_upd_apply)
           moreover from RedWait RedWaitFail obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
           ultimately show ?thesis by blast
         qed
       next
         case RedWaitFail
         note ta = \<open>ta = \<lbrace>UnlockFail\<rightarrow>a\<rbrace>\<close>
         let ?ta' = "if t \<in> interrupts s
                    then \<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>
                    else \<lbrace>Suspend a, Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a \<rbrace>"
         from ta False None have "has_lock (locks s $ a) t"
           by(auto simp add: finfun_upd_apply split: if_split_asm)
         hence "final_thread.actions_ok final s t ?ta'" using None
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps lock_ok_las_def finfun_upd_apply has_lock_may_lock wset_actions_ok_def)
         moreover from RedWaitFail RedWait RedWaitInterrupt
         obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>"
           by(cases "t \<in> interrupts s") (auto)
         ultimately show ?thesis by blast
       next
         case RedWaitNotified
         note ta = \<open>ta = \<lbrace>Notified\<rbrace>\<close>
         let ?ta' = "if has_lock (locks s $ a) t
                    then (if t \<in> interrupts s
                          then \<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>
                          else \<lbrace>Suspend a, Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a \<rbrace>)
                    else \<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
         have "final_thread.actions_ok final s t ?ta'" using None
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps lock_ok_las_def finfun_upd_apply has_lock_may_lock wset_actions_ok_def)
         moreover from RedWaitNotified RedWait RedWaitInterrupt RedWaitFail
         have "\<exists>va h'. P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
         ultimately show ?thesis by blast
       next
         case RedWaitInterrupted
         note ta = \<open>ta = \<lbrace>WokenUp, ClearInterrupt t, ObsInterrupted t\<rbrace>\<close>
         let ?ta' = "if has_lock (locks s $ a) t
                    then (if t \<in> interrupts s
                          then \<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>
                          else \<lbrace>Suspend a, Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a \<rbrace>)
                    else \<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
         have "final_thread.actions_ok final s t ?ta'" using None
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps lock_ok_las_def finfun_upd_apply has_lock_may_lock wset_actions_ok_def)
         moreover from RedWaitInterrupted RedWait RedWaitInterrupt RedWaitFail
         have "\<exists>va h'. P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
         ultimately show ?thesis by blast
       next
         case RedWaitSpurious
         note ta = \<open>ta = \<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, ReleaseAcquire\<rightarrow>a, IsInterrupted t False, SyncUnlock a\<rbrace>\<close>
         from ta False None have hli: "\<not> has_lock (locks s $ a) t \<or> t \<in> interrupts s"
           by(auto simp add: lock_actions_ok'_iff finfun_upd_apply wset_actions_ok_def Cons_eq_append_conv split: if_split_asm dest: may_lock_t_may_lock_unlock_lock_t dest: has_lock_may_lock)
         show ?thesis
         proof(cases "has_lock (locks s $ a) t")
           case True
           let ?ta' = "\<lbrace>Unlock\<rightarrow>a, Lock\<rightarrow>a, IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>"
           from True hli have "t \<in> interrupts s" by simp
           with True False have "final_thread.actions_ok final s t ?ta'" using None
             by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps lock_ok_las_def finfun_upd_apply has_lock_may_lock)
           moreover from RedWaitInterrupt RedWaitSpurious(1-5)
           obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by auto
           ultimately show ?thesis by blast
         next
           case False
           let ?ta' = "\<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
           from False have "final_thread.actions_ok' s t ?ta'" using None
             by(auto simp add: lock_actions_ok'_iff finfun_upd_apply)
           moreover from ta have "final_thread.actions_subset ?ta' ta"
             by(auto simp add: collect_locks'_def finfun_upd_apply)
           moreover from RedWaitSpurious(1-5) RedWaitFail
           obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
           ultimately show ?thesis by blast
         qed
 
       next
         case RedNotify
         note ta = \<open>ta = \<lbrace>Notify a, Unlock\<rightarrow>a, Lock\<rightarrow>a\<rbrace>\<close>
         let ?ta' = "\<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
         from ta False None have "\<not> has_lock (locks s $ a) t"
           by(fastforce simp add: lock_actions_ok'_iff finfun_upd_apply wset_actions_ok_def Cons_eq_append_conv split: if_split_asm dest: may_lock_t_may_lock_unlock_lock_t has_lock_may_lock)
         hence "final_thread.actions_ok' s t ?ta'" using None
           by(auto simp add: lock_actions_ok'_iff finfun_upd_apply)
         moreover from ta have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedNotify obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
         ultimately show ?thesis by blast
       next
         case RedNotifyFail
         note ta = \<open>ta = \<lbrace>UnlockFail\<rightarrow>a\<rbrace>\<close>
         let ?ta' = "\<lbrace>Notify a, Unlock\<rightarrow>a, Lock\<rightarrow>a\<rbrace>"
         from ta False None have "has_lock (locks s $ a) t"
           by(auto simp add: finfun_upd_apply split: if_split_asm)
         hence "final_thread.actions_ok' s t ?ta'" using None
           by(auto simp add: finfun_upd_apply simp add: wset_actions_ok_def intro: has_lock_may_lock)
         moreover from ta have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedNotifyFail obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
         ultimately show ?thesis by blast
       next
         case RedNotifyAll
         note ta = \<open>ta = \<lbrace>NotifyAll a, Unlock\<rightarrow>a, Lock\<rightarrow>a\<rbrace>\<close>
         let ?ta' = "\<lbrace>UnlockFail\<rightarrow>a\<rbrace>"
         from ta False None have "\<not> has_lock (locks s $ a) t"
           by(auto simp add: lock_actions_ok'_iff finfun_upd_apply wset_actions_ok_def Cons_eq_append_conv split: if_split_asm dest: may_lock_t_may_lock_unlock_lock_t)
         hence "final_thread.actions_ok' s t ?ta'" using None
           by(auto simp add: lock_actions_ok'_iff finfun_upd_apply)
         moreover from ta have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedNotifyAll obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
         ultimately show ?thesis by blast
       next
         case RedNotifyAllFail
         note ta = \<open>ta = \<lbrace>UnlockFail\<rightarrow>a\<rbrace>\<close>
         let ?ta' = "\<lbrace>NotifyAll a, Unlock\<rightarrow>a, Lock\<rightarrow>a\<rbrace>"
         from ta False None have "has_lock (locks s $ a) t"
           by(auto simp add: finfun_upd_apply split: if_split_asm)
         hence "final_thread.actions_ok' s t ?ta'" using None
           by(auto simp add: finfun_upd_apply wset_actions_ok_def intro: has_lock_may_lock)
         moreover from ta have "final_thread.actions_subset ?ta' ta"
           by(auto simp add: collect_locks'_def finfun_upd_apply)
         moreover from RedNotifyAllFail obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by(fastforce)
         ultimately show ?thesis by blast
       next
         case RedInterruptedTrue
         let ?ta' = "\<lbrace>IsInterrupted t False\<rbrace>"
         from RedInterruptedTrue have "final_thread.actions_ok final s t ?ta'"
           using None False by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>"
           using RedInterruptedFalse RedInterruptedTrue by auto
         ultimately show ?thesis by blast
       next
         case RedInterruptedFalse
         let ?ta' = "\<lbrace>IsInterrupted t True, ClearInterrupt t, ObsInterrupted t\<rbrace>"
         from RedInterruptedFalse have "final_thread.actions_ok final s t ?ta'"
           using None False
           by(auto simp add: final_thread.actions_ok_iff final_thread.cond_action_oks.simps)
         moreover obtain va h' where "P,t \<turnstile> \<langle>a\<bullet>M(vs),h\<rangle> -?ta'\<rightarrow>ext \<langle>va,h'\<rangle>"
           using RedInterruptedFalse RedInterruptedTrue by auto
         ultimately show ?thesis by blast
       qed(auto simp add: None)
     qed
   qed
 qed
 
 end
 
 context heap_base begin
 
 lemma red_external_ta_satisfiable:
   fixes final
   assumes "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   shows "\<exists>s. final_thread.actions_ok final s t ta"
 proof -
   note [simp] =
     final_thread.actions_ok_iff final_thread.cond_action_oks.simps final_thread.cond_action_ok.simps
     lock_ok_las_def finfun_upd_apply wset_actions_ok_def has_lock_may_lock
     and [intro] =
     free_thread_id.intros
     and [cong] = conj_cong
 
   from assms show ?thesis by cases(fastforce intro: exI[where x="(K$ None)(a $:= \<lfloor>(t, 0)\<rfloor>)"] exI[where x="(K$ None)"])+
 qed
 
 lemma red_external_aggr_ta_satisfiable:
   fixes final
   assumes "(ta, va, h') \<in> red_external_aggr P t a M vs h"
   shows "\<exists>s. final_thread.actions_ok final s t ta"
 proof -
   note [simp] =
     final_thread.actions_ok_iff final_thread.cond_action_oks.simps final_thread.cond_action_ok.simps
     lock_ok_las_def finfun_upd_apply wset_actions_ok_def has_lock_may_lock
     and [intro] =
     free_thread_id.intros
     and [cong] = conj_cong
 
   from assms show ?thesis
     by(fastforce simp add: red_external_aggr_def split_beta ta_upd_simps split: if_split_asm intro: exI[where x="Map.empty"] exI[where x="(K$ None)(a $:= \<lfloor>(t, 0)\<rfloor>)"] exI[where x="K$ None"])
 qed
 
 end
 
 subsection \<open>Determinism\<close>
 
 context heap_base begin
 
 lemma heap_copy_loc_deterministic:
   assumes det: "deterministic_heap_ops"
   and copy: "heap_copy_loc a a' al h ops h'" "heap_copy_loc a a' al h ops' h''"
   shows "ops = ops' \<and> h' = h''"
 using copy
 by(auto elim!: heap_copy_loc.cases dest: deterministic_heap_ops_readD[OF det] deterministic_heap_ops_writeD[OF det])
 
 lemma heap_copies_deterministic:
   assumes det: "deterministic_heap_ops"
   and copy: "heap_copies a a' als h ops h'" "heap_copies a a' als h ops' h''"
   shows "ops = ops' \<and> h' = h''"
 using copy
 apply(induct arbitrary: ops' h'')
  apply(fastforce elim!: heap_copies_cases)
 apply(erule heap_copies_cases)
 apply clarify
 apply(drule (1) heap_copy_loc_deterministic[OF det])
 apply clarify
 apply(unfold same_append_eq)
 apply blast
 done
 
 lemma heap_clone_deterministic:
   assumes det: "deterministic_heap_ops"
   and clone: "heap_clone P h a h' obs" "heap_clone P h a h'' obs'"
   shows "h' = h'' \<and> obs = obs'"
 using clone
 by(auto 4 4 elim!: heap_clone.cases dest: heap_copies_deterministic[OF det] deterministic_heap_ops_allocateD[OF det] has_fields_fun)
 
 lemma red_external_deterministic:
   fixes final
   assumes det: "deterministic_heap_ops"
   and red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), (shr s)\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>" "P,t \<turnstile> \<langle>a\<bullet>M(vs), (shr s)\<rangle> -ta'\<rightarrow>ext \<langle>va', h''\<rangle>"
   and aok: "final_thread.actions_ok final s t ta" "final_thread.actions_ok final s t ta'"
   shows "ta = ta' \<and> va = va' \<and> h' = h''"
 using red aok
 apply(simp add: final_thread.actions_ok_iff lock_ok_las_def)
 apply(erule red_external.cases)
 apply(erule_tac [!] red_external.cases)
 apply simp_all
 apply(auto simp add: finfun_upd_apply wset_actions_ok_def dest: heap_clone_deterministic[OF det] split: if_split_asm)
 using deterministic_heap_ops_no_spurious_wakeups[OF det]
 apply simp_all
 done
 
 end
 
 end
diff --git a/thys/JinjaThreads/Compiler/Correctness1.thy b/thys/JinjaThreads/Compiler/Correctness1.thy
--- a/thys/JinjaThreads/Compiler/Correctness1.thy
+++ b/thys/JinjaThreads/Compiler/Correctness1.thy
@@ -1,2385 +1,2385 @@
 (*  Title:      JinjaThreads/Compiler/Correctness1.thy
     Author:     Andreas Lochbihler, Tobias Nipkow
 
     reminiscent of the Jinja theory Compiler/Correctness1
 *)
 
 section \<open>Semantic Correctness of Stage 1\<close>
 
 theory Correctness1 imports
   J0J1Bisim
   "../J/DefAssPreservation"
 begin
 
 lemma finals_map_Val [simp]: "finals (map Val vs)"
 by(simp add: finals_iff)
 
 context J_heap_base begin
 
 lemma \<tau>red0r_preserves_defass:
   assumes wf: "wf_J_prog P"
   shows "\<lbrakk> \<tau>red0r extTA P t h (e, xs) (e', xs'); \<D> e \<lfloor>dom xs\<rfloor> \<rbrakk> \<Longrightarrow> \<D> e' \<lfloor>dom xs'\<rfloor>"
 by(induct rule: rtranclp_induct2)(auto dest: red_preserves_defass[OF wf])
 
 lemma \<tau>red0t_preserves_defass:
   assumes wf: "wf_J_prog P"
   shows "\<lbrakk> \<tau>red0t extTA P t h (e, xs) (e', xs'); \<D> e \<lfloor>dom xs\<rfloor> \<rbrakk> \<Longrightarrow> \<D> e' \<lfloor>dom xs'\<rfloor>"
 by(rule \<tau>red0r_preserves_defass[OF wf])(rule tranclp_into_rtranclp)
 
 end
 
 lemma LAss_lem:
   "\<lbrakk>x \<in> set xs; size xs \<le> size ys \<rbrakk>
   \<Longrightarrow> m1 \<subseteq>\<^sub>m m2(xs[\<mapsto>]ys) \<Longrightarrow> m1(x\<mapsto>y) \<subseteq>\<^sub>m m2(xs[\<mapsto>]ys[index xs x := y])"
 apply(simp add:map_le_def)
 apply(simp add:fun_upds_apply index_less_aux eq_sym_conv)
 done
 
 lemma Block_lem:
 fixes l :: "'a \<rightharpoonup> 'b"
 assumes 0: "l \<subseteq>\<^sub>m [Vs [\<mapsto>] ls]"
     and 1: "l' \<subseteq>\<^sub>m [Vs [\<mapsto>] ls', V\<mapsto>v]"
     and hidden: "V \<in> set Vs \<Longrightarrow> ls ! index Vs V = ls' ! index Vs V"
     and size: "size ls = size ls'"    "size Vs < size ls'"
 shows "l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']"
 proof -
   have "l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls', V\<mapsto>v](V := l V)"
     using 1 by(rule map_le_upd)
   also have "\<dots> = [Vs [\<mapsto>] ls'](V := l V)" by simp
   also have "\<dots> \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']"
   proof (cases "l V")
     case None thus ?thesis by simp
   next
     case (Some w)
     hence "[Vs [\<mapsto>] ls] V = Some w"
       using 0 by(force simp add: map_le_def split:if_splits)
     hence VinVs: "V \<in> set Vs" and w: "w = ls ! index Vs V"
       using size by(auto simp add:fun_upds_apply split:if_splits)
     hence "w = ls' ! index Vs V" using hidden[OF VinVs] by simp
     hence "[Vs [\<mapsto>] ls'](V := l V) = [Vs [\<mapsto>] ls']"
       using Some size VinVs by(simp add:index_less_aux map_upds_upd_conv_index)
     thus ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 subsection \<open>Correctness proof\<close>
 
 locale J0_J1_heap_base =
   J?: J_heap_base +
   J1?: J1_heap_base + 
   constrains addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   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
 
 lemma ta_bisim01_extTA2J0_extTA2J1:
   assumes wf: "wf_J_prog P"
   and 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>T meth D. P \<turnstile> C sees M:[]\<rightarrow>T =\<lfloor>meth\<rfloor> in D)"
   shows "ta_bisim01 (extTA2J0 P ta) (extTA2J1 (compP1 P) ta)"
 apply(simp add: ta_bisim_def ta_upd_simps)
 apply(auto intro!: list_all2_all_nthI)
 apply(case_tac "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub> ! n")
   apply(auto simp add: bisim_red0_Red1_def)
 apply(drule (1) nt)
 apply(clarify)
 apply(erule bisim_list_extTA2J0_extTA2J1[OF wf, simplified])
 done
 
 lemma red_external_ta_bisim01: 
   "\<lbrakk> wf_J_prog P; P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle> \<rbrakk> \<Longrightarrow> ta_bisim01 (extTA2J0 P ta) (extTA2J1 (compP1 P) ta)"
 apply(rule ta_bisim01_extTA2J0_extTA2J1, assumption)
 apply(drule (1) red_external_new_thread_sees, auto simp add: in_set_conv_nth)
 apply(drule red_ext_new_thread_heap, auto simp add: in_set_conv_nth)
 done
 
 lemmas \<tau>red1t_expr =
   NewArray_\<tau>red1t_xt Cast_\<tau>red1t_xt InstanceOf_\<tau>red1t_xt BinOp_\<tau>red1t_xt1 BinOp_\<tau>red1t_xt2 LAss_\<tau>red1t
   AAcc_\<tau>red1t_xt1 AAcc_\<tau>red1t_xt2 AAss_\<tau>red1t_xt1 AAss_\<tau>red1t_xt2 AAss_\<tau>red1t_xt3
   ALength_\<tau>red1t_xt FAcc_\<tau>red1t_xt FAss_\<tau>red1t_xt1 FAss_\<tau>red1t_xt2 
   CAS_\<tau>red1t_xt1 CAS_\<tau>red1t_xt2 CAS_\<tau>red1t_xt3 Call_\<tau>red1t_obj
   Call_\<tau>red1t_param Block_None_\<tau>red1t_xt Block_\<tau>red1t_Some Sync_\<tau>red1t_xt InSync_\<tau>red1t_xt
   Seq_\<tau>red1t_xt Cond_\<tau>red1t_xt Throw_\<tau>red1t_xt Try_\<tau>red1t_xt
 
 lemmas \<tau>red1r_expr =
   NewArray_\<tau>red1r_xt Cast_\<tau>red1r_xt InstanceOf_\<tau>red1r_xt BinOp_\<tau>red1r_xt1 BinOp_\<tau>red1r_xt2 LAss_\<tau>red1r
   AAcc_\<tau>red1r_xt1 AAcc_\<tau>red1r_xt2 AAss_\<tau>red1r_xt1 AAss_\<tau>red1r_xt2 AAss_\<tau>red1r_xt3
   ALength_\<tau>red1r_xt FAcc_\<tau>red1r_xt FAss_\<tau>red1r_xt1 FAss_\<tau>red1r_xt2
   CAS_\<tau>red1r_xt1 CAS_\<tau>red1r_xt2 CAS_\<tau>red1r_xt3 Call_\<tau>red1r_obj
   Call_\<tau>red1r_param Block_None_\<tau>red1r_xt Block_\<tau>red1r_Some Sync_\<tau>red1r_xt InSync_\<tau>red1r_xt
   Seq_\<tau>red1r_xt Cond_\<tau>red1r_xt Throw_\<tau>red1r_xt Try_\<tau>red1r_xt
 
 definition sim_move01 :: 
   "'addr J1_prog \<Rightarrow> 'thread_id \<Rightarrow> ('addr, 'thread_id, 'heap) J0_thread_action \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr1 \<Rightarrow> 'heap
   \<Rightarrow> 'addr locals1 \<Rightarrow> ('addr, 'thread_id, 'heap) external_thread_action \<Rightarrow> 'addr expr1 \<Rightarrow> 'heap \<Rightarrow> 'addr locals1 \<Rightarrow> bool"
 where
   "sim_move01 P t ta0 e0 e h xs ta e' h' xs' \<longleftrightarrow> \<not> final e0 \<and>
   (if \<tau>move0 P h e0 then h' = h \<and> ta0 = \<epsilon> \<and> ta = \<epsilon> \<and> \<tau>red1't P t h (e, xs) (e', xs')
    else ta_bisim01 ta0 (extTA2J1 P ta) \<and>
      (if call e0 = None \<or> call1 e = None
       then (\<exists>e'' xs''. \<tau>red1'r P t h (e, xs) (e'', xs'') \<and> False,P,t \<turnstile>1 \<langle>e'', (h, xs'')\<rangle> -ta\<rightarrow> \<langle>e', (h', xs')\<rangle> \<and>
                        \<not> \<tau>move1 P h e'')
       else False,P,t \<turnstile>1 \<langle>e, (h, xs)\<rangle> -ta\<rightarrow> \<langle>e', (h', xs')\<rangle> \<and> \<not> \<tau>move1 P h e))"
 
 definition sim_moves01 :: 
   "'addr J1_prog \<Rightarrow> 'thread_id \<Rightarrow> ('addr, 'thread_id, 'heap) J0_thread_action \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr1 list \<Rightarrow> 'heap
   \<Rightarrow> 'addr locals1 \<Rightarrow> ('addr, 'thread_id, 'heap) external_thread_action \<Rightarrow> 'addr expr1 list \<Rightarrow> 'heap \<Rightarrow> 'addr locals1 \<Rightarrow> bool"
 where
   "sim_moves01 P t ta0 es0 es h xs ta es' h' xs' \<longleftrightarrow> \<not> finals es0 \<and>
   (if \<tau>moves0 P h es0 then h' = h \<and> ta0 = \<epsilon> \<and> ta = \<epsilon> \<and> \<tau>reds1't P t h (es, xs) (es', xs')
    else ta_bisim01 ta0 (extTA2J1 P ta) \<and>
      (if calls es0 = None \<or> calls1 es = None
       then (\<exists>es'' xs''. \<tau>reds1'r P t h (es, xs) (es'', xs'') \<and> False,P,t \<turnstile>1 \<langle>es'', (h, xs'')\<rangle> [-ta\<rightarrow>] \<langle>es', (h', xs')\<rangle> \<and> 
                         \<not> \<tau>moves1 P h es'')
       else False,P,t \<turnstile>1 \<langle>es, (h, xs)\<rangle> [-ta\<rightarrow>] \<langle>es', (h', xs')\<rangle> \<and> \<not> \<tau>moves1 P h es))"
 
 declare \<tau>red1t_expr [elim!] \<tau>red1r_expr[elim!]
 
 lemma sim_move01_expr:
   assumes "sim_move01 P t ta0 e0 e h xs ta e' h' xs'"
   shows
   "sim_move01 P t ta0 (newA T\<lfloor>e0\<rceil>) (newA T\<lfloor>e\<rceil>) h xs ta (newA T\<lfloor>e'\<rceil>) h' xs'"
   "sim_move01 P t ta0 (Cast T e0) (Cast T e) h xs ta (Cast T e') h' xs'"
   "sim_move01 P t ta0 (e0 instanceof T) (e instanceof T) h xs ta (e' instanceof T) h' xs'"
   "sim_move01 P t ta0 (e0 \<guillemotleft>bop\<guillemotright> e2) (e \<guillemotleft>bop\<guillemotright> e2') h xs ta (e' \<guillemotleft>bop\<guillemotright> e2') h' xs'"
   "sim_move01 P t ta0 (Val v \<guillemotleft>bop\<guillemotright> e0) (Val v \<guillemotleft>bop\<guillemotright> e) h xs ta (Val v \<guillemotleft>bop\<guillemotright> e') h' xs'"
   "sim_move01 P t ta0 (V := e0) (V' := e) h xs ta (V' := e') h' xs'"
   "sim_move01 P t ta0 (e0\<lfloor>e2\<rceil>) (e\<lfloor>e2'\<rceil>) h xs ta (e'\<lfloor>e2'\<rceil>) h' xs'"
   "sim_move01 P t ta0 (Val v\<lfloor>e0\<rceil>) (Val v\<lfloor>e\<rceil>) h xs ta (Val v\<lfloor>e'\<rceil>) h' xs'"
   "sim_move01 P t ta0 (e0\<lfloor>e2\<rceil> := e3) (e\<lfloor>e2'\<rceil> := e3') h xs ta (e'\<lfloor>e2'\<rceil> := e3') h' xs'"
   "sim_move01 P t ta0 (Val v\<lfloor>e0\<rceil> := e3) (Val v\<lfloor>e\<rceil> := e3') h xs ta (Val v\<lfloor>e'\<rceil> := e3') h' xs'"
   "sim_move01 P t ta0 (AAss (Val v) (Val v') e0) (AAss (Val v) (Val v') e) h xs ta (AAss (Val v) (Val v') e') h' xs'"
   "sim_move01 P t ta0 (e0\<bullet>length) (e\<bullet>length) h xs ta (e'\<bullet>length) h' xs'"
   "sim_move01 P t ta0 (e0\<bullet>F{D}) (e\<bullet>F'{D'}) h xs ta (e'\<bullet>F'{D'}) h' xs'"
   "sim_move01 P t ta0 (FAss e0 F D e2) (FAss e F' D' e2') h xs ta (FAss e' F' D' e2') h' xs'"
   "sim_move01 P t ta0 (FAss (Val v) F D e0) (FAss (Val v) F' D' e) h xs ta (FAss (Val v) F' D' e') h' xs'"
   "sim_move01 P t ta0 (CompareAndSwap e0 D F e2 e3) (CompareAndSwap e D F e2' e3') h xs ta (CompareAndSwap e' D F e2' e3') h' xs'"
   "sim_move01 P t ta0 (CompareAndSwap (Val v) D F e0 e3) (CompareAndSwap (Val v) D F e e3') h xs ta (CompareAndSwap (Val v) D F e' e3') h' xs'"
   "sim_move01 P t ta0 (CompareAndSwap (Val v) D F (Val v') e0) (CompareAndSwap (Val v) D F (Val v') e) h xs ta (CompareAndSwap (Val v) D F (Val v') e') h' xs'"
   "sim_move01 P t ta0 (e0\<bullet>M(es)) (e\<bullet>M(es')) h xs ta (e'\<bullet>M(es')) h' xs'"
   "sim_move01 P t ta0 ({V:T=vo; e0}) ({V':T=None; e}) h xs ta ({V':T=None; e'}) h' xs'"
   "sim_move01 P t ta0 (sync(e0) e2) (sync\<^bsub>V'\<^esub>(e) e2') h xs ta (sync\<^bsub>V'\<^esub>(e') e2') h' xs'"
   "sim_move01 P t ta0 (insync(a) e0) (insync\<^bsub>V'\<^esub>(a') e) h xs ta (insync\<^bsub>V'\<^esub>(a') e') h' xs'"
   "sim_move01 P t ta0 (e0;;e2) (e;;e2') h xs ta (e';;e2') h' xs'"
   "sim_move01 P t ta0 (if (e0) e2 else e3) (if (e) e2' else e3') h xs ta (if (e') e2' else e3') h' xs'"
   "sim_move01 P t ta0 (throw e0) (throw e) h xs ta (throw e') h' xs'"
   "sim_move01 P t ta0 (try e0 catch(C V) e2) (try e catch(C' V') e2') h xs ta (try e' catch(C' V') e2') h' xs'"
 using assms
 apply(simp_all add: sim_move01_def final_iff \<tau>red1r_Val \<tau>red1t_Val split: if_split_asm split del: if_split)
 apply(fastforce simp add: final_iff \<tau>red1r_Val \<tau>red1t_Val split!: if_splits intro: red1_reds1.intros)+
 done
 
 lemma sim_moves01_expr:
   "sim_move01 P t ta0 e0 e h xs ta e' h' xs' \<Longrightarrow> sim_moves01 P t ta0 (e0 # es2) (e # es2') h xs ta (e' # es2') h' xs'"
   "sim_moves01 P t ta0 es0 es h xs ta es' h' xs' \<Longrightarrow> sim_moves01 P t ta0 (Val v # es0) (Val v # es) h xs ta (Val v # es') h' xs'"
 apply(simp_all add: sim_move01_def sim_moves01_def final_iff finals_iff Cons_eq_append_conv \<tau>red1t_Val \<tau>red1r_Val split: if_split_asm split del: if_split)
 apply(auto simp add: Cons_eq_append_conv \<tau>red1t_Val \<tau>red1r_Val split!: if_splits intro: List1Red1 List1Red2 \<tau>red1t_inj_\<tau>reds1t \<tau>red1r_inj_\<tau>reds1r \<tau>reds1t_cons_\<tau>reds1t \<tau>reds1r_cons_\<tau>reds1r)
 apply(force elim!: \<tau>red1r_inj_\<tau>reds1r List1Red1)
 apply(force elim!: \<tau>red1r_inj_\<tau>reds1r List1Red1)
 apply(force elim!: \<tau>red1r_inj_\<tau>reds1r List1Red1)
 apply(force elim!: \<tau>red1r_inj_\<tau>reds1r List1Red1)
 apply(force elim!: \<tau>reds1r_cons_\<tau>reds1r intro!: List1Red2)
 apply(force elim!: \<tau>reds1r_cons_\<tau>reds1r intro!: List1Red2)
 done
 
 lemma sim_move01_CallParams:
   "sim_moves01 P t ta0 es0 es h xs ta es' h' xs'
   \<Longrightarrow> sim_move01 P t ta0 (Val v\<bullet>M(es0)) (Val v\<bullet>M(es)) h xs ta (Val v\<bullet>M(es')) h' xs'"
 apply(clarsimp simp add: sim_move01_def sim_moves01_def \<tau>reds1r_map_Val \<tau>reds1t_map_Val is_vals_conv split: if_split_asm split del: if_split)
   apply(fastforce simp add: sim_move01_def sim_moves01_def \<tau>reds1r_map_Val \<tau>reds1t_map_Val intro: Call_\<tau>red1r_param Call1Params)
  apply(rule conjI, fastforce)
  apply(split if_split)
  apply(rule conjI)
   apply(clarsimp simp add: finals_iff)
  apply(clarify)
  apply(split if_split)
  apply(rule conjI)
   apply(simp del: call.simps calls.simps call1.simps calls1.simps)
   apply(fastforce simp add: sim_move01_def sim_moves01_def \<tau>red1r_Val \<tau>red1t_Val \<tau>reds1r_map_Val_Throw intro: Call_\<tau>red1r_param Call1Params split: if_split_asm)
  apply(fastforce split: if_split_asm simp add: is_vals_conv \<tau>reds1r_map_Val \<tau>reds1r_map_Val_Throw)
 apply(rule conjI, fastforce)
 apply(fastforce simp add: sim_move01_def sim_moves01_def \<tau>red1r_Val \<tau>red1t_Val \<tau>reds1t_map_Val \<tau>reds1r_map_Val is_vals_conv intro: Call_\<tau>red1r_param Call1Params split: if_split_asm)
 done
 
 lemma sim_move01_reds:
   "\<lbrakk> (h', a) \<in> allocate h (Class_type C); ta0 = \<lbrace>NewHeapElem a (Class_type C)\<rbrace>; ta = \<lbrace>NewHeapElem a (Class_type C)\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (new C) (new C) h xs ta (addr a) h' xs"
   "allocate h (Class_type C) = {} \<Longrightarrow> sim_move01 P t \<epsilon> (new C) (new C) h xs \<epsilon> (THROW OutOfMemory) h xs"
   "\<lbrakk> (h', a) \<in> allocate h (Array_type T (nat (sint i))); 0 <=s i;
      ta0 = \<lbrace>NewHeapElem a (Array_type T (nat (sint i)))\<rbrace>; ta = \<lbrace>NewHeapElem a (Array_type T (nat (sint i)))\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (newA T\<lfloor>Val (Intg i)\<rceil>) (newA T\<lfloor>Val (Intg i)\<rceil>) h xs ta (addr a) h' xs"
   "i <s 0 \<Longrightarrow> sim_move01 P t \<epsilon> (newA T\<lfloor>Val (Intg i)\<rceil>) (newA T\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW NegativeArraySize) h xs"
   "\<lbrakk> allocate h (Array_type T (nat (sint i))) = {}; 0 <=s i \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (newA T\<lfloor>Val (Intg i)\<rceil>) (newA T\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW OutOfMemory) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (Cast T (Val v)) (Cast T (Val v)) h xs \<epsilon> (Val v) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; \<not> P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (Cast T (Val v)) (Cast T (Val v)) h xs \<epsilon> (THROW ClassCast) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; b \<longleftrightarrow> v \<noteq> Null \<and> P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> ((Val v) instanceof T) ((Val v) instanceof T) h xs \<epsilon> (Val (Bool b)) h xs"
   "binop bop v1 v2 = Some (Inl v) \<Longrightarrow> sim_move01 P t \<epsilon> ((Val v1) \<guillemotleft>bop\<guillemotright> (Val v2)) (Val v1 \<guillemotleft>bop\<guillemotright> Val v2) h xs \<epsilon> (Val v) h xs"
   "binop bop v1 v2 = Some (Inr a) \<Longrightarrow> sim_move01 P t \<epsilon> ((Val v1) \<guillemotleft>bop\<guillemotright> (Val v2)) (Val v1 \<guillemotleft>bop\<guillemotright> Val v2) h xs \<epsilon> (Throw a) h xs"
   "\<lbrakk> xs!V = v; V < size xs \<rbrakk> \<Longrightarrow> sim_move01 P t \<epsilon> (Var V') (Var V) h xs \<epsilon> (Val v) h xs"
   "V < length xs \<Longrightarrow> sim_move01 P t \<epsilon> (V' := Val v) (V := Val v) h xs \<epsilon> unit h (xs[V := v])"
   "sim_move01 P t \<epsilon> (null\<lfloor>Val v\<rceil>) (null\<lfloor>Val v\<rceil>) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; i <s 0 \<or> sint i \<ge> int n \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (addr a\<lfloor>Val (Intg i)\<rceil>) ((addr a)\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW ArrayIndexOutOfBounds) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n;
      heap_read h a (ACell (nat (sint i))) v;
      ta0 = \<lbrace>ReadMem a (ACell (nat (sint i))) v\<rbrace>; 
      ta = \<lbrace>ReadMem a (ACell (nat (sint i))) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (addr a\<lfloor>Val (Intg i)\<rceil>) ((addr a)\<lfloor>Val (Intg i)\<rceil>) h xs ta (Val v) h xs"
   "sim_move01 P t \<epsilon> (null\<lfloor>Val v\<rceil> := Val v') (null\<lfloor>Val v\<rceil> := Val v') h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; i <s 0 \<or> sint i \<ge> int n \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (AAss (addr a) (Val (Intg i)) (Val v)) (AAss (addr a) (Val (Intg i)) (Val v)) h xs \<epsilon> (THROW ArrayIndexOutOfBounds) h xs"
  "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n; typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; \<not> (P \<turnstile> U \<le> T) \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (AAss (addr a) (Val (Intg i)) (Val v)) (AAss (addr a) (Val (Intg i)) (Val v)) h xs \<epsilon> (THROW ArrayStore) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n; typeof\<^bsub>h\<^esub> v = Some U; P \<turnstile> U \<le> T;
      heap_write h a (ACell (nat (sint i))) v h'; 
      ta0 = \<lbrace>WriteMem a (ACell (nat (sint i))) v\<rbrace>; ta = \<lbrace>WriteMem a (ACell (nat (sint i))) v \<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (AAss (addr a) (Val (Intg i)) (Val v)) (AAss (addr a) (Val (Intg i)) (Val v)) h xs ta unit h' xs"
   "typeof_addr h a = \<lfloor>Array_type T n\<rfloor> \<Longrightarrow> sim_move01 P t \<epsilon> (addr a\<bullet>length) (addr a\<bullet>length) h xs \<epsilon> (Val (Intg (word_of_int (int n)))) h xs"
   "sim_move01 P t \<epsilon> (null\<bullet>length) (null\<bullet>length) h xs \<epsilon> (THROW NullPointer) h xs"
 
   "\<lbrakk> heap_read h a (CField D F) v; ta0 = \<lbrace>ReadMem a (CField D F) v\<rbrace>; ta = \<lbrace>ReadMem a (CField D F) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (addr a\<bullet>F{D}) (addr a\<bullet>F{D}) h xs ta (Val v) h xs"
   "sim_move01 P t \<epsilon> (null\<bullet>F{D}) (null\<bullet>F{D}) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> heap_write h a (CField D F) v h'; ta0 = \<lbrace>WriteMem a (CField D F) v\<rbrace>; ta = \<lbrace>WriteMem a (CField D F) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (addr a\<bullet>F{D} := Val v) (addr a\<bullet>F{D} := Val v) h xs ta unit h' xs"
   "sim_move01 P t \<epsilon> (null\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) (null\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> heap_read h a (CField D F) v''; heap_write h a (CField D F) v' h'; v'' = v; 
      ta0 = \<lbrace>ReadMem a (CField D F) v'', WriteMem a (CField D F) v'\<rbrace>; ta = \<lbrace>ReadMem a (CField D F) v'', WriteMem a (CField D F) v'\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs ta true h' xs"
   "\<lbrakk> heap_read h a (CField D F) v''; v'' \<noteq> v; 
      ta0 = \<lbrace>ReadMem a (CField D F) v''\<rbrace>; ta = \<lbrace>ReadMem a (CField D F) v''\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs ta false h xs"
   "sim_move01 P t \<epsilon> (null\<bullet>F{D} := Val v) (null\<bullet>F{D} := Val v) h xs \<epsilon> (THROW NullPointer) h xs"
   "sim_move01 P t \<epsilon> ({V':T=vo; Val u}) ({V:T=None; Val u}) h xs \<epsilon> (Val u) h xs"
   "V < length xs \<Longrightarrow> sim_move01 P t \<epsilon> (sync(null) e0) (sync\<^bsub>V\<^esub> (null) e1) h xs \<epsilon> (THROW NullPointer) h (xs[V := Null])"
   "sim_move01 P t \<epsilon> (Val v;;e0) (Val v;; e1) h xs \<epsilon> e1 h xs"
   "sim_move01 P t \<epsilon> (if (true) e0 else e0') (if (true) e1 else e1') h xs \<epsilon> e1 h xs"
   "sim_move01 P t \<epsilon> (if (false) e0 else e0') (if (false) e1 else e1') h xs \<epsilon> e1' h xs"
   "sim_move01 P t \<epsilon> (throw null) (throw null) h xs \<epsilon> (THROW NullPointer) h xs"
   "sim_move01 P t \<epsilon> (try (Val v) catch(C V') e0) (try (Val v) catch(C V) e1) h xs \<epsilon> (Val v) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Class_type D\<rfloor>; P \<turnstile> D \<preceq>\<^sup>* C; V < length xs \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (try (Throw a) catch(C V') e0) (try (Throw a) catch(C V) e1) h xs \<epsilon> ({V:Class C=None; e1}) h (xs[V := Addr a])"
   "sim_move01 P t \<epsilon> (newA T\<lfloor>Throw a\<rceil>) (newA T\<lfloor>Throw a\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Cast T (Throw a)) (Cast T (Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> ((Throw a) instanceof T) ((Throw a) instanceof T) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> ((Throw a) \<guillemotleft>bop\<guillemotright> e0) ((Throw a) \<guillemotleft>bop\<guillemotright> e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v \<guillemotleft>bop\<guillemotright> (Throw a)) (Val v \<guillemotleft>bop\<guillemotright> (Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (V' := Throw a) (V := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<lfloor>e0\<rceil>) (Throw a\<lfloor>e1\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<lfloor>Throw a\<rceil>) (Val v\<lfloor>Throw a\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<lfloor>e0\<rceil> := e0') (Throw a\<lfloor>e1\<rceil> := e1') h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<lfloor>Throw a\<rceil> := e0) (Val v\<lfloor>Throw a\<rceil> := e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<lfloor>Val v'\<rceil> := Throw a) (Val v\<lfloor>Val v'\<rceil> := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<bullet>length) (Throw a\<bullet>length) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<bullet>F{D}) (Throw a\<bullet>F{D}) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<bullet>F{D} := e0) (Throw a\<bullet>F{D} := e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<bullet>F{D} := Throw a) (Val v\<bullet>F{D} := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<bullet>compareAndSwap(D\<bullet>F, e2, e3)) (Throw a\<bullet>compareAndSwap(D\<bullet>F, e2', e3')) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<bullet>compareAndSwap(D\<bullet>F, Throw a, e3)) (Val v\<bullet>compareAndSwap(D\<bullet>F, Throw a, e3')) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', Throw a)) (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a\<bullet>M(es0)) (Throw a\<bullet>M(es1)) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> ({V':T=vo; Throw a}) ({V:T=None; Throw a}) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (sync(Throw a) e0) (sync\<^bsub>V\<^esub>(Throw a) e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (Throw a;;e0) (Throw a;;e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (if (Throw a) e0 else e0') (if (Throw a) e1 else e1') h xs \<epsilon> (Throw a) h xs"
   "sim_move01 P t \<epsilon> (throw (Throw a)) (throw (Throw a)) h xs \<epsilon> (Throw a) h xs"
 apply(simp_all add: sim_move01_def ta_bisim_def split: if_split_asm split del: if_split)
 apply(fastforce intro: red1_reds1.intros)+
 done
 
 lemma sim_move01_ThrowParams:
   "sim_move01 P t \<epsilon> (Val v\<bullet>M(map Val vs @ Throw a # es0)) (Val v\<bullet>M(map Val vs @ Throw a # es1)) h xs \<epsilon> (Throw a) h xs"
 apply(simp add: sim_move01_def split del: if_split)
 apply(rule conjI, fastforce)
 apply(split if_split)
 apply(rule conjI)
  apply(fastforce intro: red1_reds1.intros)
 apply(fastforce simp add: sim_move01_def intro: red1_reds1.intros)
 done
 
 lemma sim_move01_CallNull:
   "sim_move01 P t \<epsilon> (null\<bullet>M(map Val vs)) (null\<bullet>M(map Val vs)) h xs \<epsilon> (THROW NullPointer) h xs"
 by(fastforce simp add: sim_move01_def map_eq_append_conv intro: red1_reds1.intros)
 
 lemma sim_move01_SyncLocks:
   "\<lbrakk> V < length xs; ta0 = \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace>; ta = \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace> \<rbrakk>
    \<Longrightarrow> sim_move01 P t ta0 (sync(addr a) e0) (sync\<^bsub>V\<^esub> (addr a) e1) h xs ta (insync\<^bsub>V\<^esub> (a) e1) h (xs[V := Addr a])"
   "\<lbrakk> xs ! V = Addr a'; V < length xs; ta0 = \<lbrace>Unlock\<rightarrow>a', SyncUnlock a'\<rbrace>; ta = \<lbrace>Unlock\<rightarrow>a', SyncUnlock a'\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (insync(a') (Val v)) (insync\<^bsub>V\<^esub> (a) (Val v)) h xs ta (Val v) h xs"
   "\<lbrakk> xs ! V = Addr a'; V < length xs; ta0 = \<lbrace>Unlock\<rightarrow>a', SyncUnlock a'\<rbrace>; ta = \<lbrace>Unlock\<rightarrow>a', SyncUnlock a'\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 (insync(a') (Throw a'')) (insync\<^bsub>V\<^esub> (a) (Throw a'')) h xs ta (Throw a'') h xs"
 by(fastforce simp add: sim_move01_def ta_bisim_def expand_finfun_eq fun_eq_iff finfun_upd_apply ta_upd_simps  intro: red1_reds1.intros[simplified] split: if_split_asm)+
 
 lemma sim_move01_TryFail:
   "\<lbrakk> typeof_addr h a = \<lfloor>Class_type D\<rfloor>; \<not> P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
   \<Longrightarrow> sim_move01 P t \<epsilon> (try (Throw a) catch(C V') e0) (try (Throw a) catch(C V) e1) h xs \<epsilon> (Throw a) h xs"
 by(auto simp add: sim_move01_def intro!: Red1TryFail)
 
 lemma sim_move01_BlockSome:
   "\<lbrakk> sim_move01 P t ta0 e0 e h (xs[V := v]) ta e' h' xs'; V < length xs \<rbrakk>
   \<Longrightarrow> sim_move01 P t ta0 ({V':T=\<lfloor>v\<rfloor>; e0}) ({V:T=\<lfloor>v\<rfloor>; e}) h xs ta ({V:T=None; e'}) h' xs'"
   "V < length xs \<Longrightarrow> sim_move01 P t \<epsilon> ({V':T=\<lfloor>v\<rfloor>; Val u}) ({V:T=\<lfloor>v\<rfloor>; Val u}) h xs \<epsilon> (Val u) h (xs[V := v])"
   "V < length xs \<Longrightarrow> sim_move01 P t \<epsilon> ({V':T=\<lfloor>v\<rfloor>; Throw a}) ({V:T=\<lfloor>v\<rfloor>; Throw a}) h xs \<epsilon> (Throw a) h (xs[V := v])"
 apply(auto simp add: sim_move01_def)
 apply(split if_split_asm)
  apply(fastforce intro: intro: converse_rtranclp_into_rtranclp Block1Some Block1Red Block_\<tau>red1r_Some)
 apply(fastforce intro: intro: converse_rtranclp_into_rtranclp Block1Some Block1Red Block_\<tau>red1r_Some)
 apply(fastforce simp add: sim_move01_def intro!: \<tau>red1t_2step[OF Block1Some] \<tau>red1r_1step[OF Block1Some] Red1Block Block1Throw)+
 done
 
 lemmas sim_move01_intros =
   sim_move01_expr sim_move01_reds sim_move01_ThrowParams sim_move01_CallNull sim_move01_TryFail
   sim_move01_BlockSome sim_move01_CallParams
 
 declare sim_move01_intros[intro]
 
 lemma sim_move01_preserves_len: "sim_move01 P t ta0 e0 e h xs ta e' h' xs' \<Longrightarrow> length xs' = length xs"
 by(fastforce simp add: sim_move01_def split: if_split_asm dest: \<tau>red1r_preserves_len \<tau>red1t_preserves_len red1_preserves_len)
 
 lemma sim_move01_preserves_unmod:
   "\<lbrakk> sim_move01 P t ta0 e0 e h xs ta e' h' xs'; unmod e i; i < length xs \<rbrakk> \<Longrightarrow> xs' ! i = xs ! i"
 apply(auto simp add: sim_move01_def split: if_split_asm dest: \<tau>red1t_preserves_unmod)
 apply(frule (2) \<tau>red1'r_preserves_unmod)
 apply(frule (1) \<tau>red1r_unmod_preserved)
 apply(frule \<tau>red1r_preserves_len)
 apply(auto dest: red1_preserves_unmod)
 apply(frule (2) \<tau>red1'r_preserves_unmod)
 apply(frule (1) \<tau>red1r_unmod_preserved)
 apply(frule \<tau>red1r_preserves_len)
 apply(auto dest: red1_preserves_unmod)
 done
 
 lemma assumes wf: "wf_J_prog P"
   shows red1_simulates_red_aux:
   "\<lbrakk> extTA2J0 P,P,t \<turnstile> \<langle>e1, S\<rangle> -TA\<rightarrow> \<langle>e1', S'\<rangle>; bisim vs e1 e2 XS; fv e1 \<subseteq> set vs;
      lcl S \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e1 \<le> length XS;
      \<forall>aMvs. call e1 = \<lfloor>aMvs\<rfloor> \<longrightarrow> synthesized_call P (hp S) aMvs \<rbrakk>
   \<Longrightarrow> \<exists>ta e2' XS'. sim_move01 (compP1 P) t TA e1 e2 (hp S) XS ta e2' (hp S') XS' \<and> bisim vs e1' e2' XS' \<and> lcl S' \<subseteq>\<^sub>m [vs [\<mapsto>] XS']"
   (is "\<lbrakk> _; _; _; _; _; ?synth e1 S \<rbrakk> \<Longrightarrow> ?concl e1 e2 S XS e1' S' TA vs")
 
   and reds1_simulates_reds_aux:
   "\<lbrakk> extTA2J0 P,P,t \<turnstile> \<langle>es1, S\<rangle> [-TA\<rightarrow>] \<langle>es1', S'\<rangle>; bisims vs es1 es2 XS; fvs es1 \<subseteq> set vs;
     lcl S \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_varss es1 \<le> length XS;
     \<forall>aMvs. calls es1 = \<lfloor>aMvs\<rfloor> \<longrightarrow> synthesized_call P (hp S) aMvs \<rbrakk>
   \<Longrightarrow> \<exists>ta es2' xs'. sim_moves01 (compP1 P) t TA es1 es2 (hp S) XS ta es2' (hp S') xs' \<and> bisims vs es1' es2' xs' \<and> lcl S' \<subseteq>\<^sub>m [vs [\<mapsto>] xs']"
   (is "\<lbrakk> _; _; _; _; _; ?synths es1 S \<rbrakk> \<Longrightarrow> ?concls es1 es2 S XS es1' S' TA vs")
 proof(induct arbitrary: vs e2 XS and vs es2 XS rule: red_reds.inducts)
   case (BinOpRed1 e s ta e' s' bop e2 Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs (e \<guillemotleft>bop\<guillemotright> e2) E2 xs\<close> obtain E
     where "E2 = E \<guillemotleft>bop\<guillemotright> compE1 Vs e2" and "bisim Vs e E xs" and "\<not> contains_insync e2" by auto
   with IH[of Vs E xs] \<open>fv (e \<guillemotleft>bop\<guillemotright> e2) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val e\<close>
     \<open>length Vs + max_vars (e \<guillemotleft>bop\<guillemotright> e2) \<le> length xs\<close> \<open>?synth (e \<guillemotleft>bop\<guillemotright> e2) s\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
   show ?case by(cases "is_val e'")(fastforce elim!: sim_move01_expr)+
 next
   case (BinOpRed2 e s ta e' s' v bop Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>bisim Vs (Val v \<guillemotleft>bop\<guillemotright> e) E2 xs\<close> obtain E
     where "E2 = Val v \<guillemotleft>bop\<guillemotright> E" and "bisim Vs e E xs" by auto
   with IH[of Vs E xs] \<open>fv (Val v \<guillemotleft>bop\<guillemotright> e) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
     \<open>length Vs + max_vars (Val v \<guillemotleft>bop\<guillemotright> e) \<le> length xs\<close> \<open>?synth (Val v \<guillemotleft>bop\<guillemotright> e) s\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
   show ?case by(fastforce elim!: sim_move01_expr)
 next
   case RedVar thus ?case
     by(fastforce simp add: index_less_aux map_le_def fun_upds_apply intro!: exI dest: bspec)
 next
   case RedLAss thus ?case
     by(fastforce intro: index_less_aux LAss_lem intro!: exI simp del: fun_upd_apply)
 next
   case (AAccRed1 a s ta a' s' i Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs a e2 XS; fv a \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars a \<le> length XS;
             ?synth a s \<rbrakk> \<Longrightarrow> ?concl a e2 s XS a' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close> have "\<not> is_val a" by auto
   with \<open>bisim Vs (a\<lfloor>i\<rceil>) E2 xs\<close> obtain E
     where "E2 = E\<lfloor>compE1 Vs i\<rceil>" and "bisim Vs a E xs" and "\<not> contains_insync i" by auto
   with IH[of Vs E xs] \<open>fv (a\<lfloor>i\<rceil>) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val a\<close>
     \<open>length Vs + max_vars (a\<lfloor>i\<rceil>) \<le> length xs\<close> \<open>?synth (a\<lfloor>i\<rceil>) s\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close>
   show ?case by(cases "is_val a'")(fastforce elim!: sim_move01_expr)+
 next
   case (AAccRed2 i s ta i' s' a Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs i e2 XS; fv i \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars i \<le> length XS;
             ?synth i s \<rbrakk> \<Longrightarrow> ?concl i e2 s XS i' s' ta vs\<close>
   from \<open>bisim Vs (Val a\<lfloor>i\<rceil>) E2 xs\<close> obtain E
     where "E2 = Val a\<lfloor>E\<rceil>" and "bisim Vs i E xs" by auto
   with IH[of Vs E xs] \<open>fv (Val a\<lfloor>i\<rceil>) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
     \<open>length Vs + max_vars (Val a\<lfloor>i\<rceil>) \<le> length xs\<close> \<open>?synth (Val a\<lfloor>i\<rceil>) s\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>\<close>
   show ?case by(fastforce elim!: sim_move01_expr)
 next
   case RedAAcc thus ?case by(auto simp del: split_paired_Ex)
 next
   case (AAssRed1 a s ta a' s' i e Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs a e2 XS; fv a \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars a \<le> length XS;
             ?synth a s \<rbrakk> \<Longrightarrow> ?concl a e2 s XS a' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close> have "\<not> is_val a" by auto
   with \<open>bisim Vs (a\<lfloor>i\<rceil>:=e) E2 xs\<close> obtain E
     where E2: "E2 = E\<lfloor>compE1 Vs i\<rceil>:=compE1 Vs e" and "bisim Vs a E xs"
     and sync: "\<not> contains_insync i" "\<not> contains_insync e" by auto
   with IH[of Vs E xs] \<open>fv (a\<lfloor>i\<rceil>:=e) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val a\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close>
     \<open>length Vs + max_vars (a\<lfloor>i\<rceil>:=e) \<le> length xs\<close> \<open>?synth (a\<lfloor>i\<rceil>:=e) s\<close>
   obtain ta' e2' xs'
     where IH': "sim_move01 (compP1 P) t ta a E (hp s) xs ta' e2' (hp s') xs'"
     "bisim Vs a' e2' xs'" "lcl s' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']"
     by auto
   show ?case
   proof(cases "is_val a'")
     case True
     from \<open>fv (a\<lfloor>i\<rceil>:=e) \<subseteq> set Vs\<close> sync
     have "bisim Vs i (compE1 Vs i) xs'" "bisim Vs e (compE1 Vs e) xs'" by auto
     with IH' E2 True sync  \<open>\<not> is_val a\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close> show ?thesis
       by(cases "is_val i")(fastforce elim!: sim_move01_expr)+
   next
     case False with IH' E2 sync \<open>\<not> is_val a\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close>
     show ?thesis by(fastforce elim!: sim_move01_expr)
   qed
 next
   case (AAssRed2 i s ta i' s' a e Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs i e2 XS; fv i \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars i \<le> length XS;
             ?synth i s \<rbrakk> \<Longrightarrow> ?concl i e2 s XS i' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>\<close> have "\<not> is_val i" by auto
   with \<open>bisim Vs (Val a\<lfloor>i\<rceil> := e) E2 xs\<close> obtain E
     where "E2 = Val a\<lfloor>E\<rceil>:=compE1 Vs e" and "bisim Vs i E xs" and "\<not> contains_insync e" by auto
   with IH[of Vs E xs] \<open>fv (Val a\<lfloor>i\<rceil>:=e) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val i\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>\<close>
     \<open>length Vs + max_vars (Val a\<lfloor>i\<rceil>:=e) \<le> length xs\<close> \<open>?synth (Val a\<lfloor>i\<rceil>:=e) s\<close>
   show ?case by(cases "is_val i'")(fastforce elim!: sim_move01_expr)+
 next
   case (AAssRed3 e s ta e' s' a i Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>bisim Vs (Val a\<lfloor>Val i\<rceil> := e) E2 xs\<close> obtain E
     where "E2 = Val a\<lfloor>Val i\<rceil>:=E" and "bisim Vs e E xs" by auto
   with IH[of Vs E xs] \<open>fv (Val a\<lfloor>Val i\<rceil>:=e) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars (Val a\<lfloor>Val i\<rceil>:=e) \<le> length xs\<close> \<open>?synth (Val a\<lfloor>Val i\<rceil>:=e) s\<close>
   show ?case by(fastforce elim!: sim_move01_expr)
 next
   case RedAAssStore thus ?case by(auto intro!: exI)
 next
   case (FAssRed1 e s ta e' s' F D e2 Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs (e\<bullet>F{D} := e2) E2 xs\<close> obtain E
     where "E2 = E\<bullet>F{D} := compE1 Vs e2" and "bisim Vs e E xs" and "\<not> contains_insync e2" by auto
   with IH[of Vs E xs] \<open>fv (e\<bullet>F{D} := e2) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val e\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars (e\<bullet>F{D} := e2) \<le> length xs\<close> \<open>?synth (e\<bullet>F{D} := e2) s\<close>
   show ?case by(cases "is_val e'")(fastforce elim!: sim_move01_expr)+
 next
   case (FAssRed2 e s ta e' s' v F D Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>bisim Vs (Val v\<bullet>F{D} := e) E2 xs\<close> obtain E
     where "E2 = Val v\<bullet>F{D} := E" and "bisim Vs e E xs" by auto
   with IH[of Vs E xs] \<open>fv (Val v\<bullet>F{D} := e) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars (Val v\<bullet>F{D} := e) \<le> length xs\<close> \<open>?synth (Val v\<bullet>F{D} := e) s\<close>
   show ?case by(fastforce elim!: sim_move01_expr)
 next
   case (CASRed1 e s ta e' s' D F e2 e3 Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs _ E2 xs\<close> obtain E
     where E2: "E2 = E\<bullet>compareAndSwap(D\<bullet>F, compE1 Vs e2, compE1 Vs e3)" and "bisim Vs e E xs"
     and sync: "\<not> contains_insync e2" "\<not> contains_insync e3" by(auto)
   with IH[of Vs E xs] \<open>fv _ \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val e\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars _ \<le> length xs\<close> \<open>?synth _ s\<close>
   obtain ta' e2' xs'
     where IH': "sim_move01 (compP1 P) t ta e E (hp s) xs ta' e2' (hp s') xs'"
     "bisim Vs e' e2' xs'" "lcl s' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']"
     by auto
   show ?case
   proof(cases "is_val e'")
     case True
     from \<open>fv _ \<subseteq> set Vs\<close> sync
     have "bisim Vs e2 (compE1 Vs e2) xs'" "bisim Vs e3 (compE1 Vs e3) xs'" by auto
     with IH' E2 True sync  \<open>\<not> is_val e\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> show ?thesis
       by(cases "is_val e2")(fastforce elim!: sim_move01_expr)+
   next
     case False with IH' E2 sync \<open>\<not> is_val e\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     show ?thesis by(fastforce elim!: sim_move01_expr)
   qed
 next
   case (CASRed2 e s ta e' s' v D F e3 Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs _ E2 xs\<close> obtain E
     where "E2 = Val v\<bullet>compareAndSwap(D\<bullet>F, E, compE1 Vs e3)" and "bisim Vs e E xs" and "\<not> contains_insync e3" by(auto)
   with IH[of Vs E xs] \<open>fv _ \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>\<not> is_val e\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars _ \<le> length xs\<close> \<open>?synth _ s\<close>
   show ?case by(cases "is_val e'")(fastforce elim!: sim_move01_expr)+
 next
   case (CASRed3 e s ta e' s' v D F v' Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>bisim Vs _ E2 xs\<close> obtain E
     where "E2 = Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', E)" and "bisim Vs e E xs" by auto
   with IH[of Vs E xs] \<open>fv _ \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_vars _ \<le> length xs\<close> \<open>?synth _ s\<close>
   show ?case by(fastforce elim!: sim_move01_expr)
 next
   case (CallObj e s ta e' s' M es Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs (e\<bullet>M(es)) E2 xs\<close> obtain E
     where "E2 = E\<bullet>M(compEs1 Vs es)" and "bisim Vs e E xs" and "\<not> contains_insyncs es"
     by(auto simp add: compEs1_conv_map)
   with IH[of Vs E xs] \<open>fv (e\<bullet>M(es)) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
     \<open>length Vs + max_vars (e\<bullet>M(es)) \<le> length xs\<close> \<open>?synth (e\<bullet>M(es)) s\<close>
   show ?case by(cases "is_val e'")(fastforce elim!: sim_move01_expr split: if_split_asm)+
 next
   case (CallParams es s ta es' s' v M Vs E2 xs)
   note IH = \<open>\<And>vs es2 XS. \<lbrakk>bisims vs es es2 XS; fvs es \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_varss es \<le> length XS;
             ?synths es s \<rbrakk> \<Longrightarrow> ?concls es es2 s XS es' s' ta vs\<close>
   from \<open>bisim Vs (Val v\<bullet>M(es)) E2 xs\<close> obtain Es 
     where "E2 = Val v\<bullet>M(Es)" and "bisims Vs es Es xs" by auto
   moreover from \<open>extTA2J0 P,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>\<close> have "\<not> is_vals es" by auto
   with \<open>?synth (Val v\<bullet>M(es)) s\<close> have "?synths es s" by(auto)
   moreover note IH[of Vs Es xs] \<open>fv (Val v\<bullet>M(es)) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> 
     \<open>length Vs + max_vars (Val v\<bullet>M(es)) \<le> length xs\<close>
   ultimately show ?case by(fastforce elim!: sim_move01_CallParams)
 next
   case (RedCall s a U M Ts T pns body D vs Vs E2 xs)
   from \<open>typeof_addr (hp s) a = \<lfloor>U\<rfloor>\<close>
   have "call (addr a\<bullet>M(map Val vs)) = \<lfloor>(a, M, vs)\<rfloor>" by auto
   with \<open>?synth (addr a\<bullet>M(map Val vs)) s\<close> have "synthesized_call P (hp s) (a, M, vs)" by auto
   with \<open>typeof_addr (hp s) a = \<lfloor>U\<rfloor>\<close> \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D\<close>
   have False by(auto simp add: synthesized_call_conv dest: sees_method_fun)
   thus ?case ..
 next
   case (RedCallExternal s a T M Ts Tr D vs ta va h' ta' e' s' Vs E2 xs)
   from \<open>bisim Vs (addr a\<bullet>M(map Val vs)) E2 xs\<close> have "E2 = addr a\<bullet>M(map Val vs)" by auto
   moreover note \<open>P \<turnstile> class_type_of T sees M: Ts\<rightarrow>Tr = Native in D\<close> \<open>typeof_addr (hp s) a = \<lfloor>T\<rfloor>\<close> \<open>ta' = extTA2J0 P ta\<close>
     \<open>e' = extRet2J (addr a\<bullet>M(map Val vs)) va\<close> \<open>s' = (h', lcl s)\<close> \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
     \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
   moreover from wf \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
   have "ta_bisim01 (extTA2J0 P ta) (extTA2J1 (compP1 P) ta)" by(rule red_external_ta_bisim01)
   moreover from \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close> \<open>typeof_addr (hp s) a = \<lfloor>T\<rfloor>\<close>
     \<open>P \<turnstile> class_type_of T sees M: Ts\<rightarrow>Tr = Native in D\<close>
   have "\<tau>external_defs D M \<Longrightarrow> h' = hp s \<and> ta = \<epsilon>"
     by(fastforce dest: \<tau>external'_red_external_heap_unchanged \<tau>external'_red_external_TA_empty simp add: \<tau>external'_def \<tau>external_def)
   ultimately show ?case 
     by(cases va)(fastforce intro!: exI[where x=ta] intro: Red1CallExternal simp add: map_eq_append_conv sim_move01_def dest: sees_method_fun simp del: split_paired_Ex)+
 next
   case (BlockRed e h x V vo ta e' h' x' T Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl (h, x(V := vo)) \<subseteq>\<^sub>m [vs [\<mapsto>] XS];
                          length vs + max_vars e \<le> length XS; ?synth e (h, (x(V := vo)))\<rbrakk>
             \<Longrightarrow> ?concl e e2 (h, x(V := vo)) XS e' (h', x') ta vs\<close>
   note red = \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,(h, x(V := vo))\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close>
   note len = \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
   from \<open>fv {V:T=vo; e} \<subseteq> set Vs\<close> have fv: "fv e \<subseteq> set (Vs@[V])" by auto
   from \<open>bisim Vs {V:T=vo; e} E2 xs\<close> show ?case
   proof(cases rule: bisim_cases(7)[consumes 1, case_names BlockNone BlockSome BlockSomeNone])
     case (BlockNone E')
     with red IH[of "Vs@[V]" E' xs] fv \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
       \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>?synth {V:T=vo; e} (h, x)\<close>
     obtain TA' e2' xs' where red': "sim_move01 (compP1 P) t ta e E' h xs TA' e2' h' xs'"
       and bisim': "bisim (Vs @ [V]) e' e2' xs'" "x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']" by auto 
     from red' \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
     have "length (Vs@[V]) + max_vars e \<le> length xs'"
       by(fastforce simp add: sim_move01_def dest: red1_preserves_len \<tau>red1t_preserves_len \<tau>red1r_preserves_len split: if_split_asm)
     with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs', V \<mapsto> xs' ! length Vs]" by(simp)
     moreover 
     { assume "V \<in> set Vs"
       hence "hidden (Vs @ [V]) (index Vs V)" by(rule hidden_index)
       with \<open>bisim (Vs @ [V]) e E' xs\<close> have "unmod E' (index Vs V)"
         by -(rule hidden_bisim_unmod)
       moreover from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>V \<in> set Vs\<close>
       have "index Vs V < length xs" by(auto intro: index_less_aux)
       ultimately have "xs ! index Vs V = xs' ! index Vs V"
         using sim_move01_preserves_unmod[OF red'] by(simp) }
     moreover from red' have "length xs = length xs'" by(rule sim_move01_preserves_len[symmetric])
     ultimately have rel: "x'(V := x V) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']"
       using \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
       by(auto intro: Block_lem)
     show ?thesis
     proof(cases "x' V")
       case None
       with red' bisim' BlockNone len
       show ?thesis by(fastforce simp del: split_paired_Ex fun_upd_apply intro: rel)
     next
       case (Some v)
       moreover
       with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "[Vs @ [V] [\<mapsto>] xs'] V = \<lfloor>v\<rfloor>"
         by(auto simp add: map_le_def dest: bspec)
       moreover
       from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> have "length Vs < length xs" by auto
       ultimately have "xs' ! length Vs = v" using \<open>length xs = length xs'\<close> by(simp)
       with red' bisim' BlockNone Some len
       show ?thesis by(fastforce simp del: fun_upd_apply intro: rel)
     qed
   next
     case (BlockSome E' v)
     with red IH[of "Vs@[V]" E' "xs[length Vs := v]"] fv \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
       \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>?synth {V:T=vo; e} (h, x)\<close>
     obtain TA' e2' xs' where red': "sim_move01 (compP1 P) t ta e E' h (xs[length Vs := v]) TA' e2' h' xs'"
       and bisim': "bisim (Vs @ [V]) e' e2' xs'" "x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']" by auto
     from red' \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
     have "length (Vs@[V]) + max_vars e \<le> length xs'" by(auto dest: sim_move01_preserves_len)
     with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs', V \<mapsto> xs' ! length Vs]" by(simp)
     moreover 
     { assume "V \<in> set Vs"
       hence "hidden (Vs @ [V]) (index Vs V)" by(rule hidden_index)
       with \<open>bisim (Vs @ [V]) e E' (xs[length Vs := v])\<close> have "unmod E' (index Vs V)"
         by -(rule hidden_bisim_unmod)
       moreover from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>V \<in> set Vs\<close>
       have "index Vs V < length xs" by(auto intro: index_less_aux)
       moreover from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>V \<in> set Vs\<close>
       have "(xs[length Vs := v]) ! index Vs V = xs ! index Vs V" by(simp)
       ultimately have "xs ! index Vs V = xs' ! index Vs V"
         using sim_move01_preserves_unmod[OF red', of "index Vs V"] by(simp) }
     moreover from red' have "length xs = length xs'" by(auto dest: sim_move01_preserves_len)
     ultimately have rel: "x'(V := x V) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']"
       using \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
       by(auto intro: Block_lem)
     from BlockSome red obtain v' where Some: "x' V = \<lfloor>v'\<rfloor>" by(auto dest!: red_lcl_incr)
     with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "[Vs @ [V] [\<mapsto>] xs'] V = \<lfloor>v'\<rfloor>"
       by(auto simp add: map_le_def dest: bspec)
     moreover
     from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> have "length Vs < length xs" by auto
     ultimately have "xs' ! length Vs = v'" using \<open>length xs = length xs'\<close> by(simp)
     with red' bisim' BlockSome Some \<open>length Vs < length xs\<close>
     show ?thesis by(fastforce simp del: fun_upd_apply intro: rel)
   next 
     case (BlockSomeNone E')
     with red IH[of "Vs@[V]" E' xs] fv \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
       \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>?synth {V:T=vo; e} (h, x)\<close>
     obtain TA' e2' xs' where red': "sim_move01 (compP1 P) t ta e E' h xs TA' e2' h' xs'"
       and IH': "bisim (Vs @ [V]) e' e2' xs'" "x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']" by auto
     from red' \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
     have "length (Vs@[V]) + max_vars e \<le> length xs'" by(auto dest: sim_move01_preserves_len)
     with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs', V \<mapsto> xs' ! length Vs]" by(simp)
     moreover 
     { assume "V \<in> set Vs"
       hence "hidden (Vs @ [V]) (index Vs V)" by(rule hidden_index)
       with \<open>bisim (Vs @ [V]) e E' xs\<close> have "unmod E' (index Vs V)"
         by -(rule hidden_bisim_unmod)
       moreover from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>V \<in> set Vs\<close>
       have "index Vs V < length xs" by(auto intro: index_less_aux)
       moreover from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> \<open>V \<in> set Vs\<close>
       have "(xs[length Vs := v]) ! index Vs V = xs ! index Vs V" by(simp)
       ultimately have "xs ! index Vs V = xs' ! index Vs V"
         using sim_move01_preserves_unmod[OF red', of "index Vs V"] by(simp) }
     moreover from red' have "length xs = length xs'" by(auto dest: sim_move01_preserves_len)
     ultimately have rel: "x'(V := x V) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']"
       using \<open>lcl (h, x) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close>
       by(auto intro: Block_lem)
     from BlockSomeNone red obtain v' where Some: "x' V = \<lfloor>v'\<rfloor>" by(auto dest!: red_lcl_incr)
     with \<open>x' \<subseteq>\<^sub>m [Vs @ [V] [\<mapsto>] xs']\<close> have "[Vs @ [V] [\<mapsto>] xs'] V = \<lfloor>v'\<rfloor>"
       by(auto simp add: map_le_def dest: bspec)
     moreover
     from \<open>length Vs + max_vars {V:T=vo; e} \<le> length xs\<close> have "length Vs < length xs" by auto
     ultimately have "xs' ! length Vs = v'" using \<open>length xs = length xs'\<close> by(simp)
     with red' IH' BlockSomeNone Some \<open>length Vs < length xs\<close>
     show ?thesis by(fastforce simp del: fun_upd_apply intro: rel)
   qed
 next
   case (RedBlock V T vo u s Vs E2 xs)
   from \<open>bisim Vs {V:T=vo; Val u} E2 xs\<close> obtain vo'
     where [simp]: "E2 = {length Vs:T=vo'; Val u}" by auto
   from RedBlock show ?case
   proof(cases vo)
     case (Some v)
     with \<open>bisim Vs {V:T=vo; Val u} E2 xs\<close>
     have vo': "case vo' of None \<Rightarrow> xs ! length Vs = v | Some v' \<Rightarrow> v = v'" by auto
     have "sim_move01 (compP1 P) t \<epsilon> {V:T=vo; Val u} E2 (hp s) xs \<epsilon> (Val u) (hp s) (xs[length Vs := v])"
     proof(cases vo')
       case None with vo'
       have "xs[length Vs := v] = xs" by auto
       thus ?thesis using Some None by auto
     next
       case Some
       from \<open>length Vs + max_vars {V:T=vo; Val u} \<le> length xs\<close> have "length Vs < length xs" by simp
       with vo' Some show ?thesis using \<open>vo = Some v\<close> by auto
     qed
     thus ?thesis using RedBlock by fastforce
   qed fastforce
 next
   case SynchronizedNull thus ?case by fastforce
 next
   case (LockSynchronized a e s Vs E2 xs)
   from \<open>bisim Vs (sync(addr a) e) E2 xs\<close>
   have E2: "E2 = sync\<^bsub>length Vs\<^esub> (addr a) (compE1 (Vs@[fresh_var Vs]) e)" 
     and sync: "\<not> contains_insync e" by auto
   moreover have "fresh_var Vs \<notin> set Vs" by(rule fresh_var_fresh)
   with \<open>fv (sync(addr a) e) \<subseteq> set Vs\<close> have "fresh_var Vs \<notin> fv e" by auto
   from E2 \<open>fv (sync(addr a) e) \<subseteq> set Vs\<close> sync
   have "bisim (Vs@[fresh_var Vs]) e (compE1 (Vs@[fresh_var Vs]) e) (xs[length Vs := Addr a])"
     by(auto intro!: compE1_bisim)
   hence "bisim Vs (insync(a) e) (insync\<^bsub>length Vs\<^esub> (a) (compE1 (Vs@[fresh_var Vs]) e)) (xs[length Vs := Addr a])"
     using \<open>fresh_var Vs \<notin> fv e\<close> \<open>length Vs + max_vars (sync(addr a) e) \<le> length xs\<close> by auto
   moreover from \<open>length Vs + max_vars (sync(addr a) e) \<le> length xs\<close>
   have "False,compP1 P,t \<turnstile>1 \<langle>sync\<^bsub>length Vs\<^esub> (addr a) (compE1 (Vs@[fresh_var Vs]) e), (hp s, xs)\<rangle>
         -\<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace>\<rightarrow>
         \<langle>insync\<^bsub>length Vs\<^esub> (a) (compE1 (Vs@[fresh_var Vs]) e), (hp s, xs[length Vs := Addr a])\<rangle>"
     by -(rule Lock1Synchronized, auto)
   hence "sim_move01 (compP1 P) t \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace> (sync(addr a) e) E2 (hp s) xs \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace> (insync\<^bsub>length Vs\<^esub> (a) (compE1 (Vs@[fresh_var Vs]) e)) (hp s) (xs[length Vs := Addr a])"
     using E2 by(fastforce simp add: sim_move01_def ta_bisim_def)
   moreover have "zip Vs (xs[length Vs := Addr a]) = (zip Vs xs)[length Vs := (arbitrary, Addr a)]"
     by(rule sym)(simp add: update_zip)
   hence "zip Vs (xs[length Vs := Addr a]) = zip Vs xs" by simp
   with \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> have "lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs[length Vs := Addr a]]"
     by(auto simp add: map_le_def map_upds_def)
   ultimately show ?case using \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> by fastforce
 next
   case (SynchronizedRed2 e s ta e' s' a Vs E2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
             ?synth e s \<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>bisim Vs (insync(a) e) E2 xs\<close> obtain E
     where E2: "E2 = insync\<^bsub>length Vs\<^esub> (a) E" and bisim: "bisim (Vs@[fresh_var Vs]) e E xs"
     and xsa: "xs ! length Vs = Addr a" by auto
   from \<open>fv (insync(a) e) \<subseteq> set Vs\<close> fresh_var_fresh[of Vs] have fv: "fresh_var Vs \<notin> fv e" by auto
   from \<open>length Vs + max_vars (insync(a) e) \<le> length xs\<close> have "length Vs < length xs" by simp
   { assume "lcl s (fresh_var Vs) \<noteq> None"
     then obtain v where "lcl s (fresh_var Vs) = \<lfloor>v\<rfloor>" by auto
     with \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> have "[Vs [\<mapsto>] xs] (fresh_var Vs) = \<lfloor>v\<rfloor>" 
       by(auto simp add: map_le_def dest: bspec)
     hence "fresh_var Vs \<in> set Vs" 
       by(auto simp add: map_upds_def set_zip dest!: map_of_SomeD )
     moreover have "fresh_var Vs \<notin> set Vs" by(rule fresh_var_fresh)
     ultimately have False by contradiction }
   hence "lcl s (fresh_var Vs) = None" by(cases "lcl s (fresh_var Vs)", auto)
   hence "(lcl s)(fresh_var Vs := None) = lcl s" by(auto intro: ext)
   moreover from \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
   have "(lcl s)(fresh_var Vs := None) \<subseteq>\<^sub>m [Vs [\<mapsto>] xs, fresh_var Vs \<mapsto> xs ! length Vs]" by(simp)
   ultimately have "lcl s \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] xs]"
     using \<open>length Vs < length xs\<close> by(auto)
   with IH[of "Vs@[fresh_var Vs]" E xs] \<open>fv (insync(a) e) \<subseteq> set Vs\<close> bisim
     \<open>length Vs + max_vars (insync(a) e) \<le> length xs\<close> \<open>?synth (insync(a) e) s\<close> 
   obtain TA' e2' xs' where IH': "sim_move01 (compP1 P) t ta e E (hp s) xs TA' e2' (hp s') xs'"
     "bisim (Vs @ [fresh_var Vs]) e' e2' xs'" "lcl s' \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] xs']" by auto
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "dom (lcl s') \<subseteq> dom (lcl s) \<union> fv e" by(auto dest: red_dom_lcl)
   with fv \<open>lcl s (fresh_var Vs) = None\<close> have "(fresh_var Vs) \<notin> dom (lcl s')" by auto
   hence "lcl s' (fresh_var Vs) = None" by auto
   moreover from IH' have "length xs = length xs'" by(auto dest: sim_move01_preserves_len)
   moreover note \<open>lcl s' \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] xs']\<close> \<open>length Vs < length xs\<close>
   ultimately have "lcl s' \<subseteq>\<^sub>m [Vs [\<mapsto>] xs']" by(auto simp add: map_le_def dest: bspec)
   moreover from bisim fv have "unmod E (length Vs)" by(auto intro: bisim_fv_unmod)
   with IH' \<open>length Vs < length xs\<close> have "xs ! length Vs = xs' ! length Vs"
     by(auto dest!: sim_move01_preserves_unmod)
   with xsa have "xs' ! length Vs = Addr a" by simp
   ultimately show ?case using IH' E2 by(fastforce)
 next
   case (UnlockSynchronized a v s Vs E2 xs)
   from \<open>bisim Vs (insync(a) Val v) E2 xs\<close> have E2: "E2 = insync\<^bsub>length Vs\<^esub> (a) Val v" 
     and xsa: "xs ! length Vs = Addr a" by auto
   moreover from \<open>length Vs + max_vars (insync(a) Val v) \<le> length xs\<close> xsa
   have "False,compP1 P,t \<turnstile>1 \<langle>insync\<^bsub>length Vs\<^esub> (a) (Val v), (hp s, xs)\<rangle> -\<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>\<rightarrow> \<langle>Val v, (hp s, xs)\<rangle>"
     by-(rule Unlock1Synchronized, auto)
   hence "sim_move01 (compP1 P) t \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> (insync(a) Val v) (insync\<^bsub>length Vs\<^esub> (a) Val v) (hp s) xs \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> (Val v) (hp s) xs"
     by(fastforce simp add: sim_move01_def ta_bisim_def)
   ultimately show ?case using \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> by fastforce
 next
   case (RedWhile b c s Vs E2 xs)
   from \<open>bisim Vs (while (b) c) E2 xs\<close> have "E2 = while (compE1 Vs b) (compE1 Vs c)"
     and sync: "\<not> contains_insync b" "\<not> contains_insync c" by auto
   moreover have "False,compP1 P,t \<turnstile>1 \<langle>while(compE1 Vs b) (compE1 Vs c), (hp s, xs)\<rangle> 
                  -\<epsilon>\<rightarrow> \<langle>if (compE1 Vs b) (compE1 Vs c;;while(compE1 Vs b) (compE1 Vs c)) else unit, (hp s, xs)\<rangle>"
     by(rule Red1While)
   hence "sim_move01 (compP1 P) t \<epsilon> (while (b) c) (while (compE1 Vs b) (compE1 Vs c)) (hp s) xs \<epsilon> (if (compE1 Vs b) (compE1 Vs c;;while(compE1 Vs b) (compE1 Vs c)) else unit) (hp s) xs"
     by(auto simp add: sim_move01_def)
   moreover from \<open>fv (while (b) c) \<subseteq> set Vs\<close> sync
   have "bisim Vs (if (b) (c;; while (b) c) else unit)
                  (if (compE1 Vs b) (compE1 Vs (c;; while(b) c)) else (compE1 Vs unit)) xs"
     by -(rule bisimCond, auto)
   ultimately show ?case using \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close>
     by(simp)((rule exI)+, erule conjI, auto)
 next
   case (RedTryCatch s a D C V e2 Vs E2 xs)
   thus ?case by(auto intro!: exI)(auto intro!: compE1_bisim)
 next
   case RedTryFail thus ?case by(auto intro!: exI)
 next
   case (ListRed1 e s ta e' s' es Vs ES2 xs)
   note IH = \<open>\<And>vs e2 XS. \<lbrakk>bisim vs e e2 XS; fv e \<subseteq> set vs; lcl s \<subseteq>\<^sub>m [vs [\<mapsto>] XS]; length vs + max_vars e \<le> length XS;
                          ?synth e s\<rbrakk> \<Longrightarrow> ?concl e e2 s XS e' s' ta vs\<close>
   from \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisims Vs (e # es) ES2 xs\<close> obtain E' 
     where "bisim Vs e E' xs" and ES2: "ES2 = E' # compEs1 Vs es" 
     and sync: "\<not> contains_insyncs es" by(auto simp add: compEs1_conv_map)
   with IH[of Vs E' xs] \<open>fvs (e # es) \<subseteq> set Vs\<close> \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>extTA2J0 P,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
     \<open>length Vs + max_varss (e # es) \<le> length xs\<close> \<open>?synths (e # es) s\<close> \<open>\<not> is_val e\<close>
   show ?case by(cases "is_val e'")(fastforce elim!: sim_moves01_expr split: if_split_asm)+
 next
   case (ListRed2 es s ta es' s' v Vs ES2 xs)
   thus ?case by(fastforce elim!: bisims_cases elim!: sim_moves01_expr)
 next
   case CallThrowParams thus ?case
     by(fastforce elim!:bisim_cases simp add: bisims_map_Val_Throw)
 next
   case (BlockThrow V T vo a s Vs e2 xs) thus ?case
     by(cases vo)(fastforce elim!: bisim_cases)+
 next    
   case (SynchronizedThrow2 a ad s Vs E2 xs)
   from \<open>bisim Vs (insync(a) Throw ad) E2 xs\<close> have "xs ! length Vs = Addr a" by auto
   with \<open>length Vs + max_vars (insync(a) Throw ad) \<le> length xs\<close>
   have "False,compP1 P,t \<turnstile>1 \<langle>insync\<^bsub>length Vs\<^esub> (a) Throw ad, (hp s, xs)\<rangle> -\<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>\<rightarrow> \<langle>Throw ad, (hp s, xs)\<rangle>"
     by-(rule Synchronized1Throw2, auto)
   hence "sim_move01 (compP1 P) t \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> (insync(a) Throw ad) (insync\<^bsub>length Vs\<^esub> (a) Throw ad) (hp s) xs \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> (Throw ad) (hp s) xs"
     by(fastforce simp add: sim_move01_def ta_bisim_def fun_eq_iff expand_finfun_eq finfun_upd_apply ta_upd_simps split: if_split_asm)
   moreover note \<open>lcl s \<subseteq>\<^sub>m [Vs [\<mapsto>] xs]\<close> \<open>bisim Vs (insync(a) Throw ad) E2 xs\<close>
   ultimately show ?case by(fastforce)
 next
   case InstanceOfRed thus ?case by(fastforce)
 next
   case RedInstanceOf thus ?case by(auto intro!: exI)
 next
   case InstanceOfThrow thus ?case by fastforce
 qed(fastforce simp del: fun_upd_apply split: if_split_asm)+
 
 end
 
 declare max_dest [iff del]
 
 declare split_paired_Ex [simp del]
 
 primrec countInitBlock :: "('a, 'b, 'addr) exp \<Rightarrow> nat"
   and countInitBlocks :: "('a, 'b, 'addr) exp list \<Rightarrow> nat"
 where 
   "countInitBlock (new C) = 0"
 | "countInitBlock (newA T\<lfloor>e\<rceil>) = countInitBlock e"
 | "countInitBlock (Cast T e) = countInitBlock e"
 | "countInitBlock (e instanceof T) = countInitBlock e"
 | "countInitBlock (Val v) = 0"
 | "countInitBlock (Var V) = 0"
 | "countInitBlock (V := e) = countInitBlock e"
 | "countInitBlock (e \<guillemotleft>bop\<guillemotright> e') = countInitBlock e + countInitBlock e'"
 | "countInitBlock (a\<lfloor>i\<rceil>) = countInitBlock a + countInitBlock i"
 | "countInitBlock (AAss a i e) = countInitBlock a + countInitBlock i + countInitBlock e"
 | "countInitBlock (a\<bullet>length) = countInitBlock a"
 | "countInitBlock (e\<bullet>F{D}) = countInitBlock e"
 | "countInitBlock (FAss e F D e') = countInitBlock e + countInitBlock e'"
 | "countInitBlock (e\<bullet>compareAndSwap(D\<bullet>F, e', e'')) = 
    countInitBlock e + countInitBlock e' + countInitBlock e''"
 | "countInitBlock (e\<bullet>M(es)) = countInitBlock e + countInitBlocks es"
 | "countInitBlock ({V:T=vo; e}) = (case vo of None \<Rightarrow> 0 | Some v \<Rightarrow> 1) + countInitBlock e"
 | "countInitBlock (sync\<^bsub>V'\<^esub> (e) e') = countInitBlock e + countInitBlock e'"
 | "countInitBlock (insync\<^bsub>V'\<^esub> (ad) e) = countInitBlock e"
 | "countInitBlock (e;;e') = countInitBlock e + countInitBlock e'"
 | "countInitBlock (if (e) e1 else e2) = countInitBlock e + countInitBlock e1 + countInitBlock e2"
 | "countInitBlock (while(b) e) = countInitBlock b + countInitBlock e"
 | "countInitBlock (throw e) = countInitBlock e"
 | "countInitBlock (try e catch(C V) e') = countInitBlock e + countInitBlock e'"
 
 | "countInitBlocks [] = 0"
 | "countInitBlocks (e # es) = countInitBlock e + countInitBlocks es"
 
 context J0_J1_heap_base begin
 
 lemmas \<tau>red0r_expr =
   NewArray_\<tau>red0r_xt Cast_\<tau>red0r_xt InstanceOf_\<tau>red0r_xt BinOp_\<tau>red0r_xt1 BinOp_\<tau>red0r_xt2 LAss_\<tau>red0r
   AAcc_\<tau>red0r_xt1 AAcc_\<tau>red0r_xt2 AAss_\<tau>red0r_xt1 AAss_\<tau>red0r_xt2 AAss_\<tau>red0r_xt3
   ALength_\<tau>red0r_xt FAcc_\<tau>red0r_xt FAss_\<tau>red0r_xt1 FAss_\<tau>red0r_xt2
   CAS_\<tau>red0r_xt1 CAS_\<tau>red0r_xt2 CAS_\<tau>red0r_xt3 Call_\<tau>red0r_obj
   Call_\<tau>red0r_param Block_\<tau>red0r_xt Sync_\<tau>red0r_xt InSync_\<tau>red0r_xt
   Seq_\<tau>red0r_xt Cond_\<tau>red0r_xt Throw_\<tau>red0r_xt Try_\<tau>red0r_xt
 
 lemmas \<tau>red0t_expr =
   NewArray_\<tau>red0t_xt Cast_\<tau>red0t_xt InstanceOf_\<tau>red0t_xt BinOp_\<tau>red0t_xt1 BinOp_\<tau>red0t_xt2 LAss_\<tau>red0t
   AAcc_\<tau>red0t_xt1 AAcc_\<tau>red0t_xt2 AAss_\<tau>red0t_xt1 AAss_\<tau>red0t_xt2 AAss_\<tau>red0t_xt3
   ALength_\<tau>red0t_xt FAcc_\<tau>red0t_xt FAss_\<tau>red0t_xt1 FAss_\<tau>red0t_xt2
   CAS_\<tau>red0t_xt1 CAS_\<tau>red0t_xt2 CAS_\<tau>red0t_xt3 Call_\<tau>red0t_obj
   Call_\<tau>red0t_param Block_\<tau>red0t_xt Sync_\<tau>red0t_xt InSync_\<tau>red0t_xt
   Seq_\<tau>red0t_xt Cond_\<tau>red0t_xt Throw_\<tau>red0t_xt Try_\<tau>red0t_xt
 
 declare \<tau>red0r_expr [elim!]
 declare \<tau>red0t_expr [elim!]
 
 definition sim_move10 :: 
   "'addr J_prog \<Rightarrow> 'thread_id \<Rightarrow> ('addr, 'thread_id, 'heap) external_thread_action \<Rightarrow> 'addr expr1 \<Rightarrow> 'addr expr1 \<Rightarrow> 'addr expr
   \<Rightarrow> 'heap \<Rightarrow> 'addr locals \<Rightarrow> ('addr, 'thread_id, 'heap) J0_thread_action \<Rightarrow> 'addr expr \<Rightarrow> 'heap \<Rightarrow> 'addr locals \<Rightarrow> bool"
 where
   "sim_move10 P t ta1 e1 e1' e h xs ta e' h' xs' \<longleftrightarrow> \<not> final e1 \<and>
   (if \<tau>move1 P h e1 then (\<tau>red0t (extTA2J0 P) P t h (e, xs) (e', xs') \<or> countInitBlock e1' < countInitBlock e1 \<and> e' = e \<and> xs' = xs) \<and> h' = h \<and> ta1 = \<epsilon> \<and> ta = \<epsilon>
    else ta_bisim01 ta (extTA2J1 (compP1 P) ta1) \<and>
      (if call e = None \<or> call1 e1 = None 
       then (\<exists>e'' xs''. \<tau>red0r (extTA2J0 P) P t h (e, xs) (e'', xs'') \<and> extTA2J0 P,P,t \<turnstile> \<langle>e'', (h, xs'')\<rangle> -ta\<rightarrow> \<langle>e', (h', xs')\<rangle> \<and> no_call P h e'' \<and> \<not> \<tau>move0 P h e'')
       else extTA2J0 P,P,t \<turnstile> \<langle>e, (h, xs)\<rangle> -ta\<rightarrow> \<langle>e', (h', xs')\<rangle> \<and> no_call P h e \<and> \<not> \<tau>move0 P h e))"
 
 definition sim_moves10 :: 
   "'addr J_prog \<Rightarrow> 'thread_id \<Rightarrow> ('addr, 'thread_id, 'heap) external_thread_action \<Rightarrow> 'addr expr1 list \<Rightarrow> 'addr expr1 list
   \<Rightarrow> 'addr expr list \<Rightarrow> 'heap \<Rightarrow> 'addr locals \<Rightarrow> ('addr, 'thread_id, 'heap) J0_thread_action \<Rightarrow> 'addr expr list \<Rightarrow> 'heap 
   \<Rightarrow> 'addr locals \<Rightarrow> bool"
 where
   "sim_moves10 P t ta1 es1 es1' es h xs ta es' h' xs' \<longleftrightarrow> \<not> finals es1 \<and>
   (if \<tau>moves1 P h es1 then (\<tau>reds0t (extTA2J0 P) P t h (es, xs) (es', xs') \<or> countInitBlocks es1' < countInitBlocks es1 \<and> es' = es \<and> xs' = xs) \<and> h' = h \<and> ta1 = \<epsilon> \<and> ta = \<epsilon>
    else ta_bisim01 ta (extTA2J1 (compP1 P) ta1) \<and>
      (if calls es = None \<or> calls1 es1 = None
       then (\<exists>es'' xs''. \<tau>reds0r (extTA2J0 P) P t h (es, xs) (es'', xs'') \<and> extTA2J0 P,P,t \<turnstile> \<langle>es'', (h, xs'')\<rangle> [-ta\<rightarrow>] \<langle>es', (h', xs')\<rangle> \<and> no_calls P h es'' \<and> \<not> \<tau>moves0 P h es'')
       else extTA2J0 P,P,t \<turnstile> \<langle>es, (h, xs)\<rangle> [-ta\<rightarrow>] \<langle>es', (h', xs')\<rangle> \<and> no_calls P h es \<and> \<not> \<tau>moves0 P h es))"
 
 lemma sim_move10_expr:
   assumes "sim_move10 P t ta1 e1 e1' e h xs ta e' h' xs'"
   shows
   "sim_move10 P t ta1 (newA T\<lfloor>e1\<rceil>) (newA T\<lfloor>e1'\<rceil>) (newA T\<lfloor>e\<rceil>) h xs ta (newA T\<lfloor>e'\<rceil>) h' xs'"
   "sim_move10 P t ta1 (Cast T e1) (Cast T e1') (Cast T e) h xs ta (Cast T e') h' xs'"
   "sim_move10 P t ta1 (e1 instanceof T) (e1' instanceof T) (e instanceof T) h xs ta (e' instanceof T) h' xs'"
   "sim_move10 P t ta1 (e1 \<guillemotleft>bop\<guillemotright> e2) (e1' \<guillemotleft>bop\<guillemotright> e2) (e \<guillemotleft>bop\<guillemotright> e2') h xs ta (e' \<guillemotleft>bop\<guillemotright> e2') h' xs'"
   "sim_move10 P t ta1 (Val v \<guillemotleft>bop\<guillemotright> e1) (Val v \<guillemotleft>bop\<guillemotright> e1') (Val v \<guillemotleft>bop\<guillemotright> e) h xs ta (Val v \<guillemotleft>bop\<guillemotright> e') h' xs'"
   "sim_move10 P t ta1 (V := e1) (V := e1') (V' := e) h xs ta (V' := e') h' xs'"
   "sim_move10 P t ta1 (e1\<lfloor>e2\<rceil>) (e1'\<lfloor>e2\<rceil>) (e\<lfloor>e2'\<rceil>) h xs ta (e'\<lfloor>e2'\<rceil>) h' xs'"
   "sim_move10 P t ta1 (Val v\<lfloor>e1\<rceil>) (Val v\<lfloor>e1'\<rceil>) (Val v\<lfloor>e\<rceil>) h xs ta (Val v\<lfloor>e'\<rceil>) h' xs'"
   "sim_move10 P t ta1 (e1\<lfloor>e2\<rceil> := e3) (e1'\<lfloor>e2\<rceil> := e3) (e\<lfloor>e2'\<rceil> := e3') h xs ta (e'\<lfloor>e2'\<rceil> := e3') h' xs'"
   "sim_move10 P t ta1 (Val v\<lfloor>e1\<rceil> := e3) (Val v\<lfloor>e1'\<rceil> := e3) (Val v\<lfloor>e\<rceil> := e3') h xs ta (Val v\<lfloor>e'\<rceil> := e3') h' xs'"
   "sim_move10 P t ta1 (AAss (Val v) (Val v') e1) (AAss (Val v) (Val v') e1') (AAss (Val v) (Val v') e) h xs ta (AAss (Val v) (Val v') e') h' xs'"
   "sim_move10 P t ta1 (e1\<bullet>length) (e1'\<bullet>length) (e\<bullet>length) h xs ta (e'\<bullet>length) h' xs'"
   "sim_move10 P t ta1 (e1\<bullet>F{D}) (e1'\<bullet>F{D}) (e\<bullet>F'{D'}) h xs ta (e'\<bullet>F'{D'}) h' xs'"
   "sim_move10 P t ta1 (FAss e1 F D e2) (FAss e1' F D e2) (FAss e F' D' e2') h xs ta (FAss e' F' D' e2') h' xs'"
   "sim_move10 P t ta1 (FAss (Val v) F D e1) (FAss (Val v) F D e1') (FAss (Val v) F' D' e) h xs ta (FAss (Val v) F' D' e') h' xs'"
   "sim_move10 P t ta1 (CompareAndSwap e1 F D e2 e3) (CompareAndSwap e1' F D e2 e3) (CompareAndSwap e F' D' e2' e3') h xs ta (CompareAndSwap e' F' D' e2' e3') h' xs'"
   "sim_move10 P t ta1 (CompareAndSwap (Val v) F D e1 e3) (CompareAndSwap (Val v) F D e1' e3) (CompareAndSwap (Val v) F' D' e e3') h xs ta (CompareAndSwap (Val v) F' D' e' e3') h' xs'"
   "sim_move10 P t ta1 (CompareAndSwap (Val v) F D (Val v') e1) (CompareAndSwap (Val v) F D (Val v') e1') (CompareAndSwap (Val v) F' D' (Val v') e) h xs ta (CompareAndSwap (Val v) F' D' (Val v') e') h' xs'"
   "sim_move10 P t ta1 (e1\<bullet>M(es)) (e1'\<bullet>M(es)) (e\<bullet>M(es')) h xs ta (e'\<bullet>M(es')) h' xs'"
   "sim_move10 P t ta1 (sync\<^bsub>V\<^esub>(e1) e2) (sync\<^bsub>V\<^esub>(e1') e2) (sync(e) e2') h xs ta (sync(e') e2') h' xs'"
   "sim_move10 P t ta1 (insync\<^bsub>V\<^esub>(a) e1) (insync\<^bsub>V\<^esub>(a) e1') (insync(a') e) h xs ta (insync(a') e') h' xs'"
   "sim_move10 P t ta1 (e1;;e2) (e1';;e2) (e;;e2') h xs ta (e';;e2') h' xs'"
   "sim_move10 P t ta1 (if (e1) e2 else e3) (if (e1') e2 else e3) (if (e) e2' else e3') h xs ta (if (e') e2' else e3') h' xs'"
   "sim_move10 P t ta1 (throw e1) (throw e1') (throw e) h xs ta (throw e') h' xs'"
   "sim_move10 P t ta1 (try e1 catch(C V) e2) (try e1' catch(C V) e2) (try e catch(C' V') e2') h xs ta (try e' catch(C' V') e2') h' xs'"
 using assms
 apply(simp_all add: sim_move10_def final_iff split del: if_split split: if_split_asm)
 apply(fastforce simp: \<tau>red0t_Val \<tau>red0r_Val intro: red_reds.intros split!: if_splits)+
 done
 
 lemma sim_moves10_expr:
   "sim_move10 P t ta1 e1 e1' e h xs ta e' h' xs' \<Longrightarrow> sim_moves10 P t ta1 (e1 # es2) (e1' # es2) (e # es2') h xs ta (e' # es2') h' xs'"
   "sim_moves10 P t ta1 es1 es1' es h xs ta es' h' xs' \<Longrightarrow> sim_moves10 P t ta1 (Val v # es1) (Val v # es1') (Val v # es) h xs ta (Val v # es') h' xs'"
 unfolding sim_moves10_def sim_move10_def final_iff finals_iff
 apply(simp_all add: Cons_eq_append_conv split del: if_split split: if_split_asm)
 apply(safe intro!: if_split)
 apply(fastforce simp add: is_vals_conv \<tau>reds0t_map_Val \<tau>reds0r_map_Val \<tau>red0t_Val \<tau>red0r_Val intro!: \<tau>red0r_inj_\<tau>reds0r \<tau>reds0r_cons_\<tau>reds0r \<tau>red0t_inj_\<tau>reds0t \<tau>reds0t_cons_\<tau>reds0t ListRed1 ListRed2 split: if_split_asm)+
 done
 
 lemma sim_move10_CallParams:
   "sim_moves10 P t ta1 es1 es1' es h xs ta es' h' xs'
   \<Longrightarrow> sim_move10 P t ta1 (Val v\<bullet>M(es1)) (Val v\<bullet>M(es1')) (Val v\<bullet>M(es)) h xs ta (Val v\<bullet>M(es')) h' xs'"
 unfolding sim_move10_def sim_moves10_def
 apply(simp split: if_split_asm split del: if_split add: is_vals_conv)
   apply(fastforce simp add: \<tau>red0t_Val \<tau>red0r_Val \<tau>reds0t_map_Val \<tau>reds0r_map_Val intro: Call_\<tau>red0r_param Call_\<tau>red0t_param CallParams split: if_split_asm split del: if_split intro!: if_split)
  apply(rule conjI)
   apply fastforce
  apply(rule if_intro)
   apply fastforce
  apply(clarsimp split del: if_split)
  apply(rule if_intro)
   apply(clarsimp split: if_split_asm simp add: is_vals_conv)
    apply(rule exI conjI)+
     apply(erule Call_\<tau>red0r_param)
    apply(fastforce intro: CallParams)
   apply(rule exI conjI)+
    apply(erule Call_\<tau>red0r_param)
   apply(fastforce intro!: CallParams)
  apply(clarsimp split del: if_split split: if_split_asm simp add: is_vals_conv \<tau>reds0r_map_Val)
  apply fastforce
 apply(rule conjI)
  apply fastforce
 apply(rule if_intro)
  apply fastforce
 apply(rule conjI)
  apply fastforce
 apply(rule if_intro)
  apply(clarsimp split: if_split_asm)
 apply(clarsimp split: if_split_asm split del: if_split simp add: is_vals_conv)
 apply(fastforce intro: CallParams)
 done
 
 lemma sim_move10_Block:
   "sim_move10 P t ta1 e1 e1' e h (xs(V' := vo)) ta e' h' xs'
   \<Longrightarrow> sim_move10 P t ta1 ({V:T=None; e1}) ({V:T=None; e1'}) ({V':T=vo; e}) h xs ta ({V':T=xs' V'; e'}) h' (xs'(V' := xs V'))"
 proof -
   assume "sim_move10 P t ta1 e1 e1' e h (xs(V' := vo)) ta e' h' xs'"
   moreover {
     fix e'' xs''
     assume "extTA2J0 P,P,t \<turnstile> \<langle>e'',(h, xs'')\<rangle> -ta\<rightarrow> \<langle>e',(h', xs')\<rangle>"
     hence "extTA2J0 P,P,t \<turnstile> \<langle>e'',(h, xs''(V' := xs V', V' := xs'' V'))\<rangle> -ta\<rightarrow> \<langle>e',(h', xs')\<rangle>" by simp
     from BlockRed[OF this, of T]
     have "extTA2J0 P,P,t \<turnstile> \<langle>{V':T=xs'' V'; e''},(h, xs''(V' := xs V'))\<rangle> -ta\<rightarrow> \<langle>{V':T=xs' V'; e'},(h', xs'(V' := xs V'))\<rangle>"
       by simp }
   ultimately show ?thesis
     by(fastforce simp add: sim_move10_def final_iff split: if_split_asm)
 qed
 
 lemma sim_move10_reds:
   "\<lbrakk> (h', a) \<in> allocate h (Class_type C); ta1 = \<lbrace>NewHeapElem a (Class_type C)\<rbrace>; ta = \<lbrace>NewHeapElem a (Class_type C)\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (new C) e1' (new C) h xs ta (addr a) h' xs"
   "allocate h (Class_type C) = {} \<Longrightarrow> sim_move10 P t \<epsilon> (new C) e1' (new C) h xs \<epsilon> (THROW OutOfMemory) h xs"
   "\<lbrakk> (h', a) \<in> allocate h (Array_type T (nat (sint i))); 0 <=s i;
      ta1 = \<lbrace>NewHeapElem a (Array_type T (nat (sint i)))\<rbrace>; ta = \<lbrace>NewHeapElem a (Array_type T (nat (sint i)))\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (newA T\<lfloor>Val (Intg i)\<rceil>) e1' (newA T\<lfloor>Val (Intg i)\<rceil>) h xs ta (addr a) h' xs"
   "i <s 0 \<Longrightarrow> sim_move10 P t \<epsilon> (newA T\<lfloor>Val (Intg i)\<rceil>) e1' (newA T\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW NegativeArraySize) h xs"
   "\<lbrakk> allocate h (Array_type T (nat (sint i))) = {}; 0 <=s i \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (newA T\<lfloor>Val (Intg i)\<rceil>) e1' (newA T\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW OutOfMemory) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (Cast T (Val v)) e1' (Cast T (Val v)) h xs \<epsilon> (Val v) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; \<not> P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (Cast T (Val v)) e1' (Cast T (Val v)) h xs \<epsilon> (THROW ClassCast) h xs"
   "\<lbrakk> typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; b \<longleftrightarrow> v \<noteq> Null \<and> P \<turnstile> U \<le> T \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> ((Val v) instanceof T) e1' ((Val v) instanceof T) h xs \<epsilon> (Val (Bool b)) h xs"
   "binop bop v1 v2 = Some (Inl v) \<Longrightarrow> sim_move10 P t \<epsilon> ((Val v1) \<guillemotleft>bop\<guillemotright> (Val v2)) e1' (Val v1 \<guillemotleft>bop\<guillemotright> Val v2) h xs \<epsilon> (Val v) h xs"
   "binop bop v1 v2 = Some (Inr a) \<Longrightarrow> sim_move10 P t \<epsilon> ((Val v1) \<guillemotleft>bop\<guillemotright> (Val v2)) e1' (Val v1 \<guillemotleft>bop\<guillemotright> Val v2) h xs \<epsilon> (Throw a) h xs"
   "xs V = \<lfloor>v\<rfloor> \<Longrightarrow> sim_move10 P t \<epsilon> (Var V') e1' (Var V) h xs \<epsilon> (Val v) h xs"
   "sim_move10 P t \<epsilon> (V' := Val v) e1' (V := Val v) h xs \<epsilon> unit h (xs(V \<mapsto> v))"
   "sim_move10 P t \<epsilon> (null\<lfloor>Val v\<rceil>) e1' (null\<lfloor>Val v\<rceil>) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; i <s 0 \<or> sint i \<ge> int n \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (addr a\<lfloor>Val (Intg i)\<rceil>) e1' ((addr a)\<lfloor>Val (Intg i)\<rceil>) h xs \<epsilon> (THROW ArrayIndexOutOfBounds) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n;
      heap_read h a (ACell (nat (sint i))) v;
      ta1 = \<lbrace>ReadMem a (ACell (nat (sint i))) v\<rbrace>; ta = \<lbrace>ReadMem a (ACell (nat (sint i))) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (addr a\<lfloor>Val (Intg i)\<rceil>) e1' ((addr a)\<lfloor>Val (Intg i)\<rceil>) h xs ta (Val v) h xs"
   "sim_move10 P t \<epsilon> (null\<lfloor>Val v\<rceil> := Val v') e1' (null\<lfloor>Val v\<rceil> := Val v') h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; i <s 0 \<or> sint i \<ge> int n \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (AAss (addr a) (Val (Intg i)) (Val v)) e1' (AAss (addr a) (Val (Intg i)) (Val v)) h xs \<epsilon> (THROW ArrayIndexOutOfBounds) h xs"
  "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n; typeof\<^bsub>h\<^esub> v = \<lfloor>U\<rfloor>; \<not> (P \<turnstile> U \<le> T) \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (AAss (addr a) (Val (Intg i)) (Val v)) e1' (AAss (addr a) (Val (Intg i)) (Val v)) h xs \<epsilon> (THROW ArrayStore) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Array_type T n\<rfloor>; 0 <=s i; sint i < int n; typeof\<^bsub>h\<^esub> v = Some U; P \<turnstile> U \<le> T;
      heap_write h a (ACell (nat (sint i))) v h';
      ta1 = \<lbrace>WriteMem a (ACell (nat (sint i))) v\<rbrace>; ta = \<lbrace>WriteMem a (ACell (nat (sint i))) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (AAss (addr a) (Val (Intg i)) (Val v)) e1' (AAss (addr a) (Val (Intg i)) (Val v)) h xs ta unit h' xs"
   "typeof_addr h a = \<lfloor>Array_type T n\<rfloor> \<Longrightarrow> sim_move10 P t \<epsilon> (addr a\<bullet>length) e1' (addr a\<bullet>length) h xs \<epsilon> (Val (Intg (word_of_nat n))) h xs"
   "sim_move10 P t \<epsilon> (null\<bullet>length) e1' (null\<bullet>length) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> heap_read h a (CField D F) v; ta1 = \<lbrace>ReadMem a (CField D F) v\<rbrace>; ta = \<lbrace>ReadMem a (CField D F) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (addr a\<bullet>F{D}) e1' (addr a\<bullet>F{D}) h xs ta (Val v) h xs"
   "sim_move10 P t \<epsilon> (null\<bullet>F{D}) e1' (null\<bullet>F{D}) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> heap_write h a (CField D F) v h'; ta1 = \<lbrace>WriteMem a (CField D F) v\<rbrace>; ta = \<lbrace>WriteMem a (CField D F) v\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (addr a\<bullet>F{D} := Val v) e1' (addr a\<bullet>F{D} := Val v) h xs ta unit h' xs"
   "sim_move10 P t \<epsilon> (null\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) e1' (null\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs \<epsilon> (THROW NullPointer) h xs"
   "\<lbrakk> heap_read h a (CField D F) v''; heap_write h a (CField D F) v' h'; v'' = v;
      ta1 = \<lbrace> ReadMem a (CField D F) v'', WriteMem a (CField D F) v' \<rbrace>; ta = \<lbrace> ReadMem a (CField D F) v'', WriteMem a (CField D F) v' \<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) e1' (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs ta true h' xs"
   "\<lbrakk> heap_read h a (CField D F) v''; v'' \<noteq> v;
      ta1 = \<lbrace> ReadMem a (CField D F) v'' \<rbrace>; ta = \<lbrace> ReadMem a (CField D F) v'' \<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) e1' (addr a\<bullet>compareAndSwap(D\<bullet>F, Val v, Val v')) h xs ta false h xs"
 
   "sim_move10 P t \<epsilon> (null\<bullet>F{D} := Val v) e1' (null\<bullet>F{D} := Val v) h xs \<epsilon> (THROW NullPointer) h xs"
   "sim_move10 P t \<epsilon> ({V':T=None; Val u}) e1' ({V:T=vo; Val u}) h xs \<epsilon> (Val u) h xs"
   "sim_move10 P t \<epsilon> ({V':T=\<lfloor>v\<rfloor>; e}) ({V':T=None; e}) ({V:T=vo; e'}) h xs \<epsilon> ({V:T=vo; e'}) h xs"
 
   "sim_move10 P t \<epsilon> (sync\<^bsub>V'\<^esub>(null) e0) e1' (sync(null) e1) h xs \<epsilon> (THROW NullPointer) h xs"
   "sim_move10 P t \<epsilon> (Val v;;e0) e1' (Val v;; e1) h xs \<epsilon> e1 h xs"
   "sim_move10 P t \<epsilon> (if (true) e0 else e0') e1' (if (true) e1 else e2) h xs \<epsilon> e1 h xs"
   "sim_move10 P t \<epsilon> (if (false) e0 else e0') e1' (if (false) e1 else e2) h xs \<epsilon> e2 h xs"
   "sim_move10 P t \<epsilon> (throw null) e1' (throw null) h xs \<epsilon> (THROW NullPointer) h xs"
   "sim_move10 P t \<epsilon> (try (Val v) catch(C V') e0) e1' (try (Val v) catch(C V) e1) h xs \<epsilon> (Val v) h xs"
   "\<lbrakk> typeof_addr h a = \<lfloor>Class_type D\<rfloor>; P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (try (Throw a) catch(C V') e0) e1' (try (Throw a) catch(C V) e1) h xs \<epsilon> ({V:Class C=\<lfloor>Addr a\<rfloor>; e1}) h xs"
   "sim_move10 P t \<epsilon> (newA T\<lfloor>Throw a\<rceil>) e1' (newA T\<lfloor>Throw a\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Cast T (Throw a)) e1' (Cast T (Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> ((Throw a) instanceof T) e1' ((Throw a) instanceof T) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> ((Throw a) \<guillemotleft>bop\<guillemotright> e0) e1' ((Throw a) \<guillemotleft>bop\<guillemotright> e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v \<guillemotleft>bop\<guillemotright> (Throw a)) e1' (Val v \<guillemotleft>bop\<guillemotright> (Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (V' := Throw a) e1' (V := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<lfloor>e0\<rceil>) e1' (Throw a\<lfloor>e1\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v\<lfloor>Throw a\<rceil>) e1' (Val v\<lfloor>Throw a\<rceil>) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<lfloor>e0\<rceil> := e0') e1' (Throw a\<lfloor>e1\<rceil> := e2) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v\<lfloor>Throw a\<rceil> := e0) e1' (Val v\<lfloor>Throw a\<rceil> := e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v\<lfloor>Val v'\<rceil> := Throw a) e1' (Val v\<lfloor>Val v'\<rceil> := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<bullet>length) e1' (Throw a\<bullet>length) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<bullet>F{D}) e1' (Throw a\<bullet>F{D}) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<bullet>F{D} := e0) e1' (Throw a\<bullet>F{D} := e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v\<bullet>F{D} := Throw a) e1' (Val v\<bullet>F{D} := Throw a) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (CompareAndSwap (Throw a) D F e0 e0') e1' (Throw a\<bullet>compareAndSwap(D\<bullet>F, e1'', e1''')) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (CompareAndSwap (Val v) D F (Throw a) e0') e1' (Val v\<bullet>compareAndSwap(D\<bullet>F, Throw a, e1'')) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (CompareAndSwap (Val v) D F (Val v') (Throw a)) e1' (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', Throw a)) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a\<bullet>M(es0)) e1' (Throw a\<bullet>M(es1)) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Val v\<bullet>M(map Val vs @ Throw a # es0)) e1' (Val v\<bullet>M(map Val vs @ Throw a # es1)) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> ({V':T=None; Throw a}) e1' ({V:T=vo; Throw a}) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (sync\<^bsub>V'\<^esub>(Throw a) e0) e1' (sync(Throw a) e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (Throw a;;e0) e1' (Throw a;;e1) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (if (Throw a) e0 else e0') e1' (if (Throw a) e1 else e2) h xs \<epsilon> (Throw a) h xs"
   "sim_move10 P t \<epsilon> (throw (Throw a)) e1' (throw (Throw a)) h xs \<epsilon> (Throw a) h xs"
 apply(fastforce simp add: sim_move10_def no_calls_def no_call_def ta_bisim_def intro: red_reds.intros)+
 done
 
 lemma sim_move10_CallNull:
   "sim_move10 P t \<epsilon> (null\<bullet>M(map Val vs)) e1' (null\<bullet>M(map Val vs)) h xs \<epsilon> (THROW NullPointer) h xs"
 by(fastforce simp add: sim_move10_def map_eq_append_conv intro: RedCallNull)
 
 lemma sim_move10_SyncLocks:
   "\<lbrakk> ta1 = \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace>; ta = \<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace> \<rbrakk>
    \<Longrightarrow> sim_move10 P t ta1 (sync\<^bsub>V\<^esub>(addr a) e0) e1' (sync(addr a) e1) h xs ta (insync(a) e1) h xs"
   "\<lbrakk> ta1 = \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>; ta = \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (insync\<^bsub>V\<^esub>(a') (Val v)) e1' (insync(a) (Val v)) h xs ta (Val v) h xs"
   "\<lbrakk> ta1 = \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>; ta = \<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace> \<rbrakk>
   \<Longrightarrow> sim_move10 P t ta1 (insync\<^bsub>V\<^esub>(a') (Throw a'')) e1' (insync(a) (Throw a'')) h xs ta (Throw a'') h xs"
 by(fastforce simp add: sim_move10_def ta_bisim_def ta_upd_simps intro: red_reds.intros[simplified])+
 
 lemma sim_move10_TryFail:
   "\<lbrakk> typeof_addr h a = \<lfloor>Class_type D\<rfloor>; \<not> P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
   \<Longrightarrow> sim_move10 P t \<epsilon> (try (Throw a) catch(C V') e0) e1' (try (Throw a) catch(C V) e1) h xs \<epsilon> (Throw a) h xs"
 by(auto simp add: sim_move10_def intro!: RedTryFail)
 
 lemmas sim_move10_intros =
   sim_move10_expr sim_move10_reds sim_move10_CallNull sim_move10_TryFail sim_move10_Block sim_move10_CallParams
 
 lemma sim_move10_preserves_defass:
   assumes wf: "wf_J_prog P"
   shows "\<lbrakk> sim_move10 P t ta1 e1 e1' e h xs ta e' h' xs'; \<D> e \<lfloor>dom xs\<rfloor> \<rbrakk> \<Longrightarrow> \<D> e' \<lfloor>dom xs'\<rfloor>"
 by(auto simp add: sim_move10_def split: if_split_asm dest!: \<tau>red0r_preserves_defass[OF wf] \<tau>red0t_preserves_defass[OF wf] red_preserves_defass[OF wf])
 
 declare sim_move10_intros[intro]
 
 lemma assumes wf: "wf_J_prog P"
   shows red_simulates_red1_aux:
   "\<lbrakk> False,compP1 P,t \<turnstile>1 \<langle>e1, S\<rangle> -TA\<rightarrow> \<langle>e1', S'\<rangle>; bisim vs e2 e1 (lcl S); fv e2 \<subseteq> set vs;
      x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl S]; length vs + max_vars e1 \<le> length (lcl S);
      \<D> e2 \<lfloor>dom x\<rfloor> \<rbrakk>
   \<Longrightarrow> \<exists>ta e2' x'. sim_move10 P t TA e1 e1' e2 (hp S) x ta e2' (hp S') x' \<and> bisim vs e2' e1' (lcl S') \<and> x' \<subseteq>\<^sub>m [vs [\<mapsto>] lcl S']"
   (is "\<lbrakk> _; _; _; _; _; _ \<rbrakk> \<Longrightarrow> ?concl e1 e1' e2 S x TA S' e1' vs")
 
   and reds_simulates_reds1_aux:
   "\<lbrakk> False,compP1 P,t \<turnstile>1 \<langle>es1, S\<rangle> [-TA\<rightarrow>] \<langle>es1', S'\<rangle>; bisims vs es2 es1 (lcl S); fvs es2 \<subseteq> set vs;
      x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl S]; length vs + max_varss es1 \<le> length (lcl S);
      \<D>s es2 \<lfloor>dom x\<rfloor> \<rbrakk>
   \<Longrightarrow> \<exists>ta es2' x'. sim_moves10 P t TA es1 es1' es2 (hp S) x ta es2' (hp S') x' \<and> bisims vs es2' es1' (lcl S') \<and> x' \<subseteq>\<^sub>m [vs [\<mapsto>] lcl S']"
   (is "\<lbrakk> _; _; _; _; _; _ \<rbrakk> \<Longrightarrow> ?concls es1 es1' es2 S x TA S' es1' vs")
 proof(induct arbitrary: vs e2 x and vs es2 x rule: red1_reds1.inducts)
   case (Bin1OpRed1 e s ta e' s' bop e2 Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
              \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs E2 (e \<guillemotleft>bop\<guillemotright> e2) (lcl s)\<close> obtain E E2'
     where E2: "E2 = E \<guillemotleft>bop\<guillemotright> E2'" "e2 = compE1 Vs E2'" and "bisim Vs E e (lcl s)"
     and sync: "\<not> contains_insync E2'"
     by(auto elim!: bisim_cases)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (e \<guillemotleft>bop\<guillemotright> e2) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> sync show ?case by(cases "is_val e2'")(auto intro: BinOpRed1)
 next
   case (Bin1OpRed2 e s ta e' s' v bop Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
               \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>bisim Vs E2 (Val v \<guillemotleft>bop\<guillemotright> e) (lcl s)\<close> obtain E 
     where E2: "E2 = Val v \<guillemotleft>bop\<guillemotright> E" and "bisim Vs E e (lcl s)" by(auto)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (Val v \<guillemotleft>bop\<guillemotright> e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close> E2
   ultimately show ?case by(auto intro: BinOpRed2)
 next
   case (Red1Var s V v Vs E2 X)
   from \<open>bisim Vs E2 (Var V) (lcl s)\<close> \<open>fv E2 \<subseteq> set Vs\<close>
   obtain V' where "E2 = Var V'" "V' = Vs ! V" "V = index Vs V'" by(clarify, simp)
   from \<open>E2 = Var V'\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   obtain v' where "X V' = \<lfloor>v'\<rfloor>" by(auto simp add: hyperset_defs)
   with \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> have "[Vs [\<mapsto>] lcl s] V' = \<lfloor>v'\<rfloor>" by(rule map_le_SomeD)
   with \<open>length Vs + max_vars (Var V) \<le> length (lcl s)\<close>
   have "lcl s ! (index Vs V') = v'" by(auto intro: map_upds_Some_eq_nth_index)
   with \<open>V = index Vs V'\<close> \<open>lcl s ! V = v\<close> have "v = v'" by simp
   with \<open>X V' = \<lfloor>v'\<rfloor>\<close> \<open>E2 = Var V'\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
   show ?case by(fastforce intro: RedVar)
 next
   case (LAss1Red e s ta e' s' V Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>bisim Vs E2 (V:=e) (lcl s)\<close> obtain E V'
     where E2: "E2 = (V':=E)" "V = index Vs V'" and "bisim Vs E e (lcl s)" by auto
   with IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (V:=e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
     E2 show ?case by(auto intro: LAssRed)
 next
   case (Red1LAss V l v h Vs E2 X)
   from \<open>bisim Vs E2 (V:=Val v) (lcl (h, l))\<close> obtain V' where "E2 = (V' := Val v)" "V = index Vs V'" by(auto)
   moreover with \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, l)]\<close> \<open>length Vs + max_vars (V:=Val v) \<le> length (lcl (h, l))\<close>
   have "X(V' \<mapsto> v) \<subseteq>\<^sub>m [Vs [\<mapsto>] l[index Vs V' := v]]" by(auto intro: LAss_lem)
   ultimately show ?case by(auto intro: RedLAss simp del: fun_upd_apply)
 next
   case (AAcc1Red1 a s ta a' s' i Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 a (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars a \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
              \<Longrightarrow> ?concl a a' e2 s x ta s' a' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close> have "\<not> is_val a" by auto
   with \<open>bisim Vs E2 (a\<lfloor>i\<rceil>) (lcl s)\<close> obtain E E2'
     where E2: "E2 = E\<lfloor>E2'\<rceil>" "i = compE1 Vs E2'" and "bisim Vs E a (lcl s)"
     and sync: "\<not> contains_insync E2'" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (a\<lfloor>i\<rceil>) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where "sim_move10 P t ta a a' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' a' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> sync show ?case
     by(cases "is_val e2'")(auto intro: AAccRed1)
 next
   case (AAcc1Red2 i s ta i' s' a Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 i (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars i \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl i i' e2 s x ta s' i' vs\<close>
   from \<open>bisim Vs E2 (Val a\<lfloor>i\<rceil>) (lcl s)\<close> obtain E 
     where E2: "E2 = Val a\<lfloor>E\<rceil>" and "bisim Vs E i (lcl s)" by(auto)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> E2
     \<open>length Vs + max_vars (Val a\<lfloor>i\<rceil>) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately show ?case by(auto intro: AAccRed2)
 next
   case Red1AAcc thus ?case by(fastforce intro: RedAAcc simp del: fun_upd_apply)
 next
   case (AAss1Red1 a s ta a' s' i e Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 a (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars a \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor> \<rbrakk>
              \<Longrightarrow> ?concl a a' e2 s x ta s' a' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>\<close> have "\<not> is_val a" by auto
   with \<open>bisim Vs E2 (a\<lfloor>i\<rceil>:=e) (lcl s)\<close> obtain E E2' E2''
     where E2: "E2 = E\<lfloor>E2'\<rceil>:=E2''" "i = compE1 Vs E2'" "e = compE1 Vs E2''" and "bisim Vs E a (lcl s)"
     and sync: "\<not> contains_insync E2'" "\<not> contains_insync E2''" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (a\<lfloor>i\<rceil>:=e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where IH': "sim_move10 P t ta a a' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' a' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   show ?case
   proof(cases "is_val e2'")
     case True
     from E2 \<open>fv E2 \<subseteq> set Vs\<close> sync have "bisim Vs E2' i (lcl s')" "bisim Vs E2'' e (lcl s')" by auto
     with IH' E2 True sync show ?thesis
       by(cases "is_val E2'")(fastforce intro: AAssRed1)+
   next
     case False with IH' E2 sync show ?thesis by(fastforce intro: AAssRed1)
   qed
 next
   case (AAss1Red2 i s ta i' s' a e Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 i (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars i \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl i i' e2 s x ta s' i' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>\<close> have "\<not> is_val i" by auto
   with \<open>bisim Vs E2 (Val a\<lfloor>i\<rceil>:=e) (lcl s)\<close> obtain E E2'
     where E2: "E2 = Val a\<lfloor>E\<rceil>:=E2'" "e = compE1 Vs E2'" and "bisim Vs E i (lcl s)"
     and sync: "\<not> contains_insync E2'" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (Val a\<lfloor>i\<rceil>:=e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where "sim_move10 P t ta i i' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' i' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> sync show ?case
     by(cases "is_val e2'")(fastforce intro: AAssRed2)+
 next
   case (AAss1Red3 e s ta e' s' a i Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>bisim Vs E2 (Val a\<lfloor>Val i\<rceil>:=e) (lcl s)\<close> obtain E
     where E2: "E2 = Val a\<lfloor>Val i\<rceil>:=E" and "bisim Vs E e (lcl s)" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> E2
     \<open>length Vs + max_vars (Val a\<lfloor>Val i\<rceil>:=e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately show ?case by(fastforce intro: AAssRed3)
 next
   case Red1AAssStore thus ?case by(auto)((rule exI conjI)+, auto)
 next
   case Red1AAss thus ?case 
     by(fastforce simp del: fun_upd_apply)
 next 
   case (FAss1Red1 e s ta e' s' F D e2 Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
              \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs E2 (e\<bullet>F{D}:=e2) (lcl s)\<close> obtain E E2'
     where E2: "E2 = E\<bullet>F{D}:=E2'" "e2 = compE1 Vs E2'" and "bisim Vs E e (lcl s)" 
     and sync: "\<not> contains_insync E2'" by(fastforce)
   with IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (e\<bullet>F{D}:=e2) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   obtain TA' e2' x' where "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(fastforce)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> sync show ?case by(cases "is_val e2'")(auto intro: FAssRed1)
 next 
   case (FAss1Red2 e s ta e' s' v F D Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>bisim Vs E2 (Val v\<bullet>F{D}:=e) (lcl s)\<close> obtain E
     where E2: "E2 = (Val v\<bullet>F{D}:=E)" and "bisim Vs E e (lcl s)" by(fastforce)
   with IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (Val v\<bullet>F{D}:=e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
     E2 show ?case by(fastforce intro: FAssRed2)
 next
   case (CAS1Red1 e s ta e' s' D F e2 e3 Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor> \<rbrakk>
              \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs E2 _ (lcl s)\<close> obtain E E2' E2''
     where E2: "E2 = E\<bullet>compareAndSwap(D\<bullet>F, E2', E2'')" "e2 = compE1 Vs E2'" "e3 = compE1 Vs E2''" and "bisim Vs E e (lcl s)"
     and sync: "\<not> contains_insync E2'" "\<not> contains_insync E2''" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars _ \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where IH': "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   show ?case
   proof(cases "is_val e2'")
     case True
     from E2 \<open>fv E2 \<subseteq> set Vs\<close> sync have "bisim Vs E2' e2 (lcl s')" "bisim Vs E2'' e3 (lcl s')" by auto
     with IH' E2 True sync show ?thesis by(cases "is_val E2'")(fastforce)+
   next
     case False with IH' E2 sync show ?thesis by(fastforce)
   qed
 next
   case (CAS1Red2 e s ta e' s' v D F e3 Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> have "\<not> is_val e" by auto
   with \<open>bisim Vs E2 _ (lcl s)\<close> obtain E E2'
     where E2: "E2 = (Val v\<bullet>compareAndSwap(D\<bullet>F, E, E2'))" "e3 = compE1 Vs E2'" and "bisim Vs E e (lcl s)"
     and sync: "\<not> contains_insync E2'" by(auto)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars _ \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> sync show ?case
     by(cases "is_val e2'")(fastforce)+
 next
   case (CAS1Red3 e s ta e' s' v D F v' Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
              x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
             \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close>
   from \<open>bisim Vs E2 _ (lcl s)\<close> obtain E
     where E2: "E2 = (Val v\<bullet>compareAndSwap(D\<bullet>F, Val v', E))" and "bisim Vs E e (lcl s)" by(fastforce)
   moreover note IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> E2
     \<open>length Vs + max_vars _ \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately show ?case by(fastforce)
 next
   case (Call1Obj e s ta e' s' M es Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
             x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s);
             \<D> e2 \<lfloor>dom x\<rfloor> \<rbrakk> \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close> 
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> \<open>bisim Vs E2 (e\<bullet>M(es)) (lcl s)\<close>
   obtain E es' where E2: "E2 = E\<bullet>M(es')" "es = compEs1 Vs es'" and "bisim Vs E e (lcl s)"
     and sync: "\<not> contains_insyncs es'" by(auto elim!: bisim_cases simp add: compEs1_conv_map)
   with IH[of Vs E X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (e\<bullet>M(es)) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   obtain TA' e2' x' where IH': "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(fastforce)
   with E2 \<open>fv E2 \<subseteq> set Vs\<close> \<open>E2 = E\<bullet>M(es')\<close> sync show ?case
     by(cases "is_val e2'")(auto intro: CallObj)
 next
   case (Call1Params es s ta es' s' v M Vs E2 X)
   note IH = \<open>\<And>vs es2 x. \<lbrakk> bisims vs es2 es (lcl s); fvs es2 \<subseteq> set vs;
             x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_varss es \<le> length (lcl s); \<D>s es2 \<lfloor>dom x\<rfloor>\<rbrakk> 
            \<Longrightarrow> ?concls es es' es2 s x ta s' es' vs\<close>
   from \<open>bisim Vs E2 (Val v\<bullet>M(es)) (lcl s)\<close> obtain Es
     where "E2 = Val v \<bullet>M(Es)" "bisims Vs Es es (lcl s)" by(auto)
   with IH[of Vs Es X] \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_vars (Val v\<bullet>M(es)) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
     \<open>E2 = Val v \<bullet>M(Es)\<close> show ?case by(fastforce intro: CallParams)
 next
   case (Red1CallExternal s a T M Ts Tr D vs ta va h' e' s' Vs E2 X)
   from \<open>bisim Vs E2 (addr a\<bullet>M(map Val vs)) (lcl s)\<close> have E2: "E2 = addr a\<bullet>M(map Val vs)" by auto
   moreover from \<open>compP1 P \<turnstile> class_type_of T sees M: Ts\<rightarrow>Tr = Native in D\<close>
   have "P \<turnstile> class_type_of T sees M: Ts\<rightarrow>Tr = Native in D" by simp
   moreover from \<open>compP1 P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
   have "P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>" by simp
   moreover from wf \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
   have "ta_bisim01 (extTA2J0 P ta) (extTA2J1 (compP1 P) ta)"
     by(rule red_external_ta_bisim01)
   moreover note \<open>typeof_addr (hp s) a = \<lfloor>T\<rfloor>\<close> \<open>e' = extRet2J1 (addr a\<bullet>M(map Val vs)) va\<close> \<open>s' = (h', lcl s)\<close>
   moreover from \<open>typeof_addr (hp s) a = \<lfloor>T\<rfloor>\<close> \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
     \<open>P \<turnstile> class_type_of T sees M: Ts\<rightarrow>Tr = Native in D\<close>
   have "\<tau>external_defs D M \<Longrightarrow> ta = \<epsilon> \<and> h' = hp s"
     by(fastforce dest: \<tau>external'_red_external_heap_unchanged \<tau>external'_red_external_TA_empty simp add: \<tau>external'_def \<tau>external_def)
   ultimately show ?case using \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     by(fastforce intro!: exI[where x="extTA2J0 P ta"] intro: RedCallExternal simp add: map_eq_append_conv sim_move10_def synthesized_call_def dest: sees_method_fun del: disjCI intro: disjI1 disjI2)
 next
   case (Block1Red e h x ta e' h' x' V T Vs E2 X)
   note IH = \<open>\<And>vs e2 xa. \<lbrakk> bisim vs e2 e (lcl (h, x)); fv e2 \<subseteq> set vs; xa \<subseteq>\<^sub>m [vs [\<mapsto>] lcl (h, x)];
                        length vs + max_vars e \<le> length (lcl (h, x)); \<D> e2 \<lfloor>dom xa\<rfloor>\<rbrakk>
              \<Longrightarrow> ?concl e e' e2 (h, x) xa ta (h', x') e' vs\<close> 
   from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,(h, x)\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close>
   have "length x = length x'" by(auto dest: red1_preserves_len)
   with \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close>
   have "length Vs < length x'" by simp
   from \<open>bisim Vs E2 {V:T=None; e} (lcl (h, x))\<close>
   show ?case
   proof(cases rule: bisim_cases(14)[consumes 1, case_names BlockNone BlockSome BlockSomeNone])
     case (BlockNone V' E)
     with \<open>fv E2 \<subseteq> set Vs\<close> have "fv E \<subseteq> set (Vs@[V'])" by auto
     with IH[of "Vs@[V']" E "X(V' := None)"] BlockNone \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, x)]\<close>
       \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
     obtain TA' e2' X' where IH': "sim_move10 P t ta e e' E h (X(V' := None)) TA' e2' h' X'"
       "bisim (Vs @ [V']) e2' e' x'" "X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']"
       by(fastforce simp del: fun_upd_apply)
     { assume "V' \<in> set Vs"
       hence "hidden (Vs @ [V']) (index Vs V')" by(rule hidden_index)
       with \<open>bisim (Vs @ [V']) E e (lcl (h, x))\<close> have "unmod e (index Vs V')"
         by(auto intro: hidden_bisim_unmod)
       moreover from \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> \<open>V' \<in> set Vs\<close>
       have "index Vs V' < length x" by(auto intro: index_less_aux)
       ultimately have "x ! index Vs V' = x' ! index Vs V'"
         using red1_preserves_unmod[OF \<open>False,compP1 P,t \<turnstile>1 \<langle>e,(h, x)\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close>]
         by(simp) }
     with \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> 
       \<open>X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']\<close> \<open>length x = length x'\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, x)]\<close>
     have rel: "X'(V' := X V') \<subseteq>\<^sub>m [Vs [\<mapsto>] x']" by(auto intro: Block_lem)
 
     show ?thesis
     proof(cases "X' V'")
       case None
       with BlockNone IH' rel show ?thesis by(fastforce intro: BlockRed)
     next
       case (Some v)
       with \<open>X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']\<close> \<open>length Vs < length x'\<close>
       have "x' ! length Vs = v" by(auto dest: map_le_SomeD)
       with BlockNone IH' rel Some show ?thesis by(fastforce intro: BlockRed)
     qed
   next
     case BlockSome thus ?thesis by simp
   next
     case (BlockSomeNone V' E)
     with \<open>fv E2 \<subseteq> set Vs\<close> have "fv E \<subseteq> set (Vs@[V'])" by auto
     with IH[of "Vs@[V']" E "X(V' \<mapsto> x ! length Vs)"] BlockSomeNone \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, x)]\<close>
       \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
     obtain TA' e2' X' where IH': "sim_move10 P t ta e e' E h (X(V' \<mapsto> x ! length Vs)) TA' e2' h' X'"
       "bisim (Vs @ [V']) e2' e' x'" "X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']"
       by(fastforce simp del: fun_upd_apply)
     { assume "V' \<in> set Vs"
       hence "hidden (Vs @ [V']) (index Vs V')" by(rule hidden_index)
       with \<open>bisim (Vs @ [V']) E e (lcl (h, x))\<close> have "unmod e (index Vs V')"
         by(auto intro: hidden_bisim_unmod)
       moreover from \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> \<open>V' \<in> set Vs\<close>
       have "index Vs V' < length x" by(auto intro: index_less_aux)
       ultimately have "x ! index Vs V' = x' ! index Vs V'"
         using red1_preserves_unmod[OF \<open>False,compP1 P,t \<turnstile>1 \<langle>e,(h, x)\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close>]
         by(simp) }
     with \<open>length Vs + max_vars {V:T=None; e} \<le> length (lcl (h, x))\<close> 
       \<open>X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']\<close> \<open>length x = length x'\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, x)]\<close>
     have rel: "X'(V' := X V') \<subseteq>\<^sub>m [Vs [\<mapsto>] x']" by(auto intro: Block_lem)
     from \<open>sim_move10 P t ta e e' E h (X(V' \<mapsto> x ! length Vs)) TA' e2' h' X'\<close>
     obtain v' where "X' V' = \<lfloor>v'\<rfloor>"
       by(auto simp: sim_move10_def split: if_split_asm dest!: \<tau>red0t_lcl_incr \<tau>red0r_lcl_incr red_lcl_incr subsetD)
     with \<open>X' \<subseteq>\<^sub>m [Vs @ [V'] [\<mapsto>] x']\<close> \<open>length Vs < length x'\<close>
     have "x' ! length Vs = v'" by(auto dest: map_le_SomeD)
     with BlockSomeNone IH' rel \<open>X' V' = \<lfloor>v'\<rfloor>\<close>
     show ?thesis by(fastforce intro: BlockRed)
   qed
 next
   case(Block1Some V xs T v e h)
   from \<open>bisim vs e2 {V:T=\<lfloor>v\<rfloor>; e} (lcl (h, xs))\<close> obtain e' V' where "e2 = {V':T=\<lfloor>v\<rfloor>; e'}"
     and "V = length vs" "bisim (vs @ [V']) e' e (xs[length vs := v])" by(fastforce)
   moreover have "sim_move10 P t \<epsilon> {length vs:T=\<lfloor>v\<rfloor>; e} {length vs:T=None; e} {V':T=\<lfloor>v\<rfloor>; e'} h x \<epsilon> {V':T=\<lfloor>v\<rfloor>; e'} h x"
     by(auto)
   moreover from \<open>bisim (vs @ [V']) e' e (xs[length vs := v])\<close>
     \<open>length vs + max_vars {V:T=\<lfloor>v\<rfloor>; e} \<le> length (lcl (h, xs))\<close>
   have "bisim vs {V':T=\<lfloor>v\<rfloor>; e'} {length vs:T=None; e} (xs[length vs := v])" by auto
   moreover from \<open>x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl (h, xs)]\<close> \<open>length vs + max_vars {V:T=\<lfloor>v\<rfloor>; e} \<le> length (lcl (h, xs))\<close>
   have "x \<subseteq>\<^sub>m [vs [\<mapsto>] xs[length vs := v]]" by auto
   ultimately show ?case by auto
 next
   case (Lock1Synchronized V xs a e h Vs E2 X)
   note len = \<open>length Vs + max_vars (sync\<^bsub>V\<^esub> (addr a) e) \<le> length (lcl (h, xs))\<close>
   from \<open>bisim Vs E2 (sync\<^bsub>V\<^esub> (addr a) e) (lcl (h, xs))\<close> obtain E
     where E2: "E2 = sync(addr a) E" "e = compE1 (Vs@[fresh_var Vs]) E" 
     and sync: "\<not> contains_insync E" and [simp]: "V = length Vs" by auto
   moreover
   have "extTA2J0 P,P,t \<turnstile> \<langle>sync(addr a) E, (h, X)\<rangle> -\<lbrace>Lock\<rightarrow>a, SyncLock a\<rbrace>\<rightarrow> \<langle>insync(a) E, (h, X)\<rangle>"
     by(rule LockSynchronized)
   moreover from \<open>fv E2 \<subseteq> set Vs\<close> fresh_var_fresh[of Vs] sync len
   have "bisim Vs (insync(a) E) (insync\<^bsub>length Vs\<^esub> (a) e) (xs[length Vs := Addr a])"
     unfolding \<open>e = compE1 (Vs@[fresh_var Vs]) E\<close> \<open>E2 = sync(addr a) E\<close>
     by -(rule bisimInSynchronized,rule compE1_bisim, auto)
   moreover have "zip Vs (xs[length Vs := Addr a]) = (zip Vs xs)[length Vs := (arbitrary, Addr a)]"
     by(rule sym)(simp add: update_zip)
   hence "zip Vs (xs[length Vs := Addr a]) = zip Vs xs" by simp
   with \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] (lcl (h, xs))]\<close> have "X \<subseteq>\<^sub>m [Vs [\<mapsto>] xs[length Vs := Addr a]]"
     by(auto simp add: map_le_def map_upds_def)
   ultimately show ?case by(fastforce intro: sim_move10_SyncLocks)
 next
   case (Synchronized1Red2 e s ta e' s' V a Vs E2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
             x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s);
             \<D> e2 \<lfloor>dom x\<rfloor> \<rbrakk> \<Longrightarrow> ?concl e e' e2 s x ta s' e' vs\<close> 
   from \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) e) (lcl s)\<close> obtain E
     where E2: "E2 = insync(a) E" and bisim: "bisim (Vs@[fresh_var Vs]) E e (lcl s)"
     and xsa: "lcl s ! length Vs = Addr a" and [simp]: "V = length Vs" by auto
   with \<open>fv E2 \<subseteq> set Vs\<close> fresh_var_fresh[of Vs] have fv: "(fresh_var Vs) \<notin> fv E" by auto
   from \<open>length Vs + max_vars (insync\<^bsub>V\<^esub> (a) e) \<le> length (lcl s)\<close> have "length Vs < length (lcl s)" by simp
   { assume "X (fresh_var Vs) \<noteq> None"
     then obtain v where "X (fresh_var Vs) = \<lfloor>v\<rfloor>" by auto
     with \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> have "[Vs [\<mapsto>] lcl s] (fresh_var Vs) = \<lfloor>v\<rfloor>" 
       by(auto simp add: map_le_def dest: bspec)
     hence "(fresh_var Vs) \<in> set Vs" 
       by(auto simp add: map_upds_def set_zip dest!: map_of_SomeD )
     moreover have "(fresh_var Vs) \<notin> set Vs" by(rule fresh_var_fresh)
     ultimately have False by contradiction }
   hence "X (fresh_var Vs) = None" by(cases "X (fresh_var Vs)", auto)
   hence "X(fresh_var Vs := None) = X" by(auto intro: ext)
   moreover from \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
   have "X(fresh_var Vs := None) \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s, (fresh_var Vs) \<mapsto> (lcl s) ! length Vs]" by(simp)
   ultimately have "X \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] lcl s]"
     using \<open>length Vs < length (lcl s)\<close> by(auto)
   moreover note IH[of "Vs@[fresh_var Vs]" E X] bisim E2 \<open>fv E2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close> 
     \<open>length Vs + max_vars (insync\<^bsub>V\<^esub> (a) e) \<le> length (lcl s)\<close> \<open>\<D> E2 \<lfloor>dom X\<rfloor>\<close>
   ultimately obtain TA' e2' x' where IH': "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim (Vs @ [fresh_var Vs]) e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] lcl s']" by auto
   hence "dom x' \<subseteq> dom X \<union> fv E"
     by(fastforce iff del: domIff simp add: sim_move10_def dest: red_dom_lcl \<tau>red0r_dom_lcl[OF wf_prog_wwf_prog[OF wf]] \<tau>red0t_dom_lcl[OF wf_prog_wwf_prog[OF wf]] \<tau>red0r_fv_subset[OF wf_prog_wwf_prog[OF wf]] split: if_split_asm)
   with fv \<open>X (fresh_var Vs) = None\<close> have "(fresh_var Vs) \<notin> dom x'" by auto
   hence "x' (fresh_var Vs) = None" by auto
   moreover from \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
   have "length (lcl s) = length (lcl s')" by(auto dest: red1_preserves_len)
   moreover note \<open>x' \<subseteq>\<^sub>m [Vs @ [fresh_var Vs] [\<mapsto>] lcl s']\<close> \<open>length Vs < length (lcl s)\<close>
   ultimately have "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by(auto simp add: map_le_def dest: bspec)
   moreover from bisim fv have "unmod e (length Vs)" by(auto intro: bisim_fv_unmod)
   with \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close> \<open>length Vs < length (lcl s)\<close>
   have "lcl s ! length Vs = lcl s' ! length Vs"
     by(auto dest!: red1_preserves_unmod)
   with xsa have "lcl s' ! length Vs = Addr a" by simp
   ultimately show ?case using IH' E2 by(auto intro: SynchronizedRed2)
 next
   case (Unlock1Synchronized xs V a' a v h Vs E2 X)
   from \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) Val v) (lcl (h, xs))\<close>
   have E2: "E2 = insync(a) Val v" "V = length Vs" "xs ! length Vs = Addr a" by auto
   moreover with \<open>xs ! V = Addr a'\<close> have [simp]: "a' = a" by simp
   have "extTA2J0 P,P,t \<turnstile> \<langle>insync(a) (Val v), (h, X)\<rangle> -\<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>\<rightarrow> \<langle>Val v, (h, X)\<rangle>"
     by(rule UnlockSynchronized)
   ultimately show ?case using \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, xs)]\<close> by(fastforce intro: sim_move10_SyncLocks)
 next
   case (Unlock1SynchronizedNull xs V a v h Vs E2 X)
   from \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) Val v) (lcl (h, xs))\<close>
   have "V = length Vs" "xs ! length Vs = Addr a" by(auto)
   with \<open>xs ! V = Null\<close> have False by simp
   thus ?case ..
 next
   case (Unlock1SynchronizedFail xs V A' a' v h Vs E2 X)
   from \<open>False\<close> show ?case ..
 next
   case (Red1While b c s Vs E2 X)
   from \<open>bisim Vs E2 (while (b) c) (lcl s)\<close> obtain B C
     where E2: "E2 = while (B) C" "b = compE1 Vs B" "c = compE1 Vs C" 
     and sync: "\<not> contains_insync B" "\<not> contains_insync C" by auto
   moreover have "extTA2J0 P,P,t \<turnstile> \<langle>while (B) C, (hp s, X)\<rangle> -\<epsilon>\<rightarrow> \<langle>if (B) (C;;while (B) C) else unit, (hp s, X)\<rangle>"
     by(rule RedWhile)
   hence "sim_move10 P t \<epsilon> (while (compE1 Vs B) (compE1 Vs C)) (if (compE1 Vs B) (compE1 Vs C;;while (compE1 Vs B) (compE1 Vs C)) else unit) (while (B) C) (hp s) X \<epsilon> (if (B) (C;;while (B) C) else unit) (hp s) X"
     by(auto simp add: sim_move10_def)
   moreover from \<open>fv E2 \<subseteq> set Vs\<close> E2 sync
   have "bisim Vs (if (B) (C;; while (B) C) else unit)
                  (if (compE1 Vs B) (compE1 Vs (C;; while(B) C)) else (compE1 Vs unit)) (lcl s)"
     by -(rule bisimCond, auto)
   ultimately show ?case using \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     by(simp)(rule exI, rule exI, rule exI, erule conjI, auto)
 next
   case (Red1TryCatch h a D C V x e2 Vs E2 X)
   from \<open>bisim Vs E2 (try Throw a catch(C V) e2) (lcl (h, x))\<close>
   obtain E2' V' where "E2 = try Throw a catch(C V') E2'" "V = length Vs" "e2 = compE1 (Vs @ [V']) E2'"
     and sync: "\<not> contains_insync E2'" by(auto)
   with \<open>fv E2 \<subseteq> set Vs\<close> have "fv E2' \<subseteq> set (Vs @[V'])" by auto
   with \<open>e2 = compE1 (Vs @ [V']) E2'\<close>  sync have "bisim (Vs @[V']) E2' e2 (x[V := Addr a])"
     by(auto intro!: compE1_bisim)
   with \<open>V = length Vs\<close> \<open>length Vs + max_vars (try Throw a catch(C V) e2) \<le> length (lcl (h, x))\<close>
   have "bisim Vs {V':Class C=\<lfloor>Addr a\<rfloor>; E2'} {length Vs:Class C=None; e2} (x[V := Addr a])"
     by(auto intro: bisimBlockSomeNone)
   moreover from \<open>length Vs + max_vars (try Throw a catch(C V) e2) \<le> length (lcl (h, x))\<close>
   have "[Vs [\<mapsto>] x[length Vs := Addr a]] = [Vs [\<mapsto>] x]" by simp
   with \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, x)]\<close> have "X \<subseteq>\<^sub>m [Vs [\<mapsto>] x[length Vs := Addr a]]" by simp
   moreover note \<open>e2 = compE1 (Vs @ [V']) E2'\<close> \<open>E2 = try Throw a catch(C V') E2'\<close>
     \<open>typeof_addr h a = \<lfloor>Class_type D\<rfloor>\<close> \<open>compP1 P \<turnstile> D \<preceq>\<^sup>* C\<close> \<open>V = length Vs\<close>
   ultimately show ?case by(auto intro!: exI)
 next
   case Red1TryFail thus ?case by(auto intro!: exI sim_move10_TryFail)
 next
   case (List1Red1 e s ta e' s' es Vs ES2 X)
   note IH = \<open>\<And>vs e2 x. \<lbrakk> bisim vs e2 e (lcl s); fv e2 \<subseteq> set vs;
             x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_vars e \<le> length (lcl s); \<D> e2 \<lfloor>dom x\<rfloor>\<rbrakk>
            \<Longrightarrow> \<exists>TA' e2' x'. sim_move10 P t ta e e' e2 (hp s) x TA' e2' (hp s') x' \<and> 
                  bisim vs e2' e' (lcl s') \<and> x' \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s']\<close>
   from \<open>bisims Vs ES2 (e # es) (lcl s)\<close> \<open>False,compP1 P,t \<turnstile>1 \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>
   obtain E ES where "ES2 = E # ES" "\<not> is_val E" "es = compEs1 Vs ES" "bisim Vs E e (lcl s)"
     and sync: "\<not> contains_insyncs ES" by(auto elim!: bisims_cases simp add: compEs1_conv_map)
   with IH[of Vs E X] \<open>fvs ES2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_varss (e # es) \<le> length (lcl s)\<close> \<open>\<D>s ES2 \<lfloor>dom X\<rfloor>\<close>
   obtain TA' e2' x' where IH': "sim_move10 P t ta e e' E (hp s) X TA' e2' (hp s') x'"
     "bisim Vs e2' e' (lcl s')" "x' \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s']" by fastforce
   show ?case
   proof(cases "is_val e2'")
     case False
     with IH' \<open>ES2 = E # ES\<close> \<open>es = compEs1 Vs ES\<close> sync show ?thesis by(auto intro: sim_moves10_expr)
   next
     case True
     from \<open>fvs ES2 \<subseteq> set Vs\<close> \<open>ES2 = E # ES\<close> \<open>es = compEs1 Vs ES\<close> sync
     have "bisims Vs ES es (lcl s')" by(auto intro: compEs1_bisims)
     with IH' True \<open>ES2 = E # ES\<close> \<open>es = compEs1 Vs ES\<close> show ?thesis by(auto intro: sim_moves10_expr)
   qed
 next
   case (List1Red2 es s ta es' s' v Vs ES2 X)
   note IH = \<open>\<And>vs es2 x. \<lbrakk>bisims vs es2 es (lcl s); fvs es2 \<subseteq> set vs;
             x \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s]; length vs + max_varss es \<le> length (lcl s); \<D>s es2 \<lfloor>dom x\<rfloor>\<rbrakk>
            \<Longrightarrow> \<exists>TA' es2' x'. sim_moves10 P t ta es es' es2 (hp s) x TA' es2' (hp s') x' \<and> bisims vs es2' es' (lcl s') \<and> x' \<subseteq>\<^sub>m [vs [\<mapsto>] lcl s']\<close>
   from \<open>bisims Vs ES2 (Val v # es) (lcl s)\<close> obtain ES where "ES2 = Val v # ES" "bisims Vs ES es (lcl s)"
     by(auto elim!: bisims_cases)
   with IH[of Vs ES X] \<open>fvs ES2 \<subseteq> set Vs\<close> \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl s]\<close>
     \<open>length Vs + max_varss (Val v # es) \<le> length (lcl s)\<close> \<open>\<D>s ES2 \<lfloor>dom X\<rfloor>\<close>
     \<open>ES2 = Val v # ES\<close> show ?case by(fastforce intro: sim_moves10_expr)
 next
   case Call1ThrowParams
   thus ?case by(fastforce intro: CallThrowParams elim!: bisim_cases simp add: bisims_map_Val_Throw2)
 next
   case (Synchronized1Throw2 xs V a' a ad h Vs E2 X)
   from \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) Throw ad) (lcl (h, xs))\<close>
   have "xs ! length Vs = Addr a" and "V = length Vs" by auto
   with \<open>xs ! V = Addr a'\<close> have [simp]: "a' = a" by simp
   have "extTA2J0 P,P,t \<turnstile> \<langle>insync(a) Throw ad, (h, X)\<rangle> -\<lbrace>Unlock\<rightarrow>a, SyncUnlock a\<rbrace>\<rightarrow> \<langle>Throw ad, (h, X)\<rangle>"
     by(rule SynchronizedThrow2)
   with \<open>X \<subseteq>\<^sub>m [Vs [\<mapsto>] lcl (h, xs)]\<close> \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) Throw ad) (lcl (h, xs))\<close>
   show ?case by(auto intro: sim_move10_SyncLocks intro!: exI)
 next
   case (Synchronized1Throw2Null xs V a a' h Vs E2 X)
   from \<open>bisim Vs E2 (insync\<^bsub>V\<^esub> (a) Throw a') (lcl (h, xs))\<close>
   have "V = length Vs" "xs ! length Vs = Addr a" by(auto)
   with \<open>xs ! V = Null\<close> have False by simp
   thus ?case ..
 next
   case (Synchronized1Throw2Fail xs V A' a' a h Vs E2 X)
   from \<open>False\<close> show ?case ..
 next
   case InstanceOf1Red thus ?case by auto(blast)
 next
   case Red1InstanceOf thus ?case by hypsubst_thin auto
 next
   case InstanceOf1Throw thus ?case by auto
 next
   case CAS1Throw thus ?case by fastforce
 next
   case CAS1Throw2 thus ?case by fastforce
 next
   case CAS1Throw3 thus ?case by fastforce
 qed(simp_all del: fun_upd_apply, (fastforce intro: red_reds.intros simp del: fun_upd_apply simp add: finfun_upd_apply)+)
 
 lemma bisim_call_Some_call1:
   "\<lbrakk> bisim Vs e e' xs; call e = \<lfloor>aMvs\<rfloor>; length Vs + max_vars e' \<le> length xs \<rbrakk>
   \<Longrightarrow> \<exists>e'' xs'. \<tau>red1'r P t h (e', xs) (e'', xs') \<and> call1 e'' = \<lfloor>aMvs\<rfloor> \<and> 
                bisim Vs e e'' xs' \<and> take (length Vs) xs = take (length Vs) xs'"
 
   and bisims_calls_Some_calls1:
   "\<lbrakk> bisims Vs es es' xs; calls es = \<lfloor>aMvs\<rfloor>; length Vs + max_varss es' \<le> length xs \<rbrakk> 
   \<Longrightarrow> \<exists>es'' xs'. \<tau>reds1'r P t h (es', xs) (es'', xs') \<and> calls1 es'' = \<lfloor>aMvs\<rfloor> \<and> 
                 bisims Vs es es'' xs' \<and> take (length Vs) xs = take (length Vs) xs'"
 proof(induct rule: bisim_bisims.inducts)
   case bisimCallParams thus ?case
     by(fastforce simp add: is_vals_conv split: if_split_asm)
 next
   case bisimBlockNone thus ?case by(fastforce intro: take_eq_take_le_eq)
 next
   case (bisimBlockSome Vs V e e' xs v T)
   from \<open>length Vs + max_vars {length Vs:T=\<lfloor>v\<rfloor>; e'} \<le> length xs\<close>
   have "\<tau>red1'r P t h ({length Vs:T=\<lfloor>v\<rfloor>; e'}, xs) ({length Vs:T=None; e'}, xs[length Vs := v])"
     by(auto intro!: \<tau>red1r_1step Block1Some)
   also from bisimBlockSome obtain e'' xs'
     where "\<tau>red1'r P t h (e', xs[length Vs := v]) (e'', xs')"
     and "call1 e'' = \<lfloor>aMvs\<rfloor>" "bisim (Vs @ [V]) e e'' xs'" 
     and "take (length (Vs @ [V])) (xs[length Vs := v]) = take (length (Vs @ [V])) xs'" by auto
   hence "\<tau>red1'r P t h ({length Vs:T=None; e'}, xs[length Vs := v]) ({length Vs:T=None; e''}, xs')" by auto
   also from \<open>call1 e'' = \<lfloor>aMvs\<rfloor>\<close> have "call1 {length Vs:T=None; e''} = \<lfloor>aMvs\<rfloor>" by simp
   moreover from \<open>take (length (Vs @ [V])) (xs[length Vs := v]) = take (length (Vs @ [V])) xs'\<close>
   have "take (length Vs) xs = take (length Vs) xs'"
-    by(auto dest: take_eq_take_le_eq[where m="length Vs"] simp add: take_list_update_beyond)
+    by(auto dest: take_eq_take_le_eq[where m="length Vs"] simp add: take_update_cancel)
   moreover {
     have "xs' ! length Vs = take (length (Vs @ [V])) xs' ! length Vs" by simp
     also note \<open>take (length (Vs @ [V])) (xs[length Vs := v]) = take (length (Vs @ [V])) xs'\<close>[symmetric]
     also have "take (length (Vs @ [V])) (xs[length Vs := v]) ! length Vs = v"
       using \<open>length Vs + max_vars {length Vs:T=\<lfloor>v\<rfloor>; e'} \<le> length xs\<close> by simp
     finally have "bisim Vs {V:T=\<lfloor>v\<rfloor>; e} {length Vs:T=None; e''} xs'"
       using \<open>bisim (Vs @ [V]) e e'' xs'\<close> by auto }
   ultimately show ?case by blast
 next
   case (bisimBlockSomeNone Vs V e e' xs v T)
   then obtain e'' xs' where "\<tau>red1'r P t h (e', xs) (e'', xs')" "call1 e'' = \<lfloor>aMvs\<rfloor>" "bisim (Vs @ [V]) e e'' xs'"
     and "take (length (Vs @ [V])) xs = take (length (Vs @ [V])) xs'" by auto
   hence "\<tau>red1'r P t h ({length Vs:T=None; e'}, xs) ({length Vs:T=None; e''}, xs')" by auto
   moreover from \<open>call1 e'' = \<lfloor>aMvs\<rfloor>\<close> have "call1 ({length Vs:T=None; e''}) = \<lfloor>aMvs\<rfloor>" by simp
   moreover from \<open>take (length (Vs @ [V])) xs = take (length (Vs @ [V])) xs'\<close>
   have "take (length Vs) xs = take (length Vs) xs'" by(auto intro: take_eq_take_le_eq)
   moreover {
     have "xs' ! length Vs = take (length (Vs @ [V])) xs' ! length Vs" by simp
     also note \<open>take (length (Vs @ [V])) xs = take (length (Vs @ [V])) xs'\<close>[symmetric]
     also have "take (length (Vs @ [V])) xs ! length Vs = v" using \<open>xs ! length Vs = v\<close> by simp
     finally have "bisim Vs {V:T=\<lfloor>v\<rfloor>; e} {length Vs:T=None; e''} xs'"
       using \<open>bisim (Vs @ [V]) e e'' xs'\<close> by auto }
   ultimately show ?case by blast
 next
   case (bisimInSynchronized Vs e e' xs a)
   then obtain e'' xs' where "\<tau>red1'r P t h (e', xs) (e'', xs')" "call1 e'' = \<lfloor>aMvs\<rfloor>" "bisim (Vs @ [fresh_var Vs]) e e'' xs'"
     and "take (Suc (length Vs)) xs = take (Suc (length Vs)) xs'" by auto
   hence "\<tau>red1'r P t h (insync\<^bsub>length Vs\<^esub> (a) e', xs) (insync\<^bsub>length Vs\<^esub> (a) e'', xs')" by auto
   moreover from \<open>call1 e'' = \<lfloor>aMvs\<rfloor>\<close> have "call1 (insync\<^bsub>length Vs\<^esub> (a) e'') = \<lfloor>aMvs\<rfloor>" by simp
   moreover from \<open>take (Suc (length Vs)) xs = take (Suc (length Vs)) xs'\<close>
   have "take (length Vs) xs = take (length Vs) xs'" by(auto intro: take_eq_take_le_eq)
   moreover {
     have "xs' ! length Vs = take (Suc (length Vs)) xs' ! length Vs" by simp
     also note \<open>take (Suc (length Vs)) xs = take (Suc (length Vs)) xs'\<close>[symmetric]
     also have "take (Suc (length Vs)) xs ! length Vs = Addr a"
       using \<open>xs ! length Vs = Addr a\<close> by simp
     finally have "bisim Vs (insync(a) e) (insync\<^bsub>length Vs\<^esub> (a) e'') xs'"
       using \<open>bisim (Vs @ [fresh_var Vs]) e e'' xs'\<close> by auto }
   ultimately show ?case by blast
 next
   case bisimsCons1 thus ?case by(fastforce intro!: \<tau>red1r_inj_\<tau>reds1r)
 next
   case bisimsCons2 thus ?case by(fastforce intro!: \<tau>reds1r_cons_\<tau>reds1r)
 qed fastforce+
 
 lemma sim_move01_into_Red1:
   "sim_move01 P t ta e E' h xs ta' e2' h' xs'
   \<Longrightarrow> if \<tau>Move0 P h (e, es1)
       then \<tau>Red1't P t h ((E', xs), exs2) ((e2', xs'), exs2) \<and> ta = \<epsilon> \<and> h = h'
       else \<exists>ex2' exs2' ta'. \<tau>Red1'r P t h ((E', xs), exs2) (ex2', exs2') \<and>
                            (call e = None \<or> call1 E' = None \<or> ex2' = (E', xs) \<and> exs2' = exs2) \<and>
                            False,P,t \<turnstile>1 \<langle>ex2'/exs2',h\<rangle> -ta'\<rightarrow> \<langle>(e2', xs')/exs2,h'\<rangle> \<and>
                            \<not> \<tau>Move1 P h (ex2', exs2') \<and> ta_bisim01 ta ta'"
 apply(auto simp add: sim_move01_def intro: \<tau>red1t_into_\<tau>Red1t \<tau>red1r_into_\<tau>Red1r red1Red split: if_split_asm)
 apply(fastforce intro: red1Red intro!: \<tau>red1r_into_\<tau>Red1r)+
 done
 
 lemma sim_move01_max_vars_decr:
   "sim_move01 P t ta e0 e h xs ta' e' h' xs' \<Longrightarrow> max_vars e' \<le> max_vars e"
 by(fastforce simp add: sim_move01_def split: if_split_asm dest: \<tau>red1t_max_vars red1_max_vars_decr \<tau>red1r_max_vars)
 
 lemma Red1_simulates_red0:
   assumes wf: "wf_J_prog P"
   and red: "P,t \<turnstile>0 \<langle>e1/es1, h\<rangle> -ta\<rightarrow> \<langle>e1'/es1', h'\<rangle>"
   and bisiml: "bisim_list1 (e1, es1) (ex2, exs2)"
   shows "\<exists>ex2'' exs2''. bisim_list1 (e1', es1') (ex2'', exs2'') \<and>
         (if \<tau>Move0 P h (e1, es1)
          then \<tau>Red1't (compP1 P) t h (ex2, exs2) (ex2'', exs2'') \<and> ta = \<epsilon> \<and> h = h'
          else \<exists>ex2' exs2' ta'. \<tau>Red1'r (compP1 P) t h (ex2, exs2) (ex2', exs2') \<and> 
                                (call e1 = None \<or> call1 (fst ex2) = None \<or> ex2' = ex2 \<and> exs2' = exs2) \<and>
                                False,compP1 P,t \<turnstile>1 \<langle>ex2'/exs2', h\<rangle> -ta'\<rightarrow> \<langle>ex2''/exs2'', h'\<rangle> \<and>
                                \<not> \<tau>Move1 P h (ex2', exs2') \<and> ta_bisim01 ta ta')"
   (is "\<exists>ex2'' exs2'' . _ \<and> ?red ex2'' exs2''")
 using red
 proof(cases)
   case (red0Red XS')
   note [simp] = \<open>es1' = es1\<close>
     and red = \<open>extTA2J0 P,P,t \<turnstile> \<langle>e1,(h, Map.empty)\<rangle> -ta\<rightarrow> \<langle>e1',(h', XS')\<rangle>\<close>
     and notsynth = \<open>\<forall>aMvs. call e1 = \<lfloor>aMvs\<rfloor> \<longrightarrow> synthesized_call P h aMvs\<close>
   from bisiml obtain E xs where ex2: "ex2 = (E, xs)"
     and bisim: "bisim [] e1 E xs" and fv: "fv e1 = {}" 
     and length: "max_vars E \<le> length xs" and bsl: "bisim_list es1 exs2"
     and D: "\<D> e1 \<lfloor>{}\<rfloor>" by(auto elim!: bisim_list1_elim)
   from bisim_max_vars[OF bisim] length red1_simulates_red_aux[OF wf red bisim] fv notsynth
   obtain ta' e2' xs' where sim: "sim_move01 (compP1 P) t ta e1 E h xs ta' e2' h' xs'"
     and bisim': "bisim [] e1' e2' xs'" and XS': "XS' \<subseteq>\<^sub>m Map.empty" by auto
   from sim_move01_into_Red1[OF sim, of es1 exs2]
   have "?red (e2', xs') exs2" unfolding ex2 by auto
   moreover {
     note bsl bisim' moreover
     from fv red_fv_subset[OF wf_prog_wwf_prog[OF wf] red]
     have "fv e1' = {}" by simp
     moreover from red D have "\<D> e1' \<lfloor>dom XS'\<rfloor>"
       by(auto dest: red_preserves_defass[OF wf] split: if_split_asm)
     with red_dom_lcl[OF red] \<open>fv e1 = {}\<close> have "\<D> e1' \<lfloor>{}\<rfloor>"
       by(auto elim!: D_mono' simp add: hyperset_defs)
     moreover from sim have "length xs = length xs'" "max_vars e2' \<le> max_vars E"
       by(auto dest: sim_move01_preserves_len sim_move01_max_vars_decr)
     with length have length': "max_vars e2' \<le> length xs'" by(auto)
     ultimately have "bisim_list1 (e1', es1) ((e2', xs'), exs2)" by(rule bisim_list1I) }
   ultimately show ?thesis using ex2 by(simp split del: if_split)(rule exI conjI|assumption)+
 next
   case (red0Call a M vs U Ts T pns body D)
   note [simp] = \<open>ta = \<epsilon>\<close> \<open>h' = h\<close>
     and es1' = \<open>es1' = e1 # es1\<close>
     and e1' = \<open>e1' = blocks (this # pns) (Class D # Ts) (Addr a # vs) body\<close>
     and call = \<open>call e1 = \<lfloor>(a, M, vs)\<rfloor>\<close>
     and ha = \<open>typeof_addr h a = \<lfloor>U\<rfloor>\<close>
     and sees = \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D\<close>
     and len = \<open>length vs = length pns\<close> \<open>length Ts = length pns\<close>
   from bisiml obtain E xs where ex2: "ex2 = (E, xs)"
     and bisim: "bisim [] e1 E xs" and fv: "fv e1 = {}" 
     and length: "max_vars E \<le> length xs" and bsl: "bisim_list es1 exs2"
     and D: "\<D> e1 \<lfloor>{}\<rfloor>" by(auto elim!: bisim_list1_elim)
   
   from bisim_call_Some_call1[OF bisim call, of "compP1 P" t h] length
   obtain e' xs' where red: "\<tau>red1'r (compP1 P) t h (E, xs) (e', xs')"
     and "call1 e' = \<lfloor>(a, M, vs)\<rfloor>" "bisim [] e1 e' xs'" 
     and "take 0 xs = take 0 xs'" by auto
     
   let ?e1' = "blocks (this # pns) (Class D # Ts) (Addr a # vs) body"
   let ?e2' = "blocks1 0 (Class D#Ts) (compE1 (this # pns) body)"
   let ?xs2' = "Addr a # vs @ replicate (max_vars (compE1 (this # pns) body)) undefined_value"
   let ?exs2' = "(e', xs') # exs2"
 
   have "\<tau>Red1'r (compP1 P) t h ((E, xs), exs2) ((e', xs'), exs2)"
     using red by(rule \<tau>red1r_into_\<tau>Red1r)
   moreover {
     note \<open>call1 e' = \<lfloor>(a, M, vs)\<rfloor>\<close> 
     moreover note ha
     moreover have "compP1 P \<turnstile> class_type_of U sees M:Ts \<rightarrow> T = map_option (\<lambda>(pns, body). compE1 (this # pns) body) \<lfloor>(pns, body)\<rfloor> in D"
       using sees unfolding compP1_def by(rule sees_method_compP)
     hence sees': "compP1 P \<turnstile> class_type_of U sees M:Ts \<rightarrow> T = \<lfloor>compE1 (this # pns) body\<rfloor> in D" by simp
     moreover from len have "length vs = length Ts" by simp
     ultimately have "False,compP1 P,t \<turnstile>1 \<langle>(e', xs')/exs2,h\<rangle> -\<epsilon>\<rightarrow> \<langle>(?e2', ?xs2')/?exs2', h\<rangle>" by(rule red1Call) 
     moreover have "\<tau>Move1 P h ((e', xs'), exs2)" using \<open>call1 e' = \<lfloor>(a, M, vs)\<rfloor>\<close> ha sees
       by(auto simp add: synthesized_call_def \<tau>external'_def dest: sees_method_fun dest!: \<tau>move1_not_call1[where P=P and h=h])
     ultimately have "\<tau>Red1' (compP1 P) t h ((e', xs'), exs2) ((?e2', ?xs2'), ?exs2')" by auto }
   ultimately have "\<tau>Red1't (compP1 P) t h ((E, xs), exs2) ((?e2', ?xs2'), ?exs2')" by(rule rtranclp_into_tranclp1)
   moreover
   { from red have "length xs' = length xs" by(rule \<tau>red1r_preserves_len)
     moreover from red have "max_vars e' \<le> max_vars E" by(rule \<tau>red1r_max_vars)
     ultimately have "max_vars e' \<le> length xs'" using length by simp }
   with bsl \<open>bisim [] e1 e' xs'\<close> fv D have "bisim_list (e1 # es1) ?exs2'"
     using \<open>call e1 = \<lfloor>(a, M, vs)\<rfloor>\<close> \<open>call1 e' = \<lfloor>(a, M, vs)\<rfloor>\<close> by(rule bisim_listCons)
   hence "bisim_list1 (e1', es1') ((?e2', ?xs2'), ?exs2')"
     unfolding e1' es1'
   proof(rule bisim_list1I)
     from wf_prog_wwf_prog[OF wf] sees
     have "wf_mdecl wwf_J_mdecl P D (M,Ts,T,\<lfloor>(pns,body)\<rfloor>)" by(rule sees_wf_mdecl)
     hence fv': "fv body \<subseteq> set pns \<union> {this}" by(auto simp add: wf_mdecl_def)
     moreover from \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D\<close> have "\<not> contains_insync body"
       by(auto dest!: sees_wf_mdecl[OF wf] WT_expr_locks simp add: wf_mdecl_def contains_insync_conv)
     ultimately have "bisim ([this] @ pns) body (compE1 ([this] @ pns) body) ?xs2'"
       by -(rule compE1_bisim, auto)
     with \<open>length vs = length pns\<close> \<open>length Ts = length pns\<close>
     have "bisim ([] @ [this]) (blocks pns Ts vs body) (blocks1 (Suc 0) Ts (compE1 (this # pns) body)) ?xs2'"
       by -(drule blocks_bisim,auto simp add: nth_append)
     from bisimBlockSomeNone[OF this, of "Addr a" "Class D"]
     show "bisim [] ?e1' ?e2' ?xs2'" by simp
     from fv' len show "fv ?e1' = {}" by auto
 
     from wf sees
     have "wf_mdecl wf_J_mdecl P D (M,Ts,T,\<lfloor>(pns,body)\<rfloor>)" by(rule sees_wf_mdecl)
     hence "\<D> body \<lfloor>set pns \<union> {this}\<rfloor>" by(auto simp add: wf_mdecl_def)
     with \<open>length vs = length pns\<close> \<open>length Ts = length pns\<close>
     have "\<D> (blocks pns Ts vs body) \<lfloor>dom [this \<mapsto> Addr a]\<rfloor>" by(auto)
     thus "\<D> ?e1' \<lfloor>{}\<rfloor>" by auto
     
     from len show "max_vars ?e2' \<le> length ?xs2'" by(auto simp add: blocks1_max_vars)
   qed
   moreover have "\<tau>Move0 P h (e1, es1)" using call ha sees
     by(fastforce simp add: synthesized_call_def  \<tau>external'_def dest: sees_method_fun \<tau>move0_callD[where P=P and h=h])
   ultimately show ?thesis using ex2 \<open>call e1 = \<lfloor>(a, M, vs)\<rfloor>\<close> 
     by(simp del: \<tau>Move1.simps)(rule exI conjI|assumption)+
 next
   case (red0Return e)
   note es1 = \<open>es1 = e # es1'\<close> and e1' = \<open>e1' = inline_call e1 e\<close>
     and [simp] = \<open>ta = \<epsilon>\<close> \<open>h' = h\<close>
     and fin = \<open>final e1\<close>
   from bisiml es1 obtain E' xs' E xs exs' aMvs where ex2: "ex2 = (E', xs')" and exs2: "exs2 = (E, xs) # exs'"
     and bisim': "bisim [] e1 E' xs'"
     and bisim: "bisim [] e E xs"
     and fv: "fv e = {}"
     and length: "max_vars E \<le> length xs"
     and bisiml: "bisim_list es1' exs'"
     and D: "\<D> e \<lfloor>{}\<rfloor>"
     and call: "call e = \<lfloor>aMvs\<rfloor>"
     and call1: "call1 E = \<lfloor>aMvs\<rfloor>"
     by(fastforce elim: bisim_list1_elim)
   let ?e2' = "inline_call E' E"
 
   from \<open>final e1\<close> bisim' have "final E'" by(auto)
   hence red': "False,compP1 P,t \<turnstile>1 \<langle>ex2/exs2, h\<rangle> -\<epsilon>\<rightarrow> \<langle>(?e2', xs)/exs', h\<rangle>"
     unfolding ex2 exs2 by(rule red1Return)
   moreover have "\<tau>Move0 P h (e1, es1) = \<tau>Move1 P h ((E', xs'), exs2)"
     using \<open>final e1\<close> \<open>final E'\<close> by auto
   moreover {
     note bisiml
     moreover
     from bisim' fin bisim
     have "bisim [] (inline_call e1 e) (inline_call E' E) xs"
       using call by(rule bisim_inline_call)(simp add: fv)
     moreover from fv_inline_call[of e1 e] fv fin 
     have "fv (inline_call e1 e) = {}" by auto
     moreover from fin have "\<D> (inline_call e1 e) \<lfloor>{}\<rfloor>"
       using call D by(rule defass_inline_call)
     moreover have "max_vars ?e2' \<le> max_vars E + max_vars E'" by(rule inline_call_max_vars1)
     with \<open>final E'\<close> length have "max_vars ?e2' \<le> length xs" by(auto elim!: final.cases)
     ultimately have "bisim_list1 (inline_call e1 e, es1') ((?e2', xs), exs')"
       by(rule bisim_list1I) }
   ultimately show ?thesis using e1' \<open>final e1\<close> \<open>final E'\<close> ex2 
     apply(simp del: \<tau>Move0.simps \<tau>Move1.simps)
     apply(rule exI conjI impI|assumption)+
      apply(rule tranclp.r_into_trancl, simp)
     apply blast
     done
 qed
 
 lemma sim_move10_into_red0:
   assumes wwf: "wwf_J_prog P"
   and sim: "sim_move10 P t ta e2 e2' e h Map.empty ta' e' h' x'"
   and fv: "fv e = {}"
   shows "if \<tau>move1 P h e2
          then (\<tau>Red0t P t h (e, es) (e', es) \<or> countInitBlock e2' < countInitBlock e2 \<and> e' = e \<and> x' = Map.empty) \<and> ta = \<epsilon> \<and> h = h'
          else \<exists>e'' ta'. \<tau>Red0r P t h (e, es) (e'', es) \<and>
                         (call1 e2 = None \<or> call e = None \<or> e'' = e) \<and>
                         P,t \<turnstile>0 \<langle>e''/es,h\<rangle> -ta'\<rightarrow> \<langle>e'/es,h'\<rangle> \<and>
                         \<not> \<tau>Move0 P h (e'', es) \<and> ta_bisim01 ta' (extTA2J1 (compP1 P) ta)"
 proof(cases "\<tau>move1 P h e2")
   case True
   with sim have "\<not> final e2"
     and red: "\<tau>red0t (extTA2J0 P) P t h (e, Map.empty) (e', x') \<or>
               countInitBlock e2' < countInitBlock e2 \<and> e' = e \<and> x' = Map.empty"
     and [simp]: "h' = h" "ta = \<epsilon>" "ta' = \<epsilon>" by(simp_all add: sim_move10_def)
   from red have "\<tau>Red0t P t h (e, es) (e', es) \<or>
                  countInitBlock e2' < countInitBlock e2 \<and> e' = e \<and> x' = Map.empty"
   proof
     assume red: "\<tau>red0t (extTA2J0 P) P t h (e, Map.empty) (e', x')"
     from \<tau>red0t_fv_subset[OF wwf red] \<tau>red0t_dom_lcl[OF wwf red] fv
     have "dom x' \<subseteq> {}" by(auto split: if_split_asm)
     hence "x' = Map.empty" by auto
     with red have "\<tau>red0t (extTA2J0 P) P t h (e, Map.empty) (e', Map.empty)" by simp
     with wwf have "\<tau>Red0t P t h (e, es) (e', es)"
       using fv by(rule \<tau>red0t_into_\<tau>Red0t)
     thus ?thesis ..
   qed simp
   with True show ?thesis by simp
 next
   case False
   with sim obtain e'' xs'' where "\<not> final e2"
     and \<tau>red: "\<tau>red0r (extTA2J0 P) P t h (e, Map.empty) (e'', xs'')"
     and red: "extTA2J0 P,P,t \<turnstile> \<langle>e'',(h, xs'')\<rangle> -ta'\<rightarrow> \<langle>e',(h', x')\<rangle>"
     and call: "call1 e2 = None \<or> call e = None \<or> e'' = e"
     and "\<not> \<tau>move0 P h e''" "ta_bisim01 ta' (extTA2J1 (compP1 P) ta)" "no_call P h e''"
     by(auto simp add: sim_move10_def split: if_split_asm)
   from \<tau>red0r_fv_subset[OF wwf \<tau>red] \<tau>red0r_dom_lcl[OF wwf \<tau>red] fv
   have "dom xs'' \<subseteq> {}" by(auto)
   hence "xs'' = Map.empty" by(auto)
   with \<tau>red have "\<tau>red0r (extTA2J0 P) P t h (e, Map.empty) (e'', Map.empty)" by simp
   with wwf have "\<tau>Red0r P t h (e, es) (e'', es)"
     using fv by(rule \<tau>red0r_into_\<tau>Red0r)
   moreover from red \<open>xs'' = Map.empty\<close>
   have "extTA2J0 P,P,t \<turnstile> \<langle>e'',(h, Map.empty)\<rangle> -ta'\<rightarrow> \<langle>e',(h', x')\<rangle>" by simp
   from red0Red[OF this] \<open>no_call P h e''\<close> 
   have "P,t \<turnstile>0 \<langle>e''/es,h\<rangle> -ta'\<rightarrow> \<langle>e'/es,h'\<rangle>" by(simp add: no_call_def)
   moreover from \<open>\<not> \<tau>move0 P h e''\<close> red
   have "\<not> \<tau>Move0 P h (e'', es)" by auto
   ultimately show ?thesis using False \<open>ta_bisim01 ta' (extTA2J1 (compP1 P) ta)\<close> call
     by(simp del: \<tau>Move0.simps) blast
 qed
 
 lemma red0_simulates_Red1:
   assumes wf: "wf_J_prog P"
   and red: "False,compP1 P,t \<turnstile>1 \<langle>ex2/exs2, h\<rangle> -ta\<rightarrow> \<langle>ex2'/exs2', h'\<rangle>"
   and bisiml: "bisim_list1 (e, es) (ex2, exs2)"
   shows "\<exists>e' es'. bisim_list1 (e', es') (ex2', exs2') \<and>
                  (if \<tau>Move1 P h (ex2, exs2)
                   then (\<tau>Red0t P t h (e, es) (e', es') \<or> countInitBlock (fst ex2') < countInitBlock (fst ex2) \<and> exs2' = exs2 \<and> e' = e \<and> es' = es) \<and>
                         ta = \<epsilon> \<and> h = h'
                   else \<exists>e'' es'' ta'. \<tau>Red0r P t h (e, es) (e'', es'') \<and>
                                       (call1 (fst ex2) = None \<or> call e = None \<or> e'' = e \<and> es'' = es) \<and>
                                       P,t \<turnstile>0 \<langle>e''/es'', h\<rangle> -ta'\<rightarrow> \<langle>e'/es', h'\<rangle> \<and>
                                       \<not> \<tau>Move0 P h (e'', es'') \<and> ta_bisim01 ta' ta)"
   (is "\<exists>e' es' . _ \<and> ?red e' es'")
 using red
 proof(cases)
   case (red1Red E xs TA E' xs')
   note red = \<open>False,compP1 P,t \<turnstile>1 \<langle>E,(h, xs)\<rangle> -TA\<rightarrow> \<langle>E',(h', xs')\<rangle>\<close>
     and ex2 = \<open>ex2 = (E, xs)\<close>
     and ex2' = \<open>ex2' = (E', xs')\<close>
     and [simp] = \<open>ta = extTA2J1 (compP1 P) TA\<close> \<open>exs2' = exs2\<close>
   from bisiml ex2 have bisim: "bisim [] e E xs" and fv: "fv e = {}"
     and length: "max_vars E \<le> length xs" and bsl: "bisim_list es exs2"
     and D: "\<D> e \<lfloor>{}\<rfloor>" by(auto elim: bisim_list1_elim)
   from red_simulates_red1_aux[OF wf red, simplified, OF bisim, of Map.empty] fv length D
   obtain TA' e2' x' where red': "sim_move10 P t TA E E' e h Map.empty TA' e2' h' x'"
     and bisim'': "bisim [] e2' E' xs'" and lcl': "x' \<subseteq>\<^sub>m Map.empty" by auto
   from red have "\<not> final E" by auto
   with sim_move10_into_red0[OF wf_prog_wwf_prog[OF wf] red', of es] fv ex2 ex2'
   have red'': "?red e2' es" by fastforce
   moreover {
     note bsl bisim''
     moreover from red' fv have "fv e2' = {}"
       by(fastforce simp add: sim_move10_def split: if_split_asm dest: \<tau>red0r_fv_subset[OF wf_prog_wwf_prog[OF wf]] \<tau>red0t_fv_subset[OF wf_prog_wwf_prog[OF wf]] red_fv_subset[OF wf_prog_wwf_prog[OF wf]])
     moreover from red' have "dom x' \<subseteq> dom (Map.empty) \<union> fv e"
       unfolding sim_move10_def
       apply(auto split: if_split_asm del: subsetI dest: \<tau>red0r_dom_lcl[OF wf_prog_wwf_prog[OF wf]] \<tau>red0t_dom_lcl[OF wf_prog_wwf_prog[OF wf]])
       apply(frule_tac [1-2] \<tau>red0r_fv_subset[OF wf_prog_wwf_prog[OF wf]])
       apply(auto dest!: \<tau>red0r_dom_lcl[OF wf_prog_wwf_prog[OF wf]] red_dom_lcl del: subsetI, blast+)
       done
     with fv have "dom x' \<subseteq> {}" by(auto)
     hence "x' = Map.empty" by(auto)
     with D red' have "\<D> e2' \<lfloor>{}\<rfloor>"
       by(auto dest!: sim_move10_preserves_defass[OF wf] split: if_split_asm)
     moreover from red have "length xs' = length xs" by(auto dest: red1_preserves_len)
     with red1_max_vars[OF red] length
     have "max_vars E' \<le> length xs'" by simp
     ultimately have "bisim_list1 (e2', es) ((E', xs'), exs2)"
       by(rule bisim_list1I) }
   ultimately show ?thesis using ex2'
     by(clarsimp split: if_split_asm)(rule exI conjI|assumption|simp)+
 next
   case (red1Call E a M vs U Ts T body D xs)
   note [simp] = \<open>ex2 = (E, xs)\<close> \<open>h' = h\<close> \<open>ta = \<epsilon>\<close>
     and ex2' = \<open>ex2' = (blocks1 0 (Class D#Ts) body, Addr a # vs @ replicate (max_vars body) undefined_value)\<close>
     and exs' = \<open>exs2' = (E, xs) # exs2\<close>
     and call = \<open>call1 E = \<lfloor>(a, M, vs)\<rfloor>\<close> and ha = \<open>typeof_addr h a = \<lfloor>U\<rfloor>\<close>
     and sees = \<open>compP1 P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>body\<rfloor> in D\<close>
     and len = \<open>length vs = length Ts\<close>
   let ?e2' = "blocks1 0 (Class D#Ts) body"
   let ?xs2' = "Addr a # vs @ replicate (max_vars body) undefined_value"
   from bisiml have bisim: "bisim [] e E xs" and fv: "fv e = {}"
     and length: "max_vars E \<le> length xs" and bsl: "bisim_list es exs2"
     and D: "\<D> e \<lfloor>{}\<rfloor>" by(auto elim: bisim_list1_elim)
 
   from bisim \<open>call1 E = \<lfloor>(a, M, vs)\<rfloor>\<close>
   have "call e = \<lfloor>(a, M, vs)\<rfloor>" by(rule bisim_call1_Some_call)
   moreover note ha
   moreover from \<open>compP1 P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>body\<rfloor> in D\<close>
   obtain pns Jbody where sees': "P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns, Jbody)\<rfloor> in D"
     and body: "body = compE1 (this # pns) Jbody"
     by(auto dest: sees_method_compPD)
   let ?e' = "blocks (this # pns) (Class D # Ts) (Addr a # vs) Jbody"
   note sees' moreover from wf sees' have "length Ts = length pns"
     by(auto dest!: sees_wf_mdecl simp add: wf_mdecl_def)
   with len have "length vs = length pns" "length Ts = length pns" by simp_all
   ultimately have red': "P,t \<turnstile>0 \<langle>e/es, h\<rangle> -\<epsilon>\<rightarrow> \<langle>?e'/e#es, h\<rangle>" by(rule red0Call)
   moreover from \<open>call e = \<lfloor>(a, M, vs)\<rfloor>\<close> ha sees'
   have "\<tau>Move0 P h (e, es)"
     by(fastforce simp add: synthesized_call_def dest: \<tau>move0_callD[where P=P and h=h] sees_method_fun)
   ultimately have "\<tau>Red0t P t h (e, es) (?e', e#es)" by auto
   moreover
   from bsl bisim fv D length \<open>call e = \<lfloor>(a, M, vs)\<rfloor>\<close> \<open>call1 E = \<lfloor>(a, M, vs)\<rfloor>\<close>
   have "bisim_list (e # es) ((E, xs) # exs2)" by(rule bisim_list.intros)
   hence "bisim_list1 (?e', e # es) (ex2', (E, xs) # exs2)" unfolding ex2'
   proof(rule bisim_list1I)
     from wf_prog_wwf_prog[OF wf] sees'
     have "wf_mdecl wwf_J_mdecl P D (M,Ts,T,\<lfloor>(pns,Jbody)\<rfloor>)" by(rule sees_wf_mdecl)
     hence "fv Jbody \<subseteq> set pns \<union> {this}" by(auto simp add: wf_mdecl_def)
     moreover from sees' have "\<not> contains_insync Jbody"
       by(auto dest!: sees_wf_mdecl[OF wf] WT_expr_locks simp add: wf_mdecl_def contains_insync_conv)
     ultimately have "bisim ([] @ this # pns) Jbody (compE1 ([] @ this # pns) Jbody) ?xs2'"
       by -(rule compE1_bisim, auto)
     with \<open>length vs = length Ts\<close> \<open>length Ts = length pns\<close> body
     have "bisim [] ?e' (blocks1 (length ([] :: vname list)) (Class D # Ts) body) ?xs2'"
       by -(rule blocks_bisim, auto simp add: nth_append nth_Cons')
     thus "bisim [] ?e' ?e2' ?xs2'" by simp
     from \<open>length vs = length Ts\<close> \<open>length Ts = length pns\<close> \<open>fv Jbody \<subseteq> set pns \<union> {this}\<close>
     show "fv ?e' = {}" by auto
     from wf sees'
     have "wf_mdecl wf_J_mdecl P D (M,Ts,T,\<lfloor>(pns,Jbody)\<rfloor>)" by(rule sees_wf_mdecl)
     hence "\<D> Jbody \<lfloor>set pns \<union> {this}\<rfloor>" by(auto simp add: wf_mdecl_def)
     with \<open>length vs = length Ts\<close> \<open>length Ts = length pns\<close>
     have "\<D> (blocks pns Ts vs Jbody) \<lfloor>dom [this \<mapsto> Addr a]\<rfloor>" by(auto)
     thus "\<D> ?e' \<lfloor>{}\<rfloor>" by simp
     from len show "max_vars ?e2' \<le> length ?xs2'" by(simp add: blocks1_max_vars)
   qed
   moreover have "\<tau>Move1 P h (ex2, exs2)" using ha \<open>call1 E = \<lfloor>(a, M, vs)\<rfloor>\<close> sees'
     by(auto simp add: synthesized_call_def \<tau>external'_def dest!: \<tau>move1_not_call1[where P=P and h=h] dest: sees_method_fun)
   ultimately show ?thesis using exs'
     by(simp del: \<tau>Move1.simps \<tau>Move0.simps)(rule exI conjI rtranclp.rtrancl_refl|assumption)+
 next
   case (red1Return E' x' E x)
   note [simp] = \<open>h' = h\<close> \<open>ta = \<epsilon>\<close>
     and ex2 = \<open>ex2 = (E', x')\<close> and exs2 = \<open>exs2 = (E, x) # exs2'\<close>
     and ex2' = \<open>ex2' = (inline_call E' E, x)\<close>
     and fin = \<open>final E'\<close>
   from bisiml ex2 exs2 obtain e' es' aMvs where es: "es = e' # es'"
     and bsl: "bisim_list es' exs2'"
     and bisim: "bisim [] e E' x'"
     and bisim': "bisim [] e' E x"
     and fv: "fv e' = {}"
     and length: "max_vars E \<le> length x"
     and D: "\<D> e' \<lfloor>{}\<rfloor>"
     and call: "call e' = \<lfloor>aMvs\<rfloor>"
     and call1: "call1 E = \<lfloor>aMvs\<rfloor>"
     by(fastforce elim!: bisim_list1_elim)
   
   from \<open>final E'\<close> bisim have fin': "final e" by(auto)
   hence "P,t \<turnstile>0 \<langle>e/e' # es',h\<rangle> -\<epsilon>\<rightarrow> \<langle>inline_call e e'/es',h\<rangle>" by(rule red0Return)
   moreover from bisim fin' bisim' call
   have "bisim [] (inline_call e e') (inline_call E' E) x"
     by(rule bisim_inline_call)(simp add: fv)
   with bsl have "bisim_list1 (inline_call e e', es') (ex2', exs2')" unfolding ex2'
   proof(rule bisim_list1I)
     from fin' fv_inline_call[of e e'] fv show "fv (inline_call e e') = {}" by auto
     from fin' show "\<D> (inline_call e e') \<lfloor>{}\<rfloor>" using call D by(rule defass_inline_call)
     
     from call1_imp_call[OF call1]
     have "max_vars (inline_call E' E) \<le> max_vars E + max_vars E'"
       by(rule inline_call_max_vars)
     with fin length show "max_vars (inline_call E' E) \<le> length x" by(auto elim!: final.cases)
   qed
   moreover have "\<tau>Move1 P h (ex2, exs2) = \<tau>Move0 P h (e, es)" using ex2 call1 call fin fin' by(auto)
   ultimately show ?thesis using es
     by(simp del: \<tau>Move1.simps \<tau>Move0.simps) blast
 qed
 
 end
 
 sublocale J0_J1_heap_base < red0_Red1': FWdelay_bisimulation_base
   final_expr0
   "mred0 P"
   final_expr1
   "mred1' (compP1 P)"
   convert_RA
   "\<lambda>t. bisim_red0_Red1" 
   bisim_wait01
   "\<tau>MOVE0 P"
   "\<tau>MOVE1 (compP1 P)"
   for P
 .
 
 context J0_J1_heap_base begin
 
 lemma delay_bisimulation_red0_Red1: 
   assumes wf: "wf_J_prog P"
   shows "delay_bisimulation_measure (mred0 P t) (mred1' (compP1 P) t) bisim_red0_Red1 (ta_bisim (\<lambda>t. bisim_red0_Red1)) (\<tau>MOVE0 P) (\<tau>MOVE1 (compP1 P)) (\<lambda>es es'. False) (\<lambda>(((e', xs'), exs'), h') (((e, xs), exs), h). countInitBlock e'< countInitBlock e)"
   (is "delay_bisimulation_measure _ _ _ _ _ _ ?\<mu>1 ?\<mu>2")
 proof(unfold_locales)
   fix s1 s2 s1'
   assume "bisim_red0_Red1 s1 s2" "red0_mthr.silent_move P t s1 s1'"
   moreover obtain ex1 exs1 h1 where s1: "s1 = ((ex1, exs1), h1)" by(cases s1, auto)
   moreover obtain ex1' exs1' h1' where s1': "s1' = ((ex1', exs1'), h1')" by(cases s1', auto)
   moreover obtain ex2 exs2 h2 where s2: "s2 = ((ex2, exs2), h2)" by(cases s2, auto)
   ultimately have bisim: "bisim_list1 (ex1, exs1) (ex2, exs2)"
     and heap: "h1 = h2"
     and red: "P,t \<turnstile>0 \<langle>ex1/exs1,h1\<rangle> -\<epsilon>\<rightarrow> \<langle>ex1'/exs1',h1'\<rangle>"
     and \<tau>: "\<tau>Move0 P h1 (ex1, exs1)"
     by(auto simp add: bisim_red0_Red1_def red0_mthr.silent_move_iff)
   from Red1_simulates_red0[OF wf red bisim] \<tau>
   obtain ex2'' exs2'' where bisim': "bisim_list1 (ex1', exs1') (ex2'', exs2'')" 
     and red': "\<tau>Red1't (compP1 P) t h1 (ex2, exs2) (ex2'', exs2'')"
     and [simp]: "h1' = h1" by auto
   from \<tau>Red1't_into_Red1'_\<tau>mthr_silent_movet[OF red'] bisim' heap
   have "\<exists>s2'. Red1_mthr.silent_movet False (compP1 P) t s2 s2' \<and> bisim_red0_Red1 s1' s2'"
     unfolding s2 s1' by(auto simp add: bisim_red0_Red1_def)
   thus "bisim_red0_Red1 s1' s2 \<and> ?\<mu>1^++ s1' s1 \<or> (\<exists>s2'. Red1_mthr.silent_movet False (compP1 P) t s2 s2' \<and> bisim_red0_Red1 s1' s2')" ..
 next
   fix s1 s2 s2'
   assume "bisim_red0_Red1 s1 s2" "Red1_mthr.silent_move False (compP1 P) t s2 s2'"
   moreover obtain ex1 exs1 h1 where s1: "s1 = ((ex1, exs1), h1)" by(cases s1, auto)
   moreover obtain ex2 exs2 h2 where s2: "s2 = ((ex2, exs2), h2)" by(cases s2, auto)
   moreover obtain ex2' exs2' h2' where s2': "s2' = ((ex2', exs2'), h2')" by(cases s2', auto)
   ultimately have bisim: "bisim_list1 (ex1, exs1) (ex2, exs2)"
     and heap: "h1 = h2"
     and red: "False,compP1 P,t \<turnstile>1 \<langle>ex2/exs2,h2\<rangle> -\<epsilon>\<rightarrow> \<langle>ex2'/exs2',h2'\<rangle>"
     and \<tau>: "\<tau>Move1 P h2 (ex2, exs2)"
     by(fastforce simp add: bisim_red0_Red1_def Red1_mthr.silent_move_iff)+
   from red0_simulates_Red1[OF wf red bisim] \<tau>
   obtain e' es' where bisim': "bisim_list1 (e', es') (ex2', exs2')"
     and red': "\<tau>Red0t P t h2 (ex1, exs1) (e', es') \<or> 
                countInitBlock (fst ex2') < countInitBlock (fst ex2) \<and> exs2' = exs2 \<and> e' = ex1 \<and> es' = exs1"
     and [simp]: "h2' = h2" by auto
   from red'
   show "bisim_red0_Red1 s1 s2' \<and> ?\<mu>2^++ s2' s2 \<or> (\<exists>s1'. red0_mthr.silent_movet P t s1 s1' \<and> bisim_red0_Red1 s1' s2')"
     (is "?refl \<or> ?step")
   proof
     assume "\<tau>Red0t P t h2 (ex1, exs1) (e', es')"
     from \<tau>Red0t_into_red0_\<tau>mthr_silent_movet[OF this] bisim' heap
     have ?step unfolding s1 s2' by(auto simp add: bisim_red0_Red1_def)
     thus ?thesis ..
   next
     assume "countInitBlock (fst ex2') < countInitBlock (fst ex2) \<and> exs2' = exs2 \<and> e' = ex1 \<and> es' = exs1"
     hence ?refl using bisim' heap unfolding s1 s2' s2
       by (auto simp add: bisim_red0_Red1_def split_beta)
     thus ?thesis ..
   qed
 next
   fix s1 s2 ta1 s1'
   assume "bisim_red0_Red1 s1 s2"  and "mred0 P t s1 ta1 s1'" and \<tau>: "\<not> \<tau>MOVE0 P s1 ta1 s1'"
   moreover obtain ex1 exs1 h1 where s1: "s1 = ((ex1, exs1), h1)" by(cases s1, auto)
   moreover obtain ex1' exs1' h1' where s1': "s1' = ((ex1', exs1'), h1')" by(cases s1', auto)
   moreover obtain ex2 exs2 h2 where s2: "s2 = ((ex2, exs2), h2)" by(cases s2, auto)
   ultimately have heap: "h2 = h1"
     and bisim: "bisim_list1 (ex1, exs1) (ex2, exs2)"
     and red: "P,t \<turnstile>0 \<langle>ex1/exs1,h1\<rangle> -ta1\<rightarrow> \<langle>ex1'/exs1',h1'\<rangle>"
     by(auto simp add: bisim_red0_Red1_def)
   from \<tau> have "\<not> \<tau>Move0 P h1 (ex1, exs1)" unfolding s1
     using red by(auto elim!: red0.cases dest: red_\<tau>_taD[where extTA="extTA2J0 P", OF extTA2J0_\<epsilon>])
   with Red1_simulates_red0[OF wf red bisim]
   obtain ex2'' exs2'' ex2' exs2' ta'
     where bisim': "bisim_list1 (ex1', exs1') (ex2'', exs2'')"
     and red': "\<tau>Red1'r (compP1 P) t h1 (ex2, exs2) (ex2', exs2')"
     and red'': "False,compP1 P,t \<turnstile>1 \<langle>ex2'/exs2',h1\<rangle> -ta'\<rightarrow> \<langle>ex2''/exs2'',h1'\<rangle>"
     and \<tau>': "\<not> \<tau>Move1 P h1 (ex2', exs2')"
     and ta: "ta_bisim01 ta1 ta'" by fastforce
   from red'' have "mred1' (compP1 P) t ((ex2', exs2'), h1) ta' ((ex2'', exs2''), h1')" by auto
   moreover from \<tau>' have "\<not> \<tau>MOVE1 (compP1 P) ((ex2', exs2'), h1) ta' ((ex2'', exs2''), h1')" by simp
   moreover from red' have "Red1_mthr.silent_moves False (compP1 P) t s2 ((ex2', exs2'), h1)"
     unfolding s2 heap by(rule \<tau>Red1'r_into_Red1'_\<tau>mthr_silent_moves)
   moreover from bisim' have "bisim_red0_Red1 ((ex1', exs1'), h1') ((ex2'', exs2''), h1')"
     by(auto simp add: bisim_red0_Red1_def)
   ultimately
   show "\<exists>s2' s2'' ta2. Red1_mthr.silent_moves False (compP1 P) t s2 s2' \<and> mred1' (compP1 P) t s2' ta2 s2'' \<and>
              \<not> \<tau>MOVE1 (compP1 P) s2' ta2 s2'' \<and> bisim_red0_Red1 s1' s2'' \<and> ta_bisim01 ta1 ta2"
     using ta unfolding s1' by blast
 next
   fix s1 s2 ta2 s2'
   assume "bisim_red0_Red1 s1 s2"  and "mred1' (compP1 P) t s2 ta2 s2'" and \<tau>: "\<not> \<tau>MOVE1 (compP1 P) s2 ta2 s2'"
   moreover obtain ex1 exs1 h1 where s1: "s1 = ((ex1, exs1), h1)" by(cases s1, auto)
   moreover obtain ex2 exs2 h2 where s2: "s2 = ((ex2, exs2), h2)" by(cases s2, auto)
   moreover obtain ex2' exs2' h2' where s2': "s2' = ((ex2', exs2'), h2')" by(cases s2', auto)
   ultimately have heap: "h2 = h1"
     and bisim: "bisim_list1 (ex1, exs1) (ex2, exs2)"
     and red: "False,compP1 P,t \<turnstile>1 \<langle>ex2/exs2,h1\<rangle> -ta2\<rightarrow> \<langle>ex2'/exs2',h2'\<rangle>"
     by(auto simp add: bisim_red0_Red1_def)
   from \<tau> heap have "\<not> \<tau>Move1 P h2 (ex2, exs2)" unfolding s2
     using red by(fastforce elim!: Red1.cases dest: red1_\<tau>_taD)
   with red0_simulates_Red1[OF wf red bisim]
   obtain e' es' e'' es'' ta'
     where bisim': "bisim_list1 (e', es') (ex2', exs2')"
     and red': "\<tau>Red0r P t h1 (ex1, exs1) (e'', es'')"
     and red'': "P,t \<turnstile>0 \<langle>e''/es'',h1\<rangle> -ta'\<rightarrow> \<langle>e'/es',h2'\<rangle>"
     and \<tau>': "\<not> \<tau>Move0 P h1 (e'', es'')"
     and ta: "ta_bisim01 ta' ta2" using heap by fastforce
   from red'' have "mred0 P t ((e'', es''), h1) ta' ((e', es'), h2')" by auto
   moreover from red' have "red0_mthr.silent_moves P t ((ex1, exs1), h1) ((e'', es''), h1)"
     by(rule \<tau>Red0r_into_red0_\<tau>mthr_silent_moves)
   moreover from \<tau>' have "\<not> \<tau>MOVE0 P ((e'', es''), h1) ta' ((e', es'), h2')" by simp
   moreover from bisim' have "bisim_red0_Red1 ((e', es'), h2') ((ex2', exs2'), h2')"
     by(auto simp add: bisim_red0_Red1_def)
   ultimately
   show "\<exists>s1' s1'' ta1. red0_mthr.silent_moves P t s1 s1' \<and>
              mred0 P t s1' ta1 s1'' \<and> \<not> \<tau>MOVE0 P s1' ta1 s1'' \<and>
              bisim_red0_Red1 s1'' s2' \<and> ta_bisim01 ta1 ta2"
     using ta unfolding s1 s2' by blast
 next
   show "wfP ?\<mu>1" by auto
 next
   have "wf (measure countInitBlock)" ..
   hence "wf (inv_image (measure countInitBlock) (\<lambda>(((e', xs'), exs'), h'). e'))" ..
   also have "inv_image (measure countInitBlock) (\<lambda>(((e', xs'), exs'), h'). e') = {(s2', s2). ?\<mu>2 s2' s2}"
     by(simp add: inv_image_def split_beta)
   finally show "wfP ?\<mu>2" by(simp add: wfP_def)
 qed
 
 lemma delay_bisimulation_diverge_red0_Red1: 
   assumes "wf_J_prog P"
   shows "delay_bisimulation_diverge (mred0 P t) (mred1' (compP1 P) t) bisim_red0_Red1 (ta_bisim (\<lambda>t. bisim_red0_Red1)) (\<tau>MOVE0 P) (\<tau>MOVE1 (compP1 P))"
 proof -
   interpret delay_bisimulation_measure
     "mred0 P t" "mred1' (compP1 P) t" "bisim_red0_Red1" "ta_bisim (\<lambda>t. bisim_red0_Red1)" "\<tau>MOVE0 P" "\<tau>MOVE1 (compP1 P)"
     "\<lambda>es es'. False" "\<lambda>(((e', xs'), exs'), h') (((e, xs), exs), h). countInitBlock e'< countInitBlock e"
     using assms by(rule delay_bisimulation_red0_Red1)
   show ?thesis by unfold_locales
 qed
 
 lemma red0_Red1'_FWweak_bisim:
   assumes wf: "wf_J_prog P"
   shows "FWdelay_bisimulation_diverge final_expr0 (mred0 P) final_expr1 (mred1' (compP1 P))
            (\<lambda>t. bisim_red0_Red1) bisim_wait01 (\<tau>MOVE0 P) (\<tau>MOVE1 (compP1 P))"
 proof -
   interpret delay_bisimulation_diverge
     "mred0 P t"
     "mred1' (compP1 P) t" 
     bisim_red0_Red1 
     "ta_bisim (\<lambda>t. bisim_red0_Red1)" "\<tau>MOVE0 P" "\<tau>MOVE1 (compP1 P)"
     for t
     using wf by(rule delay_bisimulation_diverge_red0_Red1)
   show ?thesis
   proof
     fix t and s1 and s2 :: "(('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list) \<times> 'heap"
     assume "bisim_red0_Red1 s1 s2" "(\<lambda>(x1, m). final_expr0 x1) s1"
     moreover hence "(\<lambda>(x2, m). final_expr1 x2) s2"
       by(cases s1)(cases s2,auto simp add: bisim_red0_Red1_def final_iff elim!: bisim_list1_elim elim: bisim_list.cases)
     ultimately show "\<exists>s2'. Red1_mthr.silent_moves False (compP1 P) t s2 s2' \<and> bisim_red0_Red1 s1 s2' \<and> (\<lambda>(x2, m). final_expr1 x2) s2'"
       by blast
   next
     fix t s1 and s2 :: "(('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list) \<times> 'heap"
     assume "bisim_red0_Red1 s1 s2" "(\<lambda>(x2, m). final_expr1 x2) s2"
     moreover hence "(\<lambda>(x1, m). final_expr0 x1) s1"
       by(cases s1)(cases s2,auto simp add: bisim_red0_Red1_def final_iff elim!: bisim_list1_elim elim: bisim_list.cases)
     ultimately show "\<exists>s1'. red0_mthr.silent_moves P t s1 s1' \<and> bisim_red0_Red1 s1' s2 \<and> (\<lambda>(x1, m). final_expr0 x1) s1'"
       by blast
   next
     fix t' x m1 x' m2 t x1 x2 x1' ta1 x1'' m1' x2' ta2 x2'' m2'
     assume b: "bisim_red0_Red1 (x, m1) (x', m2)"
       and bo: "bisim_red0_Red1 (x1, m1) (x2, m2)"
       and \<tau>red1: "red0_mthr.silent_moves P t (x1, m1) (x1', m1)"
       and red1: "mred0 P t (x1', m1) ta1 (x1'', m1')"
       and \<tau>1: "\<not> \<tau>MOVE0 P (x1', m1) ta1 (x1'', m1')"
       and \<tau>red2: "Red1_mthr.silent_moves False (compP1 P) t (x2, m2) (x2', m2)"
       and red2: "mred1' (compP1 P) t (x2', m2) ta2 (x2'', m2')"
       and bo': "bisim_red0_Red1 (x1'', m1') (x2'', m2')"
       and tb: "ta_bisim (\<lambda>t. bisim_red0_Red1) ta1 ta2"
     from b have "m1 = m2" by(auto simp add: bisim_red0_Red1_def split_beta)
     moreover from bo' have "m1' = m2'" by(auto simp add: bisim_red0_Red1_def split_beta)
     ultimately show "bisim_red0_Red1 (x, m1') (x', m2')" using b
       by(auto simp add: bisim_red0_Red1_def split_beta)
   next
     fix t x1 m1 x2 m2 x1' ta1 x1'' m1' x2' ta2 x2'' m2' w
     assume "bisim_red0_Red1 (x1, m1) (x2, m2)"
       and "red0_mthr.silent_moves P t (x1, m1) (x1', m1)"
       and red0: "mred0 P t (x1', m1) ta1 (x1'', m1')"
       and "\<not> \<tau>MOVE0 P (x1', m1) ta1 (x1'', m1')"
       and "Red1_mthr.silent_moves False (compP1 P) t (x2, m2) (x2', m2)"
       and red1: "mred1' (compP1 P) t (x2', m2) ta2 (x2'', m2')"
       and "\<not> \<tau>MOVE1 (compP1 P) (x2', m2) ta2 (x2'', m2')"
       and "bisim_red0_Red1 (x1'', m1') (x2'', m2')"
       and "ta_bisim01 ta1 ta2"
       and Suspend: "Suspend w \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub>" "Suspend w \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub>"
     from red0 red1 Suspend show "bisim_wait01 x1'' x2''"
       by(cases x2')(cases x2'', auto dest: Red_Suspend_is_call Red1_Suspend_is_call simp add: split_beta bisim_wait01_def is_call_def)
   next
     fix t x1 m1 x2 m2 ta1 x1' m1'
     assume "bisim_red0_Red1 (x1, m1) (x2, m2)"
       and "bisim_wait01 x1 x2"
       and "mred0 P t (x1, m1) ta1 (x1', m1')"
       and wakeup: "Notified \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub>"
     moreover obtain e0 es0 where [simp]: "x1 = (e0, es0)" by(cases x1)
     moreover obtain e0' es0' where [simp]: "x1' = (e0', es0')" by(cases x1')
     moreover obtain e1 xs1 exs1 where [simp]: "x2 = ((e1, xs1), exs1)" by(cases x2) auto
     ultimately have bisim: "bisim_list1 (e0, es0) ((e1, xs1), exs1)"
       and m1: "m2 = m1"
       and call: "call e0 \<noteq> None" "call1 e1 \<noteq> None"
       and red: "P,t \<turnstile>0 \<langle>e0/es0, m1\<rangle> -ta1\<rightarrow> \<langle>e0'/es0', m1'\<rangle>"
       by(auto simp add: bisim_wait01_def bisim_red0_Red1_def)
     from red wakeup have "\<not> \<tau>Move0 P m1 (e0, es0)"
       by(auto elim!: red0.cases dest: red_\<tau>_taD[where extTA="extTA2J0 P", simplified])
     with Red1_simulates_red0[OF wf red bisim] call m1
     show "\<exists>ta2 x2' m2'. mred1' (compP1 P) t (x2, m2) ta2 (x2', m2') \<and> bisim_red0_Red1 (x1', m1') (x2', m2') \<and> ta_bisim01 ta1 ta2"
       by(auto simp add: bisim_red0_Red1_def)
   next
     fix t x1 m1 x2 m2 ta2 x2' m2'
     assume "bisim_red0_Red1 (x1, m1) (x2, m2)"
       and "bisim_wait01 x1 x2" 
       and "mred1' (compP1 P) t (x2, m2) ta2 (x2', m2')"
       and wakeup: "Notified \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub>"
     moreover obtain e0 es0 where [simp]: "x1 = (e0, es0)" by(cases x1)
     moreover obtain e1 xs1 exs1 where [simp]: "x2 = ((e1, xs1), exs1)" by(cases x2) auto
     moreover obtain e1' xs1' exs1' where [simp]: "x2' = ((e1', xs1'), exs1')" by(cases x2') auto
     ultimately have bisim: "bisim_list1 (e0, es0) ((e1, xs1), exs1)"
       and m1: "m2 = m1"
       and call: "call e0 \<noteq> None" "call1 e1 \<noteq> None"
       and red: "False,compP1 P,t \<turnstile>1 \<langle>(e1, xs1)/exs1, m1\<rangle> -ta2\<rightarrow> \<langle>(e1', xs1')/exs1', m2'\<rangle>"
       by(auto simp add: bisim_wait01_def bisim_red0_Red1_def)
     from red wakeup have "\<not> \<tau>Move1 P m1 ((e1, xs1), exs1)"
       by(auto elim!: Red1.cases dest: red1_\<tau>_taD)
     with red0_simulates_Red1[OF wf red bisim] m1 call
     show "\<exists>ta1 x1' m1'. mred0 P t (x1, m1) ta1 (x1', m1') \<and> bisim_red0_Red1 (x1', m1') (x2', m2') \<and> ta_bisim01 ta1 ta2"
       by(auto simp add: bisim_red0_Red1_def)
   next
     show "(\<exists>x. final_expr0 x) \<longleftrightarrow> (\<exists>x. final_expr1 x)"
       by(auto simp add: split_paired_Ex final_iff)
   qed
 qed
 
 lemma bisim_J0_J1_start:
   assumes wf: "wf_J_prog P"
   and start: "wf_start_state P C M vs"
   shows "red0_Red1'.mbisim (J0_start_state P C M vs) (J1_start_state (compP1 P) C M vs)"
 proof -
   from start obtain Ts T pns body D
     where sees: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(pns,body)\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts"
     by cases auto
   from conf have vs: "length vs = length Ts" by(rule list_all2_lengthD)
   from sees_wf_mdecl[OF wf_prog_wwf_prog[OF wf] sees]
   have fvbody: "fv body \<subseteq> {this} \<union> set pns" and len: "length pns = length Ts"
     by(auto simp add: wf_mdecl_def)
   with vs have fv: "fv (blocks pns Ts vs body) \<subseteq> {this}" by auto
   have wfCM: "wf_J_mdecl P D (M, Ts, T, pns, body)"
     using sees_wf_mdecl[OF wf sees] by(auto simp add: wf_mdecl_def)
   then obtain T' where wtbody: "P,[this # pns [\<mapsto>] Class D # Ts] \<turnstile> body :: T'" by auto
   hence elbody: "expr_locks body = (\<lambda>l. 0)" by(rule WT_expr_locks)
   hence cisbody: "\<not> contains_insync body" by(auto simp add: contains_insync_conv)
   from wfCM len vs have dabody: "\<D> (blocks pns Ts vs body) \<lfloor>{this}\<rfloor>" by auto
   from sees have sees1: "compP1 P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>compE1 (this # pns) body\<rfloor> in D"
     by(auto dest: sees_method_compP[where f="(\<lambda>C M Ts T (pns, body). compE1 (this # pns) body)"])
 
   let ?e = "blocks1 0 (Class C#Ts) (compE1 (this # pns) body)"
   let ?xs = "Null # vs @ replicate (max_vars body) undefined_value"
   from fvbody cisbody len vs
   have "bisim [] (blocks (this # pns) (Class D # Ts) (Null # vs) body) (blocks1 (length ([] :: vname list)) (Class D # Ts) (compE1 (this # pns) body)) ?xs"
     by-(rule blocks_bisim,(fastforce simp add: nth_Cons' nth_append)+)
   with fv dabody len vs elbody sees sees1
   show ?thesis unfolding start_state_def
     by(auto intro!: red0_Red1'.mbisimI split: if_split_asm)(auto simp add: bisim_red0_Red1_def blocks1_max_vars intro!: bisim_list.intros bisim_list1I wset_thread_okI)
 qed
 
 end
 
 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,5581 @@
 (*  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)
 
   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)
   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)
+    by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2LAssRed2 simp add: 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)
+    by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2AAssRed simp add: 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)
+    by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2FAssRed simp add: 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)
+    by(rule \<tau>Execr1step)(auto simp add: 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)
+    by(auto intro!: \<tau>Execr1step exec_instr \<tau>move2While4 simp add: 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)
+      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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      by(auto 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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      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 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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      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 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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+      by(auto 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) }
+        by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins 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 ins have [simp]: "vs = []" by(auto simp add: nth_append compEs2_map_Val split: if_split_asm)
+    with ins have [simp]: "vs = []" by(auto simp add: 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) }
+      with bisim2 ins have False by(auto dest: bisims_Val_pc_not_Invoke) }
     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)
+      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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim2 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim2 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins 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 ins have [simp]: "ps = []" "M' = M"
-      by(auto simp add: nth_append split: if_split_asm)(auto simp add: neq_Nil_conv nth_append)
+      by(auto split: if_split_asm)(auto simp add: neq_Nil_conv)
     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 ins have ins': "compEs2 ps ! pc = Invoke M n0" by(simp)
     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) }
+      with bisim ins have False by(auto dest: bisims_Val_pc_not_Invoke) }
     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) }
+      with bisim1 ins have False by(auto dest: bisim_Val_pc_not_Invoke) }
     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)
+  with ins have ins': "compEs2 es ! pc = Invoke M n0" by(simp)
   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/Execute/Random_Scheduler.thy b/thys/JinjaThreads/Execute/Random_Scheduler.thy
--- a/thys/JinjaThreads/Execute/Random_Scheduler.thy
+++ b/thys/JinjaThreads/Execute/Random_Scheduler.thy
@@ -1,206 +1,206 @@
 (*  Title:      JinjaThreads/Execute/Random_Scheduler.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Random scheduler\<close>
 
 theory Random_Scheduler
 imports
   Scheduler
 begin
 
 type_synonym random_scheduler = Random.seed
 
 abbreviation (input)
   random_scheduler_invar :: "random_scheduler \<Rightarrow> 't set \<Rightarrow> bool"
 where "random_scheduler_invar \<equiv> \<lambda>_ _. True"
 
 locale random_scheduler_base =
   scheduler_ext_base
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update thr_iterate
     ws_\<alpha> ws_invar ws_lookup ws_update ws_sel
     is_\<alpha> is_invar is_memb is_ins is_delete
     thr'_\<alpha> thr'_invar thr'_empty thr'_ins_dj
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and "output" :: "random_scheduler \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'q option"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and thr_iterate :: "'m_t \<Rightarrow> ('t \<times> ('x \<times> 'l released_locks), 's_t) set_iterator"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_delete :: "'t \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_iterate :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status, 'm_w) set_iterator"
   and ws_sel :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status \<Rightarrow> bool) \<rightharpoonup> ('t \<times> 'w wait_set_status)"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and thr'_\<alpha> :: "'s_t \<Rightarrow> 't set"
   and thr'_invar :: "'s_t \<Rightarrow> bool"
   and thr'_empty :: "unit \<Rightarrow> 's_t"
   and thr'_ins_dj :: "'t \<Rightarrow> 's_t \<Rightarrow> 's_t"
   +
   fixes thr'_to_list :: "'s_t \<Rightarrow> 't list"
 begin
 
 definition next_thread :: "random_scheduler \<Rightarrow> 's_t \<Rightarrow> ('t \<times> random_scheduler) option"
 where
   "next_thread seed active = 
   (let ts = thr'_to_list active
    in if ts = [] then None else Some (Random.select (thr'_to_list active) seed))"
 
 definition random_scheduler :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,random_scheduler) scheduler"
 where
   "random_scheduler seed s =
    (do {
       (t, seed') \<leftarrow> next_thread seed (active_threads s);
       step_thread (\<lambda>ta. seed') s t
    })"
 
 end
 
 locale random_scheduler =
   random_scheduler_base
     final r convert_RA "output"
     thr_\<alpha> thr_invar thr_lookup thr_update thr_iterate
     ws_\<alpha> ws_invar ws_lookup ws_update ws_delete ws_iterate ws_sel
     is_\<alpha> is_invar is_memb is_ins is_delete
     thr'_\<alpha> thr'_invar thr'_empty thr'_ins_dj thr'_to_list
   +
   scheduler_ext_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update thr_iterate
     ws_\<alpha> ws_invar ws_lookup ws_update ws_sel
     is_\<alpha> is_invar is_memb is_ins is_delete
     thr'_\<alpha> thr'_invar thr'_empty thr'_ins_dj
   +
   ws: map_delete ws_\<alpha> ws_invar ws_delete +
   ws: map_iteratei ws_\<alpha> ws_invar ws_iterate +
   thr': set_to_list thr'_\<alpha> thr'_invar thr'_to_list 
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and "output" :: "random_scheduler \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'q option"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and thr_iterate :: "'m_t \<Rightarrow> ('t \<times> ('x \<times> 'l released_locks), 's_t) set_iterator"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_delete :: "'t \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_iterate :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status, 'm_w) set_iterator"
   and ws_sel :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status \<Rightarrow> bool) \<rightharpoonup> ('t \<times> 'w wait_set_status)"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and thr'_\<alpha> :: "'s_t \<Rightarrow> 't set"
   and thr'_invar :: "'s_t \<Rightarrow> bool"
   and thr'_empty :: "unit \<Rightarrow> 's_t"
   and thr'_ins_dj :: "'t \<Rightarrow> 's_t \<Rightarrow> 's_t"
   and thr'_to_list :: "'s_t \<Rightarrow> 't list"
 begin
 
 lemma next_thread_eq_None_iff:
   assumes "thr'_invar active" "random_scheduler_invar seed T"
   shows "next_thread seed active = None \<longleftrightarrow> thr'_\<alpha> active = {}"
 using thr'.to_list_correct[OF assms(1)]
 by(auto simp add: next_thread_def neq_Nil_conv)
 
 lemma next_thread_eq_SomeD:
   assumes "next_thread seed active = Some (t, seed')"
   and "thr'_invar active" "random_scheduler_invar seed T"
   shows "t \<in> thr'_\<alpha> active"
 using assms
 by(auto simp add: next_thread_def thr'.to_list_correct split: if_split_asm dest: select[of _ seed])
 
 lemma random_scheduler_spec:
   assumes det: "\<alpha>.deterministic I"
   shows "scheduler_spec final r random_scheduler random_scheduler_invar thr_\<alpha> thr_invar ws_\<alpha> ws_invar is_\<alpha> is_invar I"
 proof
   fix \<sigma> s
   assume rr: "random_scheduler \<sigma> s = None"
     and invar: "random_scheduler_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_invar s" "state_\<alpha> s \<in> I"
   from invar(2) have "thr'_invar (active_threads s)" by(rule active_threads_correct)
   thus "\<alpha>.active_threads (state_\<alpha> s) = {}" using rr invar
     by(auto simp add: random_scheduler_def Option_bind_eq_None_conv next_thread_eq_None_iff step_thread_eq_None_conv[OF det] dest: next_thread_eq_SomeD)
 next
   fix \<sigma> s t \<sigma>'
   assume rr: "random_scheduler \<sigma> s = \<lfloor>(t, None, \<sigma>')\<rfloor>"
     and invar: "random_scheduler_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_invar s" "state_\<alpha> s \<in> I"
   thus "\<exists>x ln n. thr_\<alpha> (thr s) t = \<lfloor>(x, ln)\<rfloor> \<and> 0 < ln $ n \<and> \<not> waiting (ws_\<alpha> (wset s) t) \<and> may_acquire_all (locks s) t ln"
-    by(fastforce simp add: random_scheduler_def Option_bind_eq_Some_conv dest: step_thread_Some_NoneD[OF det])
+    by(fastforce simp add: random_scheduler_def bind_eq_Some_conv dest: step_thread_Some_NoneD[OF det])
 next
   fix \<sigma> s t ta x' m' \<sigma>'
   assume rr: "random_scheduler \<sigma> s = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>"
     and invar: "random_scheduler_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_invar s" "state_\<alpha> s \<in> I"
   thus "\<exists>x. thr_\<alpha> (thr s) t = \<lfloor>(x, no_wait_locks)\<rfloor> \<and> Predicate.eval (r t (x, shr s)) (ta, x', m') \<and> \<alpha>.actions_ok (state_\<alpha> s) t ta"
-    by(auto simp add: random_scheduler_def Option_bind_eq_Some_conv dest: step_thread_Some_SomeD[OF det])
+    by(auto simp add: random_scheduler_def bind_eq_Some_conv dest: step_thread_Some_SomeD[OF det])
 qed simp_all
 
 end
 
 sublocale random_scheduler_base <
   scheduler_base
     final r convert_RA
     "random_scheduler" "output" "pick_wakeup_via_sel (\<lambda>s P. ws_sel s (\<lambda>(k,v). P k v))" random_scheduler_invar
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup ws_update ws_delete ws_iterate
     is_\<alpha> is_invar is_memb is_ins is_delete
   for n0 .
 
 sublocale random_scheduler <
   pick_wakeup_spec
     final r convert_RA
     "pick_wakeup_via_sel (\<lambda>s P. ws_sel s (\<lambda>(k,v). P k v))" random_scheduler_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
 by(rule pick_wakeup_spec_via_sel)(unfold_locales)
 
 context random_scheduler begin
 
 lemma random_scheduler_scheduler:
   assumes det: "\<alpha>.deterministic I"
   shows 
   "scheduler
      final r convert_RA
      random_scheduler (pick_wakeup_via_sel (\<lambda>s P. ws_sel s (\<lambda>(k,v). P k v))) random_scheduler_invar
      thr_\<alpha> thr_invar thr_lookup thr_update 
      ws_\<alpha> ws_invar ws_lookup ws_update ws_delete ws_iterate
      is_\<alpha> is_invar is_memb is_ins is_delete
      I"
 proof -
   interpret scheduler_spec
       final r convert_RA
       random_scheduler random_scheduler_invar
       thr_\<alpha> thr_invar
       ws_\<alpha> ws_invar
       is_\<alpha> is_invar
       I
     using det by(rule random_scheduler_spec)
 
   show ?thesis by(unfold_locales)(rule \<alpha>.deterministic_invariant3p[OF det])
 qed
 
 end
 
 subsection \<open>Code generator setup\<close>
 
 lemmas [code] =
   random_scheduler_base.next_thread_def
   random_scheduler_base.random_scheduler_def
 
 end
diff --git a/thys/JinjaThreads/Execute/Scheduler.thy b/thys/JinjaThreads/Execute/Scheduler.thy
--- a/thys/JinjaThreads/Execute/Scheduler.thy
+++ b/thys/JinjaThreads/Execute/Scheduler.thy
@@ -1,1260 +1,1260 @@
 (*  Title:      JinjaThreads/Execute/Scheduler.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Abstract scheduler\<close>
 
 theory Scheduler
 imports
   State_Refinement
   "../Framework/FWProgressAux"
   "../Framework/FWLTS"
   (*"../../Collections/spec/SetSpec"
   "../../Collections/spec/MapSpec"
   "../../Collections/spec/ListSpec"*)
   "../Basic/JT_ICF"
 
 begin
 
 text \<open>
   Define an unfold operation that puts everything into one function to avoid duplicate evaluation.
 \<close>
 
 definition unfold_tllist' :: "('a \<Rightarrow> 'b \<times> 'a + 'c) \<Rightarrow> 'a \<Rightarrow> ('b, 'c) tllist"
 where [code del]: 
   "unfold_tllist' f = 
    unfold_tllist (\<lambda>a. \<exists>c. f a = Inr c) (projr \<circ> f) (fst \<circ> projl \<circ> f) (snd \<circ> projl \<circ> f)"
 
 lemma unfold_tllist' [code]:
   "unfold_tllist' f a =
   (case f a of Inr c \<Rightarrow> TNil c | Inl (b, a') \<Rightarrow> TCons b (unfold_tllist' f a'))"
 by(rule tllist.expand)(auto simp add: unfold_tllist'_def split: sum.split_asm)
 
 
 type_synonym
   ('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler = 
     "'s \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> ('t \<times> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) option \<times> 's) option"
 
 locale scheduler_spec_base =
   state_refine_base
     final r convert_RA
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar 
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and schedule :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
 
 locale scheduler_spec = 
   scheduler_spec_base
     final r convert_RA
     schedule \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar 
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and schedule :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   +
   fixes invariant :: "('l,'t,'x,'m,'w) state set"
   assumes schedule_NoneD:
   "\<lbrakk> schedule \<sigma> s = None; state_invar s; \<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s))); state_\<alpha> s \<in> invariant \<rbrakk>
   \<Longrightarrow> \<alpha>.active_threads (state_\<alpha> s) = {}"
   and schedule_Some_NoneD:
   "\<lbrakk> schedule \<sigma> s = \<lfloor>(t, None, \<sigma>')\<rfloor>; state_invar s; \<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s))); state_\<alpha> s \<in> invariant \<rbrakk> 
   \<Longrightarrow> \<exists>x ln n. thr_\<alpha> (thr s) t = \<lfloor>(x, ln)\<rfloor> \<and> ln $ n > 0 \<and> \<not> waiting (ws_\<alpha> (wset s) t) \<and> may_acquire_all (locks s) t ln"
   and schedule_Some_SomeD:
   "\<lbrakk> schedule \<sigma> s = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>; state_invar s; \<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s))); state_\<alpha> s \<in> invariant \<rbrakk> 
   \<Longrightarrow> \<exists>x. thr_\<alpha> (thr s) t = \<lfloor>(x, no_wait_locks)\<rfloor> \<and> Predicate.eval (r t (x, shr s)) (ta, x', m') \<and> 
          \<alpha>.actions_ok (state_\<alpha> s) t ta"
   and schedule_invar_None:
   "\<lbrakk> schedule \<sigma> s = \<lfloor>(t, None, \<sigma>')\<rfloor>; state_invar s; \<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s))); state_\<alpha> s \<in> invariant \<rbrakk>
   \<Longrightarrow> \<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s)))"
   and schedule_invar_Some:
   "\<lbrakk> schedule \<sigma> s = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>; state_invar s; \<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s))); state_\<alpha> s \<in> invariant \<rbrakk>
   \<Longrightarrow> \<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s)) \<union> {t. \<exists>x m. NewThread t x m \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>})"
 
 locale pick_wakeup_spec_base =
   state_refine_base
     final r convert_RA
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar 
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and pick_wakeup :: "'s \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
 
 locale pick_wakeup_spec =
   pick_wakeup_spec_base 
     final r convert_RA
     pick_wakeup \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and pick_wakeup :: "'s \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   +
   assumes pick_wakeup_NoneD:
   "\<lbrakk> pick_wakeup \<sigma> t w ws = None; ws_invar ws; \<sigma>_invar \<sigma> T; dom (ws_\<alpha> ws) \<subseteq> T; t \<in> T \<rbrakk> 
   \<Longrightarrow> InWS w \<notin> ran (ws_\<alpha> ws)"
   and pick_wakeup_SomeD:
   "\<lbrakk> pick_wakeup \<sigma> t w ws = \<lfloor>t'\<rfloor>; ws_invar ws; \<sigma>_invar \<sigma> T; dom (ws_\<alpha> ws) \<subseteq> T; t \<in> T \<rbrakk>
   \<Longrightarrow> ws_\<alpha> ws t' = \<lfloor>InWS w\<rfloor>"
 
 locale scheduler_base_aux =
   state_refine_base
     final r convert_RA
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
 begin
 
 definition free_thread_id :: "'m_t \<Rightarrow> 't \<Rightarrow> bool"
 where "free_thread_id ts t \<longleftrightarrow> thr_lookup t ts = None"
 
 fun redT_updT :: "'m_t \<Rightarrow> ('t,'x,'m) new_thread_action \<Rightarrow> 'm_t"
 where
   "redT_updT ts (NewThread t' x m) = thr_update t' (x, no_wait_locks) ts"
 | "redT_updT ts _ = ts"
 
 definition redT_updTs :: "'m_t \<Rightarrow> ('t,'x,'m) new_thread_action list \<Rightarrow> 'm_t"
 where "redT_updTs = foldl redT_updT"
 
 primrec thread_ok :: "'m_t \<Rightarrow> ('t,'x,'m) new_thread_action \<Rightarrow> bool"
 where
   "thread_ok ts (NewThread t x m) = free_thread_id ts t"
 | "thread_ok ts (ThreadExists t b) = (b \<noteq> free_thread_id ts t)"
 
 text \<open>
   We use @{term "redT_updT"} in \<open>thread_ok\<close> instead of @{term "redT_updT'"} like in theory @{theory JinjaThreads.FWThread}.
   This fixes @{typ "'x"} in the @{typ "('t,'x,'m) new_thread_action list"} type, but avoids @{term "undefined"},
   which raises an exception during execution in the generated code.
 \<close>
 
 primrec thread_oks :: "'m_t \<Rightarrow> ('t,'x,'m) new_thread_action list \<Rightarrow> bool"
 where
   "thread_oks ts [] = True"
 | "thread_oks ts (ta#tas) = (thread_ok ts ta \<and> thread_oks (redT_updT ts ta) tas)"
 
 definition wset_actions_ok :: "'m_w \<Rightarrow> 't \<Rightarrow> ('t,'w) wait_set_action list \<Rightarrow> bool"
 where
   "wset_actions_ok ws t was \<longleftrightarrow>
    ws_lookup t ws = 
    (if Notified \<in> set was then \<lfloor>PostWS WSNotified\<rfloor>
     else if WokenUp \<in> set was then \<lfloor>PostWS WSWokenUp\<rfloor>
     else None)"
 
 primrec cond_action_ok :: "('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 't \<Rightarrow> 't conditional_action \<Rightarrow> bool" 
 where
   "\<And>ln. cond_action_ok s t (Join T) = 
    (case thr_lookup T (thr s)
       of None \<Rightarrow> True 
     | \<lfloor>(x, ln)\<rfloor> \<Rightarrow> t \<noteq> T \<and> final x \<and> ln = no_wait_locks \<and> ws_lookup T (wset s) = None)"
 | "cond_action_ok s t Yield = True"
 
 definition cond_action_oks :: "('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 't \<Rightarrow> 't conditional_action list \<Rightarrow> bool" 
 where
   "cond_action_oks s t cts = list_all (cond_action_ok s t) cts"
 
 primrec redT_updI :: "'s_i \<Rightarrow> 't interrupt_action \<Rightarrow> 's_i"
 where
   "redT_updI is (Interrupt t) = is_ins t is"
 | "redT_updI is (ClearInterrupt t) = is_delete t is"
 | "redT_updI is (IsInterrupted t b) = is"
 
 primrec redT_updIs :: "'s_i \<Rightarrow> 't interrupt_action list \<Rightarrow> 's_i"
 where
   "redT_updIs is [] = is"
 | "redT_updIs is (ia # ias) = redT_updIs (redT_updI is ia) ias"
 
 primrec interrupt_action_ok :: "'s_i \<Rightarrow> 't interrupt_action \<Rightarrow> bool"
 where
   "interrupt_action_ok is (Interrupt t) = True"
 | "interrupt_action_ok is (ClearInterrupt t) = True"
 | "interrupt_action_ok is (IsInterrupted t b) = (b = (is_memb t is))"
 
 primrec interrupt_actions_ok :: "'s_i \<Rightarrow> 't interrupt_action list \<Rightarrow> bool"
 where
   "interrupt_actions_ok is [] = True"
 | "interrupt_actions_ok is (ia # ias) \<longleftrightarrow> interrupt_action_ok is ia \<and> interrupt_actions_ok (redT_updI is ia) ias"
 
 definition actions_ok :: "('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o') thread_action \<Rightarrow> bool"
 where
   "actions_ok s t ta \<longleftrightarrow>
    lock_ok_las (locks s) t \<lbrace>ta\<rbrace>\<^bsub>l\<^esub> \<and> 
    thread_oks (thr s) \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<and>
    cond_action_oks s t \<lbrace>ta\<rbrace>\<^bsub>c\<^esub> \<and>
    wset_actions_ok (wset s) t \<lbrace>ta\<rbrace>\<^bsub>w\<^esub> \<and>
    interrupt_actions_ok (interrupts s) \<lbrace>ta\<rbrace>\<^bsub>i\<^esub>"
 
 end
 
 locale scheduler_base =
   scheduler_base_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup
     is_\<alpha> is_invar is_memb is_ins is_delete
   +
   scheduler_spec_base
     final r convert_RA
     schedule \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar 
     is_\<alpha> is_invar
   +
   pick_wakeup_spec_base
     final r convert_RA
     pick_wakeup \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and schedule :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler"
   and "output" :: "'s \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'q option"
   and pick_wakeup :: "'s \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_delete :: "'t \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_iterate :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status, 'm_w) set_iterator"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
 begin
 
 primrec exec_updW :: "'s \<Rightarrow> 't \<Rightarrow> 'm_w \<Rightarrow> ('t,'w) wait_set_action \<Rightarrow> 'm_w"
 where
   "exec_updW \<sigma> t ws (Notify w) = 
    (case pick_wakeup \<sigma> t w ws
     of None  \<Rightarrow> ws
     | Some t \<Rightarrow> ws_update t (PostWS WSNotified) ws)"
 | "exec_updW \<sigma> t ws (NotifyAll w) =
    ws_iterate ws (\<lambda>_. True) (\<lambda>(t, w') ws'. if w' = InWS w then ws_update t (PostWS WSNotified) ws' else ws') 
               ws"
 | "exec_updW \<sigma> t ws (Suspend w) = ws_update t (InWS w) ws"
 | "exec_updW \<sigma> t ws (WakeUp t') =
    (case ws_lookup t' ws of \<lfloor>InWS w\<rfloor> \<Rightarrow> ws_update t' (PostWS WSWokenUp) ws | _ \<Rightarrow> ws)"
 | "exec_updW \<sigma> t ws Notified = ws_delete t ws"
 | "exec_updW \<sigma> t ws WokenUp = ws_delete t ws"
 
 definition exec_updWs :: "'s \<Rightarrow> 't \<Rightarrow> 'm_w \<Rightarrow> ('t,'w) wait_set_action list \<Rightarrow> 'm_w"
 where "exec_updWs \<sigma> t = foldl (exec_updW \<sigma> t)"
 
 definition exec_upd ::
   "'s \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'x \<Rightarrow> 'm
   \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine"
 where [simp]:
   "exec_upd \<sigma> s t ta x' m' =
    (redT_updLs (locks s) t \<lbrace>ta\<rbrace>\<^bsub>l\<^esub>,
     (thr_update t (x', redT_updLns (locks s) t (snd (the (thr_lookup t (thr s)))) \<lbrace>ta\<rbrace>\<^bsub>l\<^esub>) (redT_updTs (thr s) \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>), m'),
     exec_updWs \<sigma> t (wset s) \<lbrace>ta\<rbrace>\<^bsub>w\<^esub>, redT_updIs (interrupts s) \<lbrace>ta\<rbrace>\<^bsub>i\<^esub>)"
 
 definition execT :: 
   "'s \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine
   \<Rightarrow> ('s \<times> 't \<times> ('l,'t,'x,'m,'w,'o) thread_action \<times> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine) option"
 where 
   "execT \<sigma> s =
   (do {
      (t, tax'm', \<sigma>') \<leftarrow> schedule \<sigma> s;
      case tax'm' of
        None \<Rightarrow> 
        (let (x, ln) = the (thr_lookup t (thr s));
             ta = (K$ [], [], [], [], [], convert_RA ln);
             s' = (acquire_all (locks s) t ln, (thr_update t (x, no_wait_locks) (thr s), shr s), wset s, interrupts s)
         in \<lfloor>(\<sigma>', t, ta, s')\<rfloor>)
      | \<lfloor>(ta, x', m')\<rfloor> \<Rightarrow> \<lfloor>(\<sigma>', t, ta, exec_upd \<sigma> s t ta x' m')\<rfloor>
    })"
 
 primrec exec_step :: 
   "'s \<times> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 
    ('s \<times> 't \<times> ('l,'t,'x,'m,'w,'o) thread_action) \<times> 's \<times> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine + ('l,'t,'m,'m_t,'m_w,'s_i) state_refine"
 where
   "exec_step (\<sigma>, s) =
    (case execT \<sigma> s of 
       None \<Rightarrow> Inr s
     | Some (\<sigma>', t, ta, s') \<Rightarrow> Inl ((\<sigma>, t, ta), \<sigma>', s'))"
 
 declare exec_step.simps [simp del]
 
 definition exec_aux ::
   "'s \<times> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine
   \<Rightarrow> ('s \<times> 't \<times> ('l,'t,'x,'m,'w,'o) thread_action, ('l,'t,'m,'m_t,'m_w,'s_i) state_refine) tllist"
 where
   "exec_aux \<sigma>s = unfold_tllist' exec_step \<sigma>s"
 
 definition exec :: "'s \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> ('q, ('l,'t,'m,'m_t,'m_w,'s_i) state_refine) tllist"
 where 
   "exec \<sigma> s = tmap the id (tfilter undefined (\<lambda>q. q \<noteq> None) (tmap (\<lambda>(\<sigma>, t, ta). output \<sigma> t ta) id (exec_aux (\<sigma>, s))))"
 
 end
 
 text \<open>
   Implement \<open>pick_wakeup\<close> by \<open>map_sel'\<close>
 \<close>
 
 definition pick_wakeup_via_sel :: 
   "('m_w \<Rightarrow> ('t \<Rightarrow> 'w wait_set_status \<Rightarrow> bool) \<rightharpoonup> 't \<times> 'w wait_set_status) 
   \<Rightarrow> 's \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
 where "pick_wakeup_via_sel ws_sel \<sigma> t w ws = map_option fst (ws_sel ws (\<lambda>t w'. w' = InWS w))"
 
 lemma pick_wakeup_spec_via_sel:
   assumes sel: "map_sel' ws_\<alpha> ws_invar ws_sel"
   shows "pick_wakeup_spec (pick_wakeup_via_sel (\<lambda>s P. ws_sel s (\<lambda>(k,v). P k v))) \<sigma>_invar ws_\<alpha> ws_invar"
 proof -
   interpret ws: map_sel' ws_\<alpha> ws_invar ws_sel by(rule sel)
   show ?thesis
     by(unfold_locales)(auto simp add: pick_wakeup_via_sel_def ran_def dest: ws.sel'_noneD ws.sel'_SomeD)
 qed
 
 locale scheduler_ext_base =
   scheduler_base_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup
     is_\<alpha> is_invar is_memb is_ins is_delete
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and thr_iterate :: "'m_t \<Rightarrow> ('t \<times> ('x \<times> 'l released_locks), 's_t) set_iterator"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_sel :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status \<Rightarrow> bool) \<rightharpoonup> ('t \<times> 'w wait_set_status)"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   +
   fixes thr'_\<alpha> :: "'s_t \<Rightarrow> 't set"
   and thr'_invar :: "'s_t \<Rightarrow> bool"
   and thr'_empty :: "unit \<Rightarrow> 's_t"
   and thr'_ins_dj :: "'t \<Rightarrow> 's_t \<Rightarrow> 's_t"
 begin
 
 abbreviation pick_wakeup :: "'s \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
 where "pick_wakeup \<equiv> pick_wakeup_via_sel (\<lambda>s P. ws_sel s (\<lambda>(k,v). P k v))"
 
 fun active_threads :: "('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 's_t"
 where
   "active_threads (ls, (ts, m), ws, is) =
    thr_iterate ts (\<lambda>_. True)
       (\<lambda>(t, (x, ln)) ts'. if ln = no_wait_locks
                        then if Predicate.holds 
                                (do {
                                   (ta, _) \<leftarrow> r t (x, m);
                                   Predicate.if_pred (actions_ok (ls, (ts, m), ws, is) t ta)
                                 })
                             then thr'_ins_dj t ts'
                             else ts'
                        else if \<not> waiting (ws_lookup t ws) \<and> may_acquire_all ls t ln then thr'_ins_dj t ts' else ts')
       (thr'_empty ())"
 
 end
 
 locale scheduler_aux =
   scheduler_base_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup
     is_\<alpha> is_invar is_memb is_ins is_delete
   +
   thr: finite_map thr_\<alpha> thr_invar +
   thr: map_lookup thr_\<alpha> thr_invar thr_lookup +
   thr: map_update thr_\<alpha> thr_invar thr_update +
   ws: map ws_\<alpha> ws_invar +
   ws: map_lookup ws_\<alpha> ws_invar ws_lookup +
   "is": set is_\<alpha> is_invar +
   "is": set_memb is_\<alpha> is_invar is_memb +
   "is": set_ins is_\<alpha> is_invar is_ins +
   "is": set_delete is_\<alpha> is_invar is_delete
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
 begin
 
 lemma free_thread_id_correct [simp]:
   "thr_invar ts \<Longrightarrow> free_thread_id ts = FWThread.free_thread_id (thr_\<alpha> ts)"
 by(auto simp add: free_thread_id_def fun_eq_iff thr.lookup_correct intro: free_thread_id.intros)
 
 lemma redT_updT_correct [simp]:
   assumes "thr_invar ts"
   shows "thr_\<alpha> (redT_updT ts nta) = FWThread.redT_updT (thr_\<alpha> ts) nta"
   and "thr_invar (redT_updT ts nta)"
 by(case_tac [!] nta)(simp_all add: thr.update_correct assms)
 
 lemma redT_updTs_correct [simp]:
   assumes  "thr_invar ts"
   shows "thr_\<alpha> (redT_updTs ts ntas) = FWThread.redT_updTs (thr_\<alpha> ts) ntas"
   and "thr_invar (redT_updTs ts ntas)"
 using assms
 by(induct ntas arbitrary: ts)(simp_all add: redT_updTs_def)
 
 lemma thread_ok_correct [simp]:
   "thr_invar ts \<Longrightarrow> thread_ok ts nta \<longleftrightarrow> FWThread.thread_ok (thr_\<alpha> ts) nta"
 by(cases nta) simp_all
 
 lemma thread_oks_correct [simp]:
   "thr_invar ts \<Longrightarrow> thread_oks ts ntas \<longleftrightarrow> FWThread.thread_oks (thr_\<alpha> ts) ntas"
 by(induct ntas arbitrary: ts) simp_all
 
 lemma wset_actions_ok_correct [simp]:
   "ws_invar ws \<Longrightarrow> wset_actions_ok ws t was \<longleftrightarrow> FWWait.wset_actions_ok (ws_\<alpha> ws) t was"
 by(simp add: wset_actions_ok_def FWWait.wset_actions_ok_def ws.lookup_correct)
 
 lemma cond_action_ok_correct [simp]:
   "state_invar s \<Longrightarrow> cond_action_ok s t cta \<longleftrightarrow> \<alpha>.cond_action_ok (state_\<alpha> s) t cta"
 by(cases s,cases cta)(auto simp add: thr.lookup_correct ws.lookup_correct)
 
 lemma cond_action_oks_correct [simp]:
   assumes "state_invar s"
   shows "cond_action_oks s t ctas \<longleftrightarrow> \<alpha>.cond_action_oks (state_\<alpha> s) t ctas"
 by(induct ctas)(simp_all add: cond_action_oks_def assms)
 
 lemma redT_updI_correct [simp]:
   assumes "is_invar is"
   shows "is_\<alpha> (redT_updI is ia) = FWInterrupt.redT_updI (is_\<alpha> is) ia"
   and "is_invar (redT_updI is ia)"
 using assms
 by(case_tac [!] ia)(auto simp add: is.ins_correct is.delete_correct)
 
 lemma redT_updIs_correct [simp]:
   assumes "is_invar is"
   shows "is_\<alpha> (redT_updIs is ias) = FWInterrupt.redT_updIs (is_\<alpha> is) ias"
   and "is_invar (redT_updIs is ias)"
 using assms
 by(induct ias arbitrary: "is")(auto)
 
 lemma interrupt_action_ok_correct [simp]:
   "is_invar is \<Longrightarrow> interrupt_action_ok is ia \<longleftrightarrow> FWInterrupt.interrupt_action_ok (is_\<alpha> is) ia"
 by(cases ia)(auto simp add: is.memb_correct)
 
 lemma interrupt_actions_ok_correct [simp]:
   "is_invar is \<Longrightarrow> interrupt_actions_ok is ias \<longleftrightarrow> FWInterrupt.interrupt_actions_ok (is_\<alpha> is) ias"
 by(induct ias arbitrary:"is") simp_all
 
 lemma actions_ok_correct [simp]:
   "state_invar s \<Longrightarrow> actions_ok s t ta \<longleftrightarrow> \<alpha>.actions_ok (state_\<alpha> s) t ta"
 by(auto simp add: actions_ok_def)
 
 end
 
 locale scheduler =
   scheduler_base 
     final r convert_RA
     schedule "output" pick_wakeup \<sigma>_invar
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup ws_update ws_delete ws_iterate
     is_\<alpha> is_invar is_memb is_ins is_delete
   +
   scheduler_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup
     is_\<alpha> is_invar is_memb is_ins is_delete
   +
   scheduler_spec
     final r convert_RA
     schedule \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
     invariant
   +
   pick_wakeup_spec
     final r convert_RA
     pick_wakeup \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
   +
   ws: map_update ws_\<alpha> ws_invar ws_update +
   ws: map_delete ws_\<alpha> ws_invar ws_delete +
   ws: map_iteratei ws_\<alpha> ws_invar ws_iterate 
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and schedule :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler"
   and "output" :: "'s \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'q option"
   and pick_wakeup :: "'s \<Rightarrow> 't \<Rightarrow> 'w \<Rightarrow> 'm_w \<Rightarrow> 't option"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_delete :: "'t \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_iterate :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status, 'm_w) set_iterator"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and invariant :: "('l,'t,'x,'m,'w) state set"
   +
   assumes invariant: "invariant3p \<alpha>.redT invariant"
 begin
 
 lemma exec_updW_correct:
   assumes invar: "ws_invar ws" "\<sigma>_invar \<sigma> T" "dom (ws_\<alpha> ws) \<subseteq> T" "t \<in> T"
   shows "redT_updW t (ws_\<alpha> ws) wa (ws_\<alpha> (exec_updW \<sigma> t ws wa))" (is "?thesis1")
   and "ws_invar (exec_updW \<sigma> t ws wa)" (is "?thesis2")
 proof -
   from invar have "?thesis1 \<and> ?thesis2"
   proof(cases wa)
     case [simp]: (Notify w)
     show ?thesis
     proof(cases "pick_wakeup \<sigma> t w ws")
       case (Some t')
       hence "ws_\<alpha> ws t' = \<lfloor>InWS w\<rfloor>" using invar by(rule pick_wakeup_SomeD)
       with Some show ?thesis using invar by(auto simp add: ws.update_correct)
     next
       case None
       hence "InWS w \<notin> ran (ws_\<alpha> ws)" using invar by(rule pick_wakeup_NoneD)
       with None show ?thesis using invar by(auto simp add: ran_def)
     qed
   next
     case [simp]: (NotifyAll w)
     let ?f = "\<lambda>(t, w') ws'. if w' = InWS w then ws_update t (PostWS WSNotified) ws' else ws'"
     let ?I = "\<lambda>T ws'. (\<forall>k. if k\<notin>T \<and> ws_\<alpha> ws k = \<lfloor>InWS w\<rfloor> then ws_\<alpha> ws' k = \<lfloor>PostWS WSNotified\<rfloor> else ws_\<alpha> ws' k = ws_\<alpha> ws k) \<and> ws_invar ws'"
     from invar have "?I (dom (ws_\<alpha> ws)) ws" by(auto simp add: ws.lookup_correct)
     with \<open>ws_invar ws\<close> have "?I {} (ws_iterate ws (\<lambda>_. True) ?f ws)"
     proof(rule ws.iterate_rule_P[where I="?I"])
       fix t w' T ws'
       assume t: "t \<in> T" and w': "ws_\<alpha> ws t = \<lfloor>w'\<rfloor>"
         and T: "T \<subseteq> dom (ws_\<alpha> ws)" and I: "?I T ws'"
       { fix t'
         assume "t' \<notin> T - {t}" "ws_\<alpha> ws t' = \<lfloor>InWS w\<rfloor>"
         with t I w' invar have "ws_\<alpha> (?f (t, w') ws') t' = \<lfloor>PostWS WSNotified\<rfloor>"
           by(auto)(simp_all add: ws.update_correct) }
       moreover {
         fix t'
         assume "t' \<in> T - {t} \<or> ws_\<alpha> ws t' \<noteq> \<lfloor>InWS w\<rfloor>"
         with t I w' invar have "ws_\<alpha> (?f (t,w') ws') t' = ws_\<alpha> ws t'"
           by(auto simp add: ws.update_correct) }
       moreover
       have "ws_invar (?f (t, w') ws')" using I by(simp add: ws.update_correct)
       ultimately show "?I (T - {t}) (?f (t, w') ws')" by safe simp
     qed
     hence "ws_\<alpha> (ws_iterate ws (\<lambda>_. True) ?f ws) = (\<lambda>t. if ws_\<alpha> ws t = \<lfloor>InWS w\<rfloor> then \<lfloor>PostWS WSNotified\<rfloor> else ws_\<alpha> ws t)"
       and "ws_invar (ws_iterate ws (\<lambda>_. True) ?f ws)" by(simp_all add: fun_eq_iff)
     thus ?thesis by simp
   next
     case WakeUp thus ?thesis using assms
       by(auto simp add: ws.lookup_correct ws.update_correct split: wait_set_status.split)
   qed(simp_all add: ws.update_correct ws.delete_correct map_upd_eq_restrict)
   thus ?thesis1 ?thesis2 by simp_all
 qed
 
 lemma exec_updWs_correct:
   assumes "ws_invar ws" "\<sigma>_invar \<sigma> T" "dom (ws_\<alpha> ws) \<subseteq> T" "t \<in> T"
   shows "redT_updWs t (ws_\<alpha> ws) was (ws_\<alpha> (exec_updWs \<sigma> t ws was))" (is "?thesis1")
   and "ws_invar (exec_updWs \<sigma> t ws was)" (is "?thesis2")
 proof -
   from \<open>ws_invar ws\<close> \<open>dom (ws_\<alpha> ws) \<subseteq> T\<close> 
   have "?thesis1 \<and> ?thesis2"
   proof(induct was arbitrary: ws)
     case Nil thus ?case by(auto simp add: exec_updWs_def redT_updWs_def)
   next
     case (Cons wa was)
     let ?ws' = "exec_updW \<sigma> t ws wa"
     from \<open>ws_invar ws\<close> \<open>\<sigma>_invar \<sigma> T\<close> \<open>dom (ws_\<alpha> ws) \<subseteq> T\<close> \<open>t \<in> T\<close>
     have invar': "ws_invar ?ws'" and red: "redT_updW t (ws_\<alpha> ws) wa (ws_\<alpha> ?ws')"
       by(rule exec_updW_correct)+
     have "dom (ws_\<alpha> ?ws') \<subseteq> T"
     proof
       fix t' assume "t' \<in> dom (ws_\<alpha> ?ws')"
       with red have "t' \<in> dom (ws_\<alpha> ws) \<or> t = t'"
         by(auto dest!: redT_updW_Some_otherD split: wait_set_status.split_asm)
       with \<open>dom (ws_\<alpha> ws) \<subseteq> T\<close> \<open>t \<in> T\<close> show "t' \<in> T" by auto
     qed
     with invar' have "redT_updWs t (ws_\<alpha> ?ws') was (ws_\<alpha> (exec_updWs \<sigma> t ?ws' was)) \<and> ws_invar (exec_updWs \<sigma> t ?ws' was)"
       by(rule Cons.hyps)
     thus ?case using red
       by(auto simp add: exec_updWs_def redT_updWs_def intro: rtrancl3p_step_converse)
   qed
   thus ?thesis1 ?thesis2 by simp_all
 qed
 
 lemma exec_upd_correct:
   assumes "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "t \<in> (dom (thr_\<alpha> (thr s)))"
   and "wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))"
   shows "redT_upd (state_\<alpha> s) t ta x' m' (state_\<alpha> (exec_upd \<sigma> s t ta x' m'))"
   and "state_invar (exec_upd \<sigma> s t ta x' m')"
 using assms unfolding wset_thread_ok_conv_dom
 by(auto simp add: thr.update_correct thr.lookup_correct intro: exec_updWs_correct)
 
 lemma execT_None:
   assumes invar: "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_\<alpha> s \<in> invariant"
   and exec: "execT \<sigma> s = None"
   shows "\<alpha>.active_threads (state_\<alpha> s) = {}"
 using assms
 by(cases "schedule \<sigma> s")(fastforce simp add: execT_def thr.lookup_correct dest: schedule_Some_NoneD schedule_NoneD)+
 
 lemma execT_Some:
   assumes invar: "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_\<alpha> s \<in> invariant"
   and wstok: "wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))"
   and exec: "execT \<sigma> s = \<lfloor>(\<sigma>', t, ta, s')\<rfloor>"
   shows "\<alpha>.redT (state_\<alpha> s) (t, ta) (state_\<alpha> s')" (is "?thesis1")
   and "state_invar s'" (is "?thesis2")
   and "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" (is "?thesis3")
 proof -
   note [simp del] = redT_upd_simps exec_upd_def
 
   have "?thesis1 \<and> ?thesis2 \<and> ?thesis3"
   proof(cases "fst (snd (the (schedule \<sigma> s)))")
     case None
     with exec invar have schedule: "schedule \<sigma> s = \<lfloor>(t, None, \<sigma>')\<rfloor>"
       and ta: "ta = (K$ [], [], [], [], [], convert_RA (snd (the (thr_\<alpha> (thr s) t))))"
       and s': "s' = (acquire_all (locks s) t (snd (the (thr_\<alpha> (thr s) t))), (thr_update t (fst (the (thr_\<alpha> (thr s) t)), no_wait_locks) (thr s), shr s), wset s, interrupts s)"
-      by(auto simp add: execT_def Option_bind_eq_Some_conv thr.lookup_correct split_beta split del: option.split_asm)
+      by(auto simp add: execT_def bind_eq_Some_conv thr.lookup_correct split_beta split del: option.split_asm)
     from schedule_Some_NoneD[OF schedule invar]
 
     obtain x ln n where t: "thr_\<alpha> (thr s) t = \<lfloor>(x, ln)\<rfloor>"
       and "0 < ln $ n" "\<not> waiting (ws_\<alpha> (wset s) t)" "may_acquire_all (locks s) t ln" by blast
     hence ?thesis1 using ta s' invar by(auto intro: \<alpha>.redT.redT_acquire simp add: thr.update_correct)
     moreover from invar s' have "?thesis2" by(simp add: thr.update_correct)
     moreover from t s' invar have "dom (thr_\<alpha> (thr s')) = dom (thr_\<alpha> (thr s))" by(auto simp add: thr.update_correct)
     hence "?thesis3" using invar schedule by(auto intro: schedule_invar_None)
     ultimately show ?thesis by simp
   next
     case (Some taxm)
     with exec invar obtain x' m' 
       where schedule: "schedule \<sigma> s = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>"
       and s': "s' = exec_upd \<sigma> s t ta x' m'"
-      by(cases taxm)(fastforce simp add: execT_def Option_bind_eq_Some_conv split del: option.split_asm)
+      by(cases taxm)(fastforce simp add: execT_def bind_eq_Some_conv split del: option.split_asm)
     from schedule_Some_SomeD[OF schedule invar]
     obtain x where t: "thr_\<alpha> (thr s) t = \<lfloor>(x, no_wait_locks)\<rfloor>" 
       and "Predicate.eval (r t (x, shr s)) (ta, x', m')" 
       and aok: "\<alpha>.actions_ok (state_\<alpha> s) t ta" by blast
     with s' have ?thesis1 using invar wstok
       by(fastforce intro: \<alpha>.redT.intros exec_upd_correct)
     moreover from invar s' t wstok have ?thesis2 by(auto intro: exec_upd_correct)
     moreover {
       from schedule invar
       have "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s)) \<union> {t. \<exists>x m. NewThread t x m \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>})"
         by(rule schedule_invar_Some)
       also have "dom (thr_\<alpha> (thr s)) \<union> {t. \<exists>x m. NewThread t x m \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>} = dom (thr_\<alpha> (thr s'))"
         using invar s' aok t
         by(auto simp add: exec_upd_def thr.lookup_correct thr.update_correct simp del: split_paired_Ex)(fastforce dest: redT_updTs_new_thread intro: redT_updTs_Some1 redT_updTs_new_thread_ts simp del: split_paired_Ex)+
       finally have "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" . }
     ultimately show ?thesis by simp
   qed
   thus ?thesis1 ?thesis2 ?thesis3 by simp_all
 qed
 
 lemma exec_step_into_redT:
   assumes invar: "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_\<alpha> s \<in> invariant"
   and wstok: "wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))"
   and exec: "exec_step (\<sigma>, s) = Inl ((\<sigma>'', t, ta), \<sigma>', s')"
   shows "\<alpha>.redT (state_\<alpha> s) (t, ta) (state_\<alpha> s')" "\<sigma>'' = \<sigma>"
   and "state_invar s'" "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" "state_\<alpha> s' \<in> invariant"
 proof -
   from exec have execT: "execT \<sigma> s = \<lfloor>(\<sigma>', t, ta, s')\<rfloor>" 
     and q: "\<sigma>'' = \<sigma>" by(auto simp add: exec_step.simps split_beta)
   from invar wstok execT show red: "\<alpha>.redT (state_\<alpha> s) (t, ta) (state_\<alpha> s')" 
     and invar': "state_invar s'" "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" "\<sigma>'' = \<sigma>"
     by(rule execT_Some)+(rule q)
   from invariant red \<open>state_\<alpha> s \<in> invariant\<close> 
   show "state_\<alpha> s' \<in> invariant" by(rule invariant3pD)
 qed
 
 lemma exec_step_InrD:
   assumes "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_\<alpha> s \<in> invariant"
   and "exec_step (\<sigma>, s) = Inr s'"
   shows "\<alpha>.active_threads (state_\<alpha> s) = {}"
   and "s' = s"
 using assms
 by(auto simp add: exec_step_def dest: execT_None)
 
 lemma (in multithreaded_base) red_in_active_threads:
   assumes "s -t\<triangleright>ta\<rightarrow> s'"
   shows "t \<in> active_threads s"
 using assms
 by cases(auto intro: active_threads.intros)
 
 lemma exec_aux_into_Runs:
   assumes "state_invar s" "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_\<alpha> s \<in> invariant"
   and "wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))"
   shows "\<alpha>.mthr.Runs (state_\<alpha> s) (lmap snd (llist_of_tllist (exec_aux (\<sigma>, s))))" (is ?thesis1)
   and "tfinite (exec_aux (\<sigma>, s)) \<Longrightarrow> state_invar (terminal (exec_aux (\<sigma>, s)))" (is "_ \<Longrightarrow> ?thesis2")
 proof -
   from assms show ?thesis1
   proof(coinduction arbitrary: \<sigma> s) 
     case (Runs \<sigma> s)
     note invar = \<open>state_invar s\<close> \<open>\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))\<close> \<open>state_\<alpha> s \<in> invariant\<close>
       and wstok = \<open>wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))\<close>
     show ?case
     proof(cases "exec_aux (\<sigma>, s)")
       case (TNil s')
       hence "\<alpha>.active_threads (state_\<alpha> s) = {}" "s' = s"
         by(auto simp add: exec_aux_def unfold_tllist' split: sum.split_asm dest: exec_step_InrD[OF invar])
       hence ?Stuck using TNil by(auto dest: \<alpha>.red_in_active_threads)
       thus ?thesis ..
     next
       case (TCons \<sigma>tta ttls')
       then obtain t ta \<sigma>' s' \<sigma>''
         where [simp]: "\<sigma>tta = (\<sigma>'', t, ta)"
         and [simp]: "ttls' = exec_aux (\<sigma>', s')"
         and step: "exec_step (\<sigma>, s) = Inl ((\<sigma>'', t, ta), \<sigma>', s')"
         unfolding exec_aux_def by(subst (asm) (2) unfold_tllist')(fastforce split: sum.split_asm)
       from invar wstok step
       have redT: "\<alpha>.redT (state_\<alpha> s) (t, ta) (state_\<alpha> s')"
         and [simp]: "\<sigma>'' = \<sigma>"
         and invar': "state_invar s'" "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" "state_\<alpha> s' \<in> invariant"
         by(rule exec_step_into_redT)+
       from wstok \<alpha>.redT_preserves_wset_thread_ok[OF redT]
       have "wset_thread_ok (ws_\<alpha> (wset s')) (thr_\<alpha> (thr s'))" by simp
       with invar' redT TCons have ?Step by(auto simp del: split_paired_Ex)
       thus ?thesis ..
     qed
   qed
 next
   assume "tfinite (exec_aux (\<sigma>, s))"
   thus "?thesis2" using assms
   proof(induct "exec_aux (\<sigma>, s)" arbitrary: \<sigma> s rule: tfinite_induct)
     case TNil thus ?case
       by(auto simp add: exec_aux_def unfold_tllist' split_beta split: sum.split_asm dest: exec_step_InrD)
   next
     case (TCons \<sigma>tta ttls)
     from \<open>TCons \<sigma>tta ttls = exec_aux (\<sigma>, s)\<close>
     obtain \<sigma>'' t ta \<sigma>' s' 
       where [simp]: "\<sigma>tta = (\<sigma>'', t, ta)"
       and ttls: "ttls = exec_aux (\<sigma>', s')"
       and step: "exec_step (\<sigma>, s) = Inl ((\<sigma>'', t, ta), \<sigma>', s')"
       unfolding exec_aux_def by(subst (asm) (2) unfold_tllist')(fastforce split: sum.split_asm)
     note ttls moreover
     from \<open>state_invar s\<close> \<open>\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))\<close> \<open>state_\<alpha> s \<in> invariant\<close> \<open>wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))\<close> step
     have [simp]: "\<sigma>'' = \<sigma>"
       and invar': "state_invar s'" "\<sigma>_invar \<sigma>' (dom (thr_\<alpha> (thr s')))" "state_\<alpha> s' \<in> invariant"
       and redT: "\<alpha>.redT (state_\<alpha> s) (t, ta) (state_\<alpha> s')"
       by(rule exec_step_into_redT)+
     note invar' moreover
     from \<alpha>.redT_preserves_wset_thread_ok[OF redT] \<open>wset_thread_ok (ws_\<alpha> (wset s)) (thr_\<alpha> (thr s))\<close>
     have "wset_thread_ok (ws_\<alpha> (wset s')) (thr_\<alpha> (thr s'))" by simp
     ultimately have "state_invar (terminal (exec_aux (\<sigma>', s')))" by(rule TCons)
     with \<open>TCons \<sigma>tta ttls = exec_aux (\<sigma>, s)\<close>[symmetric]
     show ?case unfolding ttls by simp
   qed
 qed
 
 end
 
 locale scheduler_ext_aux =
   scheduler_ext_base
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update thr_iterate
     ws_\<alpha> ws_invar ws_lookup ws_update ws_sel
     is_\<alpha> is_invar is_memb is_ins is_delete
     thr'_\<alpha> thr'_invar thr'_empty thr'_ins_dj
   +
   scheduler_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup
     is_\<alpha> is_invar is_memb is_ins is_delete
   +
   thr: map_iteratei thr_\<alpha> thr_invar thr_iterate +
   ws: map_update ws_\<alpha> ws_invar ws_update +
   ws: map_sel' ws_\<alpha> ws_invar ws_sel +
   thr': finite_set thr'_\<alpha> thr'_invar +
   thr': set_empty thr'_\<alpha> thr'_invar thr'_empty +
   thr': set_ins_dj thr'_\<alpha> thr'_invar thr'_ins_dj  
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and thr_iterate :: "'m_t \<Rightarrow> ('t \<times> ('x \<times> 'l released_locks), 's_t) set_iterator"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_sel :: "'m_w \<Rightarrow> (('t \<times> 'w wait_set_status) \<Rightarrow> bool) \<rightharpoonup> ('t \<times> 'w wait_set_status)"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and thr'_\<alpha> :: "'s_t \<Rightarrow> 't set"
   and thr'_invar :: "'s_t \<Rightarrow> bool"
   and thr'_empty :: "unit \<Rightarrow> 's_t"
   and thr'_ins_dj :: "'t \<Rightarrow> 's_t \<Rightarrow> 's_t"
 begin
 
 lemma active_threads_correct [simp]:
   assumes "state_invar s"
   shows "thr'_\<alpha> (active_threads s) = \<alpha>.active_threads (state_\<alpha> s)" (is "?thesis1")
   and "thr'_invar (active_threads s)" (is "?thesis2")
 proof -
   obtain ls ts m ws "is" where s: "s = (ls, (ts, m), ws, is)" by(cases s) fastforce
   let ?f = "\<lambda>(t, (x, ln)) TS. if ln = no_wait_locks
            then if Predicate.holds (do { (ta, _) \<leftarrow> r t (x, m); Predicate.if_pred (actions_ok (ls, (ts, m), ws, is) t ta) })
                 then thr'_ins_dj t TS else TS
            else if \<not> waiting (ws_lookup t ws) \<and> may_acquire_all ls t ln then thr'_ins_dj t TS else TS"
   let ?I = "\<lambda>T TS. thr'_invar TS \<and> thr'_\<alpha> TS \<subseteq> dom (thr_\<alpha> ts) - T \<and> (\<forall>t. t \<notin> T \<longrightarrow> t \<in> thr'_\<alpha> TS \<longleftrightarrow> t \<in> \<alpha>.active_threads (state_\<alpha> s))"
 
   from assms s have "thr_invar ts" by simp
   moreover have "?I (dom (thr_\<alpha> ts)) (thr'_empty ())"
     by(auto simp add: thr'.empty_correct s elim: \<alpha>.active_threads.cases)
   ultimately have "?I {} (thr_iterate ts (\<lambda>_. True) ?f (thr'_empty ()))"
   proof(rule thr.iterate_rule_P[where I="?I"])
     fix t xln T TS
     assume tT: "t \<in> T" 
       and tst: "thr_\<alpha> ts t = \<lfloor>xln\<rfloor>"
       and Tdom: "T \<subseteq> dom (thr_\<alpha> ts)"
       and I: "?I T TS"
     obtain x ln where xln: "xln = (x, ln)" by(cases xln)
     from tT I have t: "t \<notin> thr'_\<alpha> TS" by blast
 
     from I have invar: "thr'_invar TS" ..
     hence "thr'_invar (?f (t, xln) TS)" using t
       unfolding xln by(auto simp add: thr'.ins_dj_correct)
     moreover from I have "thr'_\<alpha> TS \<subseteq> dom (thr_\<alpha> ts) - T" by blast
     hence "thr'_\<alpha> (?f (t, xln) TS) \<subseteq> dom (thr_\<alpha> ts) - (T - {t})"
       using invar tst t by(auto simp add: xln thr'.ins_dj_correct)
     moreover
     {
       fix t'
       assume t': "t' \<notin> T - {t}"
       have "t' \<in> thr'_\<alpha> (?f (t, xln) TS) \<longleftrightarrow> t' \<in> \<alpha>.active_threads (state_\<alpha> s)" (is "?lhs \<longleftrightarrow> ?rhs")
       proof(cases "t' = t")
         case True
         show ?thesis
         proof
           assume ?lhs
           with True xln invar tst \<open>state_invar s\<close> t show ?rhs
             by(fastforce simp add: holds_eq thr'.ins_dj_correct s split_beta ws.lookup_correct split: if_split_asm elim!: bindE if_predE intro: \<alpha>.active_threads.intros)
         next
           assume ?rhs
           with True xln invar tst \<open>state_invar s\<close> t show ?lhs
             by(fastforce elim!: \<alpha>.active_threads.cases simp add: holds_eq s thr'.ins_dj_correct ws.lookup_correct elim!: bindE if_predE intro: bindI if_predI)
         qed
       next
         case False
         with t' have "t' \<notin> T" by simp
         with I have "t' \<in> thr'_\<alpha> TS \<longleftrightarrow> t' \<in> \<alpha>.active_threads (state_\<alpha> s)" by blast
         thus ?thesis using xln False invar t by(auto simp add: thr'.ins_dj_correct)
       qed
     }
     ultimately show "?I (T - {t}) (?f (t, xln) TS)" by blast
   qed
   thus "?thesis1" "?thesis2" by(auto simp add: s)
 qed
 
 end
 
 locale scheduler_ext =
   scheduler_ext_aux
     final r convert_RA
     thr_\<alpha> thr_invar thr_lookup thr_update thr_iterate
     ws_\<alpha> ws_invar ws_lookup ws_update ws_sel
     is_\<alpha> is_invar is_memb is_ins is_delete
     thr'_\<alpha> thr'_invar thr'_empty thr'_ins_dj
   +
   scheduler_spec
     final r convert_RA
     schedule \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
     is_\<alpha> is_invar
     invariant
   +
   ws: map_delete ws_\<alpha> ws_invar ws_delete +
   ws: map_iteratei ws_\<alpha> ws_invar ws_iterate
   for final :: "'x \<Rightarrow> bool"
   and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
   and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
   and schedule :: "('l,'t,'x,'m,'w,'o,'m_t,'m_w,'s_i,'s) scheduler"
   and "output" :: "'s \<Rightarrow> 't \<Rightarrow> ('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 'q option"
   and \<sigma>_invar :: "'s \<Rightarrow> 't set \<Rightarrow> bool"
   and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
   and thr_invar :: "'m_t \<Rightarrow> bool"
   and thr_lookup :: "'t \<Rightarrow> 'm_t \<rightharpoonup> ('x \<times> 'l released_locks)"
   and thr_update :: "'t \<Rightarrow> 'x \<times> 'l released_locks \<Rightarrow> 'm_t \<Rightarrow> 'm_t"
   and thr_iterate :: "'m_t \<Rightarrow> ('t \<times> ('x \<times> 'l released_locks), 's_t) set_iterator"
   and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
   and ws_invar :: "'m_w \<Rightarrow> bool"
   and ws_empty :: "unit \<Rightarrow> 'm_w"
   and ws_lookup :: "'t \<Rightarrow> 'm_w \<rightharpoonup> 'w wait_set_status"
   and ws_update :: "'t \<Rightarrow> 'w wait_set_status \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_delete :: "'t \<Rightarrow> 'm_w \<Rightarrow> 'm_w"
   and ws_iterate :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status, 'm_w) set_iterator"
   and ws_sel :: "'m_w \<Rightarrow> ('t \<times> 'w wait_set_status \<Rightarrow> bool) \<rightharpoonup> ('t \<times> 'w wait_set_status)"
   and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
   and is_invar :: "'s_i \<Rightarrow> bool"
   and is_memb :: "'t \<Rightarrow> 's_i \<Rightarrow> bool"
   and is_ins :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and is_delete :: "'t \<Rightarrow> 's_i \<Rightarrow> 's_i"
   and thr'_\<alpha> :: "'s_t \<Rightarrow> 't set"
   and thr'_invar :: "'s_t \<Rightarrow> bool"
   and thr'_empty :: "unit \<Rightarrow> 's_t"
   and thr'_ins_dj :: "'t \<Rightarrow> 's_t \<Rightarrow> 's_t"
   and invariant :: "('l,'t,'x,'m,'w) state set"
   +
   assumes invariant: "invariant3p \<alpha>.redT invariant"
 
 sublocale scheduler_ext < 
   pick_wakeup_spec
     final r convert_RA
     pick_wakeup \<sigma>_invar
     thr_\<alpha> thr_invar
     ws_\<alpha> ws_invar
 by(rule pick_wakeup_spec_via_sel)(unfold_locales)
 
 sublocale scheduler_ext < 
   scheduler
     final r convert_RA
     schedule "output" "pick_wakeup" \<sigma>_invar
     thr_\<alpha> thr_invar thr_lookup thr_update
     ws_\<alpha> ws_invar ws_lookup ws_update ws_delete ws_iterate
     is_\<alpha> is_invar is_memb is_ins is_delete
     invariant
 by(unfold_locales)(rule invariant)
 
 subsection \<open>Schedulers for deterministic small-step semantics\<close>
 
 text \<open>
   The default code equations for @{term Predicate.the} impose the type class constraint \<open>eq\<close>
   on the predicate elements. For the semantics, which contains the heap, there might be no such
   instance, so we use new constants for which other code equations can be used.
   These do not add the type class constraint, but may fail more often with non-uniqueness exception.
 \<close>
 
 definition singleton2 where [simp]: "singleton2 = Predicate.singleton"
 definition the_only2 where [simp]: "the_only2 = Predicate.the_only"
 definition the2 where [simp]: "the2 = Predicate.the"
 
 context multithreaded_base begin
 
 definition step_thread ::
   "(('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 's) \<Rightarrow> ('l,'t,'x,'m,'w) state \<Rightarrow> 't
   \<Rightarrow> ('t \<times> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) option \<times> 's) option"
 where
   "\<And>ln. step_thread update_state s t =
    (case thr s t of
       \<lfloor>(x, ln)\<rfloor> \<Rightarrow>
       if ln = no_wait_locks then
         if \<exists>ta x' m'. t \<turnstile> (x, shr s) -ta\<rightarrow> (x', m') \<and> actions_ok s t ta then
           let
             (ta, x', m') = THE (ta, x', m'). t \<turnstile> (x, shr s) -ta\<rightarrow> (x', m') \<and> actions_ok s t ta
           in
             \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, update_state ta)\<rfloor>
         else
           None
       else if may_acquire_all (locks s) t ln \<and> \<not> waiting (wset s t) then 
         \<lfloor>(t, None, update_state (K$ [], [], [], [], [], convert_RA ln))\<rfloor>
       else
         None
     | None \<Rightarrow> None)"
 
 lemma step_thread_NoneD:
   "step_thread update_state s t = None \<Longrightarrow> t \<notin> active_threads s"
 unfolding step_thread_def 
 by(fastforce simp add: split_beta elim!: active_threads.cases split: if_split_asm)
 
 lemma inactive_step_thread_eq_NoneI:
   "t \<notin> active_threads s \<Longrightarrow> step_thread update_state s t = None"
 unfolding step_thread_def
 by(fastforce simp add: split_beta split: if_split_asm intro: active_threads.intros)
 
 lemma step_thread_eq_None_conv:
   "step_thread update_state s t = None \<longleftrightarrow> t \<notin> active_threads s"
 by(blast dest: step_thread_NoneD intro: inactive_step_thread_eq_NoneI)
 
 lemma step_thread_eq_Some_activeD:
   "step_thread update_state s t = \<lfloor>(t', taxm\<sigma>')\<rfloor> 
   \<Longrightarrow> t' = t \<and> t \<in> active_threads s"
 unfolding step_thread_def 
 by(fastforce split: if_split_asm simp add: split_beta intro: active_threads.intros)
 
 declare actions_ok_iff [simp del]
 declare actions_ok.cases [rule del]
 
 lemma step_thread_Some_NoneD:
   "step_thread update_state s t' = \<lfloor>(t, None, \<sigma>')\<rfloor>
   \<Longrightarrow> \<exists>x ln n. thr s t = \<lfloor>(x, ln)\<rfloor> \<and> ln $ n > 0 \<and> \<not> waiting (wset s t) \<and> may_acquire_all (locks s) t ln \<and> \<sigma>' = update_state (K$ [], [], [], [], [], convert_RA ln)"
 unfolding step_thread_def
 by(auto split: if_split_asm simp add: split_beta elim!: neq_no_wait_locksE)
 
 lemma step_thread_Some_SomeD:
   "\<lbrakk> deterministic I; step_thread update_state s t' = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>; s \<in> I \<rbrakk>
   \<Longrightarrow> \<exists>x. thr s t = \<lfloor>(x, no_wait_locks)\<rfloor> \<and> t \<turnstile> \<langle>x, shr s\<rangle> -ta\<rightarrow> \<langle>x', m'\<rangle> \<and> actions_ok s t ta \<and> \<sigma>' = update_state ta"
 unfolding step_thread_def
 by(auto simp add: split_beta deterministic_THE split: if_split_asm)
 
 end
 
 context scheduler_base_aux begin
 
 definition step_thread ::
   "(('l,'t,'x,'m,'w,'o) thread_action \<Rightarrow> 's) \<Rightarrow> ('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> 't \<Rightarrow>
    ('t \<times> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) option \<times> 's) option"
 where 
   "\<And>ln. step_thread update_state s t =
   (case thr_lookup t (thr s) of
       \<lfloor>(x, ln)\<rfloor> \<Rightarrow>
       if ln = no_wait_locks then
         let
           reds = do {
             (ta, x', m') \<leftarrow> r t (x, shr s);
             if actions_ok s t ta then Predicate.single (ta, x', m') else bot
           }
         in
           if Predicate.holds (reds \<bind> (\<lambda>_. Predicate.single ())) then
             let
               (ta, x', m') = the2 reds
             in 
               \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, update_state ta)\<rfloor>
           else
             None
       else if may_acquire_all (locks s) t ln \<and> \<not> waiting (ws_lookup t (wset s)) then 
         \<lfloor>(t, None, update_state (K$ [], [], [], [], [],convert_RA ln))\<rfloor>
       else
         None
     | None \<Rightarrow> None)"
 
 end
 
 context scheduler_aux begin
 
 lemma deterministic_THE2:
   assumes "\<alpha>.deterministic I"
   and tst: "thr_\<alpha> (thr s) t = \<lfloor>(x, no_wait_locks)\<rfloor>"
   and red: "Predicate.eval (r t (x, shr s)) (ta, x', m')"
   and aok: "\<alpha>.actions_ok (state_\<alpha> s) t ta"
   and I: "state_\<alpha> s \<in> I"
   shows "Predicate.the (r t (x, shr s) \<bind> (\<lambda>(ta, x', m'). if \<alpha>.actions_ok (state_\<alpha> s) t ta then Predicate.single (ta, x', m') else bot)) = (ta, x', m')"
 proof -
   show ?thesis unfolding the_def
     apply(rule the_equality)
      apply(rule bindI[OF red])
      apply(simp add: singleI aok)
     apply(erule bindE)
     apply(clarsimp split: if_split_asm)
      apply(drule (1) \<alpha>.deterministicD[OF \<open>\<alpha>.deterministic I\<close>, where s="state_\<alpha> s", simplified, OF red _ tst aok])
       apply(rule I)
      apply simp
     done
 qed
 
 lemma step_thread_correct:
   assumes det: "\<alpha>.deterministic I"
   and invar: "\<sigma>_invar \<sigma> (dom (thr_\<alpha> (thr s)))" "state_invar s" "state_\<alpha> s \<in> I"
   shows
   "map_option (apsnd (apsnd \<sigma>_\<alpha>)) (step_thread update_state s t) = \<alpha>.step_thread (\<sigma>_\<alpha> \<circ> update_state) (state_\<alpha> s) t" (is ?thesis1)
   and "(\<And>ta. FWThread.thread_oks (thr_\<alpha> (thr s)) \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<Longrightarrow> \<sigma>_invar (update_state ta) (dom (thr_\<alpha> (thr s)) \<union> {t. \<exists>x m. NewThread t x m \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>})) \<Longrightarrow> case_option True (\<lambda>(t, taxm, \<sigma>). \<sigma>_invar \<sigma> (case taxm of None \<Rightarrow> dom (thr_\<alpha> (thr s)) | Some (ta, x', m') \<Rightarrow> dom (thr_\<alpha> (thr s)) \<union> {t. \<exists>x m. NewThread t x m \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>})) (step_thread update_state s t)"
   (is "(\<And>ta. ?tso ta \<Longrightarrow> ?inv ta) \<Longrightarrow> ?thesis2")
 proof -
   have "?thesis1 \<and> ((\<forall>ta. ?tso ta \<longrightarrow> ?inv ta) \<longrightarrow> ?thesis2)"
   proof(cases "step_thread update_state s t")
     case None
     with invar show ?thesis
       apply (auto simp add: thr.lookup_correct \<alpha>.step_thread_def step_thread_def ws.lookup_correct
         split_beta holds_eq split: if_split_asm cong del: image_cong_simp)
        apply metis
       apply metis
       done
   next
     case (Some a)
     then obtain t' taxm \<sigma>' 
       where rrs: "step_thread update_state s t = \<lfloor>(t', taxm, \<sigma>')\<rfloor>" by(cases a) auto
     show ?thesis
     proof(cases "taxm")
       case None
       with rrs invar have ?thesis1
         by(auto simp add: thr.lookup_correct ws.lookup_correct \<alpha>.step_thread_def step_thread_def split_beta split: if_split_asm)
       moreover {
         let ?ta = "(K$ [], [], [], [], [], convert_RA (snd (the (thr_lookup t (thr s)))))"
         assume "?tso ?ta \<longrightarrow> ?inv ?ta"
         hence ?thesis2 using None rrs
           by(auto simp add: thr.lookup_correct ws.lookup_correct \<alpha>.step_thread_def step_thread_def split_beta split: if_split_asm) }
       ultimately show ?thesis by blast
     next
       case (Some a)
       with rrs obtain ta x' m'
         where rrs: "step_thread update_state s t =  \<lfloor>(t', \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>"
         by(cases a) fastforce
       with invar have ?thesis1 
         by (auto simp add: thr.lookup_correct ws.lookup_correct \<alpha>.step_thread_def step_thread_def
           split_beta \<alpha>.deterministic_THE [OF det, where s="state_\<alpha> s", simplified]
           deterministic_THE2[OF det] holds_eq split: if_split_asm
           cong del: image_cong_simp) blast+
       moreover {
         assume "?tso ta \<longrightarrow> ?inv ta"
         hence ?thesis2 using rrs invar
           by(auto simp add: thr.lookup_correct ws.lookup_correct \<alpha>.step_thread_def step_thread_def split_beta \<alpha>.deterministic_THE[OF det, where s="state_\<alpha> s", simplified] deterministic_THE2[OF det] holds_eq split: if_split_asm)(auto simp add: \<alpha>.actions_ok_iff) 
       }
       ultimately show ?thesis by blast
     qed
   qed
   thus ?thesis1 "(\<And>ta. ?tso ta \<Longrightarrow> ?inv ta) \<Longrightarrow> ?thesis2" by blast+
 qed
 
 lemma step_thread_eq_None_conv:
   assumes det: "\<alpha>.deterministic I"
   and invar: "state_invar s" "state_\<alpha> s \<in> I"
   shows "step_thread update_state s t = None \<longleftrightarrow> t \<notin> \<alpha>.active_threads (state_\<alpha> s)"
 using assms step_thread_correct(1)[OF det _ invar(1), of "\<lambda>_ _. True", of id update_state t]
 by(simp add: map_option.id \<alpha>.step_thread_eq_None_conv)
 
 lemma step_thread_Some_NoneD:
   assumes det: "\<alpha>.deterministic I"
   and step: "step_thread update_state s t' = \<lfloor>(t, None, \<sigma>')\<rfloor>"
   and invar: "state_invar s" "state_\<alpha> s \<in> I"
   shows "\<exists>x ln n. thr_\<alpha> (thr s) t = \<lfloor>(x, ln)\<rfloor> \<and> ln $ n > 0 \<and> \<not> waiting (ws_\<alpha> (wset s) t) \<and> may_acquire_all (locks s) t ln \<and> \<sigma>' = update_state (K$ [], [], [], [], [], convert_RA ln)"
 using assms step_thread_correct(1)[OF det _ invar(1), of "\<lambda>_ _. True", of id update_state t']
 by(fastforce simp add: map_option.id dest: \<alpha>.step_thread_Some_NoneD[OF sym])
 
 lemma step_thread_Some_SomeD:
   assumes det: "\<alpha>.deterministic I"
   and step: "step_thread update_state s t' = \<lfloor>(t, \<lfloor>(ta, x', m')\<rfloor>, \<sigma>')\<rfloor>"
   and invar: "state_invar s" "state_\<alpha> s \<in> I"
   shows "\<exists>x. thr_\<alpha> (thr s) t = \<lfloor>(x, no_wait_locks)\<rfloor> \<and> Predicate.eval (r t (x, shr s)) (ta, x', m') \<and> actions_ok s t ta \<and> \<sigma>' = update_state ta"
 using assms step_thread_correct(1)[OF det _ invar(1), of "\<lambda>_ _. True", of id update_state t']
 by(auto simp add: map_option.id dest: \<alpha>.step_thread_Some_SomeD[OF det sym])
 
 end
 
 subsection \<open>Code Generator setup\<close>
 
 lemmas [code] =
   scheduler_base_aux.free_thread_id_def
   scheduler_base_aux.redT_updT.simps
   scheduler_base_aux.redT_updTs_def
   scheduler_base_aux.thread_ok.simps
   scheduler_base_aux.thread_oks.simps
   scheduler_base_aux.wset_actions_ok_def
   scheduler_base_aux.cond_action_ok.simps
   scheduler_base_aux.cond_action_oks_def
   scheduler_base_aux.redT_updI.simps
   scheduler_base_aux.redT_updIs.simps
   scheduler_base_aux.interrupt_action_ok.simps
   scheduler_base_aux.interrupt_actions_ok.simps
   scheduler_base_aux.actions_ok_def
   scheduler_base_aux.step_thread_def
 
 lemmas [code] =
   scheduler_base.exec_updW.simps
   scheduler_base.exec_updWs_def
   scheduler_base.exec_upd_def
   scheduler_base.execT_def
   scheduler_base.exec_step.simps
   scheduler_base.exec_aux_def
   scheduler_base.exec_def
 
 lemmas [code] =
   scheduler_ext_base.active_threads.simps
 
 lemma singleton2_code [code]:
   "singleton2 dfault (Predicate.Seq f) =
   (case f () of
     Predicate.Empty \<Rightarrow> dfault ()
   | Predicate.Insert x P \<Rightarrow> 
     if Predicate.is_empty P then x else Code.abort (STR ''singleton2 not unique'') (\<lambda>_. singleton2 dfault (Predicate.Seq f))
   | Predicate.Join P xq \<Rightarrow>
     if Predicate.is_empty P then 
       the_only2 dfault xq
     else if Predicate.null xq then singleton2 dfault P else Code.abort (STR ''singleton2 not unique'') (\<lambda>_. singleton2 dfault (Predicate.Seq f)))"
 unfolding singleton2_def the_only2_def
 by(auto simp only: singleton_code Code.abort_def split: seq.split if_split)
 
 lemma the_only2_code [code]:
   "the_only2 dfault Predicate.Empty = Code.abort (STR ''the_only2 empty'') dfault"
   "the_only2 dfault (Predicate.Insert x P) = 
   (if Predicate.is_empty P then x else Code.abort (STR ''the_only2 not unique'') (\<lambda>_. the_only2 dfault (Predicate.Insert x P)))"
   "the_only2 dfault (Predicate.Join P xq) = 
   (if Predicate.is_empty P then 
      the_only2 dfault xq
    else if Predicate.null xq then 
      singleton2 dfault P 
    else
      Code.abort (STR ''the_only2 not unique'') (\<lambda>_. the_only2 dfault (Predicate.Join P xq)))"
 unfolding singleton2_def the_only2_def by simp_all
 
 lemma the2_eq [code]:
   "the2 A = singleton2 (\<lambda>x. Code.abort (STR ''not_unique'') (\<lambda>_. the2 A)) A"
 unfolding the2_def singleton2_def by(rule the_eq)
 
 end
diff --git a/thys/JinjaThreads/Framework/Bisimulation.thy b/thys/JinjaThreads/Framework/Bisimulation.thy
--- a/thys/JinjaThreads/Framework/Bisimulation.thy
+++ b/thys/JinjaThreads/Framework/Bisimulation.thy
@@ -1,1296 +1,1296 @@
 (*  Title:      JinjaThreads/Framework/Bisimulation.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Various notions of bisimulation\<close>
 
 theory Bisimulation
 imports
   LTS
 begin
 
 type_synonym ('a, 'b) bisim = "'a \<Rightarrow> 'b \<Rightarrow> bool"
 
 subsection \<open>Strong bisimulation\<close>
 
 locale bisimulation_base = r1: trsys trsys1 + r2: trsys trsys2
   for trsys1 :: "('s1, 'tl1) trsys" ("_/ -1-_\<rightarrow>/ _" [50,0,50] 60)
   and trsys2 :: "('s2, 'tl2) trsys" ("_/ -2-_\<rightarrow>/ _" [50,0,50] 60) +
   fixes bisim :: "('s1, 's2) bisim" ("_/ \<approx> _" [50, 50] 60)
   and tlsim :: "('tl1, 'tl2) bisim" ("_/ \<sim> _" [50, 50] 60)
 begin
 
 notation
   r1.Trsys ("_/ -1-_\<rightarrow>*/ _" [50,0,50] 60) and
   r2.Trsys ("_/ -2-_\<rightarrow>*/ _" [50,0,50] 60)
 
 notation
   r1.inf_step ("_ -1-_\<rightarrow>* \<infinity>" [50, 0] 80) and
   r2.inf_step ("_ -2-_\<rightarrow>* \<infinity>" [50, 0] 80)
 
 notation
   r1.inf_step_table ("_ -1-_\<rightarrow>*t \<infinity>" [50, 0] 80) and
   r2.inf_step_table ("_ -2-_\<rightarrow>*t \<infinity>" [50, 0] 80)
 
 abbreviation Tlsim :: "('tl1 list, 'tl2 list) bisim" ("_/ [\<sim>] _" [50, 50] 60)
 where "Tlsim tl1 tl2 \<equiv> list_all2 tlsim tl1 tl2"
 
 abbreviation Tlsiml :: "('tl1 llist, 'tl2 llist) bisim" ("_/ [[\<sim>]] _" [50, 50] 60)
 where "Tlsiml tl1 tl2 \<equiv> llist_all2 tlsim tl1 tl2"
 
 end
 
 locale bisimulation = bisimulation_base +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   assumes simulation1: "\<lbrakk> s1 \<approx> s2; s1 -1-tl1\<rightarrow> s1' \<rbrakk> \<Longrightarrow> \<exists>s2' tl2. s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2"
   and simulation2: "\<lbrakk> s1 \<approx> s2; s2 -2-tl2\<rightarrow> s2' \<rbrakk> \<Longrightarrow> \<exists>s1' tl1. s1 -1-tl1\<rightarrow> s1' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2"
 begin
 
 lemma bisimulation_flip:
   "bisimulation trsys2 trsys1 (flip bisim) (flip tlsim)"
 by(unfold_locales)(unfold flip_simps,(blast intro: simulation1 simulation2)+)
 
 end
 
 lemma bisimulation_flip_simps [flip_simps]:
   "bisimulation trsys2 trsys1 (flip bisim) (flip tlsim) = bisimulation trsys1 trsys2 bisim tlsim"
 by(auto dest: bisimulation.bisimulation_flip simp only: flip_flip)
 
 context bisimulation begin
 
 lemma simulation1_rtrancl:
   "\<lbrakk>s1 -1-tls1\<rightarrow>* s1'; s1 \<approx> s2\<rbrakk>
   \<Longrightarrow> \<exists>s2' tls2. s2 -2-tls2\<rightarrow>* s2' \<and> s1' \<approx> s2' \<and> tls1 [\<sim>] tls2"
 proof(induct rule: rtrancl3p.induct)
   case rtrancl3p_refl thus ?case by(auto intro: rtrancl3p.rtrancl3p_refl)
 next
   case (rtrancl3p_step s1 tls1 s1' tl1 s1'')
   from \<open>s1 \<approx> s2 \<Longrightarrow> \<exists>s2' tls2. s2 -2-tls2\<rightarrow>* s2' \<and> s1' \<approx> s2' \<and> tls1 [\<sim>] tls2\<close> \<open>s1 \<approx> s2\<close>
   obtain s2' tls2 where "s2 -2-tls2\<rightarrow>* s2'" "s1' \<approx> s2'" "tls1 [\<sim>] tls2" by blast
   moreover from \<open>s1' -1-tl1\<rightarrow> s1''\<close> \<open>s1' \<approx> s2'\<close>
   obtain s2'' tl2 where "s2' -2-tl2\<rightarrow> s2''" "s1'' \<approx> s2''" "tl1 \<sim> tl2" by(auto dest: simulation1)
   ultimately have "s2 -2-tls2 @ [tl2]\<rightarrow>* s2''" "tls1 @ [tl1] [\<sim>] tls2 @ [tl2]"
     by(auto intro: rtrancl3p.rtrancl3p_step list_all2_appendI)
   with \<open>s1'' \<approx> s2''\<close> show ?case by(blast)
 qed
 
 lemma simulation2_rtrancl:
   "\<lbrakk>s2 -2-tls2\<rightarrow>* s2'; s1 \<approx> s2\<rbrakk>
   \<Longrightarrow> \<exists>s1' tls1. s1 -1-tls1\<rightarrow>* s1' \<and> s1' \<approx> s2' \<and> tls1 [\<sim>] tls2"
 using bisimulation.simulation1_rtrancl[OF bisimulation_flip]
 unfolding flip_simps .
 
 lemma simulation1_inf_step:
   assumes red1: "s1 -1-tls1\<rightarrow>* \<infinity>" and bisim: "s1 \<approx> s2"
   shows "\<exists>tls2. s2 -2-tls2\<rightarrow>* \<infinity> \<and> tls1 [[\<sim>]] tls2"
 proof -
   from r1.inf_step_imp_inf_step_table[OF red1]
   obtain stls1 where red1': "s1 -1-stls1\<rightarrow>*t \<infinity>" 
     and tls1: "tls1 = lmap (fst \<circ> snd) stls1" by blast
   define tl1_to_tl2 where "tl1_to_tl2 s2 stls1 = unfold_llist
      (\<lambda>(s2, stls1). lnull stls1)
      (\<lambda>(s2, stls1). let (s1, tl1, s1') = lhd stls1;
                         (tl2, s2') = SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2
                     in (s2, tl2, s2'))
      (\<lambda>(s2, stls1). let (s1, tl1, s1') = lhd stls1;
                         (tl2, s2') = SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2
                     in (s2', ltl stls1))
      (s2, stls1)"
     for s2 :: 's2 and stls1 :: "('s1 \<times> 'tl1 \<times> 's1) llist"
 
   have tl1_to_tl2_simps [simp]:
     "\<And>s2 stls1. lnull (tl1_to_tl2 s2 stls1) \<longleftrightarrow> lnull stls1"
     "\<And>s2 stls1. \<not> lnull stls1 \<Longrightarrow> lhd (tl1_to_tl2 s2 stls1) =
     (let (s1, tl1, s1') = lhd stls1;
          (tl2, s2') = SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2
      in (s2, tl2, s2'))"
     "\<And>s2 stls1. \<not> lnull stls1 \<Longrightarrow> ltl (tl1_to_tl2 s2 stls1) =
     (let (s1, tl1, s1') = lhd stls1;
          (tl2, s2') = SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2
      in tl1_to_tl2 s2' (ltl stls1))"
     "\<And>s2. tl1_to_tl2 s2 LNil = LNil"
     "\<And>s2 s1 tl1 s1' stls1'. tl1_to_tl2 s2 (LCons (s1, tl1, s1') stls1') =
         LCons (s2, SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2) 
               (tl1_to_tl2 (snd (SOME (tl2, s2'). trsys2 s2 tl2 s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2)) stls1')"
     by(simp_all add: tl1_to_tl2_def split_beta)
 
   have [simp]: "llength (tl1_to_tl2 s2 stls1) = llength stls1"
     by(coinduction arbitrary: s2 stls1 rule: enat_coinduct)(auto simp add: epred_llength split_beta)
 
   from red1' bisim have "s2 -2-tl1_to_tl2 s2 stls1\<rightarrow>*t \<infinity>"
   proof(coinduction arbitrary: s2 s1 stls1)
     case (inf_step_table s2 s1 stls1)
     note red1' = \<open>s1 -1-stls1\<rightarrow>*t \<infinity>\<close> and bisim = \<open>s1 \<approx> s2\<close>
     from red1' show ?case
     proof(cases)
       case (inf_step_tableI s1' stls1' tl1)
       hence stls1: "stls1 = LCons (s1, tl1, s1') stls1'"
         and r: "s1 -1-tl1\<rightarrow> s1'" and reds1: "s1' -1-stls1'\<rightarrow>*t \<infinity>" by simp_all
       let ?tl2s2' = "SOME (tl2, s2'). s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2"
       let ?tl2 = "fst ?tl2s2'" let ?s2' = "snd ?tl2s2'"
       from simulation1[OF bisim r] obtain s2' tl2
         where "s2 -2-tl2\<rightarrow> s2'" "s1' \<approx> s2'" "tl1 \<sim> tl2" by blast
       hence "(\<lambda>(tl2, s2'). s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2) (tl2, s2')" by simp
       hence "(\<lambda>(tl2, s2'). s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2) ?tl2s2'" by(rule someI)
       hence "s2 -2-?tl2\<rightarrow> ?s2'" "s1' \<approx> ?s2'" "tl1 \<sim> ?tl2" by(simp_all add: split_beta)
       then show ?thesis using reds1 stls1 by(fastforce intro: prod_eqI)
     qed
   qed
   hence "s2 -2-lmap (fst \<circ> snd) (tl1_to_tl2 s2 stls1)\<rightarrow>* \<infinity>"
     by(rule r2.inf_step_table_imp_inf_step)
   moreover have "tls1 [[\<sim>]] lmap (fst \<circ> snd) (tl1_to_tl2 s2 stls1)"
   proof(rule llist_all2_all_lnthI)
     show "llength tls1 = llength (lmap (fst \<circ> snd) (tl1_to_tl2 s2 stls1))"
       using tls1 by simp
   next
     fix n
     assume "enat n < llength tls1"
     thus "lnth tls1 n \<sim> lnth (lmap (fst \<circ> snd) (tl1_to_tl2 s2 stls1)) n"
       using red1' bisim unfolding tls1
     proof(induct n arbitrary: s1 s2 stls1 rule: nat_less_induct)
       case (1 n)
       hence IH: "\<And>m s1 s2 stls1. \<lbrakk> m < n; enat m < llength (lmap (fst \<circ> snd) stls1);
                                    s1 -1-stls1\<rightarrow>*t \<infinity>; s1 \<approx> s2 \<rbrakk>
                  \<Longrightarrow> lnth (lmap (fst \<circ> snd) stls1) m \<sim> lnth (lmap (fst \<circ> snd) (tl1_to_tl2 s2 stls1)) m"
         by blast
       from \<open>s1 -1-stls1\<rightarrow>*t \<infinity>\<close> show ?case
       proof cases
         case (inf_step_tableI s1' stls1' tl1)
         hence  stls1: "stls1 = LCons (s1, tl1, s1') stls1'"
           and r: "s1 -1-tl1\<rightarrow> s1'" and reds: "s1' -1-stls1'\<rightarrow>*t \<infinity>" by simp_all
         let ?tl2s2' = "SOME (tl2, s2').  s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2"
         let ?tl2 = "fst ?tl2s2'" let ?s2' = "snd ?tl2s2'"
         from simulation1[OF \<open>s1 \<approx> s2\<close> r] obtain s2' tl2
           where "s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2" by blast
         hence "(\<lambda>(tl2, s2'). s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2) (tl2, s2')" by simp
         hence "(\<lambda>(tl2, s2'). s2 -2-tl2\<rightarrow> s2' \<and> s1' \<approx> s2' \<and> tl1 \<sim> tl2) ?tl2s2'" by(rule someI)
         hence bisim': "s1' \<approx> ?s2'" and tlsim: "tl1 \<sim> ?tl2" by(simp_all add: split_beta)
         show ?thesis
         proof(cases n)
           case 0
           with stls1 tlsim show ?thesis by simp
         next
           case (Suc m)
           hence "m < n" by simp
           moreover have "enat m < llength (lmap (fst \<circ> snd) stls1')"
             using stls1 \<open>enat n < llength (lmap (fst \<circ> snd) stls1)\<close> Suc by(simp add: Suc_ile_eq)
           ultimately have "lnth (lmap (fst \<circ> snd) stls1') m \<sim> lnth (lmap (fst \<circ> snd) (tl1_to_tl2 ?s2' stls1')) m"
             using reds bisim' by(rule IH)
           with Suc stls1 show ?thesis by(simp del: o_apply)
         qed
       qed
     qed
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma simulation2_inf_step:
   "\<lbrakk> s2 -2-tls2\<rightarrow>* \<infinity>; s1 \<approx> s2 \<rbrakk> \<Longrightarrow> \<exists>tls1. s1 -1-tls1\<rightarrow>* \<infinity> \<and> tls1 [[\<sim>]] tls2"
 using bisimulation.simulation1_inf_step[OF bisimulation_flip]
 unfolding flip_simps .
 
 end
 
 locale bisimulation_final_base =
   bisimulation_base + 
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   fixes final1 :: "'s1 \<Rightarrow> bool"
   and final2 :: "'s2 \<Rightarrow> bool"
 
 locale bisimulation_final = bisimulation_final_base + bisimulation +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and final1 :: "'s1 \<Rightarrow> bool"
   and final2 :: "'s2 \<Rightarrow> bool"
   assumes bisim_final: "s1 \<approx> s2 \<Longrightarrow> final1 s1 \<longleftrightarrow> final2 s2"
 
 begin
 
 lemma bisimulation_final_flip:
   "bisimulation_final trsys2 trsys1 (flip bisim) (flip tlsim) final2 final1"
 apply(intro_locales)
 apply(rule bisimulation_flip)
 apply(unfold_locales)
 by(unfold flip_simps, rule bisim_final[symmetric])
 
 end
 
 lemma bisimulation_final_flip_simps [flip_simps]:
   "bisimulation_final trsys2 trsys1 (flip bisim) (flip tlsim) final2 final1 =
    bisimulation_final trsys1 trsys2 bisim tlsim final1 final2"
 by(auto dest: bisimulation_final.bisimulation_final_flip simp only: flip_flip)
 
 context bisimulation_final begin
 
 lemma final_simulation1:
   "\<lbrakk> s1 \<approx> s2; s1 -1-tls1\<rightarrow>* s1'; final1 s1' \<rbrakk>
   \<Longrightarrow> \<exists>s2' tls2. s2 -2-tls2\<rightarrow>* s2' \<and> s1' \<approx> s2' \<and> final2 s2' \<and> tls1 [\<sim>] tls2"
 by(auto dest: bisim_final dest!: simulation1_rtrancl)
 
 lemma final_simulation2:
   "\<lbrakk> s1 \<approx> s2; s2 -2-tls2\<rightarrow>* s2'; final2 s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1' tls1. s1 -1-tls1\<rightarrow>* s1' \<and> s1' \<approx> s2' \<and> final1 s1' \<and> tls1 [\<sim>] tls2"
 by(auto dest: bisim_final dest!: simulation2_rtrancl)
 
 end
 
 subsection \<open>Delay bisimulation\<close>
 
 locale delay_bisimulation_base =
   bisimulation_base +
   trsys1?: \<tau>trsys trsys1 \<tau>move1 +
   trsys2?: \<tau>trsys trsys2 \<tau>move2 
   for \<tau>move1 \<tau>move2 +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
 begin
 
 notation
   trsys1.silent_move ("_/ -\<tau>1\<rightarrow> _" [50, 50] 60) and
   trsys2.silent_move ("_/ -\<tau>2\<rightarrow> _" [50, 50] 60)
 
 notation
   trsys1.silent_moves ("_/ -\<tau>1\<rightarrow>* _" [50, 50] 60) and
   trsys2.silent_moves ("_/ -\<tau>2\<rightarrow>* _" [50, 50] 60)
 
 notation
   trsys1.silent_movet ("_/ -\<tau>1\<rightarrow>+ _" [50, 50] 60) and
   trsys2.silent_movet ("_/ -\<tau>2\<rightarrow>+ _" [50, 50] 60)
 
 notation
   trsys1.\<tau>rtrancl3p ("_ -\<tau>1-_\<rightarrow>* _" [50, 0, 50] 60) and
   trsys2.\<tau>rtrancl3p ("_ -\<tau>2-_\<rightarrow>* _" [50, 0, 50] 60)
 
 notation
   trsys1.\<tau>inf_step ("_ -\<tau>1-_\<rightarrow>* \<infinity>" [50, 0] 80) and
   trsys2.\<tau>inf_step ("_ -\<tau>2-_\<rightarrow>* \<infinity>" [50, 0] 80)
 
 notation
   trsys1.\<tau>diverge ("_ -\<tau>1\<rightarrow> \<infinity>" [50] 80) and
   trsys2.\<tau>diverge ("_ -\<tau>2\<rightarrow> \<infinity>" [50] 80)
 
 notation
   trsys1.\<tau>inf_step_table ("_ -\<tau>1-_\<rightarrow>*t \<infinity>" [50, 0] 80) and
   trsys2.\<tau>inf_step_table ("_ -\<tau>2-_\<rightarrow>*t \<infinity>" [50, 0] 80)
 
 notation
   trsys1.\<tau>Runs ("_ \<Down>1 _" [50, 50] 51) and
   trsys2.\<tau>Runs ("_ \<Down>2 _" [50, 50] 51)
 
 lemma simulation_silent1I':
   assumes "\<exists>s2'. (if \<mu>1 s1' s1 then trsys2.silent_moves else trsys2.silent_movet) s2 s2' \<and> s1' \<approx> s2'"
   shows "s1' \<approx> s2 \<and> \<mu>1^++ s1' s1 \<or> (\<exists>s2'. s2 -\<tau>2\<rightarrow>+ s2' \<and> s1' \<approx> s2')"
 proof -
   from assms obtain s2' where red: "(if \<mu>1 s1' s1 then trsys2.silent_moves else trsys2.silent_movet) s2 s2'" 
     and bisim: "s1' \<approx> s2'" by blast
   show ?thesis
   proof(cases "\<mu>1 s1' s1")
     case True
     with red have "s2 -\<tau>2\<rightarrow>* s2'" by simp
     thus ?thesis using bisim True by cases(blast intro: rtranclp_into_tranclp1)+
   next
     case False
     with red bisim show ?thesis by auto
   qed
 qed
 
 lemma simulation_silent2I':
   assumes "\<exists>s1'. (if \<mu>2 s2' s2 then trsys1.silent_moves else trsys1.silent_movet) s1 s1' \<and> s1' \<approx> s2'"
   shows "s1 \<approx> s2' \<and> \<mu>2^++ s2' s2 \<or> (\<exists>s1'. s1 -\<tau>1\<rightarrow>+ s1' \<and> s1' \<approx> s2')"
 using assms
 by(rule delay_bisimulation_base.simulation_silent1I')
 
 end
 
 locale delay_bisimulation_obs = delay_bisimulation_base _ _ _ _ \<tau>move1 \<tau>move2
   for \<tau>move1 :: "'s1 \<Rightarrow> 'tl1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<tau>move2 :: "'s2 \<Rightarrow> 'tl2 \<Rightarrow> 's2 \<Rightarrow> bool" +
   assumes simulation1:
   "\<lbrakk> s1 \<approx> s2; s1 -1-tl1\<rightarrow> s1'; \<not> \<tau>move1 s1 tl1 s1' \<rbrakk>
   \<Longrightarrow> \<exists>s2' s2'' tl2. s2 -\<tau>2\<rightarrow>* s2' \<and> s2' -2-tl2\<rightarrow> s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and> s1' \<approx> s2'' \<and> tl1 \<sim> tl2"
   and simulation2:
   "\<lbrakk> s1 \<approx> s2; s2 -2-tl2\<rightarrow> s2'; \<not> \<tau>move2 s2 tl2 s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1' s1'' tl1. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' -1-tl1\<rightarrow> s1'' \<and> \<not> \<tau>move1 s1' tl1 s1'' \<and> s1'' \<approx> s2' \<and> tl1 \<sim> tl2"
 begin
 
 lemma delay_bisimulation_obs_flip: "delay_bisimulation_obs trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1"
 apply(unfold_locales)
 apply(unfold flip_simps)
 by(blast intro: simulation1 simulation2)+
 
 end
 
 lemma delay_bisimulation_obs_flip_simps [flip_simps]:
   "delay_bisimulation_obs trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 =
    delay_bisimulation_obs trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 by(auto dest: delay_bisimulation_obs.delay_bisimulation_obs_flip simp only: flip_flip)
 
 locale delay_bisimulation_diverge = delay_bisimulation_obs _ _ _ _ \<tau>move1 \<tau>move2
   for \<tau>move1 :: "'s1 \<Rightarrow> 'tl1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<tau>move2 :: "'s2 \<Rightarrow> 'tl2 \<Rightarrow> 's2 \<Rightarrow> bool" +
   assumes simulation_silent1:
   "\<lbrakk> s1 \<approx> s2; s1 -\<tau>1\<rightarrow> s1' \<rbrakk> \<Longrightarrow> \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s1' \<approx> s2'"
   and simulation_silent2:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2\<rightarrow> s2' \<rbrakk> \<Longrightarrow> \<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' \<approx> s2'"
   and \<tau>diverge_bisim_inv: "s1 \<approx> s2 \<Longrightarrow> s1 -\<tau>1\<rightarrow> \<infinity> \<longleftrightarrow> s2 -\<tau>2\<rightarrow> \<infinity>"
 begin
 
 lemma delay_bisimulation_diverge_flip: "delay_bisimulation_diverge trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1"
 apply(rule delay_bisimulation_diverge.intro)
  apply(rule delay_bisimulation_obs_flip)
 apply(unfold_locales)
 apply(unfold flip_simps)
 by(blast intro: simulation_silent1 simulation_silent2 \<tau>diverge_bisim_inv[symmetric] del: iffI)+
 
 end
 
 
 lemma delay_bisimulation_diverge_flip_simps [flip_simps]:
   "delay_bisimulation_diverge trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 =
    delay_bisimulation_diverge trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 by(auto dest: delay_bisimulation_diverge.delay_bisimulation_diverge_flip simp only: flip_flip)
 
 context delay_bisimulation_diverge begin
 
 lemma simulation_silents1:
   assumes bisim: "s1 \<approx> s2" and moves: "s1 -\<tau>1\<rightarrow>* s1'"
   shows "\<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s1' \<approx> s2'"
 using moves bisim
 proof induct
   case base thus ?case by(blast)
 next
   case (step s1' s1'')
   from \<open>s1 \<approx> s2 \<Longrightarrow> \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s1' \<approx> s2'\<close> \<open>s1 \<approx> s2\<close>
   obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" "s1' \<approx> s2'" by blast
   from simulation_silent1[OF \<open>s1' \<approx> s2'\<close> \<open>s1' -\<tau>1\<rightarrow> s1''\<close>]
   obtain s2'' where "s2' -\<tau>2\<rightarrow>* s2''" "s1'' \<approx> s2''" by blast
   from \<open>s2 -\<tau>2\<rightarrow>* s2'\<close> \<open>s2' -\<tau>2\<rightarrow>* s2''\<close> have "s2 -\<tau>2\<rightarrow>* s2''" by(rule rtranclp_trans)
   with \<open>s1'' \<approx> s2''\<close> show ?case by blast
 qed
 
 lemma simulation_silents2:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2\<rightarrow>* s2' \<rbrakk> \<Longrightarrow> \<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' \<approx> s2'"
 using delay_bisimulation_diverge.simulation_silents1[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 lemma simulation1_\<tau>rtrancl3p:
   "\<lbrakk> s1 -\<tau>1-tls1\<rightarrow>* s1'; s1 \<approx> s2 \<rbrakk>
   \<Longrightarrow> \<exists>tls2 s2'. s2 -\<tau>2-tls2\<rightarrow>* s2' \<and> s1' \<approx> s2' \<and> tls1 [\<sim>] tls2"
 proof(induct arbitrary: s2 rule: trsys1.\<tau>rtrancl3p.induct)
   case (\<tau>rtrancl3p_refl s)
   thus ?case by(auto intro: \<tau>trsys.\<tau>rtrancl3p.intros)
 next
   case (\<tau>rtrancl3p_step s1 s1' tls1 s1'' tl1)
   from simulation1[OF \<open>s1 \<approx> s2\<close> \<open>s1 -1-tl1\<rightarrow> s1'\<close> \<open>\<not> \<tau>move1 s1 tl1 s1'\<close>]
   obtain s2' s2'' tl2 where \<tau>red: "s2 -\<tau>2\<rightarrow>* s2'"
     and red: "s2' -2-tl2\<rightarrow> s2''" and n\<tau>: "\<not> \<tau>move2 s2' tl2 s2''"
     and bisim': "s1' \<approx> s2''" and tlsim: "tl1 \<sim> tl2" by blast
   from bisim' \<open>s1' \<approx> s2'' \<Longrightarrow> \<exists>tls2 s2'. s2'' -\<tau>2-tls2\<rightarrow>* s2' \<and> s1'' \<approx> s2' \<and> tls1 [\<sim>] tls2\<close>
   obtain tls2 s2''' where IH: "s2'' -\<tau>2-tls2\<rightarrow>* s2'''" "s1'' \<approx> s2'''" "tls1 [\<sim>] tls2" by blast
   from \<tau>red have "s2 -\<tau>2-[]\<rightarrow>* s2'" by(rule trsys2.silent_moves_into_\<tau>rtrancl3p)
   also from red n\<tau> IH(1) have "s2' -\<tau>2-tl2 # tls2\<rightarrow>* s2'''" by(rule \<tau>rtrancl3p.\<tau>rtrancl3p_step)
   finally show ?case using IH tlsim by fastforce
 next
   case (\<tau>rtrancl3p_\<tau>step s1 s1' tls1 s1'' tl1)
   from \<open>s1 -1-tl1\<rightarrow> s1'\<close> \<open>\<tau>move1 s1 tl1 s1'\<close> have "s1 -\<tau>1\<rightarrow> s1'" .. 
   from simulation_silent1[OF \<open>s1 \<approx> s2\<close> this]
   obtain s2' where \<tau>red: "s2 -\<tau>2\<rightarrow>* s2'" and bisim': "s1' \<approx> s2'" by blast
   from \<tau>red have "s2 -\<tau>2-[]\<rightarrow>* s2'" by(rule trsys2.silent_moves_into_\<tau>rtrancl3p)
   also from bisim' \<open>s1' \<approx> s2' \<Longrightarrow> \<exists>tls2 s2''. s2' -\<tau>2-tls2\<rightarrow>* s2'' \<and> s1'' \<approx> s2'' \<and> tls1 [\<sim>] tls2\<close>
   obtain tls2 s2'' where IH: "s2' -\<tau>2-tls2\<rightarrow>* s2''" "s1'' \<approx> s2''" "tls1 [\<sim>] tls2" by blast
   note \<open>s2' -\<tau>2-tls2\<rightarrow>* s2''\<close>
   finally show ?case using IH by auto
 qed
 
 lemma simulation2_\<tau>rtrancl3p:
   "\<lbrakk> s2 -\<tau>2-tls2\<rightarrow>* s2'; s1 \<approx> s2 \<rbrakk>
   \<Longrightarrow> \<exists>tls1 s1'. s1 -\<tau>1-tls1\<rightarrow>* s1' \<and> s1' \<approx> s2' \<and> tls1 [\<sim>] tls2"
 using delay_bisimulation_diverge.simulation1_\<tau>rtrancl3p[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 lemma simulation1_\<tau>inf_step:
   assumes \<tau>inf1: "s1 -\<tau>1-tls1\<rightarrow>* \<infinity>" and bisim: "s1 \<approx> s2"
   shows "\<exists>tls2. s2 -\<tau>2-tls2\<rightarrow>* \<infinity> \<and> tls1 [[\<sim>]] tls2"
 proof -
   from trsys1.\<tau>inf_step_imp_\<tau>inf_step_table[OF \<tau>inf1]
   obtain sstls1 where \<tau>inf1': "s1 -\<tau>1-sstls1\<rightarrow>*t \<infinity>" 
     and tls1: "tls1 = lmap (fst \<circ> snd \<circ> snd) sstls1" by blast
   define tl1_to_tl2 where "tl1_to_tl2 s2 sstls1 = unfold_llist
      (\<lambda>(s2, sstls1). lnull sstls1)
      (\<lambda>(s2, sstls1).
         let (s1, s1', tl1, s1'') = lhd sstls1;
             (s2', tl2, s2'') = SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and>
                                      \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2
         in (s2, s2', tl2, s2''))
      (\<lambda>(s2, sstls1). 
         let (s1, s1', tl1, s1'') = lhd sstls1;
             (s2', tl2, s2'') = SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and>
                                      \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2
         in (s2'', ltl sstls1))
      (s2, sstls1)"
     for s2 :: 's2 and sstls1 :: "('s1 \<times> 's1 \<times> 'tl1 \<times> 's1) llist"
   have [simp]:
     "\<And>s2 sstls1. lnull (tl1_to_tl2 s2 sstls1) \<longleftrightarrow> lnull sstls1"
     "\<And>s2 sstls1. \<not> lnull sstls1 \<Longrightarrow> lhd (tl1_to_tl2 s2 sstls1) =
         (let (s1, s1', tl1, s1'') = lhd sstls1;
             (s2', tl2, s2'') = SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and>
                                      \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2
         in (s2, s2', tl2, s2''))"
     "\<And>s2 sstls1. \<not> lnull sstls1 \<Longrightarrow> ltl (tl1_to_tl2 s2 sstls1) =
         (let (s1, s1', tl1, s1'') = lhd sstls1;
             (s2', tl2, s2'') = SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and>
                                      \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2
         in tl1_to_tl2 s2'' (ltl sstls1))"
     "\<And>s2. tl1_to_tl2 s2 LNil = LNil"
     "\<And>s2 s1 s1' tl1 s1'' stls1'. tl1_to_tl2 s2 (LCons (s1, s1', tl1, s1'') stls1') =
         LCons (s2, SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and> 
                                           \<not> \<tau>move2 s2' tl2 s2'' \<and> s1'' \<approx> s2'' \<and> tl1 \<sim> tl2) 
               (tl1_to_tl2 (snd (snd (SOME (s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and>
                                                             \<not> \<tau>move2 s2' tl2 s2'' \<and> s1'' \<approx> s2'' \<and> tl1 \<sim> tl2)))
                            stls1')"
     by(simp_all add: tl1_to_tl2_def split_beta)
 
   have [simp]: "llength (tl1_to_tl2 s2 sstls1) = llength sstls1"
     by(coinduction arbitrary: s2 sstls1 rule: enat_coinduct)(auto simp add: epred_llength split_beta)
 
   define sstls2 where "sstls2 = tl1_to_tl2 s2 sstls1"
   with \<tau>inf1' bisim have "\<exists>s1 sstls1. s1 -\<tau>1-sstls1\<rightarrow>*t \<infinity> \<and> sstls2 = tl1_to_tl2 s2 sstls1 \<and> s1 \<approx> s2" by blast
 
   from \<tau>inf1' bisim have "s2 -\<tau>2-tl1_to_tl2 s2 sstls1\<rightarrow>*t \<infinity>"
   proof(coinduction arbitrary: s2 s1 sstls1)
     case (\<tau>inf_step_table s2 s1 sstls1)
     note \<tau>inf' = \<open>s1 -\<tau>1-sstls1\<rightarrow>*t \<infinity>\<close> and bisim = \<open>s1 \<approx> s2\<close>
     from \<tau>inf' show ?case
     proof(cases)
       case (\<tau>inf_step_table_Cons s1' s1'' sstls1' tl1)
       hence sstls1: "sstls1 = LCons (s1, s1', tl1, s1'') sstls1'"
         and \<tau>s: "s1 -\<tau>1\<rightarrow>* s1'" and r: "s1' -1-tl1\<rightarrow> s1''" and n\<tau>: "\<not> \<tau>move1 s1' tl1 s1''"
         and reds1: "s1'' -\<tau>1-sstls1'\<rightarrow>*t \<infinity>" by simp_all
       let ?P = "\<lambda>(s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2"
       let ?s2tl2s2' = "Eps ?P"
       let ?s2'' = "snd (snd ?s2tl2s2')"
       from simulation_silents1[OF \<open>s1 \<approx> s2\<close> \<tau>s]
       obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" "s1' \<approx> s2'" by blast
       from simulation1[OF \<open>s1' \<approx> s2'\<close> r n\<tau>] obtain s2'' s2''' tl2
         where "s2' -\<tau>2\<rightarrow>* s2''" 
         and rest: "s2'' -2-tl2\<rightarrow> s2'''" "\<not> \<tau>move2 s2'' tl2 s2'''" "s1'' \<approx> s2'''" "tl1 \<sim> tl2" by blast
       from \<open>s2 -\<tau>2\<rightarrow>* s2'\<close> \<open>s2' -\<tau>2\<rightarrow>* s2''\<close> have "s2 -\<tau>2\<rightarrow>* s2''" by(rule rtranclp_trans)
       with rest have "?P (s2'', tl2, s2''')" by simp
       hence "?P ?s2tl2s2'" by(rule someI)
       then show ?thesis using reds1 sstls1 by fastforce
     next
       case \<tau>inf_step_table_Nil
       hence [simp]: "sstls1 = LNil" and "s1 -\<tau>1\<rightarrow> \<infinity>" by simp_all
       from \<open>s1 -\<tau>1\<rightarrow> \<infinity>\<close> \<open>s1 \<approx> s2\<close> have "s2 -\<tau>2\<rightarrow> \<infinity>" by(simp add: \<tau>diverge_bisim_inv)
       thus ?thesis using sstls2_def by simp
     qed
   qed
   hence "s2 -\<tau>2-lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 s2 sstls1)\<rightarrow>* \<infinity>"
     by(rule trsys2.\<tau>inf_step_table_into_\<tau>inf_step)
   moreover have "tls1 [[\<sim>]] lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 s2 sstls1)"
   proof(rule llist_all2_all_lnthI)
     show "llength tls1 = llength (lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 s2 sstls1))"
       using tls1 by simp
   next
     fix n
     assume "enat n < llength tls1"
     thus "lnth tls1 n \<sim> lnth (lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 s2 sstls1)) n"
       using \<tau>inf1' bisim unfolding tls1
     proof(induct n arbitrary: s1 s2 sstls1 rule: less_induct)
       case (less n)
       note IH = \<open>\<And>m s1 s2 sstls1. \<lbrakk> m < n; enat m < llength (lmap (fst \<circ> snd \<circ> snd) sstls1);
                                    s1 -\<tau>1-sstls1\<rightarrow>*t \<infinity>; s1 \<approx> s2 \<rbrakk>
                  \<Longrightarrow> lnth (lmap (fst \<circ> snd \<circ> snd) sstls1) m \<sim> lnth (lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 s2 sstls1)) m\<close>
       from \<open>s1 -\<tau>1-sstls1\<rightarrow>*t \<infinity>\<close> show ?case
       proof cases
         case (\<tau>inf_step_table_Cons s1' s1'' sstls1' tl1)
         hence sstls1: "sstls1 = LCons (s1, s1', tl1, s1'') sstls1'"
           and \<tau>s: "s1 -\<tau>1\<rightarrow>* s1'" and r: "s1' -1-tl1\<rightarrow> s1''"
           and n\<tau>: "\<not> \<tau>move1 s1' tl1 s1''" and reds: "s1'' -\<tau>1-sstls1'\<rightarrow>*t \<infinity>" by simp_all
         let ?P = "\<lambda>(s2', tl2, s2''). s2 -\<tau>2\<rightarrow>* s2' \<and> trsys2 s2' tl2 s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and>  s1'' \<approx> s2'' \<and> tl1 \<sim> tl2"
         let ?s2tl2s2' = "Eps ?P" let ?tl2 = "fst (snd ?s2tl2s2')" let ?s2'' = "snd (snd ?s2tl2s2')"
         from simulation_silents1[OF \<open>s1 \<approx> s2\<close> \<tau>s] obtain s2'
           where "s2 -\<tau>2\<rightarrow>* s2'" "s1' \<approx> s2'" by blast
         from simulation1[OF \<open>s1' \<approx> s2'\<close> r n\<tau>] obtain s2'' s2''' tl2
           where "s2' -\<tau>2\<rightarrow>* s2''"
           and rest: "s2'' -2-tl2\<rightarrow> s2'''" "\<not> \<tau>move2 s2'' tl2 s2'''" "s1'' \<approx> s2'''" "tl1 \<sim> tl2" by blast
         from \<open>s2 -\<tau>2\<rightarrow>* s2'\<close> \<open>s2' -\<tau>2\<rightarrow>* s2''\<close> have "s2 -\<tau>2\<rightarrow>* s2''" by(rule rtranclp_trans)
         with rest have "?P (s2'', tl2, s2''')" by auto
         hence "?P ?s2tl2s2'" by(rule someI)
         hence "s1'' \<approx> ?s2''" "tl1 \<sim> ?tl2" by(simp_all add: split_beta)
         show ?thesis
         proof(cases n)
           case 0
           with sstls1 \<open>tl1 \<sim> ?tl2\<close> show ?thesis by simp
         next
           case (Suc m)
           hence "m < n" by simp
           moreover have "enat m < llength (lmap (fst \<circ> snd \<circ> snd) sstls1')"
             using sstls1 \<open>enat n < llength (lmap (fst \<circ> snd \<circ> snd) sstls1)\<close> Suc by(simp add: Suc_ile_eq)
           ultimately have "lnth (lmap (fst \<circ> snd \<circ> snd) sstls1') m \<sim> lnth (lmap (fst \<circ> snd \<circ> snd) (tl1_to_tl2 ?s2'' sstls1')) m"
             using reds \<open>s1'' \<approx> ?s2''\<close> by(rule IH)
           with Suc sstls1 show ?thesis by(simp del: o_apply)
         qed
       next
         case \<tau>inf_step_table_Nil
         with \<open>enat n < llength (lmap (fst \<circ> snd \<circ> snd) sstls1)\<close> have False by simp
         thus ?thesis ..
       qed
     qed
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma simulation2_\<tau>inf_step:
   "\<lbrakk> s2 -\<tau>2-tls2\<rightarrow>* \<infinity>; s1 \<approx> s2 \<rbrakk> \<Longrightarrow> \<exists>tls1. s1 -\<tau>1-tls1\<rightarrow>* \<infinity> \<and> tls1 [[\<sim>]] tls2"
 using delay_bisimulation_diverge.simulation1_\<tau>inf_step[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 lemma no_\<tau>move1_\<tau>s_to_no_\<tau>move2:
   assumes "s1 \<approx> s2"
   and no_\<tau>moves1: "\<And>s1'. \<not> s1 -\<tau>1\<rightarrow> s1'"
   shows "\<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>s2''. \<not> s2' -\<tau>2\<rightarrow> s2'') \<and> s1 \<approx> s2'"
 proof -
   have "\<not> s1 -\<tau>1\<rightarrow> \<infinity>"
   proof
     assume "s1 -\<tau>1\<rightarrow> \<infinity>"
     then obtain s1' where "s1 -\<tau>1\<rightarrow> s1'" by cases
     with no_\<tau>moves1[of s1'] show False by contradiction
   qed
   with \<open>s1 \<approx> s2\<close> have "\<not> s2 -\<tau>2\<rightarrow> \<infinity>" by(simp add: \<tau>diverge_bisim_inv)
   from trsys2.not_\<tau>diverge_to_no_\<tau>move[OF this]
   obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "\<And>s2''. \<not> s2' -\<tau>2\<rightarrow> s2''" by blast
   moreover from simulation_silents2[OF \<open>s1 \<approx> s2\<close> \<open>s2 -\<tau>2\<rightarrow>* s2'\<close>]
   obtain s1' where "s1 -\<tau>1\<rightarrow>* s1'" and "s1' \<approx> s2'" by blast
   from \<open>s1 -\<tau>1\<rightarrow>* s1'\<close> no_\<tau>moves1 have "s1' = s1"
     by(auto elim: converse_rtranclpE)
   ultimately show ?thesis using \<open>s1' \<approx> s2'\<close> by blast
 qed
 
 lemma no_\<tau>move2_\<tau>s_to_no_\<tau>move1:
   "\<lbrakk> s1 \<approx> s2; \<And>s2'. \<not> s2 -\<tau>2\<rightarrow> s2' \<rbrakk> \<Longrightarrow> \<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> (\<forall>s1''. \<not> s1' -\<tau>1\<rightarrow> s1'') \<and> s1' \<approx> s2"
 using delay_bisimulation_diverge.no_\<tau>move1_\<tau>s_to_no_\<tau>move2[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 lemma no_move1_to_no_move2:
   assumes "s1 \<approx> s2"
   and no_moves1: "\<And>tl1 s1'. \<not> s1 -1-tl1\<rightarrow> s1'"
   shows "\<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl2 s2''. \<not> s2' -2-tl2\<rightarrow> s2'') \<and> s1 \<approx> s2'"
 proof -
   from no_moves1 have "\<And>s1'. \<not> s1 -\<tau>1\<rightarrow> s1'" by(auto)
   from no_\<tau>move1_\<tau>s_to_no_\<tau>move2[OF \<open>s1 \<approx> s2\<close> this]
   obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "s1 \<approx> s2'" 
     and no_\<tau>moves2: "\<And>s2''. \<not> s2' -\<tau>2\<rightarrow> s2''" by blast
   moreover
   have "\<And>tl2 s2''. \<not> s2' -2-tl2\<rightarrow> s2''"
   proof
     fix tl2 s2''
     assume "s2' -2-tl2\<rightarrow> s2''"
     with no_\<tau>moves2[of s2''] have "\<not> \<tau>move2 s2' tl2 s2''" by(auto)
     from simulation2[OF \<open>s1 \<approx> s2'\<close> \<open>s2' -2-tl2\<rightarrow> s2''\<close> this]
     obtain s1' s1'' tl1 where "s1 -\<tau>1\<rightarrow>* s1'" and "s1' -1-tl1\<rightarrow> s1''" by blast
     with no_moves1 show False by(fastforce elim: converse_rtranclpE)
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma no_move2_to_no_move1:
   "\<lbrakk> s1 \<approx> s2; \<And>tl2 s2'. \<not> s2 -2-tl2\<rightarrow> s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> (\<forall>tl1 s1''. \<not> s1' -1-tl1\<rightarrow> s1'') \<and> s1' \<approx> s2"
 using delay_bisimulation_diverge.no_move1_to_no_move2[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 lemma simulation_\<tau>Runs_table1:
   assumes bisim: "s1 \<approx> s2"
   and run1: "trsys1.\<tau>Runs_table s1 stlsss1"
   shows "\<exists>stlsss2. trsys2.\<tau>Runs_table s2 stlsss2 \<and> tllist_all2 (\<lambda>(tl1, s1'') (tl2, s2''). tl1 \<sim> tl2 \<and> s1'' \<approx> s2'') (rel_option bisim) stlsss1 stlsss2"
 proof(intro exI conjI)
   let ?P = "\<lambda>(s2 :: 's2) (stlsss1 :: ('tl1 \<times> 's1, 's1 option) tllist) (tl2, s2'').
     \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s2' -2-tl2\<rightarrow> s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and> snd (thd stlsss1) \<approx> s2'' \<and> fst (thd stlsss1) \<sim> tl2"
   define tls1_to_tls2 where "tls1_to_tls2 s2 stlsss1 = unfold_tllist
       (\<lambda>(s2, stlsss1). is_TNil stlsss1)
       (\<lambda>(s2, stlsss1). map_option (\<lambda>s1'. SOME s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl s2''. \<not> s2' -2-tl\<rightarrow> s2'') \<and> s1' \<approx> s2') (terminal stlsss1))
       (\<lambda>(s2, stlsss1). let (tl2, s2'') = Eps (?P s2 stlsss1) in (tl2, s2''))
       (\<lambda>(s2, stlsss1). let (tl2, s2'') = Eps (?P s2 stlsss1) in (s2'', ttl stlsss1))
       (s2, stlsss1)"
     for s2 stlsss1
   have [simp]:
     "\<And>s2 stlsss1. is_TNil (tls1_to_tls2 s2 stlsss1) \<longleftrightarrow> is_TNil stlsss1"
     "\<And>s2 stlsss1. is_TNil stlsss1 \<Longrightarrow> terminal (tls1_to_tls2 s2 stlsss1) = map_option (\<lambda>s1'. SOME s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl s2''. \<not> s2' -2-tl\<rightarrow> s2'') \<and> s1' \<approx> s2') (terminal stlsss1)"
     "\<And>s2 stlsss1. \<not> is_TNil stlsss1 \<Longrightarrow> thd (tls1_to_tls2 s2 stlsss1) = (let (tl2, s2'') = Eps (?P s2 stlsss1) in (tl2, s2''))"
     "\<And>s2 stlsss1. \<not> is_TNil stlsss1 \<Longrightarrow> ttl (tls1_to_tls2 s2 stlsss1) = (let (tl2, s2'') = Eps (?P s2 stlsss1) in tls1_to_tls2 s2'' (ttl stlsss1))"
     "\<And>s2 os1. tls1_to_tls2 s2 (TNil os1) = 
                TNil (map_option (\<lambda>s1'. SOME s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl s2''. \<not> s2' -2-tl\<rightarrow> s2'') \<and> s1' \<approx> s2') os1)"
     by(simp_all add: tls1_to_tls2_def split_beta)
   have [simp]:
     "\<And>s2 s1 s1' tl1 s1'' stlsss1. 
      tls1_to_tls2 s2 (TCons (tl1, s1'') stlsss1) =
      (let (tl2, s2'') = SOME (tl2, s2''). \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s2' -2-tl2\<rightarrow> s2'' \<and> 
                              \<not> \<tau>move2 s2' tl2 s2'' \<and> s1'' \<approx> s2'' \<and> tl1 \<sim> tl2
       in TCons (tl2, s2'') (tls1_to_tls2 s2'' stlsss1))"
     by(rule tllist.expand)(simp_all add: split_beta)
 
   from bisim run1
   show "trsys2.\<tau>Runs_table s2 (tls1_to_tls2 s2 stlsss1)"
   proof(coinduction arbitrary: s2 s1 stlsss1)
     case (\<tau>Runs_table s2 s1 stlsss1)
     note bisim = \<open>s1 \<approx> s2\<close>
       and run1 = \<open>trsys1.\<tau>Runs_table s1 stlsss1\<close>
     from run1 show ?case
     proof cases
       case (Terminate s1')
       let ?P = "\<lambda>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl2 s2''. \<not> s2' -2-tl2\<rightarrow> s2'') \<and> s1' \<approx> s2'"
       from simulation_silents1[OF bisim \<open>s1 -\<tau>1\<rightarrow>* s1'\<close>]
       obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "s1' \<approx> s2'" by blast
       moreover from no_move1_to_no_move2[OF \<open>s1' \<approx> s2'\<close> \<open>\<And>tl1 s1''. \<not> s1' -1-tl1\<rightarrow> s1''\<close>]
       obtain s2'' where "s2' -\<tau>2\<rightarrow>* s2''" and "s1' \<approx> s2''" 
         and "\<And>tl2 s2'''. \<not> s2'' -2-tl2\<rightarrow> s2'''" by blast
       ultimately have "?P s2''" by(blast intro: rtranclp_trans)
       hence "?P (Eps ?P)" by(rule someI)
       hence ?Terminate using \<open>stlsss1 = TNil \<lfloor>s1'\<rfloor>\<close> by simp
       thus ?thesis ..
     next
       case Diverge
       with \<tau>diverge_bisim_inv[OF bisim]
       have ?Diverge by simp
       thus ?thesis by simp
     next
       case (Proceed s1' s1'' stlsss1' tl1)
       let ?P = "\<lambda>(tl2, s2''). \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s2' -2-tl2\<rightarrow> s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and> s1'' \<approx> s2'' \<and> tl1 \<sim> tl2"
       from simulation_silents1[OF bisim \<open>s1 -\<tau>1\<rightarrow>* s1'\<close>]
       obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "s1' \<approx> s2'" by blast
       moreover from simulation1[OF \<open>s1' \<approx> s2'\<close> \<open>s1' -1-tl1\<rightarrow> s1''\<close> \<open>\<not> \<tau>move1 s1' tl1 s1''\<close>]
       obtain s2'' s2''' tl2 where "s2' -\<tau>2\<rightarrow>* s2''"
         and "s2'' -2-tl2\<rightarrow> s2'''" and "\<not> \<tau>move2 s2'' tl2 s2'''"
         and "s1'' \<approx> s2'''" and "tl1 \<sim> tl2" by blast
       ultimately have "?P (tl2, s2''')" by(blast intro: rtranclp_trans)
       hence "?P (Eps ?P)" by(rule someI)
       hence ?Proceed 
         using \<open>stlsss1 = TCons (tl1, s1'') stlsss1'\<close> \<open>trsys1.\<tau>Runs_table s1'' stlsss1'\<close>
         by auto blast
       thus ?thesis by simp
     qed
   qed
 
   let ?Tlsim = "\<lambda>(tl1, s1'') (tl2, s2''). tl1 \<sim> tl2 \<and> s1'' \<approx> s2''"
   let ?Bisim = "rel_option bisim"
   from run1 bisim
   show "tllist_all2 ?Tlsim ?Bisim stlsss1 (tls1_to_tls2 s2 stlsss1)"
   proof(coinduction arbitrary: s1 s2 stlsss1)
     case (tllist_all2 s1 s2 stlsss1)
     note Runs = \<open>trsys1.\<tau>Runs_table s1 stlsss1\<close> and bisim = \<open>s1 \<approx> s2\<close>
     from Runs show ?case
     proof cases
       case (Terminate s1')
       let ?P = "\<lambda>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> (\<forall>tl2 s2''. \<not> s2' -2-tl2\<rightarrow> s2'') \<and> s1' \<approx> s2'"
       from simulation_silents1[OF bisim \<open>s1 -\<tau>1\<rightarrow>* s1'\<close>]
       obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "s1' \<approx> s2'" by blast
       moreover
       from no_move1_to_no_move2[OF \<open>s1' \<approx> s2'\<close> \<open>\<And>tl1 s1''. \<not> s1' -1-tl1\<rightarrow> s1''\<close>]
       obtain s2'' where "s2' -\<tau>2\<rightarrow>* s2''" and "s1' \<approx> s2''"
         and "\<And>tl2 s2'''. \<not> s2'' -2-tl2\<rightarrow> s2'''" by blast
       ultimately have "?P s2''" by(blast intro: rtranclp_trans)
       hence "?P (Eps ?P)" by(rule someI)
       thus ?thesis using \<open>stlsss1 = TNil \<lfloor>s1'\<rfloor>\<close> bisim by(simp)
     next
       case (Proceed s1' s1'' stlsss1' tl1)
       from simulation_silents1[OF bisim \<open>s1 -\<tau>1\<rightarrow>* s1'\<close>]
       obtain s2' where "s2 -\<tau>2\<rightarrow>* s2'" and "s1' \<approx> s2'" by blast
       moreover from simulation1[OF \<open>s1' \<approx> s2'\<close> \<open>s1' -1-tl1\<rightarrow> s1''\<close> \<open>\<not> \<tau>move1 s1' tl1 s1''\<close>]
       obtain s2'' s2''' tl2 where "s2' -\<tau>2\<rightarrow>* s2''"
         and "s2'' -2-tl2\<rightarrow> s2'''" and "\<not> \<tau>move2 s2'' tl2 s2'''"
         and "s1'' \<approx> s2'''" and "tl1 \<sim> tl2" by blast
       ultimately have "?P s2 stlsss1 (tl2, s2''')"
         using \<open>stlsss1 = TCons (tl1, s1'') stlsss1'\<close> by(auto intro: rtranclp_trans)
       hence "?P s2 stlsss1 (Eps (?P s2 stlsss1))" by(rule someI)
       thus ?thesis using \<open>stlsss1 = TCons (tl1, s1'') stlsss1'\<close> \<open>trsys1.\<tau>Runs_table s1'' stlsss1'\<close> bisim
         by auto blast
     qed simp
   qed
 qed
 
 lemma simulation_\<tau>Runs_table2:
   assumes "s1 \<approx> s2"
   and "trsys2.\<tau>Runs_table s2 stlsss2"
   shows "\<exists>stlsss1. trsys1.\<tau>Runs_table s1 stlsss1 \<and> tllist_all2 (\<lambda>(tl1, s1'') (tl2, s2''). tl1 \<sim> tl2 \<and> s1'' \<approx> s2'') (rel_option bisim) stlsss1 stlsss2"
 using delay_bisimulation_diverge.simulation_\<tau>Runs_table1[OF delay_bisimulation_diverge_flip, unfolded flip_simps, OF assms]
 by(subst tllist_all2_flip[symmetric])(simp only: flip_def split_def)
 
 lemma simulation_\<tau>Runs1:
   assumes bisim: "s1 \<approx> s2"
   and run1: "s1 \<Down>1 tls1"
   shows "\<exists>tls2. s2 \<Down>2 tls2 \<and> tllist_all2 tlsim (rel_option bisim) tls1 tls2"
 proof -
   from trsys1.\<tau>Runs_into_\<tau>Runs_table[OF run1]
   obtain stlsss1 where tls1: "tls1 = tmap fst id stlsss1"
     and \<tau>Runs1: "trsys1.\<tau>Runs_table s1 stlsss1" by blast
   from simulation_\<tau>Runs_table1[OF bisim \<tau>Runs1]
   obtain stlsss2 where \<tau>Runs2: "trsys2.\<tau>Runs_table s2 stlsss2"
     and tlsim: "tllist_all2 (\<lambda>(tl1, s1'') (tl2, s2''). tl1 \<sim> tl2 \<and> s1'' \<approx> s2'')
                             (rel_option bisim) stlsss1 stlsss2" by blast
   from \<tau>Runs2 have "s2 \<Down>2 tmap fst id stlsss2"
     by(rule \<tau>Runs_table_into_\<tau>Runs)
   moreover have "tllist_all2 tlsim (rel_option bisim) tls1 (tmap fst id stlsss2)"
     using tlsim unfolding tls1
     by(fastforce simp add: tllist_all2_tmap1 tllist_all2_tmap2 elim: tllist_all2_mono rel_option_mono)
   ultimately show ?thesis by blast
 qed
 
 lemma simulation_\<tau>Runs2:
   "\<lbrakk> s1 \<approx> s2; s2 \<Down>2 tls2 \<rbrakk>
   \<Longrightarrow> \<exists>tls1. s1 \<Down>1 tls1 \<and> tllist_all2 tlsim (rel_option bisim) tls1 tls2"
 using delay_bisimulation_diverge.simulation_\<tau>Runs1[OF delay_bisimulation_diverge_flip]
 unfolding flip_simps .
 
 end
 
 locale delay_bisimulation_final_base =
   delay_bisimulation_base _ _ _ _ \<tau>move1 \<tau>move2 +
   bisimulation_final_base _ _ _ _ final1 final2 
   for \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
   and final1 :: "'s1 \<Rightarrow> bool"
   and final2 :: "'s2 \<Rightarrow> bool" +
   assumes final1_simulation: "\<lbrakk> s1 \<approx> s2; final1 s1 \<rbrakk> \<Longrightarrow> \<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s1 \<approx> s2' \<and> final2 s2'"
   and final2_simulation: "\<lbrakk> s1 \<approx> s2; final2 s2 \<rbrakk> \<Longrightarrow> \<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' \<approx> s2 \<and> final1 s1'"
 begin
 
 lemma delay_bisimulation_final_base_flip:
   "delay_bisimulation_final_base trsys2 trsys1 (flip bisim) \<tau>move2 \<tau>move1 final2 final1"
 apply(unfold_locales)
 apply(unfold flip_simps)
 by(blast intro: final1_simulation final2_simulation)+
 
 end
 
 lemma delay_bisimulation_final_base_flip_simps [flip_simps]:
   "delay_bisimulation_final_base trsys2 trsys1 (flip bisim) \<tau>move2 \<tau>move1 final2 final1 =
   delay_bisimulation_final_base trsys1 trsys2 bisim \<tau>move1 \<tau>move2 final1 final2"
 by(auto dest: delay_bisimulation_final_base.delay_bisimulation_final_base_flip simp only: flip_flip)
 
 context delay_bisimulation_final_base begin
 
 lemma \<tau>Runs_terminate_final1:
   assumes "s1 \<Down>1 tls1"
   and "s2 \<Down>2 tls2"
   and "tllist_all2 tlsim (rel_option bisim) tls1 tls2"
   and "tfinite tls1"
   and "terminal tls1 = Some s1'"
   and "final1 s1'"
   shows "\<exists>s2'. tfinite tls2 \<and> terminal tls2 = Some s2' \<and> final2 s2'"
 using assms(4) assms(1-3,5-)
 apply(induct arbitrary: tls2 s1 s2 rule: tfinite_induct)
-apply(auto 4 4 simp add: tllist_all2_TCons1 tllist_all2_TNil1 rel_option_Some1 trsys1.\<tau>Runs_simps trsys2.\<tau>Runs_simps dest: final1_simulation elim: converse_rtranclpE)
+apply(auto 4 4 simp add: tllist_all2_TCons1 tllist_all2_TNil1 option_rel_Some1 trsys1.\<tau>Runs_simps trsys2.\<tau>Runs_simps dest: final1_simulation elim: converse_rtranclpE)
 done
 
 lemma \<tau>Runs_terminate_final2:
   "\<lbrakk> s1 \<Down>1 tls1; s2 \<Down>2 tls2; tllist_all2 tlsim (rel_option bisim) tls1 tls2;
      tfinite tls2; terminal tls2 = Some s2'; final2 s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1'. tfinite tls1 \<and> terminal tls1 = Some s1' \<and> final1 s1'"
 using delay_bisimulation_final_base.\<tau>Runs_terminate_final1[where tlsim = "flip tlsim", OF delay_bisimulation_final_base_flip]
 unfolding flip_simps by -
 
 end
 
 locale delay_bisimulation_diverge_final = 
   delay_bisimulation_diverge + 
   delay_bisimulation_final_base +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
   and final1 :: "'s1 \<Rightarrow> bool"
   and final2 :: "'s2 \<Rightarrow> bool"
 begin
 
 lemma delay_bisimulation_diverge_final_flip:
   "delay_bisimulation_diverge_final trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 final2 final1"
 apply(rule delay_bisimulation_diverge_final.intro)
  apply(rule delay_bisimulation_diverge_flip)
 apply(unfold_locales, unfold flip_simps)
 apply(blast intro: final1_simulation final2_simulation)+
 done
 
 end
 
 lemma delay_bisimulation_diverge_final_flip_simps [flip_simps]:
   "delay_bisimulation_diverge_final trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 final2 final1 =
    delay_bisimulation_diverge_final trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 final1 final2"
 by(auto dest: delay_bisimulation_diverge_final.delay_bisimulation_diverge_final_flip simp only: flip_flip)
 
 context delay_bisimulation_diverge_final begin
 
 lemma delay_bisimulation_diverge:
   "delay_bisimulation_diverge trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 by(unfold_locales)
 
 lemma delay_bisimulation_final_base:
   "delay_bisimulation_final_base trsys1 trsys2 bisim \<tau>move1 \<tau>move2 final1 final2"
 by(unfold_locales)
 
 lemma final_simulation1:
   "\<lbrakk> s1 \<approx> s2; s1 -\<tau>1-tls1\<rightarrow>* s1'; final1 s1' \<rbrakk>
   \<Longrightarrow> \<exists>s2' tls2. s2 -\<tau>2-tls2\<rightarrow>* s2' \<and> s1' \<approx> s2' \<and> final2 s2' \<and> tls1 [\<sim>] tls2"
 by(blast dest: simulation1_\<tau>rtrancl3p final1_simulation intro: \<tau>rtrancl3p_trans[OF _ silent_moves_into_\<tau>rtrancl3p, simplified])
 
 lemma final_simulation2:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2-tls2\<rightarrow>* s2'; final2 s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1' tls1. s1 -\<tau>1-tls1\<rightarrow>* s1' \<and> s1' \<approx> s2' \<and> final1 s1' \<and> tls1 [\<sim>] tls2"
 by(rule delay_bisimulation_diverge_final.final_simulation1[OF delay_bisimulation_diverge_final_flip, unfolded flip_simps])
 
 end
 
 locale delay_bisimulation_measure_base = 
   delay_bisimulation_base +
   constrains trsys1 :: "'s1 \<Rightarrow> 'tl1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and trsys2 :: "'s2 \<Rightarrow> 'tl2 \<Rightarrow> 's2 \<Rightarrow> bool"
   and bisim :: "'s1 \<Rightarrow> 's2 \<Rightarrow> bool"
   and tlsim :: "'tl1 \<Rightarrow> 'tl2 \<Rightarrow> bool"
   and \<tau>move1 :: "'s1 \<Rightarrow> 'tl1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<tau>move2 :: "'s2 \<Rightarrow> 'tl2 \<Rightarrow> 's2 \<Rightarrow> bool"
   fixes \<mu>1 :: "'s1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<mu>2 :: "'s2 \<Rightarrow> 's2 \<Rightarrow> bool"
 
 locale delay_bisimulation_measure =
   delay_bisimulation_measure_base _ _ _ _ \<tau>move1 \<tau>move2 \<mu>1 \<mu>2 +
   delay_bisimulation_obs trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2
   for \<tau>move1 :: "'s1 \<Rightarrow> 'tl1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<tau>move2 :: "'s2 \<Rightarrow> 'tl2 \<Rightarrow> 's2 \<Rightarrow> bool"
   and \<mu>1 :: "'s1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<mu>2 :: "'s2 \<Rightarrow> 's2 \<Rightarrow> bool" +
   assumes simulation_silent1:
   "\<lbrakk> s1 \<approx> s2; s1 -\<tau>1\<rightarrow> s1' \<rbrakk> \<Longrightarrow> s1' \<approx> s2 \<and> \<mu>1^++ s1' s1 \<or> (\<exists>s2'. s2 -\<tau>2\<rightarrow>+ s2' \<and> s1' \<approx> s2')"
   and simulation_silent2:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2\<rightarrow> s2' \<rbrakk> \<Longrightarrow> s1 \<approx> s2' \<and> \<mu>2^++ s2' s2 \<or> (\<exists>s1'. s1 -\<tau>1\<rightarrow>+ s1' \<and> s1' \<approx> s2')"
   and wf_\<mu>1: "wfP \<mu>1"
   and wf_\<mu>2: "wfP \<mu>2"
 begin
 
 lemma delay_bisimulation_measure_flip:
   "delay_bisimulation_measure trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 \<mu>2 \<mu>1"
 apply(rule delay_bisimulation_measure.intro)
  apply(rule delay_bisimulation_obs_flip)
 apply(unfold_locales)
 apply(unfold flip_simps)
 apply(rule simulation_silent1 simulation_silent2 wf_\<mu>1 wf_\<mu>2|assumption)+
 done
 
 end
 
 lemma delay_bisimulation_measure_flip_simps [flip_simps]:
   "delay_bisimulation_measure trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 \<mu>2 \<mu>1 =
    delay_bisimulation_measure trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 \<mu>1 \<mu>2"
 by(auto dest: delay_bisimulation_measure.delay_bisimulation_measure_flip simp only: flip_simps)
 
 context delay_bisimulation_measure begin
 
 lemma simulation_silentst1:
   assumes bisim: "s1 \<approx> s2" and moves: "s1 -\<tau>1\<rightarrow>+ s1'"
   shows "s1' \<approx> s2 \<and> \<mu>1^++ s1' s1 \<or> (\<exists>s2'. s2 -\<tau>2\<rightarrow>+ s2' \<and> s1' \<approx> s2')"
 using moves bisim
 proof induct
   case (base s1') thus ?case by(auto dest: simulation_silent1)
 next
   case (step s1' s1'')
   hence "s1' \<approx> s2 \<and> \<mu>1\<^sup>+\<^sup>+ s1' s1 \<or> (\<exists>s2'. s2 -\<tau>2\<rightarrow>+ s2' \<and> s1' \<approx> s2')" by blast
   thus ?case
   proof
     assume "s1' \<approx> s2 \<and> \<mu>1\<^sup>+\<^sup>+ s1' s1"
     hence "s1' \<approx> s2" "\<mu>1\<^sup>+\<^sup>+ s1' s1" by simp_all
     with simulation_silent1[OF \<open>s1' \<approx> s2\<close> \<open>s1' -\<tau>1\<rightarrow> s1''\<close>]
     show ?thesis by(auto)
   next
     assume "\<exists>s2'. trsys2.silent_move\<^sup>+\<^sup>+ s2 s2' \<and> s1' \<approx> s2'"
     then obtain s2' where "s2 -\<tau>2\<rightarrow>+ s2'" "s1' \<approx> s2'" by blast
     with simulation_silent1[OF \<open>s1' \<approx> s2'\<close> \<open>s1' -\<tau>1\<rightarrow> s1''\<close>]
     show ?thesis by(auto intro: tranclp_trans)
   qed
 qed
 
 lemma simulation_silentst2:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2\<rightarrow>+ s2' \<rbrakk> \<Longrightarrow> s1 \<approx> s2' \<and> \<mu>2^++ s2' s2 \<or> (\<exists>s1'. s1 -\<tau>1\<rightarrow>+ s1' \<and> s1' \<approx> s2')"
 using delay_bisimulation_measure.simulation_silentst1[OF delay_bisimulation_measure_flip]
 unfolding flip_simps .
 
 lemma \<tau>diverge_simulation1:
   assumes diverge1: "s1 -\<tau>1\<rightarrow> \<infinity>"
   and bisim: "s1 \<approx> s2"
   shows "s2 -\<tau>2\<rightarrow> \<infinity>"
 proof -
   from assms have "s1 -\<tau>1\<rightarrow> \<infinity> \<and> s1 \<approx> s2" by blast
   thus ?thesis using wfP_trancl[OF wf_\<mu>1]
   proof(coinduct rule: trsys2.\<tau>diverge_trancl_measure_coinduct)
     case (\<tau>diverge s2 s1)
     hence "s1 -\<tau>1\<rightarrow> \<infinity>" "s1 \<approx> s2" by simp_all
     then obtain s1' where "trsys1.silent_move s1 s1'" "s1' -\<tau>1\<rightarrow> \<infinity>"
       by(fastforce elim: trsys1.\<tau>diverge.cases)
     from simulation_silent1[OF \<open>s1 \<approx> s2\<close> \<open>trsys1.silent_move s1 s1'\<close>] \<open>s1' -\<tau>1\<rightarrow> \<infinity>\<close>
     show ?case by auto
   qed
 qed
 
 lemma \<tau>diverge_simulation2:
   "\<lbrakk> s2 -\<tau>2\<rightarrow> \<infinity>; s1 \<approx> s2 \<rbrakk> \<Longrightarrow> s1 -\<tau>1\<rightarrow> \<infinity>"
 using delay_bisimulation_measure.\<tau>diverge_simulation1[OF delay_bisimulation_measure_flip]
 unfolding flip_simps .
 
 lemma \<tau>diverge_bisim_inv:
   "s1 \<approx> s2 \<Longrightarrow> s1 -\<tau>1\<rightarrow> \<infinity> \<longleftrightarrow> s2 -\<tau>2\<rightarrow> \<infinity>"
 by(blast intro: \<tau>diverge_simulation1 \<tau>diverge_simulation2)
 
 end
 
 sublocale delay_bisimulation_measure < delay_bisimulation_diverge
 proof
   fix s1 s2 s1'
   assume "s1 \<approx> s2" "s1 -\<tau>1\<rightarrow> s1'"
   from simulation_silent1[OF this]
   show "\<exists>s2'. s2 -\<tau>2\<rightarrow>* s2' \<and> s1' \<approx> s2'" by(auto intro: tranclp_into_rtranclp)
 next
   fix s1 s2 s2'
   assume "s1 \<approx> s2" "s2 -\<tau>2\<rightarrow> s2'"
   from simulation_silent2[OF this]
   show "\<exists>s1'. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' \<approx> s2'" by(auto intro: tranclp_into_rtranclp)
 next
   fix s1 s2
   assume "s1 \<approx> s2"
   thus "s1 -\<tau>1\<rightarrow> \<infinity> \<longleftrightarrow> s2 -\<tau>2\<rightarrow> \<infinity>" by(rule \<tau>diverge_bisim_inv)
 qed
 
 text \<open>
   Counter example for
   @{prop "delay_bisimulation_diverge trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 \<Longrightarrow> \<exists>\<mu>1 \<mu>2. delay_bisimulation_measure trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 \<mu>1 \<mu>2"}
 
  (only \<open>\<tau>\<close>moves):
 \begin{verbatim}
 --|
 | v
 --a  ~  x
   |     |
   |     |
   v     v
 --b  ~  y--
 | ^     ^ |
 --|     |--
 \end{verbatim}
 \<close>
 
 locale delay_bisimulation_measure_final =
   delay_bisimulation_measure + 
   delay_bisimulation_final_base +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
   and \<mu>1 :: "'s1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<mu>2 :: "'s2 \<Rightarrow> 's2 \<Rightarrow> bool"
   and final1 :: "'s1 \<Rightarrow> bool"
   and final2 :: "'s2 \<Rightarrow> bool"
 
 sublocale delay_bisimulation_measure_final < delay_bisimulation_diverge_final
 by unfold_locales
 
 locale \<tau>inv = delay_bisimulation_base +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
   and \<tau>moves1 :: "'s1 \<Rightarrow> 's1 \<Rightarrow> bool"
   and \<tau>moves2 :: "'s2 \<Rightarrow> 's2 \<Rightarrow> bool"
   assumes \<tau>inv: "\<lbrakk> s1 \<approx> s2; s1 -1-tl1\<rightarrow> s1'; s2 -2-tl2\<rightarrow> s2'; s1' \<approx> s2'; tl1 \<sim> tl2 \<rbrakk>
                  \<Longrightarrow> \<tau>move1 s1 tl1 s1' \<longleftrightarrow> \<tau>move2 s2 tl2 s2'"
 begin
 
 lemma \<tau>inv_flip:
   "\<tau>inv trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1"
 by(unfold_locales)(unfold flip_simps,rule \<tau>inv[symmetric])
 
 end
 
 lemma \<tau>inv_flip_simps [flip_simps]:
   "\<tau>inv trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 = \<tau>inv trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 by(auto dest: \<tau>inv.\<tau>inv_flip simp only: flip_simps)
 
 locale bisimulation_into_delay =
   bisimulation + \<tau>inv +
   constrains trsys1 :: "('s1, 'tl1) trsys"
   and trsys2 :: "('s2, 'tl2) trsys"
   and bisim :: "('s1, 's2) bisim"
   and tlsim :: "('tl1, 'tl2) bisim"
   and \<tau>move1 :: "('s1, 'tl1) trsys"
   and \<tau>move2 :: "('s2, 'tl2) trsys"
 begin
 
 lemma bisimulation_into_delay_flip:
   "bisimulation_into_delay trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1"
 by(intro_locales)(intro bisimulation_flip \<tau>inv_flip)+
 
 end
 
 lemma bisimulation_into_delay_flip_simps [flip_simps]:
   "bisimulation_into_delay trsys2 trsys1 (flip bisim) (flip tlsim) \<tau>move2 \<tau>move1 =
    bisimulation_into_delay trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 by(auto dest: bisimulation_into_delay.bisimulation_into_delay_flip simp only: flip_simps)
 
 context bisimulation_into_delay begin
 
 lemma simulation_silent1_aux:
   assumes bisim: "s1 \<approx> s2" and "s1 -\<tau>1\<rightarrow> s1'"
   shows "s1' \<approx> s2 \<and> \<mu>1\<^sup>+\<^sup>+ s1' s1 \<or> (\<exists>s2'. s2 -\<tau>2\<rightarrow>+ s2' \<and> s1' \<approx> s2')"
 proof -
   from assms obtain tl1 where tr1: "s1 -1-tl1\<rightarrow> s1'"
     and \<tau>1: "\<tau>move1 s1 tl1 s1'" by(auto)
   from simulation1[OF bisim tr1]
   obtain s2' tl2 where tr2: "s2 -2-tl2\<rightarrow> s2'"
     and bisim': "s1' \<approx> s2'" and tlsim: "tl1 \<sim> tl2" by blast
   from \<tau>inv[OF bisim tr1 tr2 bisim' tlsim] \<tau>1 have \<tau>2: "\<tau>move2 s2 tl2 s2'" by simp
   from tr2 \<tau>2 have "s2 -\<tau>2\<rightarrow>+ s2'" by(auto)
   with bisim' show ?thesis by blast
 qed
 
 lemma simulation_silent2_aux:
   "\<lbrakk> s1 \<approx> s2; s2 -\<tau>2\<rightarrow> s2' \<rbrakk> \<Longrightarrow> s1 \<approx> s2' \<and> \<mu>2\<^sup>+\<^sup>+ s2' s2 \<or> (\<exists>s1'. s1 -\<tau>1\<rightarrow>+ s1' \<and> s1' \<approx> s2')"
 using bisimulation_into_delay.simulation_silent1_aux[OF bisimulation_into_delay_flip]
 unfolding flip_simps .
 
 lemma simulation1_aux:
   assumes bisim: "s1 \<approx> s2" and tr1: "s1 -1-tl1\<rightarrow> s1'" and \<tau>1: "\<not> \<tau>move1 s1 tl1 s1'"
   shows "\<exists>s2' s2'' tl2. s2 -\<tau>2\<rightarrow>* s2' \<and> s2' -2-tl2\<rightarrow> s2'' \<and> \<not> \<tau>move2 s2' tl2 s2'' \<and> s1' \<approx> s2'' \<and> tl1 \<sim> tl2"
 proof -
   from simulation1[OF bisim tr1]
   obtain s2' tl2 where tr2: "s2 -2-tl2\<rightarrow> s2'"
     and bisim': "s1' \<approx> s2'" and tlsim: "tl1 \<sim> tl2" by blast
   from \<tau>inv[OF bisim tr1 tr2 bisim' tlsim] \<tau>1 have \<tau>2: "\<not> \<tau>move2 s2 tl2 s2'" by simp
   with bisim' tr2 tlsim show ?thesis by blast
 qed
 
 lemma simulation2_aux:
   "\<lbrakk> s1 \<approx> s2; s2 -2-tl2\<rightarrow> s2'; \<not> \<tau>move2 s2 tl2 s2' \<rbrakk>
   \<Longrightarrow> \<exists>s1' s1'' tl1. s1 -\<tau>1\<rightarrow>* s1' \<and> s1' -1-tl1\<rightarrow> s1'' \<and> \<not> \<tau>move1 s1' tl1 s1'' \<and> s1'' \<approx> s2' \<and> tl1 \<sim> tl2"
 using bisimulation_into_delay.simulation1_aux[OF bisimulation_into_delay_flip]
 unfolding flip_simps .
 
 lemma delay_bisimulation_measure:
   assumes wf_\<mu>1: "wfP \<mu>1"
   and wf_\<mu>2: "wfP \<mu>2"
   shows "delay_bisimulation_measure trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 \<mu>1 \<mu>2"
 apply(unfold_locales)
 apply(rule simulation_silent1_aux simulation_silent2_aux simulation1_aux simulation2_aux wf_\<mu>1 wf_\<mu>2|assumption)+
 done
 
 lemma delay_bisimulation:
   "delay_bisimulation_diverge trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2"
 proof -
   interpret delay_bisimulation_measure trsys1 trsys2 bisim tlsim \<tau>move1 \<tau>move2 "\<lambda>s s'. False" "\<lambda>s s'. False"
     by(blast intro: delay_bisimulation_measure wfP_empty)
   show ?thesis ..
 qed
 
 end
 
 sublocale bisimulation_into_delay < delay_bisimulation_diverge
 by(rule delay_bisimulation)
 
 lemma delay_bisimulation_conv_bisimulation:
   "delay_bisimulation_diverge trsys1 trsys2 bisim tlsim (\<lambda>s tl s'. False) (\<lambda>s tl s'. False) =
    bisimulation trsys1 trsys2 bisim tlsim"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then interpret delay_bisimulation_diverge trsys1 trsys2 bisim tlsim "\<lambda>s tl s'. False" "\<lambda>s tl s'. False" .
   show ?rhs by(unfold_locales)(fastforce simp add: \<tau>moves_False dest: simulation1 simulation2)+
 next
   assume ?rhs
   then interpret bisimulation trsys1 trsys2 bisim tlsim .
   interpret bisimulation_into_delay trsys1 trsys2 bisim tlsim "\<lambda>s tl s'. False" "\<lambda>s tl s'. False"
     by(unfold_locales)(rule refl)
   show ?lhs by unfold_locales
 qed
 
 context bisimulation_final begin
 
 lemma delay_bisimulation_final_base: 
   "delay_bisimulation_final_base trsys1 trsys2 bisim \<tau>move1 \<tau>move2 final1 final2"
 by(unfold_locales)(auto simp add: bisim_final)
 
 end
 
 sublocale bisimulation_final < delay_bisimulation_final_base
 by(rule delay_bisimulation_final_base)
 
 subsection \<open>Transitivity for bisimulations\<close>
 
 definition bisim_compose :: "('s1, 's2) bisim \<Rightarrow> ('s2, 's3) bisim \<Rightarrow> ('s1, 's3) bisim" (infixr "\<circ>\<^sub>B" 60)
 where "(bisim1 \<circ>\<^sub>B bisim2) s1 s3 \<equiv> \<exists>s2. bisim1 s1 s2 \<and> bisim2 s2 s3"
 
 lemma bisim_composeI [intro]:
   "\<lbrakk> bisim12 s1 s2; bisim23 s2 s3 \<rbrakk> \<Longrightarrow> (bisim12 \<circ>\<^sub>B bisim23) s1 s3"
 by(auto simp add: bisim_compose_def)
 
 lemma bisim_composeE [elim!]:
   assumes bisim: "(bisim12 \<circ>\<^sub>B bisim23) s1 s3"
   obtains s2 where "bisim12 s1 s2" "bisim23 s2 s3"
 by(atomize_elim)(rule bisim[unfolded bisim_compose_def])
 
 lemma bisim_compose_assoc [simp]:
   "(bisim12 \<circ>\<^sub>B bisim23) \<circ>\<^sub>B bisim34 = bisim12 \<circ>\<^sub>B bisim23 \<circ>\<^sub>B bisim34"
 by(auto simp add: fun_eq_iff)
 
 lemma bisim_compose_conv_relcomp:
   "case_prod (bisim_compose bisim12 bisim23) = (\<lambda>x. x \<in> relcomp (Collect (case_prod bisim12)) (Collect (case_prod bisim23)))"
 by(auto simp add: relcomp_unfold)
 
 lemma list_all2_bisim_composeI:
   "\<lbrakk> list_all2 A xs ys; list_all2 B ys zs \<rbrakk>
   \<Longrightarrow> list_all2 (A \<circ>\<^sub>B B) xs zs"
 by(rule list_all2_trans) auto+
 
 lemma delay_bisimulation_diverge_compose:
   assumes wbisim12: "delay_bisimulation_diverge trsys1 trsys2 bisim12 tlsim12 \<tau>move1 \<tau>move2"
   and wbisim23: "delay_bisimulation_diverge trsys2 trsys3 bisim23 tlsim23 \<tau>move2 \<tau>move3"
   shows "delay_bisimulation_diverge trsys1 trsys3 (bisim12 \<circ>\<^sub>B bisim23) (tlsim12 \<circ>\<^sub>B tlsim23) \<tau>move1 \<tau>move3"
 proof -
   interpret trsys1: \<tau>trsys trsys1 \<tau>move1 .
   interpret trsys2: \<tau>trsys trsys2 \<tau>move2 .
   interpret trsys3: \<tau>trsys trsys3 \<tau>move3 .
   interpret wb12: delay_bisimulation_diverge trsys1 trsys2 bisim12 tlsim12 \<tau>move1 \<tau>move2 by(auto intro: wbisim12)
   interpret wb23: delay_bisimulation_diverge trsys2 trsys3 bisim23 tlsim23 \<tau>move2 \<tau>move3 by(auto intro: wbisim23)
   show ?thesis
   proof
     fix s1 s3 s1'
     assume bisim: "(bisim12 \<circ>\<^sub>B bisim23) s1 s3" and tr1: "trsys1.silent_move s1 s1'"
     from bisim obtain s2 where bisim1: "bisim12 s1 s2" and bisim2: "bisim23 s2 s3" by blast
     from wb12.simulation_silent1[OF bisim1 tr1] obtain s2'
       where tr2: "trsys2.silent_moves s2 s2'" and bisim1': "bisim12 s1' s2'" by blast
     from wb23.simulation_silents1[OF bisim2 tr2] obtain s3'
       where "trsys3.silent_moves s3 s3'" "bisim23 s2' s3'" by blast
     with bisim1' show "\<exists>s3'. trsys3.silent_moves s3 s3' \<and> (bisim12 \<circ>\<^sub>B bisim23) s1' s3'"
       by(blast intro: bisim_composeI)
   next
     fix s1 s3 s3'
     assume bisim: "(bisim12 \<circ>\<^sub>B bisim23) s1 s3" and tr3: "trsys3.silent_move s3 s3'"
     from bisim obtain s2 where bisim1: "bisim12 s1 s2" and bisim2: "bisim23 s2 s3" by blast
     from wb23.simulation_silent2[OF bisim2 tr3] obtain s2'
       where tr2: "trsys2.silent_moves s2 s2'" and bisim2': "bisim23 s2' s3'" by blast
     from wb12.simulation_silents2[OF bisim1 tr2] obtain s1'
       where "trsys1.silent_moves s1 s1'" "bisim12 s1' s2'" by blast
     with bisim2' show "\<exists>s1'. trsys1.silent_moves s1 s1' \<and> (bisim12 \<circ>\<^sub>B bisim23) s1' s3'"
       by(blast intro: bisim_composeI)
   next
     fix s1 s3 tl1 s1'
     assume bisim: "(bisim12 \<circ>\<^sub>B bisim23) s1 s3"
       and tr1: "trsys1 s1 tl1 s1'" and \<tau>1: "\<not> \<tau>move1 s1 tl1 s1'"
     from bisim obtain s2 where bisim1: "bisim12 s1 s2" and bisim2: "bisim23 s2 s3" by blast
     from wb12.simulation1[OF bisim1 tr1 \<tau>1] obtain s2' s2'' tl2
       where tr21: "trsys2.silent_moves s2 s2'" and tr22: "trsys2 s2' tl2 s2''" and \<tau>2: "\<not> \<tau>move2 s2' tl2 s2''"
       and bisim1': "bisim12 s1' s2''" and tlsim1: "tlsim12 tl1 tl2" by blast
     from wb23.simulation_silents1[OF bisim2 tr21] obtain s3'
       where tr31: "trsys3.silent_moves s3 s3'" and bisim2': "bisim23 s2' s3'" by blast
     from wb23.simulation1[OF bisim2' tr22 \<tau>2] obtain s3'' s3''' tl3
       where "trsys3.silent_moves s3' s3''" "trsys3 s3'' tl3 s3'''"
       "\<not> \<tau>move3 s3'' tl3 s3'''" "bisim23 s2'' s3'''" "tlsim23 tl2 tl3" by blast
     with tr31 bisim1' tlsim1 
     show "\<exists>s3' s3'' tl3. trsys3.silent_moves s3 s3' \<and> trsys3 s3' tl3 s3'' \<and> \<not> \<tau>move3 s3' tl3 s3'' \<and>
                          (bisim12 \<circ>\<^sub>B bisim23) s1' s3'' \<and> (tlsim12 \<circ>\<^sub>B tlsim23) tl1 tl3"
       by(blast intro: rtranclp_trans bisim_composeI)
   next
     fix s1 s3 tl3 s3'
     assume bisim: "(bisim12 \<circ>\<^sub>B bisim23) s1 s3"
       and tr3: "trsys3 s3 tl3 s3'" and \<tau>3: "\<not> \<tau>move3 s3 tl3 s3'"
     from bisim obtain s2 where bisim1: "bisim12 s1 s2" and bisim2: "bisim23 s2 s3" by blast
     from wb23.simulation2[OF bisim2 tr3 \<tau>3] obtain s2' s2'' tl2
       where tr21: "trsys2.silent_moves s2 s2'" and tr22: "trsys2 s2' tl2 s2''" and \<tau>2: "\<not> \<tau>move2 s2' tl2 s2''"
       and bisim2': "bisim23 s2'' s3'" and tlsim2: "tlsim23 tl2 tl3" by blast
     from wb12.simulation_silents2[OF bisim1 tr21] obtain s1'
       where tr11: "trsys1.silent_moves s1 s1'" and bisim1': "bisim12 s1' s2'" by blast
     from wb12.simulation2[OF bisim1' tr22 \<tau>2] obtain s1'' s1''' tl1
       where "trsys1.silent_moves s1' s1''" "trsys1 s1'' tl1 s1'''"
       "\<not> \<tau>move1 s1'' tl1 s1'''" "bisim12 s1''' s2''" "tlsim12 tl1 tl2" by blast
     with tr11 bisim2' tlsim2
     show "\<exists>s1' s1'' tl1. trsys1.silent_moves s1 s1' \<and> trsys1 s1' tl1 s1'' \<and> \<not> \<tau>move1 s1' tl1 s1'' \<and>
                          (bisim12 \<circ>\<^sub>B bisim23) s1'' s3' \<and> (tlsim12 \<circ>\<^sub>B tlsim23) tl1 tl3"
       by(blast intro: rtranclp_trans bisim_composeI)
   next
     fix s1 s2
     assume "(bisim12 \<circ>\<^sub>B bisim23) s1 s2"
     thus "\<tau>trsys.\<tau>diverge trsys1 \<tau>move1 s1 = \<tau>trsys.\<tau>diverge trsys3 \<tau>move3 s2"
       by(auto simp add: wb12.\<tau>diverge_bisim_inv wb23.\<tau>diverge_bisim_inv)
   qed
 qed
 
 lemma bisimulation_bisim_compose:
   "\<lbrakk> bisimulation trsys1 trsys2 bisim12 tlsim12; bisimulation trsys2 trsys3 bisim23 tlsim23 \<rbrakk>
   \<Longrightarrow> bisimulation trsys1 trsys3 (bisim_compose bisim12 bisim23) (bisim_compose tlsim12 tlsim23)"
 unfolding delay_bisimulation_conv_bisimulation[symmetric]
 by(rule delay_bisimulation_diverge_compose)
 
 lemma delay_bisimulation_diverge_final_compose:
   fixes \<tau>move1 \<tau>move2
   assumes wbisim12: "delay_bisimulation_diverge_final trsys1 trsys2 bisim12 tlsim12 \<tau>move1 \<tau>move2 final1 final2"
   and wbisim23: "delay_bisimulation_diverge_final trsys2 trsys3 bisim23 tlsim23 \<tau>move2 \<tau>move3 final2 final3"
   shows "delay_bisimulation_diverge_final trsys1 trsys3 (bisim12 \<circ>\<^sub>B bisim23) (tlsim12 \<circ>\<^sub>B tlsim23) \<tau>move1 \<tau>move3 final1 final3"
 proof -
   interpret trsys1: \<tau>trsys trsys1 \<tau>move1 .
   interpret trsys2: \<tau>trsys trsys2 \<tau>move2 .
   interpret trsys3: \<tau>trsys trsys3 \<tau>move3 .
   interpret wb12: delay_bisimulation_diverge_final trsys1 trsys2 bisim12 tlsim12 \<tau>move1 \<tau>move2 final1 final2
     by(auto intro: wbisim12)
   interpret wb23: delay_bisimulation_diverge_final trsys2 trsys3 bisim23 tlsim23 \<tau>move2 \<tau>move3 final2 final3
     by(auto intro: wbisim23)
   interpret delay_bisimulation_diverge trsys1 trsys3 "bisim12 \<circ>\<^sub>B bisim23" "tlsim12 \<circ>\<^sub>B tlsim23" \<tau>move1 \<tau>move3
     by(rule delay_bisimulation_diverge_compose)(unfold_locales)
   show ?thesis
   proof
     fix s1 s3
     assume "(bisim12 \<circ>\<^sub>B bisim23) s1 s3" "final1 s1"
     from \<open>(bisim12 \<circ>\<^sub>B bisim23) s1 s3\<close> obtain s2 where "bisim12 s1 s2" and "bisim23 s2 s3" ..
     from wb12.final1_simulation[OF \<open>bisim12 s1 s2\<close> \<open>final1 s1\<close>]
     obtain s2' where "trsys2.silent_moves s2 s2'" "bisim12 s1 s2'" "final2 s2'" by blast
     from wb23.simulation_silents1[OF \<open>bisim23 s2 s3\<close> \<open>trsys2.silent_moves s2 s2'\<close>]
     obtain s3' where "trsys3.silent_moves s3 s3'" "bisim23 s2' s3'" by blast
     from wb23.final1_simulation[OF \<open>bisim23 s2' s3'\<close> \<open>final2 s2'\<close>]
     obtain s3'' where "trsys3.silent_moves s3' s3''" "bisim23 s2' s3''" "final3 s3''" by blast
     from \<open>trsys3.silent_moves s3 s3'\<close> \<open>trsys3.silent_moves s3' s3''\<close>
     have "trsys3.silent_moves s3 s3''" by(rule rtranclp_trans)
     moreover from \<open>bisim12 s1 s2'\<close> \<open>bisim23 s2' s3''\<close>
     have "(bisim12 \<circ>\<^sub>B bisim23) s1 s3''" ..
     ultimately show "\<exists>s3'. trsys3.silent_moves s3 s3' \<and> (bisim12 \<circ>\<^sub>B bisim23) s1 s3' \<and> final3 s3'"
       using \<open>final3 s3''\<close> by iprover
   next
     fix s1 s3
     assume "(bisim12 \<circ>\<^sub>B bisim23) s1 s3" "final3 s3"
     from \<open>(bisim12 \<circ>\<^sub>B bisim23) s1 s3\<close> obtain s2 where "bisim12 s1 s2" and "bisim23 s2 s3" ..
     from wb23.final2_simulation[OF \<open>bisim23 s2 s3\<close> \<open>final3 s3\<close>]
     obtain s2' where "trsys2.silent_moves s2 s2'" "bisim23 s2' s3" "final2 s2'" by blast
     from wb12.simulation_silents2[OF \<open>bisim12 s1 s2\<close> \<open>trsys2.silent_moves s2 s2'\<close>]
     obtain s1' where "trsys1.silent_moves s1 s1'" "bisim12 s1' s2'" by blast
     from wb12.final2_simulation[OF \<open>bisim12 s1' s2'\<close> \<open>final2 s2'\<close>]
     obtain s1'' where "trsys1.silent_moves s1' s1''" "bisim12 s1'' s2'" "final1 s1''" by blast
     from \<open>trsys1.silent_moves s1 s1'\<close> \<open>trsys1.silent_moves s1' s1''\<close>
     have "trsys1.silent_moves s1 s1''" by(rule rtranclp_trans)
     moreover from \<open>bisim12 s1'' s2'\<close> \<open>bisim23 s2' s3\<close>
     have "(bisim12 \<circ>\<^sub>B bisim23) s1'' s3" ..
     ultimately show "\<exists>s1'. trsys1.silent_moves s1 s1' \<and> (bisim12 \<circ>\<^sub>B bisim23) s1' s3 \<and> final1 s1'"
       using \<open>final1 s1''\<close> by iprover
   qed
 qed
 
 end
diff --git a/thys/JinjaThreads/Framework/LTS.thy b/thys/JinjaThreads/Framework/LTS.thy
--- a/thys/JinjaThreads/Framework/LTS.thy
+++ b/thys/JinjaThreads/Framework/LTS.thy
@@ -1,1417 +1,1417 @@
 (*  Title:      JinjaThreads/Framework/LTS.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Labelled transition systems\<close>
 
 theory LTS
 imports
   "../Basic/Auxiliary"
   Coinductive.TLList
 begin
 
 no_notation floor ("\<lfloor>_\<rfloor>")
 
 lemma rel_option_mono:
   "\<lbrakk> rel_option R x y; \<And>x y. R x y \<Longrightarrow> R' x y \<rbrakk> \<Longrightarrow> rel_option R' x y"
 by(cases x)(case_tac [!] y, auto)
 
 lemma nth_concat_conv:
   "n < length (concat xss) 
    \<Longrightarrow> \<exists>m n'. concat xss ! n = (xss ! m) ! n' \<and> n' < length (xss ! m) \<and> 
              m < length xss \<and> n = (\<Sum>i<m. length (xss ! i)) + n'"
 using lnth_lconcat_conv[of n "llist_of (map llist_of xss)"]
-  sum_hom[where f = enat and h = "\<lambda>i. length (xss ! i)"]
+  sum_comp_morphism[where h = enat and g = "\<lambda>i. length (xss ! i)"]
 by(clarsimp simp add: lconcat_llist_of zero_enat_def[symmetric]) blast
 
 
 definition flip :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'c"
 where "flip f = (\<lambda>b a. f a b)"
 
 text \<open>Create a dynamic list \<open>flip_simps\<close> of theorems for flip\<close>
 ML \<open>
 structure FlipSimpRules = Named_Thms
 (
   val name = @{binding flip_simps}
   val description = "Simplification rules for flip in bisimulations"
 )
 \<close>
 setup \<open>FlipSimpRules.setup\<close>
 
 lemma flip_conv [flip_simps]: "flip f b a = f a b"
 by(simp add: flip_def)
 
 lemma flip_flip [flip_simps, simp]: "flip (flip f) = f"
 by(simp add: flip_def)
 
 lemma list_all2_flip [flip_simps]: "list_all2 (flip P) xs ys = list_all2 P ys xs"
 unfolding flip_def list_all2_conv_all_nth by auto
 
 lemma llist_all2_flip [flip_simps]: "llist_all2 (flip P) xs ys = llist_all2 P ys xs"
 unfolding flip_def llist_all2_conv_all_lnth by auto
 
 lemma rtranclp_flipD:
   assumes "(flip r)^** x y"
   shows "r^** y x" 
 using assms
 by(induct rule: rtranclp_induct)(auto intro: rtranclp.rtrancl_into_rtrancl simp add: flip_conv)
 
 lemma rtranclp_flip [flip_simps]:
   "(flip r)^** = flip r^**"
 by(auto intro!: ext simp add: flip_conv intro: rtranclp_flipD)
 
 lemma rel_prod_flip [flip_simps]:
   "rel_prod (flip R) (flip S) = flip (rel_prod R S)"
 by(auto intro!: ext simp add: flip_def)
 
 lemma rel_option_flip [flip_simps]:
   "rel_option (flip R) = flip (rel_option R)"
 by(simp add: fun_eq_iff rel_option_iff flip_def)
 
 lemma tllist_all2_flip [flip_simps]:
   "tllist_all2 (flip P) (flip Q) xs ys \<longleftrightarrow> tllist_all2 P Q ys xs"
 proof
   assume "tllist_all2 (flip P) (flip Q) xs ys"
   thus "tllist_all2 P Q ys xs"
     by(coinduct rule: tllist_all2_coinduct)(auto dest: tllist_all2_is_TNilD tllist_all2_tfinite2_terminalD tllist_all2_thdD intro: tllist_all2_ttlI simp add: flip_def)
 next
   assume "tllist_all2 P Q ys xs"
   thus "tllist_all2 (flip P) (flip Q) xs ys"
     by(coinduct rule: tllist_all2_coinduct)(auto dest: tllist_all2_is_TNilD tllist_all2_tfinite2_terminalD tllist_all2_thdD intro: tllist_all2_ttlI simp add: flip_def)
 qed
 
 subsection \<open>Labelled transition systems\<close>
 
 type_synonym ('a, 'b) trsys = "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> bool"
 
 locale trsys = 
   fixes trsys :: "('s, 'tl) trsys" ("_/ -_\<rightarrow>/ _" [50, 0, 50] 60)
 begin
 
 abbreviation Trsys :: "('s, 'tl list) trsys" ("_/ -_\<rightarrow>*/ _" [50,0,50] 60)
 where "\<And>tl. s -tl\<rightarrow>* s' \<equiv> rtrancl3p trsys s tl s'"
 
 coinductive inf_step :: "'s \<Rightarrow> 'tl llist \<Rightarrow> bool" ("_ -_\<rightarrow>* \<infinity>" [50, 0] 80)
 where inf_stepI: "\<lbrakk> trsys a b a'; a' -bs\<rightarrow>* \<infinity> \<rbrakk> \<Longrightarrow> a -LCons b bs\<rightarrow>* \<infinity>"
 
 coinductive inf_step_table :: "'s \<Rightarrow> ('s \<times> 'tl \<times> 's) llist \<Rightarrow> bool" ("_ -_\<rightarrow>*t \<infinity>" [50, 0] 80)
 where 
   inf_step_tableI:
   "\<And>tl. \<lbrakk> trsys s tl s'; s' -stls\<rightarrow>*t \<infinity> \<rbrakk> 
   \<Longrightarrow> s -LCons (s, tl, s') stls\<rightarrow>*t \<infinity>"
 
 definition inf_step2inf_step_table :: "'s \<Rightarrow> 'tl llist \<Rightarrow> ('s \<times> 'tl \<times> 's) llist"
 where
   "inf_step2inf_step_table s tls =
    unfold_llist
      (\<lambda>(s, tls). lnull tls)
      (\<lambda>(s, tls). (s, lhd tls, SOME s'. trsys s (lhd tls) s' \<and> s' -ltl tls\<rightarrow>* \<infinity>)) 
      (\<lambda>(s, tls). (SOME s'. trsys s (lhd tls) s' \<and> s' -ltl tls\<rightarrow>* \<infinity>, ltl tls))
      (s, tls)"
 
 coinductive Rtrancl3p :: "'s \<Rightarrow> ('tl, 's) tllist \<Rightarrow> bool"
 where 
   Rtrancl3p_stop: "(\<And>tl s'. \<not> s -tl\<rightarrow> s') \<Longrightarrow>  Rtrancl3p s (TNil s)"
 | Rtrancl3p_into_Rtrancl3p: "\<And>tl. \<lbrakk> s -tl\<rightarrow> s'; Rtrancl3p s' tlss \<rbrakk> \<Longrightarrow> Rtrancl3p s (TCons tl tlss)"
   
 inductive_simps Rtrancl3p_simps:
   "Rtrancl3p s (TNil s')"
   "Rtrancl3p s (TCons tl' tlss)"
 
 inductive_cases Rtrancl3p_cases:
   "Rtrancl3p s (TNil s')"
   "Rtrancl3p s (TCons tl' tlss)"
 
 coinductive Runs :: "'s \<Rightarrow> 'tl llist \<Rightarrow> bool"
 where
   Stuck: "(\<And>tl s'. \<not> s -tl\<rightarrow> s') \<Longrightarrow> Runs s LNil"
 | Step: "\<And>tl. \<lbrakk> s -tl\<rightarrow> s'; Runs s' tls \<rbrakk> \<Longrightarrow> Runs s (LCons tl tls)"
 
 coinductive Runs_table :: "'s \<Rightarrow> ('s \<times> 'tl \<times> 's) llist \<Rightarrow> bool"
 where
   Stuck: "(\<And>tl s'. \<not> s -tl\<rightarrow> s') \<Longrightarrow> Runs_table s LNil"
 | Step: "\<And>tl. \<lbrakk> s -tl\<rightarrow> s'; Runs_table s' stlss \<rbrakk> \<Longrightarrow> Runs_table s (LCons (s, tl, s') stlss)"
 
 inductive_simps Runs_table_simps:
   "Runs_table s LNil"
   "Runs_table s (LCons stls stlss)"
 
 lemma inf_step_not_finite_llist:
   assumes r: "s -bs\<rightarrow>* \<infinity>"
   shows "\<not> lfinite bs"
 proof
   assume "lfinite bs" thus False using r
     by(induct arbitrary: s rule: lfinite.induct)(auto elim: inf_step.cases)
 qed
 
 lemma inf_step2inf_step_table_LNil [simp]: "inf_step2inf_step_table s LNil = LNil"
 by(simp add: inf_step2inf_step_table_def)
 
 lemma inf_step2inf_step_table_LCons [simp]:
   fixes tl shows
   "inf_step2inf_step_table s (LCons tl tls) =
    LCons (s, tl, SOME s'. trsys s tl s' \<and> s' -tls\<rightarrow>* \<infinity>) 
          (inf_step2inf_step_table (SOME s'. trsys s tl s' \<and> s' -tls\<rightarrow>* \<infinity>) tls)"
 by(simp add: inf_step2inf_step_table_def)
 
 lemma lnull_inf_step2inf_step_table [simp]: 
   "lnull (inf_step2inf_step_table s tls) \<longleftrightarrow> lnull tls"
 by(simp add: inf_step2inf_step_table_def)
 
 lemma inf_step2inf_step_table_eq_LNil: 
   "inf_step2inf_step_table s tls = LNil \<longleftrightarrow> tls = LNil"
 using lnull_inf_step2inf_step_table unfolding lnull_def .
 
 lemma lhd_inf_step2inf_step_table [simp]:
   "\<not> lnull tls
   \<Longrightarrow> lhd (inf_step2inf_step_table s tls) =
       (s, lhd tls, SOME s'. trsys s (lhd tls) s' \<and> s' -ltl tls\<rightarrow>* \<infinity>)"
 by(simp add: inf_step2inf_step_table_def)
 
 lemma ltl_inf_step2inf_step_table [simp]:
   "ltl (inf_step2inf_step_table s tls) =
    inf_step2inf_step_table (SOME s'. trsys s (lhd tls) s' \<and> s' -ltl tls\<rightarrow>* \<infinity>) (ltl tls)"
 by(cases tls) simp_all
 
 lemma lmap_inf_step2inf_step_table: "lmap (fst \<circ> snd) (inf_step2inf_step_table s tls) = tls"
 by(coinduction arbitrary: s tls) auto
 
 lemma inf_step_imp_inf_step_table:
   assumes "s -tls\<rightarrow>* \<infinity>"
   shows "\<exists>stls. s -stls\<rightarrow>*t \<infinity> \<and> tls = lmap (fst \<circ> snd) stls"
 proof -
   from assms have "s -inf_step2inf_step_table s tls\<rightarrow>*t \<infinity>"
   proof(coinduction arbitrary: s tls)
     case (inf_step_table s tls)
     thus ?case
     proof cases
       case (inf_stepI tl s' tls')
       let ?s' = "SOME s'. trsys s tl s' \<and> s' -tls'\<rightarrow>* \<infinity>"
       have "trsys s tl ?s' \<and> ?s' -tls'\<rightarrow>* \<infinity>" by(rule someI)(blast intro: inf_stepI)
       thus ?thesis using \<open>tls = LCons tl tls'\<close> by auto
     qed
   qed
   moreover have "tls = lmap (fst \<circ> snd) (inf_step2inf_step_table s tls)"
     by(simp only: lmap_inf_step2inf_step_table)
   ultimately show ?thesis by blast
 qed
 
 lemma inf_step_table_imp_inf_step:
   "s-stls\<rightarrow>*t \<infinity> \<Longrightarrow>s -lmap (fst \<circ> snd) stls\<rightarrow>* \<infinity>"
 proof(coinduction arbitrary: s stls rule: inf_step.coinduct)
   case (inf_step s tls)
   thus ?case by cases auto
 qed
 
 lemma Runs_table_into_Runs:
   "Runs_table s stlss \<Longrightarrow> Runs s (lmap (\<lambda>(s, tl, s'). tl) stlss)"
 proof(coinduction arbitrary: s stlss)
   case (Runs s tls)
   thus ?case by (cases)auto
 qed
 
 lemma Runs_into_Runs_table:
   assumes "Runs s tls"
   obtains stlss
   where "tls = lmap (\<lambda>(s, tl, s'). tl) stlss"
   and "Runs_table s stlss"
 proof -
   define stlss where "stlss s tls = unfold_llist
     (\<lambda>(s, tls). lnull tls)
     (\<lambda>(s, tls). (s, lhd tls, SOME s'. s -lhd tls\<rightarrow> s' \<and> Runs s' (ltl tls)))
     (\<lambda>(s, tls). (SOME s'. s -lhd tls\<rightarrow> s' \<and> Runs s' (ltl tls), ltl tls))
     (s, tls)"
     for s tls
   have [simp]:
     "\<And>s. stlss s LNil = LNil"
     "\<And>s tl tls. stlss s (LCons tl tls) = LCons (s, tl, SOME s'. s -tl\<rightarrow> s' \<and> Runs s' tls) (stlss (SOME s'. s -tl\<rightarrow> s' \<and> Runs s' tls) tls)"
     "\<And>s tls. lnull (stlss s tls) \<longleftrightarrow> lnull tls"
     "\<And>s tls. \<not> lnull tls \<Longrightarrow> lhd (stlss s tls) = (s, lhd tls, SOME s'. s -lhd tls\<rightarrow> s' \<and> Runs s' (ltl tls))"
     "\<And>s tls. \<not> lnull tls \<Longrightarrow> ltl (stlss s tls) = stlss (SOME s'. s -lhd tls\<rightarrow> s' \<and> Runs s' (ltl tls)) (ltl tls)"
     by(simp_all add: stlss_def)
   
   from assms have "tls = lmap (\<lambda>(s, tl, s'). tl) (stlss s tls)"
   proof(coinduction arbitrary: s tls)
     case Eq_llist
     thus ?case by cases(auto 4 3 intro: someI2)
   qed
   moreover
   from assms have "Runs_table s (stlss s tls)"
   proof(coinduction arbitrary: s tls)
     case (Runs_table s stlss')
     thus ?case
     proof(cases)
       case (Step s' tls' tl)
       let ?P = "\<lambda>s'. s -tl\<rightarrow> s' \<and> Runs s' tls'"
       from \<open>s -tl\<rightarrow> s'\<close> \<open>Runs s' tls'\<close> have "?P s'" ..
       hence "?P (Eps ?P)" by(rule someI)
       with Step have ?Step by auto
       thus ?thesis ..
     qed simp
   qed
   ultimately show ?thesis by(rule that)
 qed
 
 lemma Runs_lappendE:
   assumes "Runs \<sigma> (lappend tls tls')"
   and "lfinite tls"
   obtains \<sigma>' where "\<sigma> -list_of tls\<rightarrow>* \<sigma>'"
   and "Runs \<sigma>' tls'"
 proof(atomize_elim)
   from \<open>lfinite tls\<close> \<open>Runs \<sigma> (lappend tls tls')\<close>
   show "\<exists>\<sigma>'. \<sigma> -list_of tls\<rightarrow>* \<sigma>' \<and> Runs \<sigma>' tls'"
   proof(induct arbitrary: \<sigma>)
     case lfinite_LNil thus ?case by(auto)
   next
     case (lfinite_LConsI tls tl)
     from \<open>Runs \<sigma> (lappend (LCons tl tls) tls')\<close>
     show ?case unfolding lappend_code
     proof(cases)
       case (Step \<sigma>')
       from \<open>Runs \<sigma>' (lappend tls tls') \<Longrightarrow> \<exists>\<sigma>''. \<sigma>' -list_of tls\<rightarrow>* \<sigma>'' \<and> Runs \<sigma>'' tls'\<close> \<open>Runs \<sigma>' (lappend tls tls')\<close>
       obtain \<sigma>'' where "\<sigma>' -list_of tls\<rightarrow>* \<sigma>''" "Runs \<sigma>'' tls'" by blast
       from \<open>\<sigma> -tl\<rightarrow> \<sigma>'\<close> \<open>\<sigma>' -list_of tls\<rightarrow>* \<sigma>''\<close>
       have "\<sigma> -tl # list_of tls\<rightarrow>* \<sigma>''" by(rule rtrancl3p_step_converse)
       with \<open>lfinite tls\<close> have "\<sigma> -list_of (LCons tl tls)\<rightarrow>* \<sigma>''" by(simp)
       with \<open>Runs \<sigma>'' tls'\<close> show ?thesis by blast
     qed
   qed
 qed
 
 lemma Trsys_into_Runs:
   assumes "s -tls\<rightarrow>* s'"
   and "Runs s' tls'"
   shows "Runs s (lappend (llist_of tls) tls')"
 using assms
 by(induct rule: rtrancl3p_converse_induct)(auto intro: Runs.Step)
 
 lemma rtrancl3p_into_Rtrancl3p:
   "\<lbrakk> rtrancl3p trsys a bs a'; \<And>b a''. \<not> a' -b\<rightarrow> a'' \<rbrakk> \<Longrightarrow> Rtrancl3p a (tllist_of_llist a' (llist_of bs))"
   by(induct rule: rtrancl3p_converse_induct)(auto intro: Rtrancl3p.intros)
     
 lemma Rtrancl3p_into_Runs:
   "Rtrancl3p s tlss \<Longrightarrow> Runs s (llist_of_tllist tlss)"
 by(coinduction arbitrary: s tlss rule: Runs.coinduct)(auto elim: Rtrancl3p.cases)
 
 lemma Runs_into_Rtrancl3p:
   assumes "Runs s tls"
   obtains tlss where "tls = llist_of_tllist tlss" "Rtrancl3p s tlss"
 proof
   let ?Q = "\<lambda>s tls s'. s -lhd tls\<rightarrow> s' \<and> Runs s' (ltl tls)"
   define tlss where "tlss = corec_tllist 
     (\<lambda>(s, tls). lnull tls) (\<lambda>(s, tls). s)
     (\<lambda>(s, tls). lhd tls)
     (\<lambda>_. False) undefined (\<lambda>(s, tls). (SOME s'. ?Q s tls s', ltl tls))"
   have [simp]:
     "tlss (s, LNil) = TNil s"
     "tlss (s, LCons tl tls) = TCons tl (tlss (SOME s'. ?Q s (LCons tl tls) s', tls))"
     for s tl tls by(auto simp add: tlss_def intro: tllist.expand)
 
   show "tls = llist_of_tllist (tlss (s, tls))" using assms
     by(coinduction arbitrary: s tls)(erule Runs.cases; fastforce intro: someI2)
       
   show "Rtrancl3p s (tlss (s, tls))" using assms
     by(coinduction arbitrary: s tls)(erule Runs.cases; simp; iprover intro: someI2[where Q="trsys _ _"] someI2[where Q="\<lambda>s'. Runs s' _"])
 qed
 
 lemma fixes tl
   assumes "Rtrancl3p s tlss" "tfinite tlss"
   shows Rtrancl3p_into_Trsys: "Trsys s (list_of (llist_of_tllist tlss)) (terminal tlss)"
     and terminal_Rtrancl3p_final: "\<not> terminal tlss -tl\<rightarrow> s'"
 using assms(2,1) by(induction arbitrary: s rule: tfinite_induct)(auto simp add: Rtrancl3p_simps intro: rtrancl3p_step_converse)
 
 end
   
 subsection \<open>Labelled transition systems with internal actions\<close>
 
 locale \<tau>trsys = trsys +
   constrains trsys :: "('s, 'tl) trsys"
   fixes \<tau>move :: "('s, 'tl) trsys"
 begin
 
 inductive silent_move :: "'s \<Rightarrow> 's \<Rightarrow> bool" ("_ -\<tau>\<rightarrow> _" [50, 50] 60)
 where [intro]: "!!tl. \<lbrakk> trsys s tl s'; \<tau>move s tl s' \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow> s'"
 
 declare silent_move.cases [elim]
 
 lemma silent_move_iff: "silent_move = (\<lambda>s s'. (\<exists>tl. trsys s tl s' \<and> \<tau>move s tl s'))"
 by(auto simp add: fun_eq_iff)
 
 abbreviation silent_moves :: "'s \<Rightarrow> 's \<Rightarrow> bool" ("_ -\<tau>\<rightarrow>* _" [50, 50] 60)
 where "silent_moves == silent_move^**"
 
 abbreviation silent_movet :: "'s \<Rightarrow> 's \<Rightarrow> bool" ("_ -\<tau>\<rightarrow>+ _" [50, 50] 60)
 where "silent_movet == silent_move^++"
 
 coinductive \<tau>diverge :: "'s \<Rightarrow> bool" ("_ -\<tau>\<rightarrow> \<infinity>" [50] 60)
 where
   \<tau>divergeI: "\<lbrakk> s -\<tau>\<rightarrow> s'; s' -\<tau>\<rightarrow> \<infinity> \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow> \<infinity>"
 
 coinductive \<tau>inf_step :: "'s \<Rightarrow> 'tl llist \<Rightarrow> bool" ("_ -\<tau>-_\<rightarrow>* \<infinity>" [50, 0] 60)
 where
   \<tau>inf_step_Cons: "\<And>tl. \<lbrakk> s -\<tau>\<rightarrow>* s'; s' -tl\<rightarrow> s''; \<not> \<tau>move s' tl s''; s'' -\<tau>-tls\<rightarrow>* \<infinity> \<rbrakk> \<Longrightarrow> s -\<tau>-LCons tl tls\<rightarrow>* \<infinity>"
 | \<tau>inf_step_Nil: "s -\<tau>\<rightarrow> \<infinity> \<Longrightarrow> s -\<tau>-LNil\<rightarrow>* \<infinity>"
 
 coinductive \<tau>inf_step_table :: "'s \<Rightarrow> ('s \<times> 's \<times> 'tl \<times> 's) llist \<Rightarrow> bool" ("_ -\<tau>-_\<rightarrow>*t \<infinity>" [50, 0] 80)
 where
   \<tau>inf_step_table_Cons:
   "\<And>tl. \<lbrakk> s -\<tau>\<rightarrow>* s'; s' -tl\<rightarrow> s''; \<not> \<tau>move s' tl s''; s'' -\<tau>-tls\<rightarrow>*t \<infinity> \<rbrakk> \<Longrightarrow> s -\<tau>-LCons (s, s', tl, s'') tls\<rightarrow>*t \<infinity>"
 
 | \<tau>inf_step_table_Nil:
   "s -\<tau>\<rightarrow> \<infinity> \<Longrightarrow> s -\<tau>-LNil\<rightarrow>*t \<infinity>"
 
 definition \<tau>inf_step2\<tau>inf_step_table :: "'s \<Rightarrow> 'tl llist \<Rightarrow> ('s \<times> 's \<times> 'tl \<times> 's) llist"
 where
   "\<tau>inf_step2\<tau>inf_step_table s tls =
    unfold_llist
      (\<lambda>(s, tls). lnull tls)
      (\<lambda>(s, tls). let (s', s'') = SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -lhd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (lhd tls) s'' \<and> s'' -\<tau>-ltl tls\<rightarrow>* \<infinity>
         in (s, s', lhd tls, s''))
      (\<lambda>(s, tls). let (s', s'') = SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -lhd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (lhd tls) s'' \<and> s'' -\<tau>-ltl tls\<rightarrow>* \<infinity>
         in (s'', ltl tls))
      (s, tls)"
 
 definition silent_move_from :: "'s \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool"
 where "silent_move_from s0 s1 s2 \<longleftrightarrow> silent_moves s0 s1 \<and> silent_move s1 s2"
 
 inductive \<tau>rtrancl3p :: "'s \<Rightarrow> 'tl list \<Rightarrow> 's \<Rightarrow> bool" ("_ -\<tau>-_\<rightarrow>* _" [50, 0, 50] 60)
 where
   \<tau>rtrancl3p_refl: "\<tau>rtrancl3p s [] s"
 | \<tau>rtrancl3p_step: "\<And>tl. \<lbrakk> s -tl\<rightarrow> s'; \<not> \<tau>move s tl s'; \<tau>rtrancl3p s' tls s'' \<rbrakk> \<Longrightarrow> \<tau>rtrancl3p s (tl # tls) s''"
 | \<tau>rtrancl3p_\<tau>step: "\<And>tl. \<lbrakk> s -tl\<rightarrow> s'; \<tau>move s tl s'; \<tau>rtrancl3p s' tls s'' \<rbrakk> \<Longrightarrow> \<tau>rtrancl3p s tls s''"
 
 coinductive \<tau>Runs :: "'s \<Rightarrow> ('tl, 's option) tllist \<Rightarrow> bool" ("_ \<Down> _" [50, 50] 51)
 where
   Terminate: "\<lbrakk> s -\<tau>\<rightarrow>* s'; \<And>tl s''. \<not> s' -tl\<rightarrow> s'' \<rbrakk> \<Longrightarrow> s \<Down> TNil \<lfloor>s'\<rfloor>" 
 | Diverge: "s -\<tau>\<rightarrow> \<infinity> \<Longrightarrow> s \<Down> TNil None"
 | Proceed: "\<And>tl. \<lbrakk> s -\<tau>\<rightarrow>* s'; s' -tl\<rightarrow> s''; \<not> \<tau>move s' tl s''; s'' \<Down> tls \<rbrakk> \<Longrightarrow> s \<Down> TCons tl tls"
 
 inductive_simps \<tau>Runs_simps:
   "s \<Down> TNil (Some s')"
   "s \<Down> TNil None"
   "s \<Down> TCons tl' tls"
 
 coinductive \<tau>Runs_table :: "'s \<Rightarrow> ('tl \<times> 's, 's option) tllist \<Rightarrow> bool"
 where 
   Terminate: "\<lbrakk> s -\<tau>\<rightarrow>* s'; \<And>tl s''. \<not> s' -tl\<rightarrow> s'' \<rbrakk> \<Longrightarrow> \<tau>Runs_table s (TNil \<lfloor>s'\<rfloor>)"
 | Diverge: "s -\<tau>\<rightarrow> \<infinity> \<Longrightarrow> \<tau>Runs_table s (TNil None)"
 | Proceed:
   "\<And>tl. \<lbrakk> s -\<tau>\<rightarrow>* s'; s' -tl\<rightarrow> s''; \<not> \<tau>move s' tl s''; \<tau>Runs_table s'' tls \<rbrakk> 
   \<Longrightarrow> \<tau>Runs_table s (TCons (tl, s'') tls)"
 
 definition silent_move2 :: "'s \<Rightarrow> 'tl \<Rightarrow> 's \<Rightarrow> bool"
 where "\<And>tl. silent_move2 s tl s' \<longleftrightarrow> s -tl\<rightarrow> s' \<and> \<tau>move s tl s'"
 
 abbreviation silent_moves2 :: "'s \<Rightarrow> 'tl list \<Rightarrow> 's \<Rightarrow> bool"
 where "silent_moves2 \<equiv> rtrancl3p silent_move2"
 
 coinductive \<tau>Runs_table2 :: "'s \<Rightarrow> ('tl list \<times> 's \<times> 'tl \<times> 's, ('tl list \<times> 's) + 'tl llist) tllist \<Rightarrow> bool"
 where 
   Terminate: "\<lbrakk> silent_moves2 s tls s'; \<And>tl s''. \<not> s' -tl\<rightarrow> s'' \<rbrakk> \<Longrightarrow> \<tau>Runs_table2 s (TNil (Inl (tls, s')))"
 | Diverge: "trsys.inf_step silent_move2 s tls \<Longrightarrow> \<tau>Runs_table2 s (TNil (Inr tls))"
 | Proceed:
   "\<And>tl. \<lbrakk> silent_moves2 s tls s'; s' -tl\<rightarrow> s''; \<not> \<tau>move s' tl s''; \<tau>Runs_table2 s'' tlsstlss \<rbrakk> 
   \<Longrightarrow> \<tau>Runs_table2 s (TCons (tls, s', tl, s'') tlsstlss)"
 
 inductive_simps \<tau>Runs_table2_simps:
   "\<tau>Runs_table2 s (TNil tlss)"
   "\<tau>Runs_table2 s (TCons tlsstls tlsstlss)"
 
 lemma inf_step_table_all_\<tau>_into_\<tau>diverge:
   "\<lbrakk> s -stls\<rightarrow>*t \<infinity>; \<forall>(s, tl, s') \<in> lset stls. \<tau>move s tl s' \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow> \<infinity>"
 proof(coinduction arbitrary: s stls)
   case (\<tau>diverge s)
   thus ?case by cases (auto simp add: silent_move_iff, blast)
 qed
 
 lemma inf_step_table_lappend_llist_ofD:
   "s -lappend (llist_of stls) (LCons (x, tl', x') xs)\<rightarrow>*t \<infinity>
   \<Longrightarrow> (s -map (fst \<circ> snd) stls\<rightarrow>* x) \<and> (x -LCons (x, tl', x') xs\<rightarrow>*t \<infinity>)"
 proof(induct stls arbitrary: s)
   case Nil thus ?case by(auto elim: inf_step_table.cases intro: inf_step_table.intros rtrancl3p_refl)
 next
   case (Cons st stls)
   note IH = \<open>\<And>s. s -lappend (llist_of stls) (LCons (x, tl', x') xs)\<rightarrow>*t \<infinity> \<Longrightarrow>
                  s -map (fst \<circ> snd) stls\<rightarrow>* x \<and> x -LCons (x, tl', x') xs\<rightarrow>*t \<infinity>\<close>
   from \<open>s -lappend (llist_of (st # stls)) (LCons (x, tl', x') xs)\<rightarrow>*t \<infinity>\<close>
   show ?case
   proof cases
     case (inf_step_tableI s' stls' tl)
     hence [simp]: "st = (s, tl, s')" "stls' = lappend (llist_of stls) (LCons (x, tl', x') xs)"
       and "s -tl\<rightarrow> s'" "s' -lappend (llist_of stls) (LCons (x, tl', x') xs)\<rightarrow>*t \<infinity>" by simp_all
     from IH[OF \<open>s' -lappend (llist_of stls) (LCons (x, tl', x') xs)\<rightarrow>*t \<infinity>\<close>]
     have "s' -map (fst \<circ> snd) stls\<rightarrow>* x" "x -LCons (x, tl', x') xs\<rightarrow>*t \<infinity>" by auto
     with \<open>s -tl\<rightarrow> s'\<close> show ?thesis by(auto simp add: o_def intro: rtrancl3p_step_converse)
   qed
 qed
 
 lemma inf_step_table_lappend_llist_of_\<tau>_into_\<tau>moves:
   assumes "lfinite stls"
   shows "\<lbrakk> s -lappend stls (LCons (x, tl' x') xs)\<rightarrow>*t \<infinity>; \<forall>(s, tl, s')\<in>lset stls. \<tau>move s tl s' \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow>* x"
 using assms
 proof(induct arbitrary: s rule: lfinite.induct)
   case lfinite_LNil thus ?case by(auto elim: inf_step_table.cases)
 next
   case (lfinite_LConsI stls st)
   note IH = \<open>\<And>s. \<lbrakk>s -lappend stls (LCons (x, tl' x') xs)\<rightarrow>*t \<infinity>; \<forall>(s, tl, s')\<in>lset stls. \<tau>move s tl s' \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow>* x\<close>
   obtain s1 tl1 s1' where [simp]: "st = (s1, tl1, s1')" by(cases st)
   from \<open>s -lappend (LCons st stls) (LCons (x, tl' x') xs)\<rightarrow>*t \<infinity>\<close>
   show ?case
   proof cases
     case (inf_step_tableI X' STLS TL)
     hence [simp]: "s1 = s" "TL = tl1" "X' = s1'" "STLS = lappend stls (LCons (x, tl' x') xs)"
       and "s -tl1\<rightarrow> s1'" and "s1' -lappend stls (LCons (x, tl' x') xs)\<rightarrow>*t \<infinity>" by simp_all
     from \<open>\<forall>(s, tl, s')\<in>lset (LCons st stls). \<tau>move s tl s'\<close> have "\<tau>move s tl1 s1'" by simp
     moreover
     from IH[OF \<open>s1' -lappend stls (LCons (x, tl' x') xs)\<rightarrow>*t \<infinity>\<close>] \<open>\<forall>(s, tl, s')\<in>lset (LCons st stls). \<tau>move s tl s'\<close>
     have "s1' -\<tau>\<rightarrow>* x" by simp
     ultimately show ?thesis using \<open>s -tl1\<rightarrow> s1'\<close> by(auto intro: converse_rtranclp_into_rtranclp)
   qed
 qed
 
 
 lemma inf_step_table_into_\<tau>inf_step:
   "s -stls\<rightarrow>*t \<infinity> \<Longrightarrow> s -\<tau>-lmap (fst \<circ> snd) (lfilter (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') stls)\<rightarrow>* \<infinity>"
 proof(coinduction arbitrary: s stls)
   case (\<tau>inf_step s stls)
   let ?P = "\<lambda>(s, tl, s'). \<not> \<tau>move s tl s'"
   show ?case
   proof(cases "lfilter ?P stls")
     case LNil
     with \<tau>inf_step have ?\<tau>inf_step_Nil
       by(auto intro: inf_step_table_all_\<tau>_into_\<tau>diverge simp add: lfilter_eq_LNil)
     thus ?thesis ..
   next
     case (LCons stls' xs)
     obtain x tl x' where "stls' = (x, tl, x')" by(cases stls')
     with LCons have stls: "lfilter ?P stls = LCons (x, tl, x') xs" by simp
     from lfilter_eq_LConsD[OF this] obtain stls1 stls2
       where stls1: "stls = lappend stls1 (LCons (x, tl, x') stls2)"
       and "lfinite stls1"
       and \<tau>s: "\<forall>(s, tl, s')\<in>lset stls1. \<tau>move s tl s'"
       and n\<tau>: "\<not> \<tau>move x tl x'" and xs: "xs = lfilter ?P stls2" by blast
     from \<open>lfinite stls1\<close> \<tau>inf_step \<tau>s have "s -\<tau>\<rightarrow>* x" unfolding stls1
       by(rule inf_step_table_lappend_llist_of_\<tau>_into_\<tau>moves)
     moreover from \<open>lfinite stls1\<close> have "llist_of (list_of stls1) = stls1" by(simp add: llist_of_list_of)
     with \<tau>inf_step stls1 have "s -lappend (llist_of (list_of stls1)) (LCons (x, tl, x') stls2)\<rightarrow>*t \<infinity>" by simp
     from inf_step_table_lappend_llist_ofD[OF this]
     have "x -LCons (x, tl, x') stls2\<rightarrow>*t \<infinity>" ..
     hence "x -tl\<rightarrow> x'" "x' -stls2\<rightarrow>*t \<infinity>" by(auto elim: inf_step_table.cases)
     ultimately have ?\<tau>inf_step_Cons using xs n\<tau> by(auto simp add: stls o_def)
     thus ?thesis ..
   qed
 qed
 
 lemma inf_step_into_\<tau>inf_step:
   assumes "s -tls\<rightarrow>* \<infinity>"
   shows "\<exists>A. s -\<tau>-lnths tls A\<rightarrow>* \<infinity>"
 proof -
   from inf_step_imp_inf_step_table[OF assms]
   obtain stls where "s -stls\<rightarrow>*t \<infinity>" and tls: "tls = lmap (fst \<circ> snd) stls" by blast
   from \<open>s -stls\<rightarrow>*t \<infinity>\<close> have "s -\<tau>-lmap (fst \<circ> snd) (lfilter (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') stls)\<rightarrow>* \<infinity>"
     by(rule inf_step_table_into_\<tau>inf_step)
   hence "s -\<tau>-lnths tls {n. enat n < llength stls \<and> (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') (lnth stls n)}\<rightarrow>* \<infinity>"
     unfolding lfilter_conv_lnths tls by simp
   thus ?thesis by blast
 qed
 
 lemma silent_moves_into_\<tau>rtrancl3p:
   "s -\<tau>\<rightarrow>* s' \<Longrightarrow> s -\<tau>-[]\<rightarrow>* s'"
 by(induct rule: converse_rtranclp_induct)(blast intro: \<tau>rtrancl3p.intros)+
 
 lemma \<tau>rtrancl3p_into_silent_moves:
   "s -\<tau>-[]\<rightarrow>* s' \<Longrightarrow> s -\<tau>\<rightarrow>* s'"
 apply(induct s tls\<equiv>"[] :: 'tl list" s' rule: \<tau>rtrancl3p.induct)
 apply(auto intro: converse_rtranclp_into_rtranclp)
 done
 
 lemma \<tau>rtrancl3p_Nil_eq_\<tau>moves:
   "s -\<tau>-[]\<rightarrow>* s' \<longleftrightarrow> s -\<tau>\<rightarrow>* s'"
 by(blast intro: silent_moves_into_\<tau>rtrancl3p \<tau>rtrancl3p_into_silent_moves)
 
 lemma \<tau>rtrancl3p_trans [trans]:
   "\<lbrakk> s -\<tau>-tls\<rightarrow>* s'; s' -\<tau>-tls'\<rightarrow>* s'' \<rbrakk> \<Longrightarrow> s -\<tau>-tls @ tls'\<rightarrow>* s''"
 apply(induct rule: \<tau>rtrancl3p.induct)
 apply(auto intro: \<tau>rtrancl3p.intros)
 done
 
 lemma \<tau>rtrancl3p_SingletonE:
   fixes tl
   assumes red: "s -\<tau>-[tl]\<rightarrow>* s'''"
   obtains s' s'' where "s -\<tau>\<rightarrow>* s'" "s' -tl\<rightarrow> s''" "\<not> \<tau>move s' tl s''" "s'' -\<tau>\<rightarrow>* s'''"
 proof(atomize_elim)
   from red show "\<exists>s' s''. s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' -\<tau>\<rightarrow>* s'''"
   proof(induct s tls\<equiv>"[tl]" s''')
     case (\<tau>rtrancl3p_step s s' s'')
     from \<open>s -tl\<rightarrow> s'\<close> \<open>\<not> \<tau>move s tl s'\<close> \<open>s' -\<tau>-[]\<rightarrow>* s''\<close> show ?case
       by(auto simp add: \<tau>rtrancl3p_Nil_eq_\<tau>moves)
    next
     case (\<tau>rtrancl3p_\<tau>step s s' s'' tl')
     then obtain t' t'' where "s' -\<tau>\<rightarrow>* t'" "t' -tl\<rightarrow> t''" "\<not> \<tau>move t' tl t''" "t'' -\<tau>\<rightarrow>* s''" by auto
     moreover
     from \<open>s -tl'\<rightarrow> s'\<close> \<open>\<tau>move s tl' s'\<close> have "s -\<tau>\<rightarrow>* s'" by blast
     ultimately show ?case by(auto intro: rtranclp_trans)
   qed
 qed
 
 lemma \<tau>rtrancl3p_snocI:
   "\<And>tl. \<lbrakk> \<tau>rtrancl3p s tls s''; s'' -\<tau>\<rightarrow>* s'''; s''' -tl\<rightarrow> s'; \<not> \<tau>move s''' tl s' \<rbrakk>
   \<Longrightarrow> \<tau>rtrancl3p s (tls @ [tl]) s'"
 apply(erule \<tau>rtrancl3p_trans)
 apply(fold \<tau>rtrancl3p_Nil_eq_\<tau>moves)
 apply(drule \<tau>rtrancl3p_trans)
  apply(erule (1) \<tau>rtrancl3p_step)
  apply(rule \<tau>rtrancl3p_refl)
 apply simp
 done
 
 lemma \<tau>diverge_rtranclp_silent_move:
   "\<lbrakk> silent_move^** s s'; s' -\<tau>\<rightarrow> \<infinity> \<rbrakk> \<Longrightarrow> s -\<tau>\<rightarrow> \<infinity>"
 by(induct rule: converse_rtranclp_induct)(auto intro: \<tau>divergeI)
 
 lemma \<tau>diverge_trancl_coinduct [consumes 1, case_names \<tau>diverge]:
   assumes X: "X s"
   and step: "\<And>s. X s \<Longrightarrow> \<exists>s'. silent_move^++ s s' \<and> (X s' \<or> s' -\<tau>\<rightarrow> \<infinity>)"
   shows "s -\<tau>\<rightarrow> \<infinity>"
 proof -
   from X have "\<exists>s'. silent_move^** s s' \<and> X s'" by blast
   thus ?thesis
   proof(coinduct)
     case (\<tau>diverge s)
     then obtain s' where "silent_move\<^sup>*\<^sup>* s s'" "X s'" by blast
     from step[OF \<open>X s'\<close>] obtain s'''
       where "silent_move^++ s' s'''" "X s''' \<or> s''' -\<tau>\<rightarrow> \<infinity>" by blast
     from \<open>silent_move\<^sup>*\<^sup>* s s'\<close> show ?case
     proof(cases rule: converse_rtranclpE[consumes 1, case_names refl step])
       case refl
       moreover from tranclpD[OF \<open>silent_move^++ s' s'''\<close>] obtain s''
         where "silent_move s' s''" "silent_move^** s'' s'''" by blast
       ultimately show ?thesis using \<open>silent_move^** s'' s'''\<close> \<open>X s''' \<or> s''' -\<tau>\<rightarrow> \<infinity>\<close>
         by(auto intro: \<tau>diverge_rtranclp_silent_move)
     next
       case (step S)
       moreover from \<open>silent_move\<^sup>*\<^sup>* S s'\<close> \<open>silent_move^++ s' s'''\<close>
       have "silent_move^** S s'''" by(rule rtranclp_trans[OF _ tranclp_into_rtranclp])
       ultimately show ?thesis using \<open>X s''' \<or> s''' -\<tau>\<rightarrow> \<infinity>\<close> by(auto intro: \<tau>diverge_rtranclp_silent_move)
     qed
   qed
 qed
 
 lemma \<tau>diverge_trancl_measure_coinduct [consumes 2, case_names \<tau>diverge]:
   assumes major: "X s t" "wfP \<mu>"
   and step: "\<And>s t. X s t \<Longrightarrow> \<exists>s' t'. (\<mu> t' t \<and> s' = s \<or> silent_move^++ s s') \<and> (X s' t' \<or> s' -\<tau>\<rightarrow> \<infinity>)"
   shows "s -\<tau>\<rightarrow> \<infinity>"
 proof -
   { fix s t
     assume "X s t"
     with \<open>wfP \<mu>\<close> have "\<exists>s' t'. silent_move^++ s s' \<and> (X s' t' \<or> s' -\<tau>\<rightarrow> \<infinity>)"
     proof(induct arbitrary: s rule: wfP_induct[consumes 1])
       case (1 t)
       hence IH: "\<And>s' t'. \<lbrakk> \<mu> t' t; X s' t' \<rbrakk> \<Longrightarrow>
                  \<exists>s'' t''. silent_move^++ s' s'' \<and> (X s'' t'' \<or> s'' -\<tau>\<rightarrow> \<infinity>)" by blast
       from step[OF \<open>X s t\<close>] obtain s' t'
         where "\<mu> t' t \<and> s' = s \<or> silent_move\<^sup>+\<^sup>+ s s'" "X s' t' \<or> s' -\<tau>\<rightarrow> \<infinity>" by blast
       from \<open>\<mu> t' t \<and> s' = s \<or> silent_move\<^sup>+\<^sup>+ s s'\<close> show ?case
       proof
         assume "\<mu> t' t \<and> s' = s"
         hence  "\<mu> t' t" and [simp]: "s' = s" by simp_all
         from \<open>X s' t' \<or> s' -\<tau>\<rightarrow> \<infinity>\<close> show ?thesis
         proof
           assume "X s' t'"
           from IH[OF \<open>\<mu> t' t\<close> this] show ?thesis by simp
         next
           assume "s' -\<tau>\<rightarrow> \<infinity>" thus ?thesis
             by cases(auto simp add: silent_move_iff)
         qed
       next
         assume "silent_move\<^sup>+\<^sup>+ s s'"
         thus ?thesis using \<open>X s' t' \<or> s' -\<tau>\<rightarrow> \<infinity>\<close> by blast
       qed
     qed }
   note X = this
   from \<open>X s t\<close> have "\<exists>t. X s t" ..
   thus ?thesis
   proof(coinduct rule: \<tau>diverge_trancl_coinduct)
     case (\<tau>diverge s)
     then obtain t where "X s t" ..
     from X[OF this] show ?case by blast
   qed
 qed
 
 lemma \<tau>inf_step2\<tau>inf_step_table_LNil [simp]: "\<tau>inf_step2\<tau>inf_step_table s LNil = LNil"
 by(simp add: \<tau>inf_step2\<tau>inf_step_table_def)
 
 lemma \<tau>inf_step2\<tau>inf_step_table_LCons [simp]:
   fixes s tl ss tls
   defines "ss \<equiv> SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' -\<tau>-tls\<rightarrow>* \<infinity>"
   shows
   "\<tau>inf_step2\<tau>inf_step_table s (LCons tl tls) =
    LCons (s, fst ss, tl, snd ss) (\<tau>inf_step2\<tau>inf_step_table (snd ss) tls)"
 by(simp add: ss_def \<tau>inf_step2\<tau>inf_step_table_def split_beta)
 
 lemma lnull_\<tau>inf_step2\<tau>inf_step_table [simp]:
   "lnull (\<tau>inf_step2\<tau>inf_step_table s tls) \<longleftrightarrow> lnull tls"
 by(simp add: \<tau>inf_step2\<tau>inf_step_table_def)
 
 lemma lhd_\<tau>inf_step2\<tau>inf_step_table [simp]:
   "\<not> lnull tls \<Longrightarrow> lhd (\<tau>inf_step2\<tau>inf_step_table s tls) = 
   (let (s', s'') = SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -lhd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (lhd tls) s'' \<and> s'' -\<tau>-ltl tls\<rightarrow>* \<infinity>
   in (s, s', lhd tls, s''))"
 unfolding \<tau>inf_step2\<tau>inf_step_table_def Let_def by simp
 
 lemma ltl_\<tau>inf_step2\<tau>inf_step_table [simp]:
   "\<not> lnull tls \<Longrightarrow> ltl (\<tau>inf_step2\<tau>inf_step_table s tls) =
   (let (s', s'') = SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -lhd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (lhd tls) s'' \<and> s'' -\<tau>-ltl tls\<rightarrow>* \<infinity>
   in \<tau>inf_step2\<tau>inf_step_table s'' (ltl tls))"
 unfolding \<tau>inf_step2\<tau>inf_step_table_def Let_def
 by(simp add: split_beta)
 
 lemma lmap_\<tau>inf_step2\<tau>inf_step_table: "lmap (fst \<circ> snd \<circ> snd) (\<tau>inf_step2\<tau>inf_step_table s tls) = tls"
 by(coinduction arbitrary: s tls)(auto simp add: split_beta)
 
 lemma \<tau>inf_step_into_\<tau>inf_step_table:
   "s -\<tau>-tls\<rightarrow>* \<infinity> \<Longrightarrow> s -\<tau>-\<tau>inf_step2\<tau>inf_step_table s tls\<rightarrow>*t \<infinity>"
 proof(coinduction arbitrary: s tls)
   case (\<tau>inf_step_table s tls)
   thus ?case
   proof(cases)
     case (\<tau>inf_step_Cons s' s'' tls' tl)
     let ?ss = "SOME (s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' -\<tau>-tls'\<rightarrow>* \<infinity>"
     from \<tau>inf_step_Cons have tls: "tls = LCons tl tls'" and "s -\<tau>\<rightarrow>* s'" "s' -tl\<rightarrow> s''"
       "\<not> \<tau>move s' tl s''" "s'' -\<tau>-tls'\<rightarrow>* \<infinity>" by simp_all
     hence "(\<lambda>(s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' -\<tau>-tls'\<rightarrow>* \<infinity>) (s', s'')" by simp
     hence "(\<lambda>(s', s''). s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' -\<tau>-tls'\<rightarrow>* \<infinity>) ?ss" by(rule someI)
     with tls have ?\<tau>inf_step_table_Cons by auto
     thus ?thesis ..
   next
     case \<tau>inf_step_Nil
     then have ?\<tau>inf_step_table_Nil by simp
     thus ?thesis ..
   qed
 qed
 
 lemma \<tau>inf_step_imp_\<tau>inf_step_table:
   assumes "s -\<tau>-tls\<rightarrow>* \<infinity>"
   shows "\<exists>sstls. s -\<tau>-sstls\<rightarrow>*t \<infinity> \<and> tls = lmap (fst \<circ> snd \<circ> snd) sstls"
 using \<tau>inf_step_into_\<tau>inf_step_table[OF assms]
 by(auto simp only: lmap_\<tau>inf_step2\<tau>inf_step_table)
 
 lemma \<tau>inf_step_table_into_\<tau>inf_step:
   "s -\<tau>-sstls\<rightarrow>*t \<infinity> \<Longrightarrow> s -\<tau>-lmap (fst \<circ> snd \<circ> snd) sstls\<rightarrow>* \<infinity>"
 proof(coinduction arbitrary: s sstls)
   case (\<tau>inf_step s tls)
   thus ?case by cases(auto simp add: o_def)
 qed
 
 lemma silent_move_fromI [intro]:
   "\<lbrakk> silent_moves s0 s1; silent_move s1 s2 \<rbrakk> \<Longrightarrow> silent_move_from s0 s1 s2"
 by(simp add: silent_move_from_def)
 
 lemma silent_move_fromE [elim]:
   assumes "silent_move_from s0 s1 s2"
   obtains "silent_moves s0 s1" "silent_move s1 s2"
 using assms by(auto simp add: silent_move_from_def)
 
 lemma rtranclp_silent_move_from_imp_silent_moves:
   assumes s'x: "silent_move\<^sup>*\<^sup>* s' x"
   shows "(silent_move_from s')^** x z \<Longrightarrow> silent_moves s' z"
 by(induct rule: rtranclp_induct)(auto intro: s'x)
 
 lemma \<tau>diverge_not_wfP_silent_move_from:
   assumes "s -\<tau>\<rightarrow> \<infinity>"
   shows "\<not> wfP (flip (silent_move_from s))"
 proof
   assume "wfP (flip (silent_move_from s))"
   moreover define Q where "Q = {s'. silent_moves s s' \<and> s' -\<tau>\<rightarrow> \<infinity>}"
   hence "s \<in> Q" using \<open>s -\<tau>\<rightarrow> \<infinity>\<close> by(auto)
   ultimately have "\<exists>z\<in>Q. \<forall>y. silent_move_from s z y \<longrightarrow> y \<notin> Q"
     unfolding wfP_eq_minimal flip_simps by blast
   then obtain z where "z \<in> Q"
     and min: "\<And>y. silent_move_from s z y \<Longrightarrow> y \<notin> Q" by blast
   from \<open>z \<in> Q\<close> have "silent_moves s z" "z -\<tau>\<rightarrow> \<infinity>" unfolding Q_def by auto
   from \<open>z -\<tau>\<rightarrow> \<infinity>\<close> obtain y where "silent_move z y" "y -\<tau>\<rightarrow> \<infinity>" by cases auto
   from \<open>silent_moves s z\<close> \<open>silent_move z y\<close> have "silent_move_from s z y" ..
   hence "y \<notin> Q" by(rule min)
   moreover from \<open>silent_moves s z\<close> \<open>silent_move z y\<close> \<open>y -\<tau>\<rightarrow> \<infinity>\<close>
   have "y \<in> Q" unfolding Q_def by auto
   ultimately show False by contradiction
 qed
 
 lemma wfP_silent_move_from_unroll:
   assumes wfPs': "\<And>s'. s -\<tau>\<rightarrow> s' \<Longrightarrow> wfP (flip (silent_move_from s'))"
   shows "wfP (flip (silent_move_from s))"
   unfolding wfP_eq_minimal flip_conv
 proof(intro allI impI)
   fix Q and x :: 's
   assume "x \<in> Q"
   show "\<exists>z\<in>Q. \<forall>y. silent_move_from s z y \<longrightarrow> y \<notin> Q"
   proof(cases "\<exists>s'. s -\<tau>\<rightarrow> s' \<and> (\<exists>x'. silent_moves s' x' \<and> x' \<in> Q)")
     case False
     hence "\<forall>y. silent_move_from s x y \<longrightarrow> \<not> y \<in> Q"
       by(cases "x=s")(auto, blast elim: converse_rtranclpE intro: rtranclp.rtrancl_into_rtrancl)
     with \<open>x \<in> Q\<close> show ?thesis by blast
   next
     case True
     then obtain s' x' where "s -\<tau>\<rightarrow> s'" and "silent_moves s' x'" and "x' \<in> Q"
       by auto
     from \<open>s -\<tau>\<rightarrow> s'\<close> have "wfP (flip (silent_move_from s'))" by(rule wfPs')
     from this \<open>x' \<in> Q\<close> obtain z where "z \<in> Q" and min: "\<And>y. silent_move_from s' z y \<Longrightarrow> \<not> y \<in> Q"
       and "(silent_move_from s')^** x' z"
       by (rule wfP_minimalE) (unfold flip_simps, blast)
     { fix y
       assume "silent_move_from s z y"
       with \<open>(silent_move_from s')^** x' z\<close> \<open>silent_move^** s' x'\<close>
       have "silent_move_from s' z y"
         by(blast intro: rtranclp_silent_move_from_imp_silent_moves)
       hence "\<not> y \<in> Q" by(rule min) }
     with \<open>z \<in> Q\<close> show ?thesis by(auto simp add: intro!: bexI)
   qed
 qed
 
 lemma not_wfP_silent_move_from_\<tau>diverge:
   assumes "\<not> wfP (flip (silent_move_from s))"
   shows "s -\<tau>\<rightarrow> \<infinity>"
 using assms
 proof(coinduct)
   case (\<tau>diverge s)
   { assume wfPs': "\<And>s'. s -\<tau>\<rightarrow> s' \<Longrightarrow> wfP (flip (silent_move_from s'))"
     hence "wfP (flip (silent_move_from s))" by(rule wfP_silent_move_from_unroll) }
   with \<tau>diverge have "\<exists>s'. s -\<tau>\<rightarrow> s' \<and> \<not> wfP (flip (silent_move_from s'))" by auto
   thus ?case by blast
 qed
 
 lemma \<tau>diverge_neq_wfP_silent_move_from:
   "s -\<tau>\<rightarrow> \<infinity> \<noteq> wfP (flip (silent_move_from s))"
 by(auto intro: not_wfP_silent_move_from_\<tau>diverge dest: \<tau>diverge_not_wfP_silent_move_from)
 
 lemma not_\<tau>diverge_to_no_\<tau>move:
   assumes "\<not> s -\<tau>\<rightarrow> \<infinity>"
   shows "\<exists>s'. s -\<tau>\<rightarrow>* s' \<and> (\<forall>s''. \<not> s' -\<tau>\<rightarrow> s'')"
 proof -
   define S where "S = s"
   from \<open>\<not> \<tau>diverge s\<close> have "wfP (flip (silent_move_from S))" unfolding S_def
     using \<tau>diverge_neq_wfP_silent_move_from[of s] by simp
   moreover have "silent_moves S s" unfolding S_def ..
   ultimately show ?thesis
   proof(induct rule: wfP_induct')
     case (wfP s)
     note IH = \<open>\<And>y. \<lbrakk>flip (silent_move_from S) y s; S -\<tau>\<rightarrow>* y \<rbrakk>
              \<Longrightarrow> \<exists>s'. y -\<tau>\<rightarrow>* s' \<and> (\<forall>s''. \<not> s' -\<tau>\<rightarrow> s'')\<close>
     show ?case
     proof(cases "\<exists>s'. silent_move s s'")
       case False thus ?thesis by auto
     next
       case True
       then obtain s' where "s -\<tau>\<rightarrow> s'" ..
       with \<open>S -\<tau>\<rightarrow>* s\<close> have "flip (silent_move_from S) s' s"
         unfolding flip_conv by(rule silent_move_fromI)
       moreover from \<open>S -\<tau>\<rightarrow>* s\<close> \<open>s -\<tau>\<rightarrow> s'\<close> have "S -\<tau>\<rightarrow>* s'" ..
       ultimately have "\<exists>s''. s' -\<tau>\<rightarrow>* s'' \<and> (\<forall>s'''. \<not> s'' -\<tau>\<rightarrow> s''')" by(rule IH)
       then obtain s'' where "s' -\<tau>\<rightarrow>* s''" "\<forall>s'''. \<not> s'' -\<tau>\<rightarrow> s'''" by blast
       from \<open>s -\<tau>\<rightarrow> s'\<close> \<open>s' -\<tau>\<rightarrow>* s''\<close> have "s -\<tau>\<rightarrow>* s''" by(rule converse_rtranclp_into_rtranclp)
       with \<open>\<forall>s'''. \<not> s'' -\<tau>\<rightarrow> s'''\<close> show ?thesis by blast
     qed
   qed
 qed
 
 lemma \<tau>diverge_conv_\<tau>Runs:
   "s -\<tau>\<rightarrow> \<infinity> \<longleftrightarrow> s \<Down> TNil None"
 by(auto intro: \<tau>Runs.Diverge elim: \<tau>Runs.cases)
 
 lemma \<tau>inf_step_into_\<tau>Runs:
   "s -\<tau>-tls\<rightarrow>* \<infinity> \<Longrightarrow> s \<Down> tllist_of_llist None tls"
 proof(coinduction arbitrary: s tls)
   case (\<tau>Runs s tls')
   thus ?case by cases(auto simp add: \<tau>diverge_conv_\<tau>Runs)
 qed
 
 lemma \<tau>_into_\<tau>Runs:
   "\<lbrakk> s -\<tau>\<rightarrow> s'; s' \<Down> tls \<rbrakk> \<Longrightarrow> s \<Down> tls"
 by(blast elim: \<tau>Runs.cases intro: \<tau>Runs.intros \<tau>diverge.intros converse_rtranclp_into_rtranclp)
 
 lemma \<tau>rtrancl3p_into_\<tau>Runs:
   assumes "s -\<tau>-tls\<rightarrow>* s'"
   and "s' \<Down> tls'"
   shows "s \<Down> lappendt (llist_of tls) tls'"
 using assms
 by induct(auto intro: \<tau>Runs.Proceed \<tau>_into_\<tau>Runs)
 
 lemma \<tau>Runs_table_into_\<tau>Runs:
   "\<tau>Runs_table s stlsss \<Longrightarrow> s \<Down> tmap fst id stlsss"
 proof(coinduction arbitrary: s stlsss)
   case (\<tau>Runs s tls)
   thus ?case by cases(auto simp add: o_def id_def)
 qed
 
 definition \<tau>Runs2\<tau>Runs_table :: "'s \<Rightarrow> ('tl, 's option) tllist \<Rightarrow> ('tl \<times> 's, 's option) tllist"
 where
   "\<tau>Runs2\<tau>Runs_table s tls = unfold_tllist
      (\<lambda>(s, tls). is_TNil tls)
      (\<lambda>(s, tls). terminal tls)
      (\<lambda>(s, tls). (thd tls, SOME s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -thd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (thd tls) s'' \<and> s'' \<Down> ttl tls))
      (\<lambda>(s, tls). (SOME s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -thd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (thd tls) s'' \<and> s'' \<Down> ttl tls, ttl tls))
      (s, tls)"
 
 lemma is_TNil_\<tau>Runs2\<tau>Runs_table [simp]:
   "is_TNil (\<tau>Runs2\<tau>Runs_table s tls) \<longleftrightarrow> is_TNil tls"
   thm unfold_tllist.disc
 by(simp add: \<tau>Runs2\<tau>Runs_table_def)
 
 lemma thd_\<tau>Runs2\<tau>Runs_table [simp]:
   "\<not> is_TNil tls \<Longrightarrow>
   thd (\<tau>Runs2\<tau>Runs_table s tls) =
   (thd tls, SOME s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -thd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (thd tls) s'' \<and> s'' \<Down> ttl tls)"
 by(simp add: \<tau>Runs2\<tau>Runs_table_def)
 
 lemma ttl_\<tau>Runs2\<tau>Runs_table [simp]:
   "\<not> is_TNil tls \<Longrightarrow>
   ttl (\<tau>Runs2\<tau>Runs_table s tls) =
   \<tau>Runs2\<tau>Runs_table (SOME s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -thd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (thd tls) s'' \<and> s'' \<Down> ttl tls) (ttl tls)"
 by(simp add: \<tau>Runs2\<tau>Runs_table_def)
 
 lemma terminal_\<tau>Runs2\<tau>Runs_table [simp]:
   "is_TNil tls \<Longrightarrow> terminal (\<tau>Runs2\<tau>Runs_table s tls) = terminal tls"
 by(simp add: \<tau>Runs2\<tau>Runs_table_def)
 
 lemma \<tau>Runs2\<tau>Runs_table_simps [simp, nitpick_simp]:
   "\<tau>Runs2\<tau>Runs_table s (TNil so) = TNil so"
   "\<And>tl. 
    \<tau>Runs2\<tau>Runs_table s (TCons tl tls) =
    (let s'' = SOME s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' \<Down> tls
     in TCons (tl, s'') (\<tau>Runs2\<tau>Runs_table s'' tls))"
  apply(simp add: \<tau>Runs2\<tau>Runs_table_def)
 apply(rule tllist.expand)
 apply(simp_all)
 done
 
 lemma \<tau>Runs2\<tau>Runs_table_inverse:
   "tmap fst id (\<tau>Runs2\<tau>Runs_table s tls) = tls"
 by(coinduction arbitrary: s tls) auto
  
 lemma \<tau>Runs_into_\<tau>Runs_table:
   assumes "s \<Down> tls"
   shows "\<exists>stlsss. tls = tmap fst id stlsss \<and> \<tau>Runs_table s stlsss"
 proof(intro exI conjI)
   from assms show "\<tau>Runs_table s (\<tau>Runs2\<tau>Runs_table s tls)"
   proof(coinduction arbitrary: s tls)
     case (\<tau>Runs_table s tls)
     thus ?case
     proof cases
       case (Terminate s')
       hence ?Terminate by simp
       thus ?thesis ..
     next
       case Diverge
       hence ?Diverge by simp
       thus ?thesis by simp
     next
       case (Proceed s' s'' tls' tl)
       let ?P = "\<lambda>s''. \<exists>s'. s -\<tau>\<rightarrow>* s' \<and> s' -tl\<rightarrow> s'' \<and> \<not> \<tau>move s' tl s'' \<and> s'' \<Down> tls'"
       from Proceed have "?P s''" by auto
       hence "?P (Eps ?P)" by(rule someI)
       hence ?Proceed using \<open>tls = TCons tl tls'\<close>
         by(auto simp add: split_beta)
       thus ?thesis by simp
     qed
   qed
 qed(simp add: \<tau>Runs2\<tau>Runs_table_inverse)
 
 lemma \<tau>Runs_lappendtE:
   assumes "\<sigma> \<Down> lappendt tls tls'"
   and "lfinite tls"
   obtains \<sigma>' where "\<sigma> -\<tau>-list_of tls\<rightarrow>* \<sigma>'"
   and "\<sigma>' \<Down> tls'"
 proof(atomize_elim)
   from \<open>lfinite tls\<close> \<open>\<sigma> \<Down> lappendt tls tls'\<close>
   show "\<exists>\<sigma>'. \<sigma> -\<tau>-list_of tls\<rightarrow>* \<sigma>' \<and> \<sigma>' \<Down> tls'"
   proof(induct arbitrary: \<sigma>)
     case lfinite_LNil thus ?case by(auto intro: \<tau>rtrancl3p_refl)
   next
     case (lfinite_LConsI tls tl)
     from \<open>\<sigma> \<Down> lappendt (LCons tl tls) tls'\<close>
     show ?case unfolding lappendt_LCons
     proof(cases)
       case (Proceed \<sigma>' \<sigma>'')
       from \<open>\<sigma>'' \<Down> lappendt tls tls' \<Longrightarrow> \<exists>\<sigma>'''. \<sigma>'' -\<tau>-list_of tls\<rightarrow>* \<sigma>''' \<and> \<sigma>''' \<Down> tls'\<close> \<open>\<sigma>'' \<Down> lappendt tls tls'\<close>
       obtain \<sigma>''' where "\<sigma>'' -\<tau>-list_of tls\<rightarrow>* \<sigma>'''" "\<sigma>''' \<Down> tls'" by blast
       from \<open>\<sigma>' -tl\<rightarrow> \<sigma>''\<close> \<open>\<not> \<tau>move \<sigma>' tl \<sigma>''\<close> \<open>\<sigma>'' -\<tau>-list_of tls\<rightarrow>* \<sigma>'''\<close>
       have "\<sigma>' -\<tau>-tl # list_of tls\<rightarrow>* \<sigma>'''" by(rule \<tau>rtrancl3p_step)
       with \<open>\<sigma> -\<tau>\<rightarrow>* \<sigma>'\<close> have "\<sigma> -\<tau>-[] @ (tl # list_of tls)\<rightarrow>* \<sigma>'''"
         unfolding \<tau>rtrancl3p_Nil_eq_\<tau>moves[symmetric] by(rule \<tau>rtrancl3p_trans)
       with \<open>lfinite tls\<close> have "\<sigma> -\<tau>-list_of (LCons tl tls)\<rightarrow>* \<sigma>'''" by(simp add: list_of_LCons)
       with \<open>\<sigma>''' \<Down> tls'\<close> show ?thesis by blast
     qed
   qed
 qed
 
 lemma \<tau>Runs_total:
   "\<exists>tls. \<sigma> \<Down> tls"
 proof
   let ?\<tau>halt = "\<lambda>\<sigma> \<sigma>'. \<sigma> -\<tau>\<rightarrow>* \<sigma>' \<and> (\<forall>tl \<sigma>''. \<not> \<sigma>' -tl\<rightarrow> \<sigma>'')"
   let ?\<tau>diverge = "\<lambda>\<sigma>. \<sigma> -\<tau>\<rightarrow> \<infinity>"
   let ?proceed = "\<lambda>\<sigma> (tl, \<sigma>''). \<exists>\<sigma>'. \<sigma> -\<tau>\<rightarrow>* \<sigma>' \<and> \<sigma>' -tl\<rightarrow> \<sigma>'' \<and> \<not> \<tau>move \<sigma>' tl \<sigma>''"
 
   define tls where "tls = unfold_tllist
      (\<lambda>\<sigma>. (\<exists>\<sigma>'. ?\<tau>halt \<sigma> \<sigma>') \<or> ?\<tau>diverge \<sigma>)
      (\<lambda>\<sigma>. if \<exists>\<sigma>'. ?\<tau>halt \<sigma> \<sigma>' then Some (SOME \<sigma>'. ?\<tau>halt \<sigma> \<sigma>') else None)
      (\<lambda>\<sigma>. fst (SOME tl\<sigma>'. ?proceed \<sigma> tl\<sigma>'))
      (\<lambda>\<sigma>. snd (SOME tl\<sigma>'. ?proceed \<sigma> tl\<sigma>')) \<sigma>"
   then show "\<sigma> \<Down> tls"
   proof(coinduct \<sigma> tls rule: \<tau>Runs.coinduct)
     case (\<tau>Runs \<sigma> tls)
     show ?case
     proof(cases "\<exists>\<sigma>'. ?\<tau>halt \<sigma> \<sigma>'")
       case True
       hence "?\<tau>halt \<sigma> (SOME \<sigma>'. ?\<tau>halt \<sigma> \<sigma>')" by(rule someI_ex)
       hence ?Terminate using True unfolding \<tau>Runs by simp
       thus ?thesis ..
     next
       case False
       note \<tau>halt = this
       show ?thesis
       proof(cases "?\<tau>diverge \<sigma>")
         case True
         hence ?Diverge using False unfolding \<tau>Runs by simp
         thus ?thesis by simp
       next
         case False
         from not_\<tau>diverge_to_no_\<tau>move[OF this]
         obtain \<sigma>' where \<sigma>_\<sigma>': "\<sigma> -\<tau>\<rightarrow>* \<sigma>'"
           and no_\<tau>: "\<And>\<sigma>''. \<not> \<sigma>' -\<tau>\<rightarrow> \<sigma>''" by blast
         from \<sigma>_\<sigma>' \<tau>halt obtain tl \<sigma>'' where "\<sigma>' -tl\<rightarrow> \<sigma>''" by auto
         moreover with no_\<tau>[of \<sigma>''] have "\<not> \<tau>move \<sigma>' tl \<sigma>''" by auto
         ultimately have "?proceed \<sigma> (tl, \<sigma>'')" using \<sigma>_\<sigma>' by auto
         hence "?proceed \<sigma> (SOME tl\<sigma>. ?proceed \<sigma> tl\<sigma>)" by(rule someI)
         hence ?Proceed using False \<tau>halt unfolding \<tau>Runs
           by(subst unfold_tllist.code) fastforce
         thus ?thesis by simp
       qed
     qed
   qed
 qed
 
 lemma silent_move2_into_silent_move:
   fixes tl
   assumes "silent_move2 s tl s'"
   shows "s -\<tau>\<rightarrow> s'"
 using assms by(auto simp add: silent_move2_def)
 
 lemma silent_move_into_silent_move2:
   assumes "s -\<tau>\<rightarrow> s'"
   shows "\<exists>tl. silent_move2 s tl s'"
 using assms by(auto simp add: silent_move2_def)
 
 lemma silent_moves2_into_silent_moves:
   assumes "silent_moves2 s tls s'"
   shows "s -\<tau>\<rightarrow>* s'"
 using assms
 by(induct)(blast intro: silent_move2_into_silent_move rtranclp.rtrancl_into_rtrancl)+
 
 lemma silent_moves_into_silent_moves2:
   assumes "s -\<tau>\<rightarrow>* s'"
   shows "\<exists>tls. silent_moves2 s tls s'"
 using assms
 by(induct)(blast dest: silent_move_into_silent_move2 intro: rtrancl3p_step)+
 
 lemma inf_step_silent_move2_into_\<tau>diverge:
   "trsys.inf_step silent_move2 s tls \<Longrightarrow> s -\<tau>\<rightarrow> \<infinity>"
 proof(coinduction arbitrary: s tls)
   case (\<tau>diverge s)
   thus ?case
     by(cases rule: trsys.inf_step.cases[consumes 1])(auto intro: silent_move2_into_silent_move)
 qed
 
 lemma \<tau>diverge_into_inf_step_silent_move2:
   assumes "s -\<tau>\<rightarrow> \<infinity>"
   obtains tls where "trsys.inf_step silent_move2 s tls"
 proof -
   define tls where "tls = unfold_llist
      (\<lambda>_. False)
      (\<lambda>s. fst (SOME (tl, s'). silent_move2 s tl s' \<and> s' -\<tau>\<rightarrow> \<infinity>))
      (\<lambda>s. snd (SOME (tl, s'). silent_move2 s tl s' \<and> s' -\<tau>\<rightarrow> \<infinity>))
      s" (is "_ = ?tls s")
   
   with assms have "s -\<tau>\<rightarrow> \<infinity> \<and> tls = ?tls s" by simp
   hence "trsys.inf_step silent_move2 s tls"
   proof(coinduct rule: trsys.inf_step.coinduct[consumes 1, case_names inf_step, case_conclusion inf_step step])
     case (inf_step s tls)
     let ?P = "\<lambda>(tl, s'). silent_move2 s tl s' \<and> s' -\<tau>\<rightarrow> \<infinity>"
     from inf_step obtain "s -\<tau>\<rightarrow> \<infinity>" and tls: "tls = ?tls s" ..
     from \<open>s -\<tau>\<rightarrow> \<infinity>\<close> obtain s' where "s -\<tau>\<rightarrow> s'" "s' -\<tau>\<rightarrow> \<infinity>" by cases
     from \<open>s -\<tau>\<rightarrow> s'\<close> obtain tl where "silent_move2 s tl s'" 
       by(blast dest: silent_move_into_silent_move2)
     with \<open>s' -\<tau>\<rightarrow> \<infinity>\<close> have "?P (tl, s')" by simp
     hence "?P (Eps ?P)" by(rule someI)
     thus ?case using tls
       by(subst (asm) unfold_llist.code)(auto)
   qed
   thus thesis by(rule that)
 qed
 
 lemma \<tau>Runs_into_\<tau>rtrancl3p:
   assumes runs: "s \<Down> tlss"
   and fin: "tfinite tlss"
   and terminal: "terminal tlss = Some s'"
   shows "\<tau>rtrancl3p s (list_of (llist_of_tllist tlss)) s'"
 using fin runs terminal
 proof(induct arbitrary: s rule: tfinite_induct)
   case TNil thus ?case by cases(auto intro: silent_moves_into_\<tau>rtrancl3p)
 next
   case (TCons tl tlss)
   from \<open>s \<Down> TCons tl tlss\<close> obtain s'' s'''
     where step: "s -\<tau>\<rightarrow>* s''"
     and step2: "s'' -tl\<rightarrow> s'''" "\<not> \<tau>move s'' tl s'''" 
     and "s''' \<Down> tlss" by cases
   from \<open>terminal (TCons tl tlss) = \<lfloor>s'\<rfloor>\<close> have "terminal tlss = \<lfloor>s'\<rfloor>" by simp
   with \<open>s''' \<Down> tlss\<close> have "s''' -\<tau>-list_of (llist_of_tllist tlss)\<rightarrow>* s'" by(rule TCons)
   with step2 have "s'' -\<tau>-tl # list_of (llist_of_tllist tlss)\<rightarrow>* s'" by(rule \<tau>rtrancl3p_step)
   with step have "s -\<tau>-[] @ tl # list_of (llist_of_tllist tlss)\<rightarrow>* s'"
     by(rule \<tau>rtrancl3p_trans[OF silent_moves_into_\<tau>rtrancl3p])
   thus ?case using \<open>tfinite tlss\<close> by simp
 qed
 
 lemma \<tau>Runs_terminal_stuck:
   assumes Runs: "s \<Down> tlss"
   and fin: "tfinite tlss"
   and terminal: "terminal tlss = Some s'"
   and proceed: "s' -tls\<rightarrow> s''"
   shows False
 using fin Runs terminal
 proof(induct arbitrary: s rule: tfinite_induct)
   case TNil thus ?case using proceed by cases auto
 next
   case TCons thus ?case by(fastforce elim: \<tau>Runs.cases)
 qed
 
 lemma Runs_table_silent_diverge:
   "\<lbrakk> Runs_table s stlss; \<forall>(s, tl, s') \<in> lset stlss. \<tau>move s tl s'; \<not> lfinite stlss \<rbrakk>
   \<Longrightarrow> s -\<tau>\<rightarrow> \<infinity>"
 proof(coinduction arbitrary: s stlss)
   case (\<tau>diverge s)
   thus ?case by cases(auto 5 2)
 qed
 
 lemma Runs_table_silent_rtrancl:
   assumes "lfinite stlss"
   and "Runs_table s stlss"
   and "\<forall>(s, tl, s') \<in> lset stlss. \<tau>move s tl s'"
   shows "s -\<tau>\<rightarrow>* llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss))" (is ?thesis1)
   and "llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss)) -tl'\<rightarrow> s'' \<Longrightarrow> False" (is "PROP ?thesis2")
 proof -
   from assms have "?thesis1 \<and> (llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss)) -tl'\<rightarrow> s'' \<longrightarrow> False)"
   proof(induct arbitrary: s)
     case lfinite_LNil thus ?case by(auto elim: Runs_table.cases)
   next
     case (lfinite_LConsI stlss stls)
     from \<open>Runs_table s (LCons stls stlss)\<close>
     obtain tl s' where [simp]: "stls = (s, tl, s')"
       and "s -tl\<rightarrow> s'" and Run': "Runs_table s' stlss" by cases
     from \<open>\<forall>(s, tl, s')\<in>lset (LCons stls stlss). \<tau>move s tl s'\<close>
     have "\<tau>move s tl s'" and silent': "\<forall>(s, tl, s')\<in>lset stlss. \<tau>move s tl s'" by simp_all
     from \<open>s -tl\<rightarrow> s'\<close> \<open>\<tau>move s tl s'\<close> have "s -\<tau>\<rightarrow> s'" by auto
     moreover from Run' silent'
     have "s' -\<tau>\<rightarrow>* llast (LCons s' (lmap (\<lambda>(s, tl, s'). s') stlss)) \<and>
           (llast (LCons s' (lmap (\<lambda>(s, tl, s'). s') stlss)) -tl'\<rightarrow> s'' \<longrightarrow> False)"
       by(rule lfinite_LConsI)
     ultimately show ?case by(auto)
   qed
   thus ?thesis1 "PROP ?thesis2" by blast+
 qed
 
 lemma Runs_table_silent_lappendD:
   fixes s stlss
   defines "s' \<equiv> llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss))"
   assumes Runs: "Runs_table s (lappend stlss stlss')"
   and fin: "lfinite stlss"
   and silent: "\<forall>(s, tl, s') \<in> lset stlss. \<tau>move s tl s'"
   shows "s -\<tau>\<rightarrow>* s'" (is ?thesis1)
   and "Runs_table s' stlss'" (is ?thesis2)
   and "stlss' \<noteq> LNil \<Longrightarrow> s' = fst (lhd stlss')" (is "PROP ?thesis3")
 proof -
   from fin Runs silent
   have "?thesis1 \<and> ?thesis2 \<and> (stlss' \<noteq> LNil \<longrightarrow> s' = fst (lhd stlss'))"
     unfolding s'_def
   proof(induct arbitrary: s)
     case lfinite_LNil thus ?case
       by(auto simp add: neq_LNil_conv Runs_table_simps)
   next
     case lfinite_LConsI thus ?case
       by(clarsimp simp add: neq_LNil_conv Runs_table_simps)(blast intro: converse_rtranclp_into_rtranclp)
   qed
   thus ?thesis1 ?thesis2 "PROP ?thesis3" by simp_all
 qed
 
 lemma Runs_table_into_\<tau>Runs:
   fixes s stlss
   defines "tls \<equiv> tmap (\<lambda>(s, tl, s'). tl) id (tfilter None (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') (tllist_of_llist (Some (llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss)))) stlss))"
   (is "_ \<equiv> ?conv s stlss")
   assumes "Runs_table s stlss"
   shows "\<tau>Runs s tls"
 using assms
 proof(coinduction arbitrary: s tls stlss)
   case (\<tau>Runs s tls stlss)
   note tls = \<open>tls = ?conv s stlss\<close>
     and Run = \<open>Runs_table s stlss\<close>
   show ?case
   proof(cases tls)
     case [simp]: (TNil so)
     from tls
     have silent: "\<forall>(s, tl, s') \<in> lset stlss. \<tau>move s tl s'"
       by(auto simp add: TNil_eq_tmap_conv tfilter_empty_conv)
     show ?thesis
     proof(cases "lfinite stlss")
       case False
       with Run silent have "s -\<tau>\<rightarrow> \<infinity>" by(rule Runs_table_silent_diverge)
       hence ?Diverge using False tls by(simp add: TNil_eq_tmap_conv tfilter_empty_conv)
       thus ?thesis by simp
     next
       case True
       with Runs_table_silent_rtrancl[OF this Run silent]
       have ?Terminate using tls
         by(auto simp add: TNil_eq_tmap_conv tfilter_empty_conv terminal_tllist_of_llist split_def)
       thus ?thesis by simp
     qed
   next
     case [simp]: (TCons tl tls')
     from tls obtain s' s'' stlss' 
       where tl': "tfilter None (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') (tllist_of_llist \<lfloor>llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss))\<rfloor> stlss) = TCons (s', tl, s'') stlss'"
       and tls': "tls' = tmap (\<lambda>(s, tl, s'). tl) id stlss'"
       by(simp add: TCons_eq_tmap_conv split_def id_def split_paired_Ex) blast
     from tfilter_eq_TConsD[OF tl']
     obtain stls\<tau> rest
       where stlss_eq: "tllist_of_llist \<lfloor>llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss))\<rfloor> stlss = lappendt stls\<tau> (TCons (s', tl, s'') rest)"
       and fin: "lfinite stls\<tau>"
       and silent: "\<forall>(s, tl, s')\<in>lset stls\<tau>. \<tau>move s tl s'"
       and "\<not> \<tau>move s' tl s''"
       and stlss': "stlss' = tfilter None (\<lambda>(s, tl, s'). \<not> \<tau>move s tl s') rest"
       by(auto simp add: split_def)
     from stlss_eq fin obtain rest'
       where stlss: "stlss = lappend stls\<tau> rest'"
       and rest': "tllist_of_llist \<lfloor>llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stlss))\<rfloor> rest' = TCons (s', tl, s'') rest"
       unfolding tllist_of_llist_eq_lappendt_conv by auto
     hence "rest' \<noteq> LNil" by clarsimp
     from Run[unfolded stlss] fin silent
     have "s -\<tau>\<rightarrow>* llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stls\<tau>))"
       and "Runs_table (llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stls\<tau>))) rest'"
       and "llast (LCons s (lmap (\<lambda>(s, tl, s'). s') stls\<tau>)) = fst (lhd rest')"
       by(rule Runs_table_silent_lappendD)+(simp add: \<open>rest' \<noteq> LNil\<close>)
     moreover with rest' \<open>rest' \<noteq> LNil\<close> stlss fin obtain rest''
       where rest': "rest' = LCons (s', tl, s'') rest''"
       and rest: "rest = tllist_of_llist \<lfloor>llast (LCons s'' (lmap (\<lambda>(s, tl, s'). s') rest''))\<rfloor> rest''"
       by(clarsimp simp add: neq_LNil_conv llast_LCons lmap_lappend_distrib)
     ultimately have "s -\<tau>\<rightarrow>* s'" "s' -tl\<rightarrow> s''" "Runs_table s'' rest''"
       by(simp_all add: Runs_table_simps)
     hence ?Proceed using \<open>\<not> \<tau>move s' tl s''\<close> tls' stlss' rest
       by(auto simp add: id_def)
     thus ?thesis by simp
   qed
 qed
 
 lemma \<tau>Runs_table2_into_\<tau>Runs:
   "\<tau>Runs_table2 s tlsstlss
   \<Longrightarrow> s \<Down> tmap (\<lambda>(tls, s', tl, s''). tl) (\<lambda>x. case x of Inl (tls, s') \<Rightarrow> Some s' | Inr _ \<Rightarrow> None) tlsstlss"
 proof(coinduction arbitrary: s tlsstlss)
   case (\<tau>Runs s tlsstlss)
   thus ?case by cases(auto intro: silent_moves2_into_silent_moves inf_step_silent_move2_into_\<tau>diverge)
 qed
 
 lemma \<tau>Runs_into_\<tau>Runs_table2:
   assumes "s \<Down> tls"
   obtains tlsstlss
   where "\<tau>Runs_table2 s tlsstlss"
   and "tls = tmap (\<lambda>(tls, s', tl, s''). tl) (\<lambda>x. case x of Inl (tls, s') \<Rightarrow> Some s' | Inr _ \<Rightarrow> None) tlsstlss"
 proof -
   let ?terminal = "\<lambda>s tls. case terminal tls of 
           None \<Rightarrow> Inr (SOME tls'. trsys.inf_step silent_move2 s tls')
         | Some s' \<Rightarrow> let tls' = SOME tls'. silent_moves2 s tls' s' in Inl (tls', s')"
   let ?P = "\<lambda>s tls (tls'', s', s''). silent_moves2 s tls'' s' \<and> s' -thd tls\<rightarrow> s'' \<and> \<not> \<tau>move s' (thd tls) s'' \<and> s'' \<Down> ttl tls"
   define tlsstlss where "tlsstlss s tls = unfold_tllist
       (\<lambda>(s, tls). is_TNil tls)
       (\<lambda>(s, tls). ?terminal s tls)
       (\<lambda>(s, tls). let (tls'', s', s'') = Eps (?P s tls) in (tls'', s', thd tls, s''))
       (\<lambda>(s, tls). let (tls'', s', s'') = Eps (?P s tls) in (s'', ttl tls))
       (s, tls)"
     for s tls
 
   have [simp]:
     "\<And>s tls. is_TNil (tlsstlss s tls) \<longleftrightarrow> is_TNil tls"
     "\<And>s tls. is_TNil tls \<Longrightarrow> terminal (tlsstlss s tls) = ?terminal s tls"
     "\<And>s tls. \<not> is_TNil tls \<Longrightarrow> thd (tlsstlss s tls) = (let (tls'', s', s'') = Eps (?P s tls) in (tls'', s', thd tls, s''))"
     "\<And>s tls. \<not> is_TNil tls \<Longrightarrow> ttl (tlsstlss s tls) = (let (tls'', s', s'') = Eps (?P s tls) in tlsstlss s'' (ttl tls))"
     by(simp_all add: tlsstlss_def split_beta)
 
   have [simp]:
     "\<And>s. tlsstlss s (TNil None) = TNil (Inr (SOME tls'. trsys.inf_step silent_move2 s tls'))"
     "\<And>s s'. tlsstlss s (TNil (Some s')) = TNil (Inl (SOME tls'. silent_moves2 s tls' s', s'))"
     unfolding tlsstlss_def by simp_all
 
   let ?conv = "tmap (\<lambda>(tls, s', tl, s''). tl) (\<lambda>x. case x of Inl (tls, s') \<Rightarrow> Some s' | Inr _ \<Rightarrow> None)"
   from assms have "\<tau>Runs_table2 s (tlsstlss s tls)"
   proof(coinduction arbitrary: s tls)
     case (\<tau>Runs_table2 s tls)
     thus ?case
     proof(cases)
       case (Terminate s')
       let ?P = "\<lambda>tls'. silent_moves2 s tls' s'"
       from \<open>s -\<tau>\<rightarrow>* s'\<close> obtain tls' where "?P tls'" by(blast dest: silent_moves_into_silent_moves2)
       hence "?P (Eps ?P)" by(rule someI)
       with Terminate have ?Terminate by auto
       thus ?thesis by simp
     next
       case Diverge
       let ?P = "\<lambda>tls'. trsys.inf_step silent_move2 s tls'"
       from \<open>s -\<tau>\<rightarrow> \<infinity>\<close> obtain tls' where "?P tls'" by(rule \<tau>diverge_into_inf_step_silent_move2)
       hence "?P (Eps ?P)" by(rule someI)
       hence ?Diverge using \<open>tls = TNil None\<close> by simp
       thus ?thesis by simp
     next
       case (Proceed s' s'' tls' tl)
       from \<open>s -\<tau>\<rightarrow>* s'\<close> obtain tls'' where "silent_moves2 s tls'' s'"
         by(blast dest: silent_moves_into_silent_moves2)
       with Proceed have "?P s tls (tls'', s', s'')" by simp
       hence "?P s tls (Eps (?P s tls))" by(rule someI)
       hence ?Proceed using Proceed unfolding tlsstlss_def
         by(subst unfold_tllist.code)(auto simp add: split_def)
       thus ?thesis by simp
     qed
   qed
   moreover
   from assms have "tls = ?conv (tlsstlss s tls)"
   proof(coinduction arbitrary: s tls)
     case (Eq_tllist s tls)
     thus ?case
     proof(cases)
       case (Proceed s' s'' tls' tl)
       from \<open>s -\<tau>\<rightarrow>* s'\<close> obtain tls'' where "silent_moves2 s tls'' s'"
         by(blast dest: silent_moves_into_silent_moves2)
       with Proceed have "?P s tls (tls'', s', s'')" by simp
       hence "?P s tls (Eps (?P s tls))" by(rule someI)
       thus ?thesis using \<open>tls = TCons tl tls'\<close> by auto
     qed auto
   qed
   ultimately show thesis by(rule that)
 qed
 
 lemma \<tau>Runs_table2_into_Runs:
   assumes "\<tau>Runs_table2 s tlsstlss"
   shows "Runs s (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist tlsstlss)) (LCons (case terminal tlsstlss of Inl (tls, s') \<Rightarrow> llist_of tls | Inr tls \<Rightarrow> tls) LNil)))"
   (is "Runs _ (?conv tlsstlss)")
 using assms
 proof(coinduction arbitrary: s tlsstlss)
   case (Runs s tlsstlss)
   thus ?case
   proof(cases)
     case (Terminate tls' s')
     from \<open>silent_moves2 s tls' s'\<close> show ?thesis
     proof(cases rule: rtrancl3p_converseE)
       case refl 
       hence ?Stuck using Terminate by simp
       thus ?thesis ..
     next
       case (step tls'' tl s'')
       from \<open>silent_moves2 s'' tls'' s'\<close> \<open>\<And>tl s''. \<not> s' -tl\<rightarrow> s''\<close>
       have "\<tau>Runs_table2 s'' (TNil (Inl (tls'', s')))" ..
       with \<open>tls' = tl # tls''\<close> \<open>silent_move2 s tl s''\<close> \<open>tlsstlss = TNil (Inl (tls', s'))\<close>
       have ?Step by(auto simp add: silent_move2_def intro!: exI)
       thus ?thesis ..
     qed
   next
     case (Diverge tls')
     from \<open>trsys.inf_step silent_move2 s tls'\<close>
     obtain tl tls'' s' where "silent_move2 s tl s'" 
       and "tls' = LCons tl tls''" "trsys.inf_step silent_move2 s' tls''"
       by(cases rule: trsys.inf_step.cases[consumes 1]) auto
     from \<open>trsys.inf_step silent_move2 s' tls''\<close>
     have "\<tau>Runs_table2 s' (TNil (Inr tls''))" ..
     hence ?Step using \<open>tlsstlss = TNil (Inr tls')\<close> \<open>tls' = LCons tl tls''\<close> \<open>silent_move2 s tl s'\<close>
       by(auto simp add: silent_move2_def intro!: exI)
     thus ?thesis ..
   next
     case (Proceed tls' s' s'' tlsstlss' tl)
     from \<open>silent_moves2 s tls' s'\<close> have ?Step
     proof(cases rule: rtrancl3p_converseE)
       case refl with Proceed show ?thesis by auto
     next
       case (step tls'' tl' s''')
       from \<open>silent_moves2 s''' tls'' s'\<close> \<open>s' -tl\<rightarrow> s''\<close> \<open>\<not> \<tau>move s' tl s''\<close> \<open>\<tau>Runs_table2 s'' tlsstlss'\<close>
       have "\<tau>Runs_table2 s''' (TCons (tls'', s', tl, s'') tlsstlss')" ..
       with \<open>tls' = tl' # tls''\<close> \<open>silent_move2 s tl' s'''\<close> \<open>tlsstlss = TCons (tls', s', tl, s'') tlsstlss'\<close>
       show ?thesis by(auto simp add: silent_move2_def intro!: exI)
     qed
     thus ?thesis ..
   qed
 qed
 
 lemma \<tau>Runs_table2_silentsD:
   fixes tl
   assumes Runs: "\<tau>Runs_table2 s tlsstlss"
   and tset: "(tls, s', tl', s'') \<in> tset tlsstlss"
   and set: "tl \<in> set tls"
   shows "\<exists>s''' s''''. silent_move2 s''' tl s''''"
 using tset Runs
 proof(induct arbitrary: s rule: tset_induct)
   case (find tlsstlss')
   from \<open>\<tau>Runs_table2 s (TCons (tls, s', tl', s'') tlsstlss')\<close>
   have "silent_moves2 s tls s'" by cases
   thus ?case using set by induct auto
 next
   case step thus ?case by(auto simp add: \<tau>Runs_table2_simps)
 qed
 
 lemma \<tau>Runs_table2_terminal_silentsD:
   assumes Runs: "\<tau>Runs_table2 s tlsstlss"
   and fin: "lfinite (llist_of_tllist tlsstlss)"
   and terminal: "terminal tlsstlss = Inl (tls, s'')"
   shows "\<exists>s'. silent_moves2 s' tls s''"
 using fin Runs terminal
 proof(induct "llist_of_tllist tlsstlss" arbitrary: tlsstlss s)
   case lfinite_LNil thus ?case 
     by(cases tlsstlss)(auto simp add: \<tau>Runs_table2_simps)
 next
   case (lfinite_LConsI xs tlsstls)
   thus ?case by(cases tlsstlss)(auto simp add: \<tau>Runs_table2_simps)
 qed
 
 lemma \<tau>Runs_table2_terminal_inf_stepD:
   assumes Runs: "\<tau>Runs_table2 s tlsstlss"
   and fin: "lfinite (llist_of_tllist tlsstlss)"
   and terminal: "terminal tlsstlss = Inr tls"
   shows "\<exists>s'. trsys.inf_step silent_move2 s' tls"
 using fin Runs terminal
 proof(induct "llist_of_tllist tlsstlss" arbitrary: s tlsstlss)
   case lfinite_LNil thus ?case
     by(cases tlsstlss)(auto simp add: \<tau>Runs_table2_simps)
 next
   case (lfinite_LConsI xs tlsstls)
   thus ?case by(cases tlsstlss)(auto simp add: \<tau>Runs_table2_simps)
 qed
 
 lemma \<tau>Runs_table2_lappendtD:
   assumes Runs: "\<tau>Runs_table2 s (lappendt tlsstlss tlsstlss')"
   and fin: "lfinite tlsstlss"
   shows "\<exists>s'. \<tau>Runs_table2 s' tlsstlss'"
 using fin Runs
 by(induct arbitrary: s)(auto simp add: \<tau>Runs_table2_simps)
 
 end
 
 lemma \<tau>moves_False: "\<tau>trsys.silent_move r (\<lambda>s ta s'. False) = (\<lambda>s s'. False)"
 by(auto simp add: \<tau>trsys.silent_move_iff)
 
 lemma \<tau>rtrancl3p_False_eq_rtrancl3p: "\<tau>trsys.\<tau>rtrancl3p r (\<lambda>s tl s'. False) = rtrancl3p r"
 proof(intro ext iffI)
   fix s tls s'
   assume "\<tau>trsys.\<tau>rtrancl3p r (\<lambda>s tl s'. False) s tls s'"
   thus "rtrancl3p r s tls s'" by(rule \<tau>trsys.\<tau>rtrancl3p.induct)(blast intro: rtrancl3p_step_converse)+
 next
   fix s tls s'
   assume "rtrancl3p r s tls s'"
   thus "\<tau>trsys.\<tau>rtrancl3p r (\<lambda>s tl s'. False) s tls s'"
     by(induct rule: rtrancl3p_converse_induct)(auto intro: \<tau>trsys.\<tau>rtrancl3p.intros)
 qed
 
 lemma \<tau>diverge_empty_\<tau>move:
   "\<tau>trsys.\<tau>diverge r (\<lambda>s ta s'. False) = (\<lambda>s. False)"
 by(auto intro!: ext elim: \<tau>trsys.\<tau>diverge.cases \<tau>trsys.silent_move.cases)
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Common.thy b/thys/JinjaThreads/MM/JMM_Common.thy
--- a/thys/JinjaThreads/MM/JMM_Common.thy
+++ b/thys/JinjaThreads/MM/JMM_Common.thy
@@ -1,1045 +1,1045 @@
 (*  Title:      JinjaThreads/MM/JMM_Common.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>JMM Instantiation with Jinja -- common parts\<close>
 
 theory JMM_Common
 imports
   JMM_Framework
   JMM_Typesafe
   "../Common/BinOp"
   "../Common/ExternalCallWF"
 begin
 
 context heap begin
 
 lemma heap_copy_loc_not_New: assumes "heap_copy_loc a a' al h ob h'"
   shows "NewHeapElem a'' x \<in> set ob \<Longrightarrow> False"
 using assms
 by(auto elim: heap_copy_loc.cases)
 
 lemma heap_copies_not_New:
   assumes "heap_copies a a' als h obs h'" 
   and "NewHeapElem a'' x \<in> set obs"
   shows "False"
 using assms
 by induct(auto dest: heap_copy_loc_not_New)
 
 lemma heap_clone_New_same_addr_same:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "obs ! i = NewHeapElem a'' x" "i < length obs"
   and "obs ! j = NewHeapElem a'' x'" "j < length obs"
   shows "i = j"
 using assms
 apply cases
 apply(fastforce simp add: nth_Cons' gr0_conv_Suc in_set_conv_nth split: if_split_asm dest: heap_copies_not_New)+
 done
 
 lemma red_external_New_same_addr_same:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; 
     \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a' x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
     \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a' x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 by(auto elim!: red_external.cases simp add: nth_Cons' split: if_split_asm dest: heap_clone_New_same_addr_same)
 
 lemma red_external_aggr_New_same_addr_same:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h;
     \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a' x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
     \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a' x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 by(auto simp add: external_WT_defs.simps red_external_aggr_def nth_Cons' split: if_split_asm if_split_asm dest: heap_clone_New_same_addr_same)
 
 lemma heap_copy_loc_read_typeable:
   assumes "heap_copy_loc a a' al h obs h'"
   and "ReadMem ad al' v \<in> set obs"
   and "P,h \<turnstile> a@al : T"
   shows "ad = a \<and> al'= al"
 using assms by cases auto
 
 lemma heap_copies_read_typeable:
   assumes "heap_copies a a' als h obs h'"
   and "ReadMem ad al' v \<in> set obs"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts"
   shows "ad = a \<and> al' \<in> set als"
 using assms
 proof(induct arbitrary: Ts)
   case Nil thus ?case by simp
 next
   case (Cons al h ob h' als obs h'')
   from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) (al # als) Ts\<close>
   obtain T Ts' where Ts [simp]: "Ts = T # Ts'"
     and "P,h \<turnstile> a@al : T" 
     and "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
   from \<open>ReadMem ad al' v \<in> set (ob @ obs)\<close>
   show ?case unfolding set_append Un_iff
   proof
     assume "ReadMem ad al' v \<in> set ob"
     with \<open>heap_copy_loc a a' al h ob h'\<close>
     have "ad = a \<and> al'= al" using \<open>P,h \<turnstile> a@al : T\<close>
       by(rule heap_copy_loc_read_typeable)
     thus ?thesis by simp
   next
     assume "ReadMem ad al' v \<in> set obs"
     moreover from \<open>heap_copy_loc a a' al h ob h'\<close>
     have "h \<unlhd> h'" by(rule hext_heap_copy_loc)
     from \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'\<close>
     have "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) als Ts'"
       by(rule List.list_all2_mono)(rule addr_loc_type_hext_mono[OF _ \<open>h \<unlhd> h'\<close>])
     ultimately have "ad = a \<and> al' \<in> set als" by(rule Cons)
     thus ?thesis by simp
   qed
 qed
 
 lemma heap_clone_read_typeable:
   assumes clone: "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and read: "ReadMem ad al v \<in> set obs"
   shows "ad = a \<and> (\<exists>T'. P,h \<turnstile> ad@al : T')"
 using clone
 proof cases
   case (ObjClone C H' FDTs obs')
   let ?als = "map (\<lambda>((F, D), Tm). CField D F) FDTs"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
   note \<open>heap_copies a a' ?als H' obs' h'\<close>
   moreover
   from \<open>obs = NewHeapElem a' (Class_type C) # obs'\<close> read 
   have "ReadMem ad al v \<in> set obs'" by simp
   moreover
   from \<open>(H', a') \<in> allocate h (Class_type C)\<close> have "h \<unlhd> H'" by(rule hext_allocate)
   hence "typeof_addr H' a = \<lfloor>Class_type C\<rfloor>" using \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close>
     by(rule typeof_addr_hext_mono)
   hence type: "list_all2 (\<lambda>al T. P,H' \<turnstile> a@al : T) ?als ?Ts"
     using \<open>P \<turnstile> C has_fields FDTs\<close>
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   ultimately have "ad = a \<and> al \<in> set ?als" by(rule heap_copies_read_typeable)
   hence [simp]: "ad = a" and "al \<in> set ?als" by simp_all
   then obtain F D T where [simp]: "al = CField D F" and "((F, D), T) \<in> set FDTs" by auto
   with type \<open>h \<unlhd> H'\<close> \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close> show ?thesis 
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce elim!: ballE[where x="((F, D), T)"] addr_loc_type.cases dest: typeof_addr_hext_mono intro: addr_loc_type.intros)
 next
   case (ArrClone T n H' FDTs obs')
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate n T"
   note FDTs = \<open>P \<turnstile> Object has_fields FDTs\<close>
   note \<open>heap_copies a a' ?als H' obs' h'\<close>
   moreover from \<open>obs = NewHeapElem a' (Array_type T n) # obs'\<close> read
   have "ReadMem ad al v \<in> set obs'" by simp
   moreover from \<open>(H', a') \<in> allocate h (Array_type T n)\<close>
   have "h \<unlhd> H'" by(rule hext_allocate)
   with \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have type': "typeof_addr H' a = \<lfloor>Array_type T n\<rfloor>"
     by(auto dest: typeof_addr_hext_mono hext_arrD)
   hence type: "list_all2 (\<lambda>al T. P,H' \<turnstile> a@al : T) ?als ?Ts" using FDTs
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   ultimately have "ad = a \<and> al \<in> set ?als" by(rule heap_copies_read_typeable)
   hence [simp]: "ad = a" and "al \<in> set ?als" by simp_all
   hence "al \<in> set (map (\<lambda>((F, D), Tfm). CField D F) FDTs) \<or> al \<in> set (map ACell [0..<n])" by simp
   thus ?thesis
   proof
     assume "al \<in> set (map (\<lambda>((F, D), Tfm). CField D F) FDTs)"
     then obtain F D Tfm where [simp]: "al = CField D F" and "((F, D), Tfm) \<in> set FDTs" by auto
     with type type' \<open>h \<unlhd> H'\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close> show ?thesis 
-      by(fastforce elim!: ballE[where x="((F, D), Tfm)"] addr_loc_type.cases intro: addr_loc_type.intros simp add: list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv)
+      by(fastforce elim!: ballE[where x="((F, D), Tfm)"] addr_loc_type.cases intro: addr_loc_type.intros simp add: list_all2_append list_all2_map1 list_all2_map2 list_all2_same)
   next
     assume "al \<in> set (map ACell [0..<n])"
     then obtain n' where [simp]: "al = ACell n'" and "n' < n" by auto
     with type type' \<open>h \<unlhd> H'\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
     show ?thesis by(fastforce dest: list_all2_nthD[where p=n'] elim: addr_loc_type.cases intro: addr_loc_type.intros)
   qed
 qed
 
 lemma red_external_read_mem_typeable:
   assumes red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   and read: "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "\<exists>T'. P,h \<turnstile> ad@al : T'"
 using red read
 by cases(fastforce dest: heap_clone_read_typeable intro: addr_loc_type.intros)+
 
 end
 
 context heap_conf begin
 
 lemma heap_clone_typeof_addrD:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "hconf h"
   shows "NewHeapElem a'' x \<in> set obs \<Longrightarrow> a'' = a' \<and> typeof_addr h' a' = Some x"
 using assms
 by(fastforce elim!: heap_clone.cases dest: allocate_SomeD hext_heap_copies heap_copies_not_New typeof_addr_is_type elim: hext_objD hext_arrD)
 
 lemma red_external_New_typeof_addrD:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; NewHeapElem a' x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; hconf h \<rbrakk>
   \<Longrightarrow> typeof_addr h' a' = Some x"
 by(erule red_external.cases)(auto dest: heap_clone_typeof_addrD)
 
 lemma red_external_aggr_New_typeof_addrD:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; NewHeapElem a' x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      is_native P (the (typeof_addr h a)) M; hconf h \<rbrakk>
   \<Longrightarrow> typeof_addr h' a' = Some x"
 apply(auto simp add: is_native.simps external_WT_defs.simps red_external_aggr_def split: if_split_asm)
 apply(blast dest: heap_clone_typeof_addrD)+
 done
 
 end
 
 context heap_conf begin
 
 lemma heap_copy_loc_non_speculative_typeable:
   assumes copy: "heap_copy_loc ad ad' al h obs h'"
   and sc: "non_speculative P vs (llist_of (map NormalAction obs))"
   and vs: "vs_conf P h vs"
   and hconf: "hconf h"
   and wt: "P,h \<turnstile> ad@al : T" "P,h \<turnstile> ad'@al : T"
   shows "heap_base.heap_copy_loc (heap_read_typed P) heap_write ad ad' al h obs h'"
 proof -
   from copy obtain v where obs: "obs = [ReadMem ad al v, WriteMem ad' al v]"
     and read: "heap_read h ad al v" and "write": "heap_write h ad' al v h'" by cases
   from obs sc have "v \<in> vs (ad, al)" by auto
   with vs wt have v: "P,h \<turnstile> v :\<le> T" by(blast dest: vs_confD addr_loc_type_fun)+
   with read wt have "heap_read_typed P h ad al v"
     by(auto intro: heap_read_typedI dest: addr_loc_type_fun)
   thus ?thesis using "write" unfolding obs by(rule heap_base.heap_copy_loc.intros)
 qed
 
 lemma heap_copy_loc_non_speculative_vs_conf:
   assumes copy: "heap_copy_loc ad ad' al h obs h'"
   and sc: "non_speculative P vs (llist_of (take n (map NormalAction obs)))"
   and vs: "vs_conf P h vs"
   and hconf: "hconf h"
   and wt: "P,h \<turnstile> ad@al : T" "P,h \<turnstile> ad'@al : T"
   shows "vs_conf P h' (w_values P vs (take n (map NormalAction obs)))"
 proof -
   from copy obtain v where obs: "obs = [ReadMem ad al v, WriteMem ad' al v]"
     and read: "heap_read h ad al v" and "write": "heap_write h ad' al v h'" by cases
   from "write" have hext: "h \<unlhd> h'" by(rule hext_heap_write)
   with vs have vs': "vs_conf P h' vs" by(rule vs_conf_hext)
   show ?thesis
   proof(cases "n > 0")
     case True
     with obs sc have "v \<in> vs (ad, al)" by(auto simp add: take_Cons')
     with vs wt have v: "P,h \<turnstile> v :\<le> T" by(blast dest: vs_confD addr_loc_type_fun)+
     with hext wt have "P,h' \<turnstile> ad'@al : T" "P,h' \<turnstile> v :\<le> T"
       by(blast intro: addr_loc_type_hext_mono conf_hext)+
     thus ?thesis using vs' obs
       by(auto simp add: take_Cons' intro!: vs_confI split: if_split_asm dest: vs_confD)
   next
     case False thus ?thesis using vs' by simp
   qed
 qed
 
 lemma heap_copies_non_speculative_typeable:
   assumes "heap_copies ad ad' als h obs h'"
   and "non_speculative P vs (llist_of (map NormalAction obs))"
   and "vs_conf P h vs"
   and "hconf h"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) als Ts" "list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) als Ts"
   shows "heap_base.heap_copies (heap_read_typed P) heap_write ad ad' als h obs h'"
 using assms
 proof(induct arbitrary: Ts vs)
   case Nil show ?case by(auto intro: heap_base.heap_copies.intros)
 next
   case (Cons al h ob h' als obs h'')
   note sc = \<open>non_speculative P vs (llist_of (map NormalAction (ob @ obs)))\<close>
     and vs = \<open>vs_conf P h vs\<close>
     and hconf = \<open>hconf h\<close>
     and wt = \<open>list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) (al # als) Ts\<close> \<open>list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) (al # als) Ts\<close>
   
   have sc1: "non_speculative P vs (llist_of (map NormalAction ob))" 
     and sc2: "non_speculative P (w_values P vs (map NormalAction ob)) (llist_of (map NormalAction obs))"
     using sc by(simp_all add: non_speculative_lappend lappend_llist_of_llist_of[symmetric] del: lappend_llist_of_llist_of)
   from wt obtain T Ts' where Ts: "Ts = T # Ts'" 
     and wt1: "P,h \<turnstile> ad@al : T" "P,h \<turnstile> ad'@al : T"
     and wt2: "list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) als Ts'" "list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
   from \<open>heap_copy_loc ad ad' al h ob h'\<close> sc1 vs hconf wt1
   have copy: "heap_base.heap_copy_loc (heap_read_typed P) heap_write ad ad' al h ob h'"
     by(rule heap_copy_loc_non_speculative_typeable)+
   from heap_copy_loc_non_speculative_vs_conf[OF \<open>heap_copy_loc ad ad' al h ob h'\<close> _ vs hconf wt1, of "length ob"] sc1
   have vs': "vs_conf P h' (w_values P vs (map NormalAction ob))" by simp
 
   from \<open>heap_copy_loc ad ad' al h ob h'\<close>
   have "h \<unlhd> h'" by(rule hext_heap_copy_loc)
   with wt2 have wt2': "list_all2 (\<lambda>al T. P,h' \<turnstile> ad@al : T) als Ts'" "list_all2 (\<lambda>al T. P,h' \<turnstile> ad'@al : T) als Ts'"
     by -(erule List.list_all2_mono[OF _ addr_loc_type_hext_mono], assumption+)+
 
   from copy hconf wt1 have hconf': "hconf h'"
     by(rule heap_conf_read.hconf_heap_copy_loc_mono[OF heap_conf_read_heap_read_typed])
   
   from sc2 vs' hconf' wt2' have "heap_base.heap_copies (heap_read_typed P) heap_write ad ad' als h' obs h''" by(rule Cons)
   with copy show ?case by(rule heap_base.heap_copies.Cons)
 qed
 
 lemma heap_copies_non_speculative_vs_conf:
   assumes "heap_copies ad ad' als h obs h'"
   and "non_speculative P vs (llist_of (take n (map NormalAction obs)))"
   and "vs_conf P h vs"
   and "hconf h"
   and "list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) als Ts" "list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) als Ts"
   shows "vs_conf P h' (w_values P vs (take n (map NormalAction obs)))"
 using assms
 proof(induction arbitrary: Ts vs n)
   case Nil thus ?case by simp
 next
   case (Cons al h ob h' als obs h'')
   note sc = \<open>non_speculative P vs (llist_of (take n (map NormalAction (ob @ obs))))\<close>
     and hcl = \<open>heap_copy_loc ad ad' al h ob h'\<close>
     and vs = \<open>vs_conf P h vs\<close>
     and hconf = \<open>hconf h\<close>
     and wt = \<open>list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) (al # als) Ts\<close> \<open>list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) (al # als) Ts\<close>
   let ?vs' = "w_values P vs (take n (map NormalAction ob))"
 
   from sc have sc1: "non_speculative P vs (llist_of (take n (map NormalAction ob)))"
     and sc2: "non_speculative P ?vs' (llist_of (take (n - length ob) (map NormalAction obs)))"
     by(simp_all add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
   
   from wt obtain T Ts' where Ts: "Ts = T # Ts'" 
     and wt1: "P,h \<turnstile> ad@al : T" "P,h \<turnstile> ad'@al : T"
     and wt2: "list_all2 (\<lambda>al T. P,h \<turnstile> ad@al : T) als Ts'" "list_all2 (\<lambda>al T. P,h \<turnstile> ad'@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
 
   from hcl sc1 vs hconf wt1 have vs': "vs_conf P h' ?vs'" by(rule heap_copy_loc_non_speculative_vs_conf)
 
   show ?case
   proof(cases "n < length ob")
     case True
     from \<open>heap_copies ad ad' als h' obs h''\<close> have "h' \<unlhd> h''" by(rule hext_heap_copies)
     with vs' have "vs_conf P h'' ?vs'" by(rule vs_conf_hext)
     thus ?thesis using True by simp
   next
     case False
     note sc2 vs'
     moreover from False sc1 have sc1': "non_speculative P vs (llist_of (map NormalAction ob))" by simp
     with hcl have "heap_base.heap_copy_loc (heap_read_typed P) heap_write ad ad' al h ob h'"
       using vs hconf wt1 by(rule heap_copy_loc_non_speculative_typeable)
     hence "hconf h'" using hconf wt1
       by(rule heap_conf_read.hconf_heap_copy_loc_mono[OF heap_conf_read_heap_read_typed])
     moreover
     from hcl have "h \<unlhd> h'" by(rule hext_heap_copy_loc)
     with wt2 have wt2': "list_all2 (\<lambda>al T. P,h' \<turnstile> ad@al : T) als Ts'" "list_all2 (\<lambda>al T. P,h' \<turnstile> ad'@al : T) als Ts'"
       by -(erule List.list_all2_mono[OF _ addr_loc_type_hext_mono], assumption+)+
     ultimately have "vs_conf P h'' (w_values P ?vs' (take (n - length ob) (map NormalAction obs)))"
       by(rule Cons.IH)
     with False show ?thesis by simp
   qed
 qed
 
 lemma heap_clone_non_speculative_typeable_Some:
   assumes clone: "heap_clone P h ad h' \<lfloor>(obs, ad')\<rfloor>"
   and sc: "non_speculative P vs (llist_of (map NormalAction obs))"
   and vs: "vs_conf P h vs"
   and hconf: "hconf h"
   shows "heap_base.heap_clone allocate typeof_addr (heap_read_typed P) heap_write P h ad h' \<lfloor>(obs, ad')\<rfloor>"
 using clone
 proof(cases)
   case (ObjClone C h'' FDTs obs')
   note FDTs = \<open>P \<turnstile> C has_fields FDTs\<close>
     and obs = \<open>obs = NewHeapElem ad' (Class_type C) # obs'\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem ad' (Class_type C) :: ('addr, 'thread_id) obs_event))"
   from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> have hext: "h \<unlhd> h''" by(rule hext_heap_ops)
   hence type: "typeof_addr h'' ad = \<lfloor>Class_type C\<rfloor>" using \<open>typeof_addr h ad = \<lfloor>Class_type C\<rfloor>\<close> 
     by(rule typeof_addr_hext_mono)
     
   note \<open>heap_copies ad ad' ?als h'' obs' h'\<close>
   moreover from sc have "non_speculative P ?vs (llist_of (map NormalAction obs'))"
     by(simp add: obs)
   moreover from \<open>P \<turnstile> C has_fields FDTs\<close>
   have "is_class P C" by(rule has_fields_is_class)
   hence "is_htype P (Class_type C)" by simp
   with vs \<open>(h'', ad') \<in> allocate h (Class_type C)\<close>
   have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> hconf \<open>is_htype P (Class_type C)\<close>
   have "hconf h''" by(rule hconf_allocate_mono)
   moreover from type FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   moreover from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> \<open>is_htype P (Class_type C)\<close>
   have "typeof_addr h'' ad' = \<lfloor>Class_type C\<rfloor>" by(auto dest: allocate_SomeD)
   with FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad'@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   ultimately
   have copy: "heap_base.heap_copies (heap_read_typed P) heap_write ad ad' (map (\<lambda>((F, D), Tfm). CField D F) FDTs) h'' obs' h'"
     by(rule heap_copies_non_speculative_typeable)+
   from \<open>typeof_addr h ad = \<lfloor>Class_type C\<rfloor>\<close> \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> FDTs copy
   show ?thesis unfolding obs by(rule heap_base.heap_clone.intros)
 next
   case (ArrClone T n h'' FDTs obs')
   note obs = \<open>obs = NewHeapElem ad' (Array_type T n) # obs'\<close>
     and new = \<open>(h'', ad') \<in> allocate h (Array_type T n)\<close>
     and FDTs = \<open>P \<turnstile> Object has_fields FDTs\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate n T"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem ad' (Array_type T n) :: ('addr, 'thread_id) obs_event))"
   from new have hext: "h \<unlhd> h''" by(rule hext_heap_ops)
   hence type: "typeof_addr h'' ad = \<lfloor>Array_type T n\<rfloor>" using \<open>typeof_addr h ad = \<lfloor>Array_type T n\<rfloor>\<close> 
     by(rule typeof_addr_hext_mono)
   
   note \<open>heap_copies ad ad' ?als h'' obs' h'\<close>
   moreover from sc have "non_speculative P ?vs (llist_of (map NormalAction obs'))" by(simp add: obs)
   moreover from \<open>typeof_addr h ad = \<lfloor>Array_type T n\<rfloor>\<close> \<open>hconf h\<close> have "is_htype P (Array_type T n)"
     by(auto dest: typeof_addr_is_type)
   with vs new have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover from new hconf \<open>is_htype P (Array_type T n)\<close> have "hconf h''" by(rule hconf_allocate_mono)
   moreover
   from type FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad@al : T) ?als ?Ts"
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   moreover from new \<open>is_htype P (Array_type T n)\<close>
   have "typeof_addr h'' ad' = \<lfloor>Array_type T n\<rfloor>"
     by(auto dest: allocate_SomeD)
   hence "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad'@al : T) ?als ?Ts" using FDTs
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   ultimately have copy: "heap_base.heap_copies (heap_read_typed P) heap_write ad ad' (map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]) h'' obs' h'"
     by(rule heap_copies_non_speculative_typeable)+
   from \<open>typeof_addr h ad = \<lfloor>Array_type T n\<rfloor>\<close> new FDTs copy show ?thesis
     unfolding obs by(rule heap_base.heap_clone.ArrClone)
 qed
 
 lemma heap_clone_non_speculative_vs_conf_Some:
   assumes clone: "heap_clone P h ad h' \<lfloor>(obs, ad')\<rfloor>"
   and sc: "non_speculative P vs (llist_of (take n (map NormalAction obs)))"
   and vs: "vs_conf P h vs"
   and hconf: "hconf h"
   shows "vs_conf P h' (w_values P vs (take n (map NormalAction obs)))"
 using clone
 proof(cases)
   case (ObjClone C h'' FDTs obs')
   note FDTs = \<open>P \<turnstile> C has_fields FDTs\<close>
     and obs = \<open>obs = NewHeapElem ad' (Class_type C) # obs'\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem ad' (Class_type C) :: ('addr, 'thread_id) obs_event))"
   from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> have hext: "h \<unlhd> h''" by(rule hext_heap_ops)
   hence type: "typeof_addr h'' ad = \<lfloor>Class_type C\<rfloor>" using \<open>typeof_addr h ad = \<lfloor>Class_type C\<rfloor>\<close> 
     by(rule typeof_addr_hext_mono)
     
   note \<open>heap_copies ad ad' ?als h'' obs' h'\<close>
   moreover from sc have "non_speculative P ?vs (llist_of (take (n - 1) (map NormalAction obs')))"
     by(simp add: obs take_Cons' split: if_split_asm)
   moreover from \<open>P \<turnstile> C has_fields FDTs\<close>
   have "is_class P C" by(rule has_fields_is_class)
   hence "is_htype P (Class_type C)" by simp
   with vs \<open>(h'', ad') \<in> allocate h (Class_type C)\<close>
   have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> hconf \<open>is_htype P (Class_type C)\<close>
   have "hconf h''" by(rule hconf_allocate_mono)
   moreover from type FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   moreover from \<open>(h'', ad') \<in> allocate h (Class_type C)\<close> \<open>is_htype P (Class_type C)\<close>
   have "typeof_addr h'' ad' = \<lfloor>Class_type C\<rfloor>" by(auto dest: allocate_SomeD)
   with FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad'@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   ultimately
   have vs': "vs_conf P h' (w_values P ?vs (take (n - 1) (map NormalAction obs')))"
     by(rule heap_copies_non_speculative_vs_conf)
   show ?thesis
   proof(cases "n > 0")
     case True
     with obs vs' show ?thesis by(simp add: take_Cons')
   next
     case False
     from \<open>heap_copies ad ad' ?als h'' obs' h'\<close> have "h'' \<unlhd> h'" by(rule hext_heap_copies)
     with \<open>h \<unlhd> h''\<close> have "h \<unlhd> h'" by(rule hext_trans)
     with vs have "vs_conf P h' vs" by(rule vs_conf_hext)
     thus ?thesis using False by simp
   qed
 next
   case (ArrClone T N h'' FDTs obs')
   note obs = \<open>obs = NewHeapElem ad' (Array_type T N) # obs'\<close>
     and new = \<open>(h'', ad') \<in> allocate h (Array_type T N)\<close>
     and FDTs = \<open>P \<turnstile> Object has_fields FDTs\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<N]"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate N T"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem ad' (Array_type T N) :: ('addr, 'thread_id) obs_event))"
   from new have hext: "h \<unlhd> h''" by(rule hext_heap_ops)
   hence type: "typeof_addr h'' ad = \<lfloor>Array_type T N\<rfloor>" using \<open>typeof_addr h ad = \<lfloor>Array_type T N\<rfloor>\<close> 
     by(rule typeof_addr_hext_mono)
   
   note \<open>heap_copies ad ad' ?als h'' obs' h'\<close>
   moreover from sc have "non_speculative P ?vs (llist_of (take (n - 1) (map NormalAction obs')))"
     by(simp add: obs take_Cons' split: if_split_asm)
   moreover from \<open>typeof_addr h ad = \<lfloor>Array_type T N\<rfloor>\<close> \<open>hconf h\<close> have "is_htype P (Array_type T N)"
     by(auto dest: typeof_addr_is_type)
   with vs new have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover from new hconf \<open>is_htype P (Array_type T N)\<close> have "hconf h''" by(rule hconf_allocate_mono)
   moreover
   from type FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad@al : T) ?als ?Ts"
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   moreover from new \<open>is_htype P (Array_type T N)\<close>
   have "typeof_addr h'' ad' = \<lfloor>Array_type T N\<rfloor>"
     by(auto dest: allocate_SomeD)
   hence "list_all2 (\<lambda>al T. P,h'' \<turnstile> ad'@al : T) ?als ?Ts" using FDTs
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   ultimately have vs': "vs_conf P h' (w_values P ?vs (take (n - 1) (map NormalAction obs')))"
     by(rule heap_copies_non_speculative_vs_conf)
   show ?thesis
   proof(cases "n > 0")
     case True
     with obs vs' show ?thesis by(simp add: take_Cons')
   next
     case False
     from \<open>heap_copies ad ad' ?als h'' obs' h'\<close> have "h'' \<unlhd> h'" by(rule hext_heap_copies)
     with \<open>h \<unlhd> h''\<close> have "h \<unlhd> h'" by(rule hext_trans)
     with vs have "vs_conf P h' vs" by(rule vs_conf_hext)
     thus ?thesis using False by simp
   qed
 qed
 
 lemma heap_clone_non_speculative_typeable_None:
   assumes "heap_clone P h ad h' None"
   shows "heap_base.heap_clone allocate typeof_addr (heap_read_typed P) heap_write P h ad h' None"
 using assms
 by(cases)(blast intro: heap_base.heap_clone.intros)+
 
 lemma red_external_non_speculative_typeable:
   assumes red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   and sc: "non_speculative P Vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
   and vs: "vs_conf P h Vs"
   and hconf: "hconf h"
   shows "heap_base.red_external addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write P t h a M vs ta va h'"
 using assms
 by(cases)(auto intro: heap_base.red_external.intros heap_clone_non_speculative_typeable_None heap_clone_non_speculative_typeable_Some dest: hext_heap_clone elim: vs_conf_hext)
 
 lemma red_external_non_speculative_vs_conf:
   assumes red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   and sc: "non_speculative P Vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   and vs: "vs_conf P h Vs"
   and hconf: "hconf h"
   shows "vs_conf P h' (w_values P Vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 using assms
 by(cases)(auto intro: heap_base.red_external.intros heap_clone_non_speculative_vs_conf_Some dest: hext_heap_clone elim: vs_conf_hext simp add: take_Cons')
 
 lemma red_external_aggr_non_speculative_typeable:
   assumes red: "(ta, va, h') \<in> red_external_aggr P t a M vs h"
   and sc: "non_speculative P Vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
   and vs: "vs_conf P h Vs"
   and hconf: "hconf h"
   and native: "is_native P (the (typeof_addr h a)) M"
   shows "(ta, va, h') \<in> heap_base.red_external_aggr addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write P t a M vs h"
 using assms
 by(cases "the (typeof_addr h a)")(auto 4 3 simp add: is_native.simps external_WT_defs.simps red_external_aggr_def heap_base.red_external_aggr_def split: if_split_asm split del: if_split del: disjCI intro: heap_clone_non_speculative_typeable_None heap_clone_non_speculative_typeable_Some dest: sees_method_decl_above)
 
 lemma red_external_aggr_non_speculative_vs_conf:
   assumes red: "(ta, va, h') \<in> red_external_aggr P t a M vs h"
   and sc: "non_speculative P Vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   and vs: "vs_conf P h Vs"
   and hconf: "hconf h"
   and native: "is_native P (the (typeof_addr h a)) M"
   shows "vs_conf P h' (w_values P Vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 using assms
 by(cases "the (typeof_addr h a)")(auto 4 3 simp add: is_native.simps external_WT_defs.simps red_external_aggr_def heap_base.red_external_aggr_def take_Cons' split: if_split_asm split del: if_split del: disjCI intro: heap_clone_non_speculative_vs_conf_Some dest: hext_heap_clone elim: vs_conf_hext dest: sees_method_decl_above)
 
 end
 
 declare split_paired_Ex [simp del]
 declare eq_upto_seq_inconsist_simps [simp]
 
 context heap_progress begin
 
 lemma heap_copy_loc_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P h vs"
   and type: "P,h \<turnstile> a@al : T" "P,h \<turnstile> a'@al : T"
   and hconf: "hconf h"
   and copy: "heap_copy_loc a a' al h obs h'"
   and i: "i < length obs"
   and read: "obs ! i = ReadMem a'' al'' v"
   and v: "v' \<in> w_values P vs (map NormalAction (take i obs)) (a'', al'')"
   shows "\<exists>obs' h''. heap_copy_loc a a' al h obs' h'' \<and> i < length obs' \<and> take i obs' = take i obs \<and> 
                     obs' ! i = ReadMem a'' al'' v' \<and> length obs' \<le> length obs \<and> 
                     non_speculative P vs (llist_of (map NormalAction obs'))"
 using copy
 proof cases
   case (1 v'')
   with read i have [simp]: "i = 0" "v'' = v" "a'' = a" "al'' = al"
     by(simp_all add: nth_Cons split: nat.split_asm)
   from v have "v' \<in> vs (a, al)" by simp
   with vs type have conf: "P,h \<turnstile> v' :\<le> T" by(auto dest: addr_loc_type_fun vs_confD)
   let ?obs'' = "[ReadMem a al v', WriteMem a' al v']"
   from hrt type(1) conf hconf have "heap_read h a al v'" by(rule heap_read_typeableD)
   moreover from heap_write_total[OF hconf type(2) conf] 
   obtain h'' where "heap_write h a' al v' h''" ..
   ultimately have "heap_copy_loc a a' al h ?obs'' h''" ..
   thus ?thesis using 1 \<open>v' \<in> vs (a, al)\<close> by(auto)
 qed
 
 lemma heap_copies_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and copies: "heap_copies a a' als h obs h'"
   and vs: "vs_conf P h vs"
   and type1: "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts"
   and type2: "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts"
   and hconf: "hconf h"
   and i: "i < length obs"
   and read: "obs ! i = ReadMem a'' al'' v"
   and v: "v' \<in> w_values P vs (map NormalAction (take i obs)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take i obs)))"
   shows "\<exists>obs' h''. heap_copies a a' als h obs' h'' \<and> i < length obs' \<and> take i obs' = take i obs \<and> 
                     obs' ! i = ReadMem a'' al'' v' \<and> length obs' \<le> length obs"
   (is "?concl als h obs vs i")
 using copies vs type1 type2 hconf i read v ns
 proof(induction arbitrary: Ts vs i)
   case Nil thus ?case by simp
 next
   case (Cons al h ob h' als obs h'' Ts vs)
   note copy = \<open>heap_copy_loc a a' al h ob h'\<close>
   note vs = \<open>vs_conf P h vs\<close>
   note type1 = \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) (al # als) Ts\<close>
     and type2 = \<open>list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) (al # als) Ts\<close>
   note hconf = \<open>hconf h\<close>
   note i = \<open>i < length (ob @ obs)\<close>
   note read = \<open>(ob @ obs) ! i = ReadMem a'' al'' v\<close>
   note v = \<open>v' \<in> w_values P vs (map NormalAction (take i (ob @ obs))) (a'', al'')\<close>
   note ns = \<open>non_speculative P vs (llist_of (map NormalAction (take i (ob @ obs))))\<close>
 
   from type1 obtain T Ts' where Ts: "Ts = T # Ts'"
     and type1': "P,h \<turnstile> a@al : T"
     and type1'': "list_all2 (\<lambda>al T. P,h \<turnstile> a@al : T) als Ts'"
     by(auto simp add: list_all2_Cons1)
   from type2 Ts have type2': "P,h \<turnstile> a'@al : T"
     and type2'': "list_all2 (\<lambda>al T. P,h \<turnstile> a'@al : T) als Ts'"
     by simp_all
   show ?case
   proof(cases "i < length ob")
     case True
     with read v
     have "ob ! i = ReadMem a'' al'' v"
       and "v' \<in> w_values P vs (map NormalAction (take i ob)) (a'', al'')" by(simp_all add: nth_append)
     from heap_copy_loc_non_speculative_read[OF hrt vs type1' type2' hconf copy True this]
     obtain ob' H'' where copy': "heap_copy_loc a a' al h ob' H''"
       and i': "i < length ob'" and "take i ob' = take i ob"
       and "ob' ! i = ReadMem a'' al'' v'"
       and "length ob' \<le> length ob"
       and ns: "non_speculative P vs (llist_of (map NormalAction ob'))" by blast
     moreover {
       from copy' have hext: "h \<unlhd> H''" by(rule hext_heap_copy_loc)
       have "hconf H''" 
         by(rule heap_conf_read.hconf_heap_copy_loc_mono[OF heap_conf_read_heap_read_typed])(rule heap_copy_loc_non_speculative_typeable[OF copy' ns vs hconf type1' type2'], fact+)
       moreover
       from type1'' have "list_all2 (\<lambda>al T. P,H'' \<turnstile> a@al : T) als Ts'"
         by(rule List.list_all2_mono)(rule addr_loc_type_hext_mono[OF _ hext])
       moreover from type2'' have "list_all2 (\<lambda>al T. P,H'' \<turnstile> a'@al : T) als Ts'"
         by(rule List.list_all2_mono)(rule addr_loc_type_hext_mono[OF _ hext])
       moreover note calculation }
     from heap_copies_progress[OF this]
     obtain obs' h''' where *: "heap_copies a a' als H'' obs' h'''" by blast
     moreover note heap_copies_length[OF *]
     moreover note heap_copy_loc_length[OF copy']
     moreover note heap_copies_length[OF \<open>heap_copies a a' als h' obs h''\<close>]
     ultimately show ?thesis using True by(auto intro!: heap_copies.Cons exI simp add: nth_append)
   next
     case False
     let ?vs' = "w_values P vs (map NormalAction ob)"
     let ?i' = "i - length ob"
 
     from ns False obtain ns': "non_speculative P vs (llist_of (map NormalAction ob))"
       and ns'': "non_speculative P ?vs' (llist_of (map NormalAction (take ?i' obs)))"
       by(simp add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
 
     from heap_copy_loc_non_speculative_vs_conf[OF copy _ vs hconf type1' type2', where n="length ob"] ns'
     have "vs_conf P h' ?vs'" by simp
     moreover
     from copy have hext: "h \<unlhd> h'" by(rule hext_heap_copy_loc)
     from type1'' have "list_all2 (\<lambda>al T. P,h' \<turnstile> a@al : T) als Ts'"
       by(rule List.list_all2_mono)(rule addr_loc_type_hext_mono[OF _ hext])
     moreover from type2'' have "list_all2 (\<lambda>al T. P,h' \<turnstile> a'@al : T) als Ts'"
       by(rule List.list_all2_mono)(rule addr_loc_type_hext_mono[OF _ hext])
     moreover have "hconf h'" 
       by(rule heap_conf_read.hconf_heap_copy_loc_mono[OF heap_conf_read_heap_read_typed])(rule heap_copy_loc_non_speculative_typeable[OF copy ns' vs hconf type1' type2'], fact+)
     moreover from i False have "?i' < length obs" by simp
     moreover from read False have "obs ! ?i' = ReadMem a'' al'' v" by(simp add: nth_append)
     moreover from v False have "v' \<in> w_values P ?vs' (map NormalAction (take ?i' obs)) (a'', al'')" by(simp)
     ultimately have "?concl als h' obs ?vs' ?i'" using ns'' by(rule Cons.IH)
     thus ?thesis using False copy by safe(auto intro!: heap_copies.Cons exI simp add: nth_append)
   qed
 qed
 
 lemma heap_clone_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and clone: "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and vs: "vs_conf P h vs"
   and hconf: "hconf h"
   and i: "i < length obs"
   and read: "obs ! i = ReadMem a'' al'' v"
   and v: "v' \<in> w_values P vs (map NormalAction (take i obs)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take i obs)))"
   shows "\<exists>obs' h''. heap_clone P h a h'' \<lfloor>(obs', a')\<rfloor> \<and> i < length obs' \<and> take i obs' = take i obs \<and> 
                     obs' ! i = ReadMem a'' al'' v' \<and> length obs' \<le> length obs"
 using clone
 proof cases
   case (ObjClone C h'' FDTs obs')
 
   note obs = \<open>obs = NewHeapElem a' (Class_type C) # obs'\<close>
   note FDTs = \<open>P \<turnstile> C has_fields FDTs\<close>
   let ?als = "map (\<lambda>((F, D), Tm). CField D F) FDTs"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem a' (Class_type C)) :: ('addr, 'thread_id) obs_event action)"
   let ?i = "i - 1"
   from i read obs have i_0: "i > 0" by(simp add: nth_Cons' split: if_split_asm)
 
   from \<open>P \<turnstile> C has_fields FDTs\<close> have "is_class P C" by(rule has_fields_is_class)
   with \<open>(h'', a') \<in> allocate h (Class_type C)\<close>
   have type_a': "typeof_addr h'' a' = \<lfloor>Class_type C\<rfloor>" and hext: "h \<unlhd> h''"
     by(auto dest: allocate_SomeD hext_allocate)
 
   note \<open>heap_copies a a' ?als h'' obs' h'\<close>
   moreover from \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close> hconf have "is_htype P (Class_type C)"
     by(rule typeof_addr_is_type)
   with vs \<open>(h'', a') \<in> allocate h (Class_type C)\<close>
   have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover
   from hext \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close>
   have "typeof_addr h'' a = \<lfloor>Class_type C\<rfloor>" by(rule typeof_addr_hext_mono)
   hence "list_all2 (\<lambda>al T. P,h'' \<turnstile> a@al : T) ?als ?Ts" using FDTs
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   moreover from FDTs type_a'
   have "list_all2 (\<lambda>al T. P,h'' \<turnstile> a'@al : T) ?als ?Ts"
-    unfolding list_all2_map1 list_all2_map2 list_all2_refl_conv
+    unfolding list_all2_map1 list_all2_map2 list_all2_same
     by(fastforce intro: addr_loc_type.intros simp add: has_field_def dest: weak_map_of_SomeI)
   moreover from \<open>(h'', a') \<in> allocate h (Class_type C)\<close> hconf \<open>is_htype P (Class_type C)\<close>
   have "hconf h''" by(rule hconf_allocate_mono)
   moreover from i read i_0 obs have "?i < length obs'" "obs' ! ?i = ReadMem a'' al'' v" by simp_all
   moreover from v i_0 obs
   have "v' \<in> w_values P ?vs (map NormalAction (take ?i obs')) (a'', al'')" by(simp add: take_Cons')
   moreover from ns i_0 obs
   have "non_speculative P ?vs (llist_of (map NormalAction (take ?i obs')))" by(simp add: take_Cons')
   ultimately have "\<exists>obs'' h'''. heap_copies a a' ?als h'' obs'' h''' \<and>
                              ?i < length obs'' \<and> take ?i obs'' = take ?i obs' \<and> obs'' ! ?i = ReadMem a'' al'' v' \<and>
                              length obs'' \<le> length obs'"
     by(rule heap_copies_non_speculative_read[OF hrt])
   thus ?thesis using \<open>typeof_addr h a = \<lfloor>Class_type C\<rfloor>\<close> \<open>(h'', a') \<in> allocate h (Class_type C)\<close> FDTs obs i_0
     by(auto 4 4 intro: heap_clone.ObjClone simp add: take_Cons')
 next
   case (ArrClone T n h'' FDTs obs')
 
   note obs = \<open>obs = NewHeapElem a' (Array_type T n) # obs'\<close>
   note FDTs = \<open>P \<turnstile> Object has_fields FDTs\<close>
   let ?als = "map (\<lambda>((F, D), Tfm). CField D F) FDTs @ map ACell [0..<n]"
   let ?Ts = "map (\<lambda>(FD, T). fst (the (map_of FDTs FD))) FDTs @ replicate n T"
   let ?vs = "w_value P vs (NormalAction (NewHeapElem a' (Array_type T n)) :: ('addr, 'thread_id) obs_event action)"
   let ?i = "i - 1"
   from i read obs have i_0: "i > 0" by(simp add: nth_Cons' split: if_split_asm)
 
   from \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close> hconf
   have "is_htype P (Array_type T n)" by(rule typeof_addr_is_type)
   with \<open>(h'', a') \<in> allocate h (Array_type T n)\<close>
   have type_a': "typeof_addr h'' a' = \<lfloor>Array_type T n\<rfloor>"
     and hext: "h \<unlhd> h''"
     by(auto dest: allocate_SomeD hext_allocate)
 
   note \<open>heap_copies a a' ?als h'' obs' h'\<close>
   moreover from vs \<open>(h'', a') \<in> allocate h (Array_type T n)\<close> \<open>is_htype P (Array_type T n)\<close>
   have "vs_conf P h'' ?vs" by(rule vs_conf_allocate)
   moreover from hext \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have type'a: "typeof_addr h'' a = \<lfloor>Array_type T n\<rfloor>"
     by(auto intro: hext_arrD)
   from type'a FDTs have "list_all2 (\<lambda>al T. P,h'' \<turnstile> a@al : T) ?als ?Ts"
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   moreover from type_a' FDTs
   have "list_all2 (\<lambda>al T. P,h'' \<turnstile> a'@al : T) ?als ?Ts"
-    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_refl_conv dest: weak_map_of_SomeI)
+    by(fastforce intro: list_all2_all_nthI addr_loc_type.intros simp add: has_field_def list_all2_append list_all2_map1 list_all2_map2 list_all2_same dest: weak_map_of_SomeI)
   moreover from \<open>(h'', a') \<in> allocate h (Array_type T n)\<close> hconf \<open>is_htype P (Array_type T n)\<close>
   have "hconf h''" by(rule hconf_allocate_mono)
   moreover from i read i_0 obs have "?i < length obs'" "obs' ! ?i = ReadMem a'' al'' v" by simp_all
   moreover from v i_0 obs
   have "v' \<in> w_values P ?vs (map NormalAction (take ?i obs')) (a'', al'')" by(simp add: take_Cons')
   moreover from ns i_0 obs
   have "non_speculative P ?vs (llist_of (map NormalAction (take ?i obs')))" by(simp add: take_Cons')
   ultimately have "\<exists>obs'' h'''. heap_copies a a' ?als h'' obs'' h''' \<and>
                              ?i < length obs'' \<and> take ?i obs'' = take ?i obs' \<and> obs'' ! ?i = ReadMem a'' al'' v' \<and>
                              length obs'' \<le> length obs'"
     by(rule heap_copies_non_speculative_read[OF hrt])
   thus ?thesis using \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close> \<open>(h'', a') \<in> allocate h (Array_type T n)\<close> FDTs obs i_0
     by(auto 4 4 intro: heap_clone.ArrClone simp add: take_Cons')
 qed
 
 lemma red_external_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P (shr s) vs"
   and red: "P,t \<turnstile> \<langle>a\<bullet>M(vs'), shr s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>"
   and aok: "final_thread.actions_ok final s t ta"
   and hconf: "hconf (shr s)"
   and i: "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem a'' al'' v"
   and v: "v' \<in> w_values P vs (map NormalAction (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   shows "\<exists>ta'' va'' h''. P,t \<turnstile> \<langle>a\<bullet>M(vs'), shr s\<rangle> -ta''\<rightarrow>ext \<langle>va'', h''\<rangle> \<and> final_thread.actions_ok final s t ta'' \<and>
                          i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
                          \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem a'' al'' v' \<and> length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using red i read
 proof cases
   case [simp]: (RedClone obs a')
   from heap_clone_non_speculative_read[OF hrt \<open>heap_clone P (shr s) a h' \<lfloor>(obs, a')\<rfloor>\<close> vs hconf, of i a'' al'' v v'] i read v ns
   show ?thesis using aok
     by(fastforce intro: red_external.RedClone simp add: final_thread.actions_ok_iff)
 qed(auto simp add: nth_Cons)
 
 lemma red_external_aggr_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P (shr s) vs"
   and red: "(ta, va, h') \<in> red_external_aggr P t a M vs' (shr s)"
   and native: "is_native P (the (typeof_addr (shr s) a)) M"
   and aok: "final_thread.actions_ok final s t ta"
   and hconf: "hconf (shr s)"
   and i: "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem a'' al'' v"
   and v: "v' \<in> w_values P vs (map NormalAction (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   shows "\<exists>ta'' va'' h''. (ta'', va'', h'') \<in> red_external_aggr P t a M vs' (shr s) \<and> final_thread.actions_ok final s t ta'' \<and>
                          i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
                          \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem a'' al'' v' \<and> length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using red native aok hconf i read v ns
 apply(simp add: red_external_aggr_def final_thread.actions_ok_iff ex_disj_distrib conj_disj_distribR split nth_Cons' del: if_split split: if_split_asm disj_split_asm)
 apply(drule heap_clone_non_speculative_read[OF hrt _ vs hconf, of _ _ _ _ i a'' al'' v v'])
 apply simp_all
 apply(fastforce)
 done
 
 end
 
 declare split_paired_Ex [simp]
 declare eq_upto_seq_inconsist_simps [simp del]
 
 
 context allocated_heap begin
 
 lemma heap_copy_loc_allocated_same:
   assumes "heap_copy_loc a a' al h obs h'"
   shows "allocated h' = allocated h"
 using assms
 by cases(auto del: subsetI simp: heap_write_allocated_same)
 
 lemma heap_copy_loc_allocated_mono:
   "heap_copy_loc a a' al h obs h' \<Longrightarrow> allocated h \<subseteq> allocated h'"
 by(simp add: heap_copy_loc_allocated_same)
 
 lemma heap_copies_allocated_same:
   assumes "heap_copies a a' al h obs h'"
   shows "allocated h' = allocated h"
 using assms
 by(induct)(auto simp add: heap_copy_loc_allocated_same)
 
 lemma heap_copies_allocated_mono:
   "heap_copies a a' al h obs h' \<Longrightarrow> allocated h \<subseteq> allocated h'"
 by(simp add: heap_copies_allocated_same)
 
 lemma heap_clone_allocated_mono:
   assumes "heap_clone P h a h' aobs"
   shows "allocated h \<subseteq> allocated h'"
 using assms
 by cases(blast del: subsetI intro: heap_copies_allocated_mono allocate_allocated_mono intro: subset_trans)+
 
 lemma red_external_allocated_mono:
   assumes "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   shows "allocated h \<subseteq> allocated h'"
 using assms
 by(cases)(blast del: subsetI intro: heap_clone_allocated_mono heap_write_allocated_same)+
 
 lemma red_external_aggr_allocated_mono:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; is_native P (the (typeof_addr h a)) M \<rbrakk>
   \<Longrightarrow> allocated h \<subseteq> allocated h'"
 by(cases "the (typeof_addr h a)")(auto simp add: is_native.simps external_WT_defs.simps red_external_aggr_def split: if_split_asm dest: heap_clone_allocated_mono sees_method_decl_above)
 
 lemma heap_clone_allocatedD:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "NewHeapElem a'' x \<in> set obs"
   shows "a'' \<in> allocated h' \<and> a'' \<notin> allocated h"
 using assms
 by cases(auto dest: allocate_allocatedD heap_copies_allocated_mono heap_copies_not_New)
 
 lemma red_external_allocatedD:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; NewHeapElem a' x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a' \<in> allocated h' \<and> a' \<notin> allocated h"
 by(erule red_external.cases)(auto dest: heap_clone_allocatedD)
 
 lemma red_external_aggr_allocatedD:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; NewHeapElem a' x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      is_native P (the (typeof_addr h a)) M \<rbrakk>
   \<Longrightarrow> a' \<in> allocated h' \<and> a' \<notin> allocated h"
 by(auto simp add: is_native.simps external_WT_defs.simps red_external_aggr_def split: if_split_asm dest: heap_clone_allocatedD sees_method_decl_above)
 
 lemma heap_clone_NewHeapElemD:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "ad \<in> allocated h'"
   and "ad \<notin> allocated h"
   shows "\<exists>CTn. NewHeapElem ad CTn \<in> set obs"
 using assms
 by cases(auto dest!: allocate_allocatedD heap_copies_allocated_same)
 
 lemma heap_clone_fail_allocated_same:
   assumes "heap_clone P h a h' None"
   shows "allocated h' = allocated h"
 using assms
 by(cases)(auto)
 
 lemma red_external_NewHeapElemD:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; a' \<in> allocated h'; a' \<notin> allocated h \<rbrakk>
   \<Longrightarrow> \<exists>CTn. NewHeapElem a' CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 by(erule red_external.cases)(auto dest: heap_clone_NewHeapElemD heap_clone_fail_allocated_same)
 
 lemma red_external_aggr_NewHeapElemD:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; a' \<in> allocated h'; a' \<notin> allocated h;
      is_native P (the (typeof_addr h a)) M \<rbrakk>
   \<Longrightarrow> \<exists>CTn. NewHeapElem a' CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 by(cases "the (typeof_addr h a)")(auto simp add: is_native.simps external_WT_defs.simps red_external_aggr_def split: if_split_asm dest: heap_clone_fail_allocated_same heap_clone_NewHeapElemD sees_method_decl_above)
 
 end
 
 context heap_base begin
 
 lemma binop_known_addrs:
   assumes ok: "start_heap_ok"
   shows "binop bop v1 v2 = \<lfloor>Inl v\<rfloor> \<Longrightarrow> ka_Val v \<subseteq> ka_Val v1 \<union> ka_Val v2 \<union> set start_addrs"
   and "binop bop v1 v2 = \<lfloor>Inr a\<rfloor> \<Longrightarrow> a \<in> ka_Val v1 \<union> ka_Val v2 \<union> set start_addrs"
 apply(cases bop, auto split: if_split_asm)[1]
 apply(cases bop, auto split: if_split_asm simp add: addr_of_sys_xcpt_start_addr[OF ok])
 done
 
 lemma heap_copy_loc_known_addrs_ReadMem:
   assumes "heap_copy_loc a a' al h ob h'"
   and "ReadMem ad al' v \<in> set ob"
   shows "ad = a"
 using assms by cases simp
 
 lemma heap_copies_known_addrs_ReadMem:
   assumes "heap_copies a a' als h obs h'"
   and "ReadMem ad al v \<in> set obs"
   shows "ad = a"
 using assms
 by(induct)(auto dest: heap_copy_loc_known_addrs_ReadMem)
 
 lemma heap_clone_known_addrs_ReadMem:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "ReadMem ad al v \<in> set obs"
   shows "ad = a"
 using assms
 by cases(auto dest: heap_copies_known_addrs_ReadMem)
 
 lemma red_external_known_addrs_ReadMem:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs"
 by(erule red_external.cases)(simp_all add: heap_clone_known_addrs_ReadMem)
 
 lemma red_external_aggr_known_addrs_ReadMem:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs"
 apply(auto simp add: red_external_aggr_def split: if_split_asm dest: heap_clone_known_addrs_ReadMem)
 done
 
 lemma heap_copy_loc_known_addrs_WriteMem:
   assumes "heap_copy_loc a a' al h ob h'"
   and "ob ! n = WriteMem ad al' (Addr a'')" "n < length ob"
   shows "a'' \<in> new_obs_addrs (take n ob)"
 using assms
 by cases(auto simp add: nth_Cons new_obs_addrs_def split: nat.split_asm)
 
 lemma heap_copies_known_addrs_WriteMem:
   assumes "heap_copies a a' als h obs h'"
   and "obs ! n = WriteMem ad al (Addr a'')" "n < length obs"
   shows "a'' \<in> new_obs_addrs (take n obs)"
 using assms
 by(induct arbitrary: n)(auto simp add: nth_append new_obs_addrs_def dest: heap_copy_loc_known_addrs_WriteMem split: if_split_asm)
 
 lemma heap_clone_known_addrs_WriteMem:
   assumes "heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>"
   and "obs ! n = WriteMem ad al (Addr a'')" "n < length obs"
   shows "a'' \<in> new_obs_addrs (take n obs)"
 using assms
 by cases(auto simp add: nth_Cons new_obs_addrs_def split: nat.split_asm dest: heap_copies_known_addrs_WriteMem)
 
 lemma red_external_known_addrs_WriteMem:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a'); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a' \<in> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs \<union> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 by(erule red_external.cases)(auto dest: heap_clone_known_addrs_WriteMem)
 
 lemma red_external_aggr_known_addrs_WriteMem:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a'); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a' \<in> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs \<union> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 apply(auto simp add: red_external_aggr_def split: if_split_asm dest: heap_clone_known_addrs_WriteMem)
 done
 
 lemma red_external_known_addrs_mono:
   assumes ok: "start_heap_ok"
   and red: "P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>"
   shows "(case va of RetVal v \<Rightarrow> ka_Val v | RetExc a \<Rightarrow> {a} | RetStaySame \<Rightarrow> {}) \<subseteq> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using red
 by cases(auto simp add: addr_of_sys_xcpt_start_addr[OF ok] new_obs_addrs_def heap_clone.simps)
 
 lemma red_external_aggr_known_addrs_mono:
   assumes ok: "start_heap_ok"
   and red: "(ta, va, h') \<in> red_external_aggr P t a M vs h" "is_native P (the (typeof_addr h a)) M"
   shows "(case va of RetVal v \<Rightarrow> ka_Val v | RetExc a \<Rightarrow> {a} | RetStaySame \<Rightarrow> {}) \<subseteq> {thread_id2addr t, a} \<union> (\<Union>(ka_Val ` set vs)) \<union> set start_addrs \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using red
 apply(cases "the (typeof_addr h a)")
 apply(auto simp add: red_external_aggr_def addr_of_sys_xcpt_start_addr[OF ok] new_obs_addrs_def heap_clone.simps split: if_split_asm)
 apply(auto simp add: is_native.simps elim!: external_WT_defs.cases dest: sees_method_decl_above)
 done
 
 lemma red_external_NewThread_idD:
   "\<lbrakk> P,t \<turnstile> \<langle>a\<bullet>M(vs), h\<rangle> -ta\<rightarrow>ext \<langle>va, h'\<rangle>; NewThread t' (C, M', a') h'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> t' = addr2thread_id a \<and> a' = a"
 by(erule red_external.cases) simp_all
 
 lemma red_external_aggr_NewThread_idD:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; 
      NewThread t' (C, M', a') h'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> t' = addr2thread_id a \<and> a' = a"
 apply(auto simp add: red_external_aggr_def split: if_split_asm)
 done
 
 end
 
 locale heap'' = 
   heap'
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     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 :: "'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 P :: "'m prog"
   +
   assumes allocate_typeof_addr_SomeD: "\<lbrakk> (h', a) \<in> allocate h hT; typeof_addr a \<noteq> None \<rbrakk> \<Longrightarrow> typeof_addr a = \<lfloor>hT\<rfloor>"
 begin
 
 lemma heap_copy_loc_New_type_match:
   "\<lbrakk> h.heap_copy_loc a a' al h obs h'; NewHeapElem ad CTn \<in> set obs; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(erule h.heap_copy_loc.cases) simp
 
 lemma heap_copies_New_type_match:
   "\<lbrakk> h.heap_copies a a' als h obs h'; NewHeapElem ad CTn \<in> set obs; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(induct rule: h.heap_copies.induct)(auto dest: heap_copy_loc_New_type_match)
 
 lemma heap_clone_New_type_match:
   "\<lbrakk> h.heap_clone P h a h' \<lfloor>(obs, a')\<rfloor>; NewHeapElem ad CTn \<in> set obs; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(erule h.heap_clone.cases)(auto dest: allocate_typeof_addr_SomeD heap_copies_New_type_match)
 
 lemma red_external_New_type_match:
   "\<lbrakk> h.red_external P t a M vs h ta va h'; NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(erule h.red_external.cases)(auto dest: heap_clone_New_type_match)
 
 lemma red_external_aggr_New_type_match:
   "\<lbrakk> (ta, va, h') \<in> h.red_external_aggr P t a M vs h; NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(auto simp add: h.red_external_aggr_def split: if_split_asm dest: heap_clone_New_type_match)
 
 end
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_DRF.thy b/thys/JinjaThreads/MM/JMM_DRF.thy
--- a/thys/JinjaThreads/MM/JMM_DRF.thy
+++ b/thys/JinjaThreads/MM/JMM_DRF.thy
@@ -1,401 +1,401 @@
 (*  Title:      JinjaThreads/MM/JMM_DRF.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>The data race free guarantee of the JMM\<close>
 
 theory JMM_DRF
 imports
   JMM_Spec
 begin
 
 context drf begin
 
 lemma drf_lemma:
   assumes wf: "P \<turnstile> (E, ws) \<surd>"
   and E: "E \<in> \<E>"
   and sync: "correctly_synchronized P \<E>"
   and read_before: "\<And>r. r \<in> read_actions E \<Longrightarrow> P,E \<turnstile> ws r \<le>hb r"
   shows "sequentially_consistent P (E, ws)"
 proof(rule ccontr)
   let ?Q = "{r. r \<in> read_actions E \<and> \<not> P,E \<turnstile> r \<leadsto>mrw ws r}"
 
   assume "\<not> ?thesis"
   then obtain r where "r \<in> read_actions E" "\<not> P,E \<turnstile> r \<leadsto>mrw ws r"
     by(auto simp add: sequentially_consistent_def)
   hence "r \<in> ?Q" by simp
   with wf_action_order[of E] obtain r' 
     where "r' \<in> ?Q"  
     and "(action_order E)\<^sup>\<noteq>\<^sup>\<noteq>^** r' r"
     and r'_min: "\<And>a. (action_order E)\<^sup>\<noteq>\<^sup>\<noteq> a r' \<Longrightarrow> a \<notin> ?Q"
     by(rule wfP_minimalE) blast
   from \<open>r' \<in> ?Q\<close> have r': "r' \<in> read_actions E"
     and not_mrw: "\<not> P,E \<turnstile> r' \<leadsto>mrw ws r'" by blast+
 
   from r' obtain ad al v where obs_r': "action_obs E r' = NormalAction (ReadMem ad al v)"
     by(cases) auto
   from wf have ws: "is_write_seen P E ws" 
     and tsa_ok: "thread_start_actions_ok E" 
     by(rule wf_exec_is_write_seenD wf_exec_thread_start_actions_okD)+
   from is_write_seenD[OF ws r' obs_r']
   have ws_r: "ws r' \<in> write_actions E"
     and adal: "(ad, al) \<in> action_loc P E (ws r')"
     and v: "v = value_written P E (ws r') (ad, al)"
     and not_hb: "\<not> P,E \<turnstile> r' \<le>hb ws r'" by auto
   from r' have "P,E \<turnstile> ws r' \<le>hb r'" by(rule read_before)
   hence "E \<turnstile> ws r' \<le>a r'" by(rule happens_before_into_action_order)
   from not_mrw
   have "\<exists>w'. w' \<in> write_actions E \<and> (ad, al) \<in> action_loc P E w' \<and> 
       \<not> P,E \<turnstile> w' \<le>hb ws r' \<and> \<not> P,E \<turnstile> w' \<le>so ws r' \<and> 
       \<not> P,E \<turnstile> r' \<le>hb w' \<and> \<not> P,E \<turnstile> r' \<le>so w' \<and> E \<turnstile> w' \<le>a r'"
   proof(rule contrapos_np)
     assume inbetween: "\<not> ?thesis"
     note r'
     moreover from obs_r' have "(ad, al) \<in> action_loc P E r'" by simp
     moreover note \<open>E \<turnstile> ws r' \<le>a r'\<close> ws_r adal
     moreover
     { fix w'
       assume "w' \<in> write_actions E" "(ad, al) \<in> action_loc P E w'"
       with inbetween have "P,E \<turnstile> w' \<le>hb ws r' \<or> P,E \<turnstile> w' \<le>so ws r' \<or> P,E \<turnstile> r' \<le>hb w' \<or> P,E \<turnstile> r' \<le>so w' \<or> \<not> E \<turnstile> w' \<le>a r'" by simp
       moreover from total_onPD[OF total_action_order, of w' E r'] \<open>w' \<in> write_actions E\<close> r'
       have "E \<turnstile> w' \<le>a r' \<or> E \<turnstile> r' \<le>a w'" by(auto dest: read_actions_not_write_actions)
       ultimately have "E \<turnstile> w' \<le>a ws r' \<or> E \<turnstile> r' \<le>a w'" unfolding sync_order_def
         by(blast intro: happens_before_into_action_order) }
     ultimately show "P,E \<turnstile> r' \<leadsto>mrw ws r'" by(rule most_recent_write_for.intros)
   qed
   then obtain w' where w': "w' \<in> write_actions E"
     and adal_w': "(ad, al) \<in> action_loc P E w'"
     and "\<not> P,E \<turnstile> w' \<le>hb ws r'" "\<not> P,E \<turnstile> r' \<le>hb w'" "E \<turnstile> w' \<le>a r'" 
     and so: "\<not> P,E \<turnstile> w' \<le>so ws r'" "\<not> P,E \<turnstile> r' \<le>so w'" by blast
 
   have "ws r' \<noteq> w'" using \<open>\<not> P,E \<turnstile> w' \<le>hb ws r'\<close> ws_r
     by(auto intro: happens_before_refl)
 
   have vol: "\<not> is_volatile P al"
   proof
     assume vol_al: "is_volatile P al"
     with r' obs_r' have "r' \<in> sactions P E" by cases(rule sactionsI, simp_all)
     moreover from w' vol_al adal_w' have "w' \<in> sactions P E" 
       by(cases)(auto intro: sactionsI elim!: is_write_action.cases)
     ultimately have "P,E \<turnstile> w' \<le>so r' \<or> w' = r' \<or> P,E \<turnstile> r' \<le>so w'"
       using total_sync_order[of P E] by(blast dest: total_onPD)
     moreover have "w' \<noteq> r'" using w' r' by(auto dest: read_actions_not_write_actions)
     ultimately have "P,E \<turnstile> w' \<le>so r'" using \<open>\<not> P,E \<turnstile> r' \<le>so w'\<close> by simp
     moreover from ws_r vol_al adal have "ws r' \<in> sactions P E" 
       by(cases)(auto intro: sactionsI elim!: is_write_action.cases)
     with total_sync_order[of P E] \<open>w' \<in> sactions P E\<close> \<open>\<not> P,E \<turnstile> w' \<le>so ws r'\<close> \<open>ws r' \<noteq> w'\<close>
     have "P,E \<turnstile> ws r' \<le>so w'" by(blast dest: total_onPD)
     ultimately show False
       using is_write_seenD[OF ws r' obs_r'] w' adal_w' vol_al \<open>ws r' \<noteq> w'\<close> by auto
   qed
 
   { fix a
     assume "a < r'" and "a \<in> read_actions E"
     hence "(action_order E)\<^sup>\<noteq>\<^sup>\<noteq> a r'" using r' obs_r' by(auto intro: action_orderI)
     from r'_min[OF this] \<open>a \<in> read_actions E\<close>
     have "P,E \<turnstile> a \<leadsto>mrw ws a" by simp }
 
   from \<E>_sequential_completion[OF E wf this, of r'] r'
   obtain E' ws' where "E' \<in> \<E>" "P \<turnstile> (E', ws') \<surd>"
     and eq: "ltake (enat r') E = ltake (enat r') E'"
     and sc': "sequentially_consistent P (E', ws')" 
     and r'': "action_tid E r' = action_tid E' r'" "action_obs E r' \<approx> action_obs E' r'"
     and "r' \<in> actions E'"
     by auto
 
   from \<open>P \<turnstile> (E', ws') \<surd>\<close> have tsa_ok': "thread_start_actions_ok E'"
     by(rule wf_exec_thread_start_actions_okD)
 
   from \<open>r' \<in> read_actions E\<close> have "enat r' < llength E" by(auto elim: read_actions.cases actionsE)
   moreover from \<open>r' \<in> actions E'\<close> have "enat r' < llength E'" by(auto elim: actionsE)
   ultimately have eq': "ltake (enat (Suc r')) E [\<approx>] ltake (enat (Suc r')) E'"
     using eq[THEN eq_into_sim_actions] r''
     by(auto simp add: ltake_Suc_conv_snoc_lnth sim_actions_def split_beta action_tid_def action_obs_def intro!: llist_all2_lappendI)
   from r' have r'': "r' \<in> read_actions E'"
     by(rule read_actions_change_prefix[OF _eq']) simp
   from obs_r' have "(ad, al) \<in> action_loc P E r'" by simp
   hence adal_r'': "(ad, al) \<in> action_loc P E' r'"
     by(subst (asm) action_loc_change_prefix[OF eq']) simp
 
   from \<open>\<not> P,E \<turnstile> w' \<le>hb ws r'\<close>
   have "\<not> is_new_action (action_obs E w')"
   proof(rule contrapos_nn)
     assume new_w': "is_new_action (action_obs E w')"
     show "P,E \<turnstile> w' \<le>hb ws r'"
     proof(cases "is_new_action (action_obs E (ws r'))")
       case True
       with adal new_w' adal_w' w' ws_r
       have "ws r' \<in> new_actions_for P E (ad, al)" "w' \<in> new_actions_for P E (ad, al)"
         by(auto simp add: new_actions_for_def)
       with \<open>E \<in> \<E>\<close> have "ws r' = w'" by(rule \<E>_new_actions_for_fun)
       thus ?thesis using w' by(auto intro: happens_before_refl)
     next
       case False
       with tsa_ok w' ws_r new_w'
       show ?thesis by(auto intro: happens_before_new_not_new)
     qed
   qed
   with \<open>E \<turnstile> w' \<le>a r'\<close> have "w' \<le> r'" by(auto elim!: action_orderE)
   moreover from w' r' have "w' \<noteq> r'" by(auto intro: read_actions_not_write_actions)
   ultimately have "w' < r'" by simp
   with w' have "w' \<in> write_actions E'"
     by(auto intro: write_actions_change_prefix[OF _ eq'])
   hence "w' \<in> actions E'" by simp
 
   from adal_w' \<open>w' < r'\<close>
   have "(ad, al) \<in> action_loc P E' w'"
     by(subst action_loc_change_prefix[symmetric, OF eq']) simp_all
   
   from vol \<open>r' \<in> read_actions E'\<close> \<open>w' \<in> write_actions E'\<close> \<open>(ad, al) \<in> action_loc P E' w'\<close> adal_r''
   have "P,E' \<turnstile> r' \<dagger> w'" unfolding non_volatile_conflict_def by auto
   with sync \<open>E' \<in> \<E>\<close> \<open>P \<turnstile> (E', ws') \<surd>\<close> sc' \<open>r' \<in> actions E'\<close> \<open>w' \<in> actions E'\<close>
   have hb'_r'_w': "P,E' \<turnstile> r' \<le>hb w' \<or> P,E' \<turnstile> w' \<le>hb r'"
     by(rule correctly_synchronizedD[rule_format])
   hence "P,E \<turnstile> r' \<le>hb w' \<or> P,E \<turnstile> w' \<le>hb r'" using \<open>w' < r'\<close>
     by(auto intro: happens_before_change_prefix[OF _ tsa_ok eq'[symmetric]])
   with \<open>\<not> P,E \<turnstile> r' \<le>hb w'\<close> have "P,E \<turnstile> w' \<le>hb r'" by simp
   
   have "P,E \<turnstile> ws r' \<le>hb w'"
   proof(cases "is_new_action (action_obs E (ws r'))")
     case False
     with \<open>E \<turnstile> ws r' \<le>a r'\<close> have "ws r' \<le> r'" by(auto elim!: action_orderE)
     moreover from ws_r r' have "ws r' \<noteq> r'" by(auto dest: read_actions_not_write_actions)
     ultimately have "ws r' < r'" by simp
     with ws_r have "ws r' \<in> write_actions E'"
       by(auto intro: write_actions_change_prefix[OF _ eq'])
     hence "ws r' \<in> actions E'" by simp
     
     from adal \<open>ws r' < r'\<close>
     have "(ad, al) \<in> action_loc P E' (ws r')"
       by(subst action_loc_change_prefix[symmetric, OF eq']) simp_all
     hence "P,E' \<turnstile> ws r' \<dagger> w'"
       using \<open>ws r' \<in> write_actions E'\<close> \<open>w' \<in> write_actions E'\<close> \<open>(ad, al) \<in> action_loc P E' w'\<close> vol
       unfolding non_volatile_conflict_def by auto
     with sync \<open>E' \<in> \<E>\<close> \<open>P \<turnstile> (E', ws') \<surd>\<close> sc' \<open>ws r' \<in> actions E'\<close> \<open>w' \<in> actions E'\<close>
     have "P,E' \<turnstile> ws r' \<le>hb w' \<or> P,E' \<turnstile> w' \<le>hb ws r'"
       by(rule correctly_synchronizedD[rule_format])
     thus "P,E \<turnstile> ws r' \<le>hb w'" using \<open>w' < r'\<close> \<open>ws r' < r'\<close> \<open>\<not> P,E \<turnstile> w' \<le>hb ws r'\<close>
       by(auto dest: happens_before_change_prefix[OF _ tsa_ok eq'[symmetric]])
   next
     case True 
     with tsa_ok ws_r w' \<open>\<not> is_new_action (action_obs E w')\<close>
     show "P,E \<turnstile> ws r' \<le>hb w'" by(auto intro: happens_before_new_not_new)
   qed
   moreover
   from wf have "is_write_seen P E ws" by(rule wf_exec_is_write_seenD)
   ultimately have "w' = ws r'"
     using is_write_seenD[OF \<open>is_write_seen P E ws\<close> \<open>r' \<in> read_actions E\<close> obs_r']
       \<open>w' \<in> write_actions E\<close> \<open>(ad, al) \<in> action_loc P E w'\<close> \<open>P,E \<turnstile> w' \<le>hb r'\<close>
     by auto
   with porder_happens_before[of E P] \<open>\<not> P,E \<turnstile> w' \<le>hb ws r'\<close> ws_r show False
     by(auto dest: refl_onPD[where a="ws r'"] elim!: porder_onE)
 qed
 
 lemma justified_action_committedD:
   assumes justified: "P \<turnstile> (E, ws) weakly_justified_by J"
   and a: "a \<in> actions E"
   obtains n a' where "a = action_translation (J n) a'" "a' \<in> committed (J n)"
 proof(atomize_elim)
   from justified have "actions E = (\<Union>n. action_translation (J n) ` committed (J n))"
     by(simp add: is_commit_sequence_def)
   with a show "\<exists>n a'. a = action_translation (J n) a' \<and> a' \<in> committed (J n)" by auto
 qed
 
 theorem drf_weak:
   assumes sync: "correctly_synchronized P \<E>"
   and legal: "weakly_legal_execution P \<E> (E, ws)"
   shows "sequentially_consistent P (E, ws)"
 using legal_wf_execD[OF legal] legal_\<E>D[OF legal] sync
 proof(rule drf_lemma)
   fix r
   assume "r \<in> read_actions E"
 
   from legal obtain J where E: "E \<in> \<E>"
     and wf_exec: "P \<turnstile> (E, ws) \<surd>"
     and J: "P \<turnstile> (E, ws) weakly_justified_by J"
     and range_J: "range (justifying_exec \<circ> J) \<subseteq> \<E>"
     by(rule legal_executionE)
 
   let ?E = "\<lambda>n. justifying_exec (J n)"
     and ?ws = "\<lambda>n. justifying_ws (J n)"
     and ?C = "\<lambda>n. committed (J n)"
     and ?\<phi> = "\<lambda>n. action_translation (J n)"
   
   from \<open>r \<in> read_actions E\<close> have "r \<in> actions E" by simp
   with J obtain n r' where r: "r = action_translation (J n) r'"
     and r': "r' \<in> ?C n" by(rule justified_action_committedD)
 
   note \<open>r \<in> read_actions E\<close>
   moreover from J have wfan: "wf_action_translation_on (?E n) E (?C n) (?\<phi> n)"
     by(simp add: wf_action_translations_def)
   hence "action_obs (?E n) r' \<approx> action_obs E r" using r' unfolding r
     by(blast dest: wf_action_translation_on_actionD)
   moreover from J r' have "r' \<in> actions (?E n)"
     by(auto simp add: committed_subset_actions_def)
   ultimately have "r' \<in> read_actions (?E n)" unfolding r 
     by cases(auto intro: read_actions.intros)
   hence "P,E \<turnstile> ws (?\<phi> n r') \<le>hb ?\<phi> n r'" using \<open>r' \<in> ?C n\<close>
   proof(induct n arbitrary: r')
     case 0
     from J have "?C 0 = {}" by(simp add: is_commit_sequence_def)
     with 0 have False by simp
     thus ?case ..
   next
     case (Suc n r)
     note r = \<open>r \<in> read_actions (?E (Suc n))\<close>
     from J have wfan: "wf_action_translation_on (?E n) E (?C n) (?\<phi> n)"
       and wfaSn: "wf_action_translation_on (?E (Suc n)) E (?C (Suc n)) (?\<phi> (Suc n))"
       by(simp_all add: wf_action_translations_def)
 
     from wfaSn have injSn: "inj_on (?\<phi> (Suc n)) (actions (?E (Suc n)))"
       by(rule wf_action_translation_on_inj_onD)
     from J have C_sub_A: "?C (Suc n) \<subseteq> actions (?E (Suc n))"
       by(simp add: committed_subset_actions_def)
 
     from J have wf: "P \<turnstile> (?E (Suc n), ?ws (Suc n)) \<surd>" by(simp add: justification_well_formed_def)
     moreover from range_J have "?E (Suc n) \<in> \<E>" by auto
     ultimately have sc: "sequentially_consistent P (?E (Suc n), ?ws (Suc n))" using sync
     proof(rule drf_lemma)
       fix r'
       assume r': "r' \<in> read_actions (?E (Suc n))"
       hence "r' \<in> actions (?E (Suc n))" by simp
       
       show "P,?E (Suc n) \<turnstile> ?ws (Suc n) r' \<le>hb r'"
       proof(cases "?\<phi> (Suc n) r' \<in> ?\<phi> n ` ?C n")
         case True
         then obtain r'' where r'': "r'' \<in> ?C n"
           and r'_r'': "?\<phi> (Suc n) r' = ?\<phi> n r''" by(auto)
         from r'' wfan have "action_tid (?E n) r'' = action_tid E (?\<phi> n r'')"
           and "action_obs (?E n) r'' \<approx> action_obs E (?\<phi> n r'')"
           by(blast dest: wf_action_translation_on_actionD)+
         moreover from J have "?\<phi> n ` ?C n \<subseteq> ?\<phi> (Suc n) ` ?C (Suc n)"
           by(simp add: is_commit_sequence_def)
         with r'' have "?\<phi> (Suc n) r' \<in> ?\<phi> (Suc n) ` ?C (Suc n)" 
           unfolding r'_r'' by auto
         hence "r' \<in> ?C (Suc n)"
-          unfolding inj_on_image_mem_iff[OF injSn C_sub_A \<open>r' \<in> actions (?E (Suc n))\<close>] .
+          unfolding inj_on_image_mem_iff[OF injSn \<open>r' \<in> actions (?E (Suc n))\<close> C_sub_A] .
         with wfaSn have "action_tid (?E (Suc n)) r' = action_tid E (?\<phi> (Suc n) r')"
           and "action_obs (?E (Suc n)) r' \<approx> action_obs E (?\<phi> (Suc n) r')"
           by(blast dest: wf_action_translation_on_actionD)+
         ultimately have tid: "action_tid (?E n) r'' = action_tid (?E (Suc n)) r'"
           and obs: "action_obs (?E n) r'' \<approx> action_obs (?E (Suc n)) r'"
           unfolding r'_r'' by(auto intro: sim_action_trans sim_action_sym)
         
         from J have "?C n \<subseteq> actions (?E n)" by(simp add: committed_subset_actions_def)
         with r'' have "r'' \<in> actions (?E n)" by blast
         with r' obs have "r'' \<in> read_actions (?E n)"
           by cases(auto intro: read_actions.intros)
         hence hb'': "P,E \<turnstile> ws (?\<phi> n r'') \<le>hb ?\<phi> n r''"
           using \<open>r'' \<in> ?C n\<close> by(rule Suc)
 
         have r_conv_inv: "r' = inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) (?\<phi> n r'')"
           using \<open>r' \<in> actions (?E (Suc n))\<close> unfolding r'_r''[symmetric]
           by(simp add: inv_into_f_f[OF injSn])
         with \<open>r'' \<in> ?C n\<close> r' J \<open>r'' \<in> read_actions (?E n)\<close>
         have ws_eq[symmetric]: "?\<phi> (Suc n) (?ws (Suc n) r') = ws (?\<phi> n r'')"
-          by(simp add: write_seen_committed_def Let_def)
+          by(simp add: write_seen_committed_def)
         with r'_r''[symmetric] hb'' have "P,E \<turnstile> ?\<phi> (Suc n) (?ws (Suc n) r') \<le>hb ?\<phi> (Suc n) r'" by simp
         
         moreover
 
         from J r' \<open>r' \<in> committed (J (Suc n))\<close>
         have "ws (?\<phi> (Suc n) r') \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
           by(rule weakly_justified_write_seen_hb_read_committed)
         then obtain w' where w': "ws (?\<phi> (Suc n) r') = ?\<phi> (Suc n) w'"
           and committed_w': "w' \<in> ?C (Suc n)" by blast
         with C_sub_A have w'_action: "w' \<in> actions (?E (Suc n))" by auto
 
         hence w'_def: "w' = inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) (ws (?\<phi> (Suc n) r'))"
           using injSn unfolding w' by simp
 
         from J r'  \<open>r' \<in> committed (J (Suc n))\<close> 
         have hb_eq: "P,E \<turnstile> ws (?\<phi> (Suc n) r') \<le>hb ?\<phi> (Suc n) r' \<longleftrightarrow> P,?E (Suc n) \<turnstile> w' \<le>hb r'"
           unfolding w'_def by(simp add: happens_before_committed_weak_def)
 
         from r' obtain ad al v where "action_obs (?E (Suc n)) r' = NormalAction (ReadMem ad al v)" by(cases)
         from is_write_seenD[OF wf_exec_is_write_seenD[OF wf] r' this]
         have "?ws (Suc n) r' \<in> actions (?E (Suc n))" by(auto)
         with injSn have "w' = ?ws (Suc n) r'"
           unfolding w'_def ws_eq[folded r'_r''] by(rule inv_into_f_f)
         thus ?thesis using hb'' hb_eq w'_action r'_r''[symmetric] w' injSn by simp
       next
         case False
         with J r' show ?thesis by(auto simp add: uncommitted_reads_see_hb_def)
       qed
     qed
 
     from r have "r \<in> actions (?E (Suc n))" by simp
     let ?w = "inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) (ws (?\<phi> (Suc n) r))"
     from J r \<open>r \<in> ?C (Suc n)\<close> have ws_rE_comm: "ws (?\<phi> (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
       by(rule weakly_justified_write_seen_hb_read_committed)
     hence "?w \<in> ?C (Suc n)" using C_sub_A by(auto simp add: inv_into_f_f[OF injSn])
     with C_sub_A have w: "?w \<in> actions (?E (Suc n))" by blast
 
     from ws_rE_comm C_sub_A have w_eq: "?\<phi> (Suc n) ?w = ws (?\<phi> (Suc n) r)"
       by(auto simp: f_inv_into_f[where f="?\<phi> (Suc n)"])
     from r obtain ad al v
       where obsr: "action_obs (?E (Suc n)) r = NormalAction (ReadMem ad al v)" by cases
     hence adal_r: "(ad, al) \<in> action_loc P (?E (Suc n)) r" by simp
     from J wfaSn \<open>r \<in> ?C (Suc n)\<close>
     have obs_sim: "action_obs (?E (Suc n)) r \<approx> action_obs E (?\<phi> (Suc n) r)" "?\<phi> (Suc n) r \<in> actions E"
       by(auto dest: wf_action_translation_on_actionD simp add: committed_subset_actions_def is_commit_sequence_def)
     with obsr have rE: "?\<phi> (Suc n) r \<in> read_actions E" by(fastforce intro: read_actions.intros)
     from obs_sim obsr obtain v' 
       where obsrE: "action_obs E (?\<phi> (Suc n) r) = NormalAction (ReadMem ad al v')" by auto
     from wf_exec have "is_write_seen P E ws" by(rule wf_exec_is_write_seenD)
     from is_write_seenD[OF this rE obsrE]
     have "ws (?\<phi> (Suc n) r) \<in> write_actions E" 
       and "(ad, al) \<in> action_loc P E (ws (?\<phi> (Suc n) r))"
       and nhb: "\<not> P,E \<turnstile> ?\<phi> (Suc n) r \<le>hb ws (?\<phi> (Suc n) r)" 
       and vol: "is_volatile P al \<Longrightarrow> \<not> P,E \<turnstile> ?\<phi> (Suc n) r \<le>so ws (?\<phi> (Suc n) r)" by simp_all
 
     show ?case
     proof(cases "is_volatile P al")
       case False
 
       from wf_action_translation_on_actionD[OF wfaSn \<open>?w \<in> ?C (Suc n)\<close>]
       have "action_obs (?E (Suc n)) ?w \<approx> action_obs E (?\<phi> (Suc n) ?w)" by simp
       with w_eq have obs_sim_w: "action_obs (?E (Suc n)) ?w \<approx> action_obs E (ws (?\<phi> (Suc n) r))" by simp
       with \<open>ws (?\<phi> (Suc n) r) \<in> write_actions E\<close> \<open>?w \<in> actions (?E (Suc n))\<close>
       have "?w \<in> write_actions (?E (Suc n))"
         by cases(fastforce intro: write_actions.intros is_write_action.intros elim!: is_write_action.cases)
       from \<open>(ad, al) \<in> action_loc P E (ws (?\<phi> (Suc n) r))\<close> obs_sim_w 
       have "(ad, al) \<in> action_loc P (?E (Suc n)) ?w" by cases(auto intro: action_loc_aux_intros)
       with r adal_r \<open>?w \<in> write_actions (?E (Suc n))\<close> False
       have "P,?E (Suc n) \<turnstile> r \<dagger> ?w" by(auto simp add: non_volatile_conflict_def)
       with sc \<open>r \<in> actions (?E (Suc n))\<close> w
       have "P,?E (Suc n) \<turnstile> r \<le>hb ?w \<or> P,?E (Suc n) \<turnstile> ?w \<le>hb r"
         by(rule correctly_synchronizedD[rule_format, OF sync \<open>?E (Suc n) \<in> \<E>\<close> wf])
       moreover from J r \<open>r \<in> ?C (Suc n)\<close> 
       have "P,?E (Suc n) \<turnstile> ?w \<le>hb r \<longleftrightarrow> P,E \<turnstile> ws (?\<phi> (Suc n) r) \<le>hb ?\<phi> (Suc n) r"
         and "\<not> P,?E (Suc n) \<turnstile> r \<le>hb ?w"
         by(simp_all add: happens_before_committed_weak_def)
       ultimately show ?thesis by auto
     next
       case True
       with rE obsrE have "?\<phi> (Suc n) r \<in> sactions P E" by cases (auto intro: sactionsI)
       moreover from \<open>ws (?\<phi> (Suc n) r) \<in> write_actions E\<close> \<open>(ad, al) \<in> action_loc P E (ws (?\<phi> (Suc n) r))\<close> True 
       have "ws (?\<phi> (Suc n) r) \<in> sactions P E" by cases(auto intro!: sactionsI elim: is_write_action.cases)
       moreover have "?\<phi> (Suc n) r \<noteq> ws (?\<phi> (Suc n) r)"
         using \<open>ws (?\<phi> (Suc n) r) \<in> write_actions E\<close> rE by(auto dest: read_actions_not_write_actions)
       ultimately have "P,E \<turnstile> ws (?\<phi> (Suc n) r) \<le>so ?\<phi> (Suc n) r"
         using total_sync_order[of P E] vol[OF True] by(auto dest: total_onPD)
       moreover from \<open>ws (?\<phi> (Suc n) r) \<in> write_actions E\<close> \<open>(ad, al) \<in> action_loc P E (ws (?\<phi> (Suc n) r))\<close> True
       have "P \<turnstile> (action_tid E (ws (?\<phi> (Suc n) r)), action_obs E (ws (?\<phi> (Suc n) r))) \<leadsto>sw
         (action_tid E (?\<phi> (Suc n) r), action_obs E (?\<phi> (Suc n) r))"
         by cases(fastforce elim!: is_write_action.cases intro: synchronizes_with.intros addr_locsI simp add: obsrE)
       ultimately have "P,E \<turnstile> ws (?\<phi> (Suc n) r) \<le>sw ?\<phi> (Suc n) r" by(rule sync_withI)
       thus ?thesis unfolding po_sw_def by blast
     qed
   qed
   thus "P,E \<turnstile> ws r \<le>hb r" unfolding r .
 qed
 
 corollary drf:
   "\<lbrakk> correctly_synchronized P \<E>; legal_execution P \<E> (E, ws) \<rbrakk>
   \<Longrightarrow> sequentially_consistent P (E, ws)"
 by(erule drf_weak)(rule legal_imp_weakly_legal_execution)
 
 end
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Framework.thy b/thys/JinjaThreads/MM/JMM_Framework.thy
--- a/thys/JinjaThreads/MM/JMM_Framework.thy
+++ b/thys/JinjaThreads/MM/JMM_Framework.thy
@@ -1,3395 +1,3395 @@
 (*  Title:      JinjaThreads/MM/JMM_Framework.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Combination of locales for heap operations and interleaving\<close>
 
 theory JMM_Framework
 imports
   JMM_Heap
   "../Framework/FWInitFinLift"
   "../Common/WellForm"
 begin
 
 lemma enat_plus_eq_enat_conv: \<comment> \<open>Move to Extended\_Nat\<close>
   "enat m + n = enat k \<longleftrightarrow> k \<ge> m \<and> n = enat (k - m)"
 by(cases n) auto
 
 declare convert_new_thread_action_id [simp]
 
 context heap begin
 
 lemma init_fin_lift_state_start_state:
   "init_fin_lift_state s (start_state f P C M vs) = start_state (\<lambda>C M Ts T meth vs. (s, f C M Ts T meth vs)) P C M vs"
 by(simp add: start_state_def init_fin_lift_state_def split_beta fun_eq_iff)
 
 lemma non_speculative_start_heap_obs:
   "non_speculative P vs  (llist_of (map snd (lift_start_obs start_tid start_heap_obs)))"
 apply(rule non_speculative_nthI)
 using start_heap_obs_not_Read
 by(clarsimp simp add: lift_start_obs_def lnth_LCons o_def eSuc_enat[symmetric] in_set_conv_nth split: nat.split_asm)
 
 lemma ta_seq_consist_start_heap_obs:
   "ta_seq_consist P Map.empty (llist_of (map snd (lift_start_obs start_tid start_heap_obs)))"
 using start_heap_obs_not_Read
 by(auto intro: ta_seq_consist_nthI simp add: lift_start_obs_def o_def lnth_LCons in_set_conv_nth split: nat.split_asm)
 
 end
 
 context allocated_heap begin
 
 lemma w_addrs_lift_start_heap_obs:
   "w_addrs (w_values P vs (map snd (lift_start_obs start_tid start_heap_obs))) \<subseteq> w_addrs vs"
 by(simp add: lift_start_obs_def o_def w_addrs_start_heap_obs)
 
 end
 
 context heap begin
 
 lemma w_values_start_heap_obs_typeable:
   assumes wf: "wf_syscls P"
   and mrws: "v \<in> w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs)) (ad, al)"
   shows "\<exists>T. P,start_heap \<turnstile> ad@al : T \<and> P,start_heap \<turnstile> v :\<le> T"
 proof -
   from in_w_valuesD[OF mrws]
   obtain obs' wa obs'' 
     where eq: "map snd (lift_start_obs start_tid start_heap_obs) = obs' @ wa # obs''"
     and "is_write_action wa"
     and adal: "(ad, al) \<in> action_loc_aux P wa"
     and vwa: "value_written_aux P wa al = v"
     by blast
   from \<open>is_write_action wa\<close> show ?thesis
   proof cases
     case (WriteMem ad' al' v')
     with vwa adal eq have "WriteMem ad al v \<in> set start_heap_obs"
       by(auto simp add: map_eq_append_conv Cons_eq_append_conv lift_start_obs_def)
     thus ?thesis by(rule start_heap_write_typeable)
   next
     case (NewHeapElem ad' hT)
     with vwa adal eq have "NewHeapElem ad hT \<in> set start_heap_obs"
       by(auto simp add: map_eq_append_conv Cons_eq_append_conv lift_start_obs_def)
     hence "typeof_addr start_heap ad = \<lfloor>hT\<rfloor>"
       by(rule NewHeapElem_start_heap_obsD[OF wf])
     thus ?thesis using adal vwa NewHeapElem
       apply(cases hT)
       apply(auto intro!: addr_loc_type.intros dest: has_field_decl_above)
       apply(frule has_field_decl_above)
       apply(auto intro!: addr_loc_type.intros dest: has_field_decl_above)
       done
   qed
 qed
 
 lemma start_state_vs_conf:
   "wf_syscls P \<Longrightarrow> vs_conf P start_heap (w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs)))"
 by(rule vs_confI)(rule w_values_start_heap_obs_typeable)
 
 end
 
 
 subsection \<open>JMM traces for Jinja semantics\<close>
 
 context multithreaded_base begin
 
 inductive_set \<E> :: "('l,'t,'x,'m,'w) state \<Rightarrow> ('t \<times> 'o) llist set"
   for \<sigma> :: "('l,'t,'x,'m,'w) state"
 where
   "mthr.Runs \<sigma> E'
   \<Longrightarrow> lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') \<in> \<E> \<sigma>"
 
 lemma actions_\<E>E_aux:
   fixes \<sigma> E'
   defines "E == lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
   assumes mthr: "mthr.Runs \<sigma> E'"
   and a: "enat a < llength E"
   obtains m n t ta
   where "lnth E a = (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n)"
   and "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" and "enat m < llength E'"
   and "a = (\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + n"
   and "lnth E' m = (t, ta)"
 proof -
   from lnth_lconcat_conv[OF a[unfolded E_def], folded E_def]
   obtain m n
     where "lnth E a = lnth (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') m) n"
     and "enat n < llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') m)"
     and "enat m < llength (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
     and "enat a = (\<Sum>i<m. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) + enat n"
     by blast
   moreover
   obtain t ta where "lnth E' m = (t, ta)" by(cases "lnth E' m")
   ultimately have E_a: "lnth E a = (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n)"
     and n: "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     and m: "enat m < llength E'"
     and a: "enat a = (\<Sum>i<m. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) + enat n"
-    by(simp_all add: lnth_llist_of)
+    by(simp_all)
   note a
   also have "(\<Sum>i<m. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) = 
             sum (enat \<circ> (\<lambda>i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) {..<m}"
     using m by(simp add: less_trans[where y="enat m"] split_beta)
   also have "\<dots> = enat (\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
-    by(subst sum_hom)(simp_all add: zero_enat_def)
+    by(subst sum_comp_morphism)(simp_all add: zero_enat_def)
   finally have a: "a = (\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + n" by simp
   with E_a n m show thesis using \<open>lnth E' m = (t, ta)\<close> by(rule that)
 qed
 
 lemma actions_\<E>E:
   assumes E: "E \<in> \<E> \<sigma>"
   and a: "enat a < llength E"
   obtains E' m n t ta
   where "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
   and "mthr.Runs \<sigma> E'"
   and "lnth E a = (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n)"
   and "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" and "enat m < llength E'"
   and "a = (\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + n"
   and "lnth E' m = (t, ta)"
 proof -
   from E obtain E' ws
     where E: "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
     and "mthr.Runs \<sigma> E'" by(rule \<E>.cases) blast
   from \<open>mthr.Runs \<sigma> E'\<close> a[unfolded E]
   show ?thesis
     by(rule actions_\<E>E_aux)(fold E, rule that[OF E \<open>mthr.Runs \<sigma> E'\<close>])
 qed
 
 end
 
 context \<tau>multithreaded_wf begin
 
 text \<open>Alternative characterisation for @{term "\<E>"}\<close>
 lemma \<E>_conv_Runs:
   "\<E> \<sigma> = lconcat ` lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ` llist_of_tllist ` {E. mthr.\<tau>Runs \<sigma> E}"
   (is "?lhs = ?rhs")
 proof(intro equalityI subsetI)
   fix E
   assume "E \<in> ?rhs"
   then obtain E' where E: "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (llist_of_tllist E'))"
     and \<tau>Runs: "mthr.\<tau>Runs \<sigma> E'" by(blast)
   obtain E'' where E': "E' = tmap (\<lambda>(tls, s', tl, s''). tl) (case_sum (\<lambda>(tls, s'). \<lfloor>s'\<rfloor>) Map.empty) E''"
     and \<tau>Runs': "mthr.\<tau>Runs_table2 \<sigma> E''"
     using \<tau>Runs by(rule mthr.\<tau>Runs_into_\<tau>Runs_table2)
   have "mthr.Runs \<sigma> (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist E'')) 
                                       (LCons (case terminal E'' of Inl (tls, s') \<Rightarrow> llist_of tls | Inr tls \<Rightarrow> tls) LNil)))"
     (is "mthr.Runs _ ?E'''")
     using \<tau>Runs' by(rule mthr.\<tau>Runs_table2_into_Runs)
   moreover 
   let ?tail = "\<lambda>E''. case terminal E'' of Inl (tls, s') \<Rightarrow> llist_of tls | Inr tls \<Rightarrow> tls"
   {
     have "E = lconcat (lfilter (\<lambda>xs. \<not> lnull xs) (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (llist_of_tllist E')))"
       unfolding E by(simp add: lconcat_lfilter_neq_LNil)
     also have "\<dots> = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (lmap (\<lambda>(tls, s', tta, s''). tta) (lfilter (\<lambda>(tls, s', (t, ta), s''). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (llist_of_tllist E''))))"
       by(simp add: E' lfilter_lmap llist.map_comp o_def split_def)
     also
     from \<open>mthr.\<tau>Runs_table2 \<sigma> E''\<close>
     have "lmap (\<lambda>(tls, s', tta, s''). tta) (lfilter (\<lambda>(tls, s', (t, ta), s''). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (llist_of_tllist E'')) = 
           lfilter (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist E'')) (LCons (?tail E'') LNil)))"
       (is "?lhs \<sigma> E'' = ?rhs \<sigma> E''")
     proof(coinduction arbitrary: \<sigma> E'' rule: llist.coinduct_strong)
       case (Eq_llist \<sigma> E'')
       have ?lnull
         by(cases "lfinite (llist_of_tllist E'')")(fastforce split: sum.split_asm simp add: split_beta lset_lconcat_lfinite lappend_inf mthr.silent_move2_def dest: mthr.\<tau>Runs_table2_silentsD[OF Eq_llist] mthr.\<tau>Runs_table2_terminal_silentsD[OF Eq_llist] mthr.\<tau>Runs_table2_terminal_inf_stepD[OF Eq_llist] m\<tau>move_silentD inf_step_silentD silent_moves2_silentD split: sum.split_asm)+
       moreover
       have ?LCons
       proof(intro impI conjI)
         assume lhs': "\<not> lnull (lmap (\<lambda>(tls, s', tta, s''). tta) (lfilter (\<lambda>(tls, s', (t, ta), s''). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (llist_of_tllist E'')))"
           (is "\<not> lnull ?lhs'")
           and "\<not> lnull (lfilter (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist E'')) (LCons (case terminal E'' of Inl (tls, s') \<Rightarrow> llist_of tls | Inr tls \<Rightarrow> tls) LNil))))"
           (is "\<not> lnull ?rhs'")
 
         note \<tau>Runs' = \<open>mthr.\<tau>Runs_table2 \<sigma> E''\<close>
         from lhs' obtain tl tls' where "?lhs \<sigma> E'' = LCons tl tls'"
           by(auto simp only: not_lnull_conv)
         then obtain tls s' s'' tlsstlss'
           where tls': "tls' = lmap (\<lambda>(tls, s', tta, s''). tta) tlsstlss'"
           and filter: "lfilter (\<lambda>(tls, s', (t, ta), s''). obs_a ta \<noteq> []) (llist_of_tllist E'') = LCons (tls, s', tl, s'') tlsstlss'"
           using lhs' by(fastforce simp add: lmap_eq_LCons_conv)
         from lfilter_eq_LConsD[OF filter]
         obtain us vs where eq: "llist_of_tllist E'' = lappend us (LCons (tls, s', tl, s'') vs)"
           and fin: "lfinite us"
           and empty: "\<forall>(tls, s', (t, ta), s'')\<in>lset us. obs_a ta = []"
           and neq_empty: "obs_a (snd tl) \<noteq> []"
           and tlsstlss': "tlsstlss' = lfilter (\<lambda>(tls, s', (t, ta), s''). obs_a ta \<noteq> []) vs"
           by(auto simp add: split_beta)
         from eq obtain E''' where E'': "E'' = lappendt us E'''" 
           and eq': "llist_of_tllist E''' = LCons (tls, s', tl, s'') vs"
           and terminal: "terminal E''' = terminal E''"
           unfolding llist_of_tllist_eq_lappend_conv by auto
         from \<tau>Runs' fin E'' obtain \<sigma>' where \<tau>Runs'': "mthr.\<tau>Runs_table2 \<sigma>' E'''"
           by(auto dest: mthr.\<tau>Runs_table2_lappendtD)
         then obtain \<sigma>'' E'''' where "mthr.\<tau>Runs_table2 \<sigma>'' E''''" "E''' = TCons (tls, s', tl, s'') E''''"
           using eq' by cases auto
         moreover from \<tau>Runs' E'' fin
         have "\<forall>(tls, s, tl, s')\<in>lset us. \<forall>(t, ta)\<in>set tls. ta = \<epsilon>"
           by(fastforce dest: mthr.\<tau>Runs_table2_silentsD m\<tau>move_silentD simp add: mthr.silent_move2_def)
         hence "lfilter (\<lambda>(t, ta). obs_a ta \<noteq> []) (lconcat (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) us)) = LNil"
           using empty by(auto simp add: lfilter_empty_conv lset_lconcat_lfinite split_beta)
         moreover from \<tau>Runs'' eq' have "snd ` set tls \<subseteq> {\<epsilon>}"
           by(cases)(fastforce dest: silent_moves2_silentD)+
         hence "[(t, ta)\<leftarrow>tls . obs_a ta \<noteq> []] = []"
           by(auto simp add: filter_empty_conv split_beta)
         ultimately 
         show "lhd ?lhs' = lhd ?rhs'"
           and "(\<exists>\<sigma> E''. ltl ?lhs' = lmap (\<lambda>(tls, s', tta, s''). tta) (lfilter (\<lambda>(tls, s', (t, ta), s''). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (llist_of_tllist E'')) \<and>
            ltl ?rhs' = lfilter (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<noteq> []) (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist E'')) (LCons (case terminal E'' of Inl (tls, s') \<Rightarrow> llist_of tls | Inr tls \<Rightarrow> tls) LNil))) \<and>
            \<tau>trsys.\<tau>Runs_table2 redT m\<tau>move \<sigma> E'') \<or>
           ltl ?lhs' = ltl ?rhs'"
           using lhs' E'' fin tls' tlsstlss' filter eq' neq_empty
           by(auto simp add: lmap_lappend_distrib lappend_assoc split_beta filter_empty_conv simp del: split_paired_Ex)
       qed
       ultimately show ?case ..
     qed
     also have "lmap (\<lambda>(t, ta). llist_of (map (Pair t) (obs_a ta))) \<dots> = lfilter (\<lambda>obs. \<not> lnull obs) (lmap (\<lambda>(t, ta). llist_of (map (Pair t) (obs_a ta))) (lconcat (lappend (lmap (\<lambda>(tls, s, tl, s'). llist_of (tls @ [tl])) (llist_of_tllist E'')) (LCons (?tail E'') LNil))))"
       unfolding lfilter_lmap by(simp add: o_def split_def llist_of_eq_LNil_conv)
     finally have "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?E''')"
       by(simp add: lconcat_lfilter_neq_LNil) }
   ultimately show "E \<in> ?lhs" by(blast intro: \<E>.intros)
 next
   fix E
   assume "E \<in> ?lhs"
   then obtain E' where E: "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) (obs_a ta))) E')"
     and Runs: "mthr.Runs \<sigma> E'" by(blast elim: \<E>.cases)
   from Runs obtain E'' where E': "E' = lmap (\<lambda>(s, tl, s'). tl) E''"
     and Runs': "mthr.Runs_table \<sigma> E''" by(rule mthr.Runs_into_Runs_table)
   have "mthr.\<tau>Runs \<sigma> (tmap (\<lambda>(s, tl, s'). tl) id (tfilter None (\<lambda>(s, tl, s'). \<not> m\<tau>move s tl s') (tllist_of_llist (Some (llast (LCons \<sigma> (lmap (\<lambda>(s, tl, s'). s') E'')))) E'')))"
     (is "mthr.\<tau>Runs _ ?E'''")
     using Runs' by(rule mthr.Runs_table_into_\<tau>Runs)
   moreover
   have "(\<lambda>(s, (t, ta), s'). obs_a ta \<noteq> []) = (\<lambda>(s, (t, ta), s'). obs_a ta \<noteq> [] \<and> \<not> m\<tau>move s (t, ta) s')"
     by(rule ext)(auto dest: m\<tau>move_silentD)
   hence "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) (obs_a ta))) (llist_of_tllist ?E'''))"
     unfolding E E'
     by(subst (1 2) lconcat_lfilter_neq_LNil[symmetric])(simp add: lfilter_lmap lfilter_lfilter o_def split_def)
   ultimately show "E \<in> ?rhs" by(blast)
 qed
 
 end
 
 text \<open>Running threads have been started before\<close>
 
 definition Status_no_wait_locks :: "('l,'t,status \<times> 'x) thread_info \<Rightarrow> bool"
 where
   "Status_no_wait_locks ts \<longleftrightarrow> 
   (\<forall>t status x ln. ts t = \<lfloor>((status, x), ln)\<rfloor> \<longrightarrow> status \<noteq> Running \<longrightarrow> ln = no_wait_locks)"
 
 lemma Status_no_wait_locks_PreStartD:
   "\<And>ln. \<lbrakk> Status_no_wait_locks ts; ts t = \<lfloor>((PreStart, x), ln)\<rfloor> \<rbrakk> \<Longrightarrow> ln = no_wait_locks"
 unfolding Status_no_wait_locks_def by blast
 
 lemma Status_no_wait_locks_FinishedD:
   "\<And>ln. \<lbrakk> Status_no_wait_locks ts; ts t = \<lfloor>((Finished, x), ln)\<rfloor> \<rbrakk> \<Longrightarrow> ln = no_wait_locks"
 unfolding Status_no_wait_locks_def by blast
 
 lemma Status_no_wait_locksI:
   "(\<And>t status x ln. \<lbrakk> ts t = \<lfloor>((status, x), ln)\<rfloor>; status = PreStart \<or> status = Finished \<rbrakk> \<Longrightarrow> ln = no_wait_locks)
   \<Longrightarrow> Status_no_wait_locks ts"
 unfolding Status_no_wait_locks_def 
 apply clarify
 apply(case_tac status)
 apply auto
 done
 
 context heap_base begin
 
 lemma Status_no_wait_locks_start_state:
   "Status_no_wait_locks (thr (init_fin_lift_state status (start_state f P C M vs)))"
 by(clarsimp simp add: Status_no_wait_locks_def init_fin_lift_state_def start_state_def split_beta)
 
 end
 
 context multithreaded_base begin
 
 lemma init_fin_preserve_Status_no_wait_locks:
   assumes ok: "Status_no_wait_locks (thr s)"
   and redT: "multithreaded_base.redT init_fin_final init_fin (map NormalAction \<circ> convert_RA) s tta s'"
   shows "Status_no_wait_locks (thr s')"
 using redT
 proof(cases rule: multithreaded_base.redT.cases[consumes 1, case_names redT_normal redT_acquire])
   case redT_acquire
   with ok show ?thesis
     by(auto intro!: Status_no_wait_locksI dest: Status_no_wait_locks_PreStartD Status_no_wait_locks_FinishedD split: if_split_asm)
 next
   case redT_normal
   show ?thesis
   proof(rule Status_no_wait_locksI)
     fix t' status' x' ln'
     assume tst': "thr s' t' = \<lfloor>((status', x'), ln')\<rfloor>"
       and status: "status' = PreStart \<or> status' = Finished"
     show "ln' = no_wait_locks"
     proof(cases "thr s t'")
       case None
       with redT_normal tst' show ?thesis
         by(fastforce elim!: init_fin.cases dest: redT_updTs_new_thread simp add: final_thread.actions_ok_iff split: if_split_asm)
     next
       case (Some sxln)
       obtain status'' x'' ln'' 
         where [simp]: "sxln = ((status'', x''), ln'')" by(cases sxln) auto
       show ?thesis
       proof(cases "fst tta = t'")
         case True
         with redT_normal tst' status show ?thesis by(auto simp add: expand_finfun_eq fun_eq_iff)
       next
         case False
         with tst' redT_normal Some status have "status'' = status'" "ln'' = ln'" 
           by(force dest: redT_updTs_Some simp add: final_thread.actions_ok_iff)+
         with ok Some status show ?thesis
           by(auto dest: Status_no_wait_locks_PreStartD Status_no_wait_locks_FinishedD)
       qed
     qed
   qed
 qed
 
 lemma init_fin_Running_InitialThreadAction:
   assumes redT: "multithreaded_base.redT init_fin_final init_fin (map NormalAction \<circ> convert_RA) s tta s'"
   and not_running: "\<And>x ln. thr s t \<noteq> \<lfloor>((Running, x), ln)\<rfloor>"
   and running: "thr s' t = \<lfloor>((Running, x'), ln')\<rfloor>"
   shows "tta = (t, \<lbrace>InitialThreadAction\<rbrace>)"
 using redT
 proof(cases rule: multithreaded_base.redT.cases[consumes 1, case_names redT_normal redT_acquire])
   case redT_acquire
   with running not_running show ?thesis by(auto split: if_split_asm)
 next
   case redT_normal
   show ?thesis
   proof(cases "thr s t")
     case None
     with redT_normal running not_running show ?thesis
       by(fastforce simp add: final_thread.actions_ok_iff elim: init_fin.cases dest: redT_updTs_new_thread split: if_split_asm)
   next
     case (Some a)
     with redT_normal running not_running show ?thesis
       apply(cases a)
       apply(auto simp add: final_thread.actions_ok_iff split: if_split_asm elim: init_fin.cases)
       apply((drule (1) redT_updTs_Some)?, fastforce)+
       done
   qed
 qed
 
 end
 
 context if_multithreaded begin
 
 lemma init_fin_Trsys_preserve_Status_no_wait_locks:
   assumes ok: "Status_no_wait_locks (thr s)"
   and Trsys: "if.mthr.Trsys s ttas s'"
   shows "Status_no_wait_locks (thr s')"
 using Trsys ok
 by(induct)(blast dest: init_fin_preserve_Status_no_wait_locks)+
 
 lemma init_fin_Trsys_Running_InitialThreadAction:
   assumes redT: "if.mthr.Trsys s ttas s'"
   and not_running: "\<And>x ln. thr s t \<noteq> \<lfloor>((Running, x), ln)\<rfloor>"
   and running: "thr s' t = \<lfloor>((Running, x'), ln')\<rfloor>"
   shows "(t, \<lbrace>InitialThreadAction\<rbrace>) \<in> set ttas"
 using redT not_running running
 proof(induct arbitrary: x' ln')
   case rtrancl3p_refl thus ?case by(fastforce)
 next
   case (rtrancl3p_step s ttas s' tta s'') thus ?case
     by(cases "\<exists>x ln. thr s' t = \<lfloor>((Running, x), ln)\<rfloor>")(fastforce dest: init_fin_Running_InitialThreadAction)+
 qed
 
 end
 
 locale heap_multithreaded_base =
   heap_base
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
   +
   mthr: multithreaded_base final r convert_RA
   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 final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and convert_RA :: "'addr released_locks \<Rightarrow> ('addr, 'thread_id) obs_event list"
 
 sublocale heap_multithreaded_base < mthr: if_multithreaded_base final r convert_RA
 .
 
 context heap_multithreaded_base begin
 
 abbreviation \<E>_start ::
   "(cname \<Rightarrow> mname \<Rightarrow> ty list \<Rightarrow> ty \<Rightarrow> 'md \<Rightarrow> 'addr val list \<Rightarrow> 'x) 
   \<Rightarrow> 'md prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> 'addr val list \<Rightarrow> status 
   \<Rightarrow> ('thread_id \<times> ('addr, 'thread_id) obs_event action) llist set"
 where
   "\<E>_start f P C M vs status \<equiv> 
   lappend (llist_of (lift_start_obs start_tid start_heap_obs)) ` 
   mthr.if.\<E> (init_fin_lift_state status (start_state f P C M vs))"
 
 end
 
 locale heap_multithreaded =
   heap_multithreaded_base 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     final r convert_RA
   +
   heap
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     P 
   + 
   mthr: multithreaded final r convert_RA
 
   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 final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and convert_RA :: "'addr released_locks \<Rightarrow> ('addr, 'thread_id) obs_event list" 
   and P :: "'md prog"
 
 sublocale heap_multithreaded < mthr: if_multithreaded final r convert_RA
 by(unfold_locales)
 
 sublocale heap_multithreaded < "if": jmm_multithreaded
   mthr.init_fin_final mthr.init_fin "map NormalAction \<circ> convert_RA" P
 .
 
 context heap_multithreaded begin
 
 lemma thread_start_actions_ok_init_fin_RedT:
   assumes Red: "mthr.if.RedT (init_fin_lift_state status (start_state f P C M vs)) ttas s'"
            (is "mthr.if.RedT ?start_state _ _")
   shows "thread_start_actions_ok (llist_of (lift_start_obs start_tid start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
    (is "thread_start_actions_ok (llist_of (?obs_prefix @ ?E'))")
 proof(rule thread_start_actions_okI)
   let ?E = "llist_of (?obs_prefix @ ?E')"
   fix a
   assume a: "a \<in> actions ?E"
     and new: "\<not> is_new_action (action_obs ?E a)"
   show "\<exists>i \<le> a. action_obs ?E i = InitialThreadAction \<and> action_tid ?E i = action_tid ?E a"
   proof(cases "action_tid ?E a = start_tid")
     case True thus ?thesis
       by(auto simp add: lift_start_obs_def action_tid_def action_obs_def)
   next
     case False
     let ?a = "a - length ?obs_prefix"
 
     from False have a_len: "a \<ge> length ?obs_prefix"
       by(rule contrapos_np)(auto simp add: lift_start_obs_def action_tid_def lnth_LCons nth_append split: nat.split)
     hence [simp]: "action_tid ?E a = action_tid (llist_of ?E') ?a" "action_obs ?E a = action_obs (llist_of ?E') ?a"
       by(simp_all add: action_tid_def nth_append action_obs_def)
 
     from False have not_running: "\<And>x ln. thr ?start_state (action_tid (llist_of ?E') ?a) \<noteq> \<lfloor>((Running, x), ln)\<rfloor>"
       by(auto simp add: start_state_def split_beta init_fin_lift_state_def split: if_split_asm)
     
     from a a_len have "?a < length ?E'" by(simp add: actions_def)
     from nth_concat_conv[OF this]
     obtain m n where E'_a: "?E' ! ?a = (\<lambda>(t, ta). (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n)) (ttas ! m)"
       and n: "n < length \<lbrace>snd (ttas ! m)\<rbrace>\<^bsub>o\<^esub>"
       and m: "m < length ttas"
       and a_conv: "?a = (\<Sum>i<m. length (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas ! i)) + n"
       by(clarsimp simp add: split_def)
 
     from Red obtain s'' s''' where Red1: "mthr.if.RedT ?start_state (take m ttas) s''"
       and red: "mthr.if.redT s'' (ttas ! m) s'''"
       and Red2: "mthr.if.RedT s''' (drop (Suc m) ttas) s'"
       unfolding mthr.if.RedT_def
       by(subst (asm) (4) id_take_nth_drop[OF m])(blast elim: rtrancl3p_appendE rtrancl3p_converseE)
 
     from E'_a m n have [simp]: "action_tid (llist_of ?E') ?a = fst (ttas ! m)"
       by(simp add: action_tid_def split_def)
     
     from red obtain status x ln where tst: "thr s'' (fst (ttas ! m)) = \<lfloor>((status, x), ln)\<rfloor>" by cases auto
     show ?thesis
     proof(cases "status = PreStart \<or> status = Finished")
       case True
       from Red1 have "Status_no_wait_locks (thr s'')"
         unfolding mthr.if.RedT_def
         by(rule mthr.init_fin_Trsys_preserve_Status_no_wait_locks[OF Status_no_wait_locks_start_state])
       with True tst have "ln = no_wait_locks"
         by(auto dest: Status_no_wait_locks_PreStartD Status_no_wait_locks_FinishedD)
       with red tst True have "\<lbrace>snd (ttas ! m)\<rbrace>\<^bsub>o\<^esub> = [InitialThreadAction]" by(cases) auto
       hence "action_obs ?E a = InitialThreadAction" using a_conv n a_len E'_a
         by(simp add: action_obs_def nth_append split_beta)
       thus ?thesis by(auto)
     next
       case False
       hence "status = Running" by(cases status) auto
       with tst mthr.init_fin_Trsys_Running_InitialThreadAction[OF Red1[unfolded mthr.if.RedT_def] not_running]
       have "(fst (ttas ! m), \<lbrace>InitialThreadAction\<rbrace>) \<in> set (take m ttas)"
         using E'_a by(auto simp add: action_tid_def split_beta)
       then obtain i where i: "i < m" 
         and nth_i: "ttas ! i = (fst (ttas ! m), \<lbrace>InitialThreadAction\<rbrace>)"
         unfolding in_set_conv_nth by auto
 
       let ?i' = "length (concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take i ttas)))"
       let ?i = "length ?obs_prefix + ?i'"
 
       from i m nth_i
       have "?i' < length (concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take m ttas)))"
         apply(simp add: length_concat o_def split_beta)
         apply(subst (6) id_take_nth_drop[where i=i])
         apply(simp_all add: take_map[symmetric] min_def)
         done
       also from m have "\<dots> \<le> ?a" unfolding a_conv
         by(simp add: length_concat sum_list_sum_nth min_def split_def atLeast0LessThan)
       finally have "?i < a" using a_len by simp
       moreover
       from i m nth_i have "?i' < length ?E'"
         apply(simp add: length_concat o_def split_def)
         apply(subst (7) id_take_nth_drop[where i=i])
         apply(simp_all add: take_map[symmetric])
         done
       from nth_i i E'_a a_conv m
       have "lnth ?E ?i = (fst (ttas ! m), InitialThreadAction)"
         by(simp add: lift_start_obs_def nth_append length_concat o_def split_def)(rule nth_concat_eqI[where k=0 and i=i], simp_all add: take_map o_def split_def)
       ultimately show ?thesis using E'_a
         by(cases "ttas ! m")(auto simp add: action_obs_def action_tid_def nth_append intro!: exI[where x="?i"])
     qed
   qed
 qed
 
 (* TODO: use previous lemma for proof *)
 
 lemma thread_start_actions_ok_init_fin:
   assumes E: "E \<in> mthr.if.\<E> (init_fin_lift_state status (start_state f P C M vs))"
   shows "thread_start_actions_ok (lappend (llist_of (lift_start_obs start_tid start_heap_obs)) E)"
   (is "thread_start_actions_ok ?E")
 proof(rule thread_start_actions_okI)
   let ?start_heap_obs = "lift_start_obs start_tid start_heap_obs"
   let ?start_state = "init_fin_lift_state status (start_state f P C M vs)"
   fix a
   assume a: "a \<in> actions ?E"
     and a_new: "\<not> is_new_action (action_obs ?E a)"
   show "\<exists>i. i \<le> a \<and> action_obs ?E i = InitialThreadAction \<and> action_tid ?E i = action_tid ?E a"
   proof(cases "action_tid ?E a = start_tid")
     case True thus ?thesis
       by(auto simp add: lift_start_obs_def action_tid_def action_obs_def)
   next
     case False
 
     let ?a = "a - length ?start_heap_obs"
 
     from False have "a \<ge> length ?start_heap_obs"
       by(rule contrapos_np)(auto simp add: lift_start_obs_def action_tid_def lnth_LCons lnth_lappend1 split: nat.split)
     hence [simp]: "action_tid ?E a = action_tid E ?a" "action_obs ?E a = action_obs E ?a"
       by(simp_all add: action_tid_def lnth_lappend2 action_obs_def)
 
     from False have not_running: "\<And>x ln. thr ?start_state (action_tid E ?a) \<noteq> \<lfloor>((Running, x), ln)\<rfloor>"
       by(auto simp add: start_state_def split_beta init_fin_lift_state_def split: if_split_asm)
     
     from E obtain E' where E': "E = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
       and \<tau>Runs: "mthr.if.mthr.Runs ?start_state E'" by(rule mthr.if.\<E>.cases)
     from a E' \<open>a \<ge> length ?start_heap_obs\<close>
     have enat_a: "enat ?a < llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E'))"
       by(cases "llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E'))")(auto simp add: actions_def)
     with \<tau>Runs obtain m n t ta
     where a_obs: "lnth (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')) (a - length ?start_heap_obs) = (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n)"
       and n: "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" 
       and m: "enat m < llength E'"
       and a_conv: "?a = (\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + n"
       and E'_m: "lnth E' m = (t, ta)"
       by(rule mthr.if.actions_\<E>E_aux)
     from a_obs have [simp]: "action_tid E ?a = t" "action_obs E ?a = \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n"
       by(simp_all add: E' action_tid_def action_obs_def)
 
     let ?E' = "ldropn (Suc m) E'"
     let ?m_E' = "ltake (enat m) E'"
     have E'_unfold: "E' = lappend (ltake (enat m) E') (LCons (lnth E' m) ?E')"
       unfolding ldropn_Suc_conv_ldropn[OF m] by simp
     hence "mthr.if.mthr.Runs ?start_state (lappend ?m_E' (LCons (lnth E' m) ?E'))"
       using \<tau>Runs by simp
     then obtain \<sigma>' where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of ?m_E') \<sigma>'"
       and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' m) ?E')"
       by(rule mthr.if.mthr.Runs_lappendE) simp
     from \<tau>Runs' obtain \<sigma>''' where red_a: "mthr.if.redT \<sigma>' (t, ta) \<sigma>'''"
       and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>''' ?E'"
       unfolding E'_m by cases
     from red_a obtain status x ln where tst: "thr \<sigma>' t = \<lfloor>((status, x), ln)\<rfloor>" by cases auto
     show ?thesis
     proof(cases "status = PreStart \<or> status = Finished")
       case True
       have "Status_no_wait_locks (thr \<sigma>')"
         by(rule mthr.init_fin_Trsys_preserve_Status_no_wait_locks[OF _ \<sigma>_\<sigma>'])(rule Status_no_wait_locks_start_state)
       with True tst have "ln = no_wait_locks"
         by(auto dest: Status_no_wait_locks_PreStartD Status_no_wait_locks_FinishedD)
       with red_a tst True have "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = [InitialThreadAction]" by(cases) auto
       hence "action_obs E ?a = InitialThreadAction" using a_obs n unfolding E'
         by(simp add: action_obs_def)
       thus ?thesis by(auto)
     next
       case False
       hence "status = Running" by(cases status) auto
       with tst mthr.init_fin_Trsys_Running_InitialThreadAction[OF \<sigma>_\<sigma>' not_running]
       have "(action_tid E ?a, \<lbrace>InitialThreadAction\<rbrace>) \<in> set (list_of (ltake (enat m) E'))"
         using a_obs E' by(auto simp add: action_tid_def)
       then obtain i where "i < m" "enat i < llength E'" 
         and nth_i: "lnth E' i = (action_tid E ?a, \<lbrace>InitialThreadAction\<rbrace>)"
         unfolding in_set_conv_nth 
         by(cases "llength E'")(auto simp add: length_list_of_conv_the_enat lnth_ltake)
 
       let ?i' = "\<Sum>i<i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>"
       let ?i = "length ?start_heap_obs + ?i'"
 
       from \<open>i < m\<close> have "(\<Sum>i<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = ?i' + (\<Sum>i=i..<m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
         unfolding atLeast0LessThan[symmetric] by(subst sum.atLeastLessThan_concat) simp_all
       hence "?i' \<le> ?a" unfolding a_conv by simp
       hence "?i \<le> a" using \<open>a \<ge> length ?start_heap_obs\<close> by arith
 
 
       from \<open>?i' \<le> ?a\<close> have "enat ?i' < llength E" using enat_a E'
         by(simp add: le_less_trans[where y="enat ?a"])
       from lnth_lconcat_conv[OF this[unfolded E'], folded E']
       obtain k l 
         where nth_i': "lnth E ?i' = lnth (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') k) l"
         and l: "l < length \<lbrace>snd (lnth E' k)\<rbrace>\<^bsub>o\<^esub>"
         and k: "enat k < llength E'"
         and i_conv: "enat ?i' = (\<Sum>i<k. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) + enat l"
         by(fastforce simp add: split_beta)
 
       have "(\<Sum>i<k. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) =
             (\<Sum>i<k. (enat \<circ> (\<lambda>i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) i)"
         by(rule sum.cong)(simp_all add: less_trans[where y="enat k"] split_beta k)
       also have "\<dots> = enat (\<Sum>i<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
-        by(rule sum_hom)(simp_all add: zero_enat_def)
+        by(rule sum_comp_morphism)(simp_all add: zero_enat_def)
       finally have i_conv: "?i' = (\<Sum>i<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + l" using i_conv by simp
 
       have [simp]: "i = k"
       proof(rule ccontr)
         assume "i \<noteq> k"
         thus False unfolding neq_iff
         proof
           assume "i < k"
           hence "(\<Sum>i<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = 
                  (\<Sum>i<i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + (\<Sum>i=i..<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
             unfolding atLeast0LessThan[symmetric] by(subst sum.atLeastLessThan_concat) simp_all
           with i_conv have "(\<Sum>i=i..<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = l" "l = 0" by simp_all
           moreover have "(\<Sum>i=i..<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) \<ge> length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>"
             by(subst sum.atLeast_Suc_lessThan[OF \<open>i < k\<close>]) simp
           ultimately show False using nth_i by simp
         next
           assume "k < i"
           hence "?i' = (\<Sum>i<k. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + (\<Sum>i=k..<i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
             unfolding atLeast0LessThan[symmetric] by(subst sum.atLeastLessThan_concat) simp_all
           with i_conv have "(\<Sum>i=k..<i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = l" by simp
           moreover have "(\<Sum>i=k..<i. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) \<ge> length \<lbrace>snd (lnth E' k)\<rbrace>\<^bsub>o\<^esub>"
             by(subst sum.atLeast_Suc_lessThan[OF \<open>k < i\<close>]) simp
           ultimately show False using l by simp
         qed
       qed
       with l nth_i have [simp]: "l = 0" by simp
       
       hence "lnth E ?i' = (action_tid E ?a, InitialThreadAction)"
         using nth_i nth_i' k by simp
       with \<open>?i \<le> a\<close> show ?thesis
         by(auto simp add: action_tid_def action_obs_def lnth_lappend2)
     qed
   qed
 qed
 
 
 
 end
 
 text \<open>In the subsequent locales, \<open>convert_RA\<close> refers to @{term "convert_RA"} and is no longer a parameter!\<close>
 
 lemma convert_RA_not_write:
   "\<And>ln. ob \<in> set (convert_RA ln) \<Longrightarrow> \<not> is_write_action (NormalAction ob)"
 by(auto simp add: convert_RA_def)
 
 lemma ta_seq_consist_convert_RA:
   fixes ln shows
   "ta_seq_consist P vs (llist_of ((map NormalAction \<circ> convert_RA) ln))"
 proof(rule ta_seq_consist_nthI)
   fix i ad al v
   assume "enat i < llength (llist_of ((map NormalAction \<circ> convert_RA) ln :: ('b, 'c) obs_event action list))"
     and "lnth (llist_of ((map NormalAction \<circ> convert_RA) ln :: ('b, 'c) obs_event action list)) i = NormalAction (ReadMem ad al v)"
   hence "ReadMem ad al v \<in> set (convert_RA ln :: ('b, 'c) obs_event list)"
     by(auto simp add: in_set_conv_nth)
   hence False by(auto simp add: convert_RA_def)
   thus "\<exists>b. mrw_values P vs (list_of (ltake (enat i) (llist_of ((map NormalAction \<circ> convert_RA) ln)))) (ad, al) = \<lfloor>(v, b)\<rfloor>" ..
 qed
 
 lemma ta_hb_consistent_convert_RA:
   "\<And>ln. ta_hb_consistent P E (llist_of (map (Pair t) ((map NormalAction \<circ> convert_RA) ln)))"
 by(rule ta_hb_consistent_not_ReadI)(auto simp add: convert_RA_def)
 
 locale allocated_multithreaded =
   allocated_heap
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated
     P 
   + 
   mthr: multithreaded final r convert_RA
 
   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 allocated :: "'heap \<Rightarrow> 'addr set"
   and final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and P :: "'md prog"
   +
   assumes red_allocated_mono: "t \<turnstile> (x, m) -ta\<rightarrow> (x', m') \<Longrightarrow> allocated m \<subseteq> allocated m'"
   and red_New_allocatedD:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> allocated m' \<and> ad \<notin> allocated m"
   and red_allocated_NewD:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); ad \<in> allocated m'; ad \<notin> allocated m \<rbrakk>
   \<Longrightarrow> \<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and red_New_same_addr_same:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a CTn; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a CTn'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 
 
 sublocale allocated_multithreaded < heap_multithreaded
   addr2thread_id thread_id2addr
   spurious_wakeups
   empty_heap allocate typeof_addr heap_read heap_write
   final r convert_RA P
 by(unfold_locales)
 
 context allocated_multithreaded begin
 
 lemma redT_allocated_mono:
   assumes "mthr.redT \<sigma> (t, ta) \<sigma>'"
   shows "allocated (shr \<sigma>) \<subseteq> allocated (shr \<sigma>')"
 using assms
 by cases(auto dest: red_allocated_mono del: subsetI)
 
 lemma RedT_allocated_mono:
   assumes "mthr.RedT \<sigma> ttas \<sigma>'"
   shows "allocated (shr \<sigma>) \<subseteq> allocated (shr \<sigma>')"
 using assms unfolding mthr.RedT_def
 by induct(auto dest!: redT_allocated_mono intro: subset_trans del: subsetI)
 
 lemma init_fin_allocated_mono:
   "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m') \<Longrightarrow> allocated m \<subseteq> allocated m'"
 by(cases rule: mthr.init_fin.cases)(auto dest: red_allocated_mono)
 
 lemma init_fin_redT_allocated_mono:
   assumes "mthr.if.redT \<sigma> (t, ta) \<sigma>'"
   shows "allocated (shr \<sigma>) \<subseteq> allocated (shr \<sigma>')"
 using assms
 by cases(auto dest: init_fin_allocated_mono del: subsetI)
 
 lemma init_fin_RedT_allocated_mono:
   assumes "mthr.if.RedT \<sigma> ttas \<sigma>'"
   shows "allocated (shr \<sigma>) \<subseteq> allocated (shr \<sigma>')"
 using assms unfolding mthr.if.RedT_def
 by induct(auto dest!: init_fin_redT_allocated_mono intro: subset_trans del: subsetI)
 
 lemma init_fin_red_New_allocatedD:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')" "NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "ad \<in> allocated m' \<and> ad \<notin> allocated m"
 using assms
 by cases(auto dest: red_New_allocatedD)
 
 lemma init_fin_red_allocated_NewD:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')" "ad \<in> allocated m'" "ad \<notin> allocated m"
   shows "\<exists>CTn. NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using assms
 by(cases)(auto dest!: red_allocated_NewD)
 
 lemma init_fin_red_New_same_addr_same:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')"
   and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (NewHeapElem a CTn)" "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NormalAction (NewHeapElem a CTn')" "j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "i = j"
 using assms
 by cases(auto dest: red_New_same_addr_same)
 
 lemma init_fin_redT_allocated_NewHeapElemD:
   assumes  "mthr.if.redT s (t, ta) s'"
   and "ad \<in> allocated (shr s')"
   and "ad \<notin> allocated (shr s)"
   shows "\<exists>CTn. NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using assms
 by(cases)(auto dest: init_fin_red_allocated_NewD)
 
 lemma init_fin_RedT_allocated_NewHeapElemD:
   assumes "mthr.if.RedT s ttas s'"
   and "ad \<in> allocated (shr s')"
   and "ad \<notin> allocated (shr s)"
   shows "\<exists>t ta CTn. (t, ta) \<in> set ttas \<and> NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using assms
 proof(induct rule: mthr.if.RedT_induct')
   case refl thus ?case by simp
 next
   case (step ttas s' t ta s'') thus ?case
     by(cases "ad \<in> allocated (shr s')")(fastforce simp del: split_paired_Ex dest: init_fin_redT_allocated_NewHeapElemD)+
 qed
 
 lemma \<E>_new_actions_for_unique:
   assumes E: "E \<in> \<E>_start f P C M vs status"
   and a: "a \<in> new_actions_for P E adal"
   and a': "a' \<in> new_actions_for P E adal"
   shows "a = a'"
 using a a'
 proof(induct a a' rule: wlog_linorder_le)
   case symmetry thus ?case by simp
 next
   case (le a a')
   note a = \<open>a \<in> new_actions_for P E adal\<close>
     and a' = \<open>a' \<in> new_actions_for P E adal\<close>
     and a_a' = \<open>a \<le> a'\<close>
   obtain ad al where adal: "adal = (ad, al)" by(cases adal)
   
   let ?init_obs = "lift_start_obs start_tid start_heap_obs"
   let ?start_state = "init_fin_lift_state status (start_state f P C M vs)"
 
   have distinct: "distinct (filter (\<lambda>obs. \<exists>a CTn. obs = NormalAction (NewHeapElem a CTn)) (map snd ?init_obs))"
     unfolding start_heap_obs_def
     by(fastforce intro: inj_onI intro!: distinct_filter simp add: distinct_map distinct_zipI1 distinct_initialization_list)
 
   from start_addrs_allocated
   have dom_start_state: "{a. \<exists>CTn. NormalAction (NewHeapElem a CTn) \<in> snd ` set ?init_obs} \<subseteq> allocated (shr ?start_state)"
     by(fastforce simp add: init_fin_lift_state_conv_simps shr_start_state dest: NewHeapElem_start_heap_obs_start_addrsD subsetD)
   
   show ?case
   proof(cases "a' < length ?init_obs")
     case True
     with a' adal E obtain t_a' CTn_a'
       where CTn_a': "?init_obs ! a' = (t_a', NormalAction (NewHeapElem ad CTn_a'))"
       by(cases "?init_obs ! a'")(fastforce elim!: is_new_action.cases action_loc_aux_cases simp add: action_obs_def lnth_lappend1 new_actions_for_def )+
     from True a_a' have len_a: "a < length ?init_obs" by simp
     with a adal E obtain t_a CTn_a
       where CTn_a: "?init_obs ! a = (t_a, NormalAction (NewHeapElem ad CTn_a))"
       by(cases "?init_obs ! a")(fastforce elim!: is_new_action.cases action_loc_aux_cases simp add: action_obs_def lnth_lappend1 new_actions_for_def )+
     from CTn_a CTn_a' True len_a
     have "NormalAction (NewHeapElem ad CTn_a') \<in> snd ` set ?init_obs"
       and "NormalAction (NewHeapElem ad CTn_a) \<in> snd ` set ?init_obs" unfolding set_conv_nth
       by(fastforce intro: rev_image_eqI)+
     hence [simp]: "CTn_a' = CTn_a" using distinct_start_addrs'
       by(auto simp add: in_set_conv_nth distinct_conv_nth start_heap_obs_def start_addrs_def) blast
     from distinct_filterD[OF distinct, of a' a "NormalAction (NewHeapElem ad CTn_a)"] len_a True CTn_a CTn_a'
     show "a = a'" by simp
   next
     case False
     obtain n where n: "length ?init_obs = n" by blast
     with False have "n \<le> a'" by simp
     
     from E obtain E'' where E: "E = lappend (llist_of ?init_obs) E''"
       and E'': "E'' \<in> mthr.if.\<E> ?start_state" by auto
     from E'' obtain E' where E': "E'' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
       and \<tau>Runs: "mthr.if.mthr.Runs ?start_state E'" by(rule mthr.if.\<E>.cases)
     
     from E E'' a' n \<open>n \<le> a'\<close> adal have a': "a' - n \<in> new_actions_for P E'' adal"
       by(auto simp add: new_actions_for_def lnth_lappend2 action_obs_def actions_lappend elim: actionsE)
     
     from a' have "a' - n \<in> actions E''" by(auto elim: new_actionsE)
     hence "enat (a' - n) < llength E''" by(rule actionsE)
     with \<tau>Runs obtain a'_m a'_n t_a' ta_a'
       where E_a': "lnth E'' (a' - n) = (t_a', \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub> ! a'_n)"
       and a'_n: "a'_n < length \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub>" and a'_m: "enat a'_m < llength E'"
       and a'_conv: "a' - n = (\<Sum>i<a'_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + a'_n"
       and E'_a'_m: "lnth E' a'_m = (t_a', ta_a')"
       unfolding E' by(rule mthr.if.actions_\<E>E_aux)
     
     from a' have "is_new_action (action_obs E'' (a' - n))"
       and "(ad, al) \<in> action_loc P E'' (a' - n)"
       unfolding adal by(auto elim: new_actionsE)
     then obtain CTn'
       where "action_obs E'' (a' - n) = NormalAction (NewHeapElem ad CTn')"
       by cases(fastforce)+
     hence New_ta_a': "\<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub> ! a'_n = NormalAction (NewHeapElem ad CTn')"
       using E_a' a'_n unfolding action_obs_def by simp
 
     show ?thesis
     proof(cases "a < n")
       case True
       with a adal E n obtain t_a CTn_a where "?init_obs ! a = (t_a, NormalAction (NewHeapElem ad CTn_a))"
         by(cases "?init_obs ! a")(fastforce elim!: is_new_action.cases simp add: action_obs_def lnth_lappend1 new_actions_for_def)+
 
       with subsetD[OF dom_start_state, of ad] n True
       have a_shr_\<sigma>: "ad \<in> allocated (shr ?start_state)"
         by(fastforce simp add: set_conv_nth intro: rev_image_eqI)
       
       have E'_unfold': "E' = lappend (ltake (enat a'_m) E') (LCons (lnth E' a'_m) (ldropn (Suc a'_m) E'))"
         unfolding ldropn_Suc_conv_ldropn[OF a'_m] by simp
       hence "mthr.if.mthr.Runs ?start_state (lappend (ltake (enat a'_m) E') (LCons (lnth E' a'_m) (ldropn (Suc a'_m) E')))"
         using \<tau>Runs by simp
 
       then obtain \<sigma>'
         where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of (ltake (enat a'_m) E')) \<sigma>'"
         and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' a'_m) (ldropn (Suc a'_m) E'))"
         by(rule mthr.if.mthr.Runs_lappendE) simp
       from \<tau>Runs' obtain \<sigma>''
         where red_a': "mthr.if.redT \<sigma>' (t_a', ta_a') \<sigma>''"
         and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>'' (ldropn (Suc a'_m) E')"
         unfolding E'_a'_m by cases
       from New_ta_a' a'_n have "NormalAction (NewHeapElem ad CTn') \<in> set \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub>"
         unfolding in_set_conv_nth by blast
       with red_a' obtain x_a' x'_a' m'_a' 
         where red'_a': "mthr.init_fin t_a' (x_a', shr \<sigma>') ta_a' (x'_a', m'_a')"
         and \<sigma>''': "redT_upd \<sigma>' t_a' ta_a' x'_a' m'_a' \<sigma>''"
         and ts_t_a': "thr \<sigma>' t_a' = \<lfloor>(x_a', no_wait_locks)\<rfloor>"
         by cases auto
       from red'_a' \<open>NormalAction (NewHeapElem ad CTn') \<in> set \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub>\<close>
       obtain ta'_a' X_a' X'_a'
         where x_a': "x_a' = (Running, X_a')"
         and x'_a': "x'_a' = (Running, X'_a')"
         and ta_a': "ta_a' = convert_TA_initial (convert_obs_initial ta'_a')"
         and red''_a': "t_a' \<turnstile> \<langle>X_a', shr \<sigma>'\<rangle> -ta'_a'\<rightarrow> \<langle>X'_a', m'_a'\<rangle>"
         by cases fastforce+
       
       from ta_a' New_ta_a' a'_n have New_ta'_a': "\<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub> ! a'_n = NewHeapElem ad CTn'"
         and a'_n': "a'_n < length \<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub>" by auto
       hence "NewHeapElem ad CTn' \<in> set \<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub>" unfolding in_set_conv_nth by blast
       with red''_a' have allocated_ad': "ad \<notin> allocated (shr \<sigma>')"
         by(auto dest: red_New_allocatedD)
       
       have "allocated (shr ?start_state) \<subseteq> allocated (shr \<sigma>')"
         using \<sigma>_\<sigma>' unfolding mthr.if.RedT_def[symmetric] by(rule init_fin_RedT_allocated_mono)
       hence False using allocated_ad' a_shr_\<sigma> by blast
       thus ?thesis ..
     next
       case False
       hence "n \<le> a" by simp
 
       from E E'' a n \<open>n \<le> a\<close> adal have a: "a - n \<in> new_actions_for P E'' adal"
         by(auto simp add: new_actions_for_def lnth_lappend2 action_obs_def actions_lappend elim: actionsE)
 
       from a have "a - n \<in> actions E''" by(auto elim: new_actionsE)
       hence "enat (a - n) < llength E''" by(rule actionsE)
 
       with \<tau>Runs obtain a_m a_n t_a ta_a 
         where E_a: "lnth E'' (a - n) = (t_a, \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub> ! a_n)"
         and a_n: "a_n < length \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>" and a_m: "enat a_m < llength E'"
         and a_conv: "a - n = (\<Sum>i<a_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + a_n"
         and E'_a_m: "lnth E' a_m = (t_a, ta_a)"
         unfolding E' by(rule mthr.if.actions_\<E>E_aux)
   
       from a have "is_new_action (action_obs E'' (a - n))" 
         and "(ad, al) \<in> action_loc P E'' (a - n)" 
         unfolding adal by(auto elim: new_actionsE)
       then obtain CTn where "action_obs E'' (a - n) = NormalAction (NewHeapElem ad CTn)"
         by cases(fastforce)+
       hence New_ta_a: " \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub> ! a_n = NormalAction (NewHeapElem ad CTn)"
         using E_a a_n unfolding action_obs_def by simp
       
       let ?E' = "ldropn (Suc a_m) E'"
   
       have E'_unfold: "E' = lappend (ltake (enat a_m) E') (LCons (lnth E' a_m) ?E')"
         unfolding ldropn_Suc_conv_ldropn[OF a_m] by simp
       hence "mthr.if.mthr.Runs ?start_state (lappend (ltake (enat a_m) E') (LCons (lnth E' a_m) ?E'))"
         using \<tau>Runs by simp
       then obtain \<sigma>' where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of (ltake (enat a_m) E')) \<sigma>'"
         and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' a_m) ?E')"
         by(rule mthr.if.mthr.Runs_lappendE) simp
       from \<tau>Runs' obtain \<sigma>''
         where red_a: "mthr.if.redT \<sigma>' (t_a, ta_a) \<sigma>''"
         and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>'' ?E'"
         unfolding E'_a_m by cases
       from New_ta_a a_n have "NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>"
         unfolding in_set_conv_nth by blast
       with red_a obtain x_a x'_a m'_a 
         where red'_a: "mthr.init_fin t_a (x_a, shr \<sigma>') ta_a (x'_a, m'_a)"
         and \<sigma>''': "redT_upd \<sigma>' t_a ta_a x'_a m'_a \<sigma>''"
         and ts_t_a: "thr \<sigma>' t_a = \<lfloor>(x_a, no_wait_locks)\<rfloor>"
         by cases auto
       from red'_a \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>\<close>
       obtain ta'_a X_a X'_a
         where x_a: "x_a = (Running, X_a)"
         and x'_a: "x'_a = (Running, X'_a)"
         and ta_a: "ta_a = convert_TA_initial (convert_obs_initial ta'_a)"
         and red''_a: "t_a \<turnstile> (X_a, shr \<sigma>') -ta'_a\<rightarrow> (X'_a, m'_a)"
         by cases fastforce+
       from ta_a New_ta_a a_n have New_ta'_a: "\<lbrace>ta'_a\<rbrace>\<^bsub>o\<^esub> ! a_n = NewHeapElem ad CTn"
         and a_n': "a_n < length \<lbrace>ta'_a\<rbrace>\<^bsub>o\<^esub>" by auto
       hence "NewHeapElem ad CTn \<in> set \<lbrace>ta'_a\<rbrace>\<^bsub>o\<^esub>" unfolding in_set_conv_nth by blast
       with red''_a have allocated_m'_a_ad: "ad \<in> allocated m'_a"
         by(auto dest: red_New_allocatedD)
       
       have "a_m \<le> a'_m"
       proof(rule ccontr)
         assume "\<not> ?thesis"
         hence "a'_m < a_m" by simp
         hence "(\<Sum>i<a_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = (\<Sum>i<a'_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + (\<Sum>i = a'_m..<a_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
           by(simp add: sum_upto_add_nat)
         hence "a' - n < a - n" using \<open>a'_m < a_m\<close> a'_n E'_a'_m unfolding a_conv a'_conv
           by(subst (asm) sum.atLeast_Suc_lessThan) simp_all
         with a_a' show False by simp
       qed
   
       have a'_less: "a' - n < (a - n) - a_n + length \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>"
       proof(rule ccontr)
         assume "\<not> ?thesis"
         hence a'_greater: "(a - n) - a_n + length \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub> \<le> a' - n" by simp
         
         have "a_m < a'_m"
         proof(rule ccontr)
           assume "\<not> ?thesis"
           with \<open>a_m \<le> a'_m\<close> have "a_m = a'_m" by simp
           with a'_greater a_n a'_n E'_a'_m E'_a_m show False
             unfolding a_conv a'_conv by simp
         qed
         hence a'_m_a_m: "enat (a'_m - Suc a_m) < llength ?E'" using a'_m
           by(cases "llength E'") simp_all
         from \<open>a_m < a'_m\<close> a'_m E'_a'_m
         have E'_a'_m': "lnth ?E' (a'_m - Suc a_m) = (t_a', ta_a')" by simp
     
         have E'_unfold': "?E' = lappend (ltake (enat (a'_m - Suc a_m)) ?E') (LCons (lnth ?E' (a'_m - Suc a_m)) (ldropn (Suc (a'_m - Suc a_m)) ?E'))"
           unfolding ldropn_Suc_conv_ldropn[OF a'_m_a_m] lappend_ltake_enat_ldropn ..
         hence "mthr.if.mthr.Runs \<sigma>'' (lappend (ltake (enat (a'_m - Suc a_m)) ?E') (LCons (lnth ?E' (a'_m - Suc a_m)) (ldropn (Suc (a'_m - Suc a_m)) ?E')))"
           using \<tau>Runs'' by simp
         then obtain \<sigma>'''
           where \<sigma>''_\<sigma>''': "mthr.if.mthr.Trsys \<sigma>'' (list_of (ltake (enat (a'_m - Suc a_m)) ?E')) \<sigma>'''"
           and \<tau>Runs''': "mthr.if.mthr.Runs \<sigma>''' (LCons (lnth ?E' (a'_m - Suc a_m)) (ldropn (Suc (a'_m - Suc a_m)) ?E'))"
           by(rule mthr.if.mthr.Runs_lappendE) simp
         from \<tau>Runs''' obtain \<sigma>''''
           where red_a': "mthr.if.redT \<sigma>''' (t_a', ta_a') \<sigma>''''"
           and \<tau>Runs'''': "mthr.if.mthr.Runs \<sigma>'''' (ldropn (Suc (a'_m - Suc a_m)) ?E')"
           unfolding E'_a'_m' by cases
         from New_ta_a' a'_n have "NormalAction (NewHeapElem ad CTn') \<in> set \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub>"
           unfolding in_set_conv_nth by blast
         with red_a' obtain x_a' x'_a' m'_a' 
           where red'_a': "mthr.init_fin t_a' (x_a', shr \<sigma>''') ta_a' (x'_a', m'_a')"
           and \<sigma>'''''': "redT_upd \<sigma>''' t_a' ta_a' x'_a' m'_a' \<sigma>''''"
           and ts_t_a': "thr \<sigma>''' t_a' = \<lfloor>(x_a', no_wait_locks)\<rfloor>"
           by cases auto
         from red'_a' \<open>NormalAction (NewHeapElem ad CTn') \<in> set \<lbrace>ta_a'\<rbrace>\<^bsub>o\<^esub>\<close>
         obtain ta'_a' X_a' X'_a' 
           where x_a': "x_a' = (Running, X_a')"
           and x'_a': "x'_a' = (Running, X'_a')"
           and ta_a': "ta_a' = convert_TA_initial (convert_obs_initial ta'_a')"
           and red''_a': "t_a' \<turnstile> (X_a', shr \<sigma>''') -ta'_a'\<rightarrow> (X'_a', m'_a')"
           by cases fastforce+
         from ta_a' New_ta_a' a'_n have New_ta'_a': "\<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub> ! a'_n = NewHeapElem ad CTn'"
           and a'_n': "a'_n < length \<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub>" by auto
         hence "NewHeapElem ad CTn' \<in> set \<lbrace>ta'_a'\<rbrace>\<^bsub>o\<^esub>" unfolding in_set_conv_nth by blast
         with red''_a' have allocated_ad': "ad \<notin> allocated (shr \<sigma>''')"
           by(auto dest: red_New_allocatedD)
     
         have "allocated m'_a = allocated (shr \<sigma>'')" using \<sigma>''' by auto
         also have "\<dots> \<subseteq> allocated (shr \<sigma>''')"
           using \<sigma>''_\<sigma>''' unfolding mthr.if.RedT_def[symmetric] by(rule init_fin_RedT_allocated_mono)
         finally have "ad \<in> allocated (shr \<sigma>''')" using allocated_m'_a_ad by blast
         with allocated_ad' show False by contradiction
       qed
       
       from \<open>a_m \<le> a'_m\<close> have [simp]: "a_m = a'_m"
       proof(rule le_antisym)
         show "a'_m \<le> a_m"
         proof(rule ccontr)
           assume "\<not> ?thesis"
           hence "a_m < a'_m" by simp
           hence "(\<Sum>i<a'_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = (\<Sum>i<a_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + (\<Sum>i = a_m..<a'_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
             by(simp add: sum_upto_add_nat)
           with a'_less \<open>a_m < a'_m\<close> E'_a_m a_n a'_n show False
             unfolding a'_conv a_conv by(subst (asm) sum.atLeast_Suc_lessThan) simp_all
         qed
       qed
       with E'_a_m E'_a'_m have [simp]: "t_a' = t_a" "ta_a' = ta_a" by simp_all
       from New_ta_a' a'_n ta_a have a'_n': "a'_n < length \<lbrace>ta'_a\<rbrace>\<^bsub>o\<^esub>"
         and New_ta'_a': "\<lbrace>ta'_a\<rbrace>\<^bsub>o\<^esub> ! a'_n = NewHeapElem ad CTn'" by auto
       with red''_a New_ta'_a a_n' have "a'_n = a_n"
         by(auto dest: red_New_same_addr_same)
       with \<open>a_m = a'_m\<close> have "a - n = a' - n" unfolding a_conv a'_conv by simp
       thus ?thesis using \<open>n \<le> a\<close> \<open>n \<le> a'\<close> by simp
     qed
   qed
 qed
 
 end
 
 
 text \<open>Knowledge of addresses of a multithreaded state\<close>
 
 fun ka_Val :: "'addr val \<Rightarrow> 'addr set"
 where
   "ka_Val (Addr a) = {a}"
 | "ka_Val _ = {}"
 
 fun new_obs_addr :: "('addr, 'thread_id) obs_event \<Rightarrow> 'addr set"
 where
   "new_obs_addr (ReadMem ad al (Addr ad')) = {ad'}"
 | "new_obs_addr (NewHeapElem ad hT) = {ad}"
 | "new_obs_addr _ = {}"
 
 lemma new_obs_addr_cases[consumes 1, case_names ReadMem NewHeapElem, cases set]:
   assumes "ad \<in> new_obs_addr ob"
   obtains ad' al where "ob = ReadMem ad' al (Addr ad)"
   | CTn where "ob = NewHeapElem ad CTn"
 using assms
 by(cases ob rule: new_obs_addr.cases) auto
 
 definition new_obs_addrs :: "('addr, 'thread_id) obs_event list \<Rightarrow> 'addr set"
 where
   "new_obs_addrs obs = \<Union>(new_obs_addr ` set obs)"
 
 fun new_obs_addr_if :: "('addr, 'thread_id) obs_event action \<Rightarrow> 'addr set"
 where
   "new_obs_addr_if (NormalAction a) = new_obs_addr a"
 | "new_obs_addr_if _ = {}"
 
 definition new_obs_addrs_if :: "('addr, 'thread_id) obs_event action list \<Rightarrow> 'addr set"
 where 
   "new_obs_addrs_if obs = \<Union>(new_obs_addr_if ` set obs)"
 
 lemma ka_Val_subset_new_obs_Addr_ReadMem:
   "ka_Val v \<subseteq> new_obs_addr (ReadMem ad al v)"
 by(cases v) simp_all
 
 lemma typeof_ka: "typeof v \<noteq> None \<Longrightarrow> ka_Val v = {}"
 by(cases v) simp_all
 
 lemma ka_Val_undefined_value [simp]:
   "ka_Val undefined_value = {}"
 apply(cases "undefined_value :: 'a val")
 apply(bestsimp simp add: undefined_value_not_Addr dest: subst)+
 done
 
 locale known_addrs_base =
   fixes known_addrs :: "'t \<Rightarrow> 'x \<Rightarrow> 'addr set"
 begin
 
 definition known_addrs_thr :: "('l, 't, 'x) thread_info \<Rightarrow> 'addr set"
 where "known_addrs_thr ts = (\<Union>t \<in> dom ts. known_addrs t (fst (the (ts t))))"
 
 definition known_addrs_state :: "('l,'t,'x,'m,'w) state \<Rightarrow> 'addr set"
 where "known_addrs_state s = known_addrs_thr (thr s)"
 
 lemma known_addrs_state_simps [simp]:
   "known_addrs_state (ls, (ts, m), ws) = known_addrs_thr ts"
 by(simp add: known_addrs_state_def)
 
 lemma known_addrs_thr_cases[consumes 1, case_names known_addrs, cases set: known_addrs_thr]:
   assumes "ad \<in> known_addrs_thr ts"
   and "\<And>t x ln. \<lbrakk> ts t = \<lfloor>(x, ln)\<rfloor>; ad \<in> known_addrs t x \<rbrakk> \<Longrightarrow> thesis"
   shows thesis
 using assms
 by(auto simp add: known_addrs_thr_def ran_def)
 
 lemma known_addrs_stateI:
   "\<And>ln. \<lbrakk> ad \<in> known_addrs t x; thr s t = \<lfloor>(x, ln)\<rfloor> \<rbrakk> \<Longrightarrow> ad \<in> known_addrs_state s"
 by(fastforce simp add: known_addrs_state_def known_addrs_thr_def intro: rev_bexI)
 
 fun known_addrs_if :: "'t \<Rightarrow> status \<times> 'x \<Rightarrow> 'addr set"
 where "known_addrs_if t (s, x) = known_addrs t x"
 
 end
 
 locale if_known_addrs_base = 
   known_addrs_base known_addrs 
   +
   multithreaded_base final r convert_RA
   for known_addrs :: "'t \<Rightarrow> 'x \<Rightarrow> 'addr set"
   and final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 't, 'x, 'heap, 'addr, 'obs) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80)
   and convert_RA :: "'addr released_locks \<Rightarrow> 'obs list"
 
 sublocale if_known_addrs_base < "if": known_addrs_base known_addrs_if .
 
 locale known_addrs =
   allocated_multithreaded (* Check why all the heap operations are necessary in this locale! *)
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     allocated
     final r
     P 
   +
   if_known_addrs_base known_addrs final r convert_RA
 
   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 allocated :: "'heap \<Rightarrow> 'addr set"
   and known_addrs :: "'thread_id \<Rightarrow> 'x \<Rightarrow> 'addr set"
   and final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and P :: "'md prog"
   +
   assumes red_known_addrs_new:
   "t \<turnstile> \<langle>x, m\<rangle> -ta\<rightarrow> \<langle>x', m'\<rangle>
   \<Longrightarrow> known_addrs t x' \<subseteq> known_addrs t x \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and red_known_addrs_new_thread:
   "\<lbrakk> t \<turnstile> \<langle>x, m\<rangle> -ta\<rightarrow> \<langle>x', m'\<rangle>; NewThread t' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> known_addrs t' x'' \<subseteq> known_addrs t x"
   and red_read_knows_addr:
   "\<lbrakk> t \<turnstile> \<langle>x, m\<rangle> -ta\<rightarrow> \<langle>x', m'\<rangle>; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> known_addrs t x"
   and red_write_knows_addr:
   "\<lbrakk> t \<turnstile> \<langle>x, m\<rangle> -ta\<rightarrow> \<langle>x', m'\<rangle>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr ad'); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad' \<in> known_addrs t x \<or> ad' \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   \<comment> \<open>second possibility necessary for @{term heap_clone}\<close>
 begin
 
 notation mthr.redT_syntax1 ("_ -_\<triangleright>_\<rightarrow> _" [50,0,0,50] 80)
 
 lemma if_red_known_addrs_new: 
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')"
   shows "known_addrs_if t x' \<subseteq> known_addrs_if t x \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using assms
 by cases(auto dest!: red_known_addrs_new simp add: new_obs_addrs_if_def new_obs_addrs_def)
 
 lemma if_red_known_addrs_new_thread:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')" "NewThread t' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
   shows "known_addrs_if t' x'' \<subseteq> known_addrs_if t x"
 using assms
 by cases(fastforce dest: red_known_addrs_new_thread)+
 
 lemma if_red_read_knows_addr:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')" "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "ad \<in> known_addrs_if t x"
 using assms
 by cases(fastforce dest: red_read_knows_addr)+
 
 lemma if_red_write_knows_addr:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')"
   and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = NormalAction (WriteMem ad al (Addr ad'))" "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "ad' \<in> known_addrs_if t x \<or> ad' \<in> new_obs_addrs_if (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 using assms
 by cases(auto dest: red_write_knows_addr simp add: new_obs_addrs_if_def new_obs_addrs_def take_map)
 
 lemma if_redT_known_addrs_new:
   assumes redT: "mthr.if.redT s (t, ta) s'"
   shows "if.known_addrs_state s' \<subseteq> if.known_addrs_state s \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using redT
 proof(cases)
   case redT_acquire thus ?thesis
     by(cases s)(fastforce simp add: if.known_addrs_thr_def split: if_split_asm intro: rev_bexI)
 next
   case (redT_normal x x' m)
   note red = \<open>t \<turnstile> (x, shr s) -ta\<rightarrow>i (x', m)\<close>
   show ?thesis
   proof
     fix ad
     assume "ad \<in> if.known_addrs_state s'"
     hence "ad \<in> if.known_addrs_thr (thr s')" by(simp add: if.known_addrs_state_def)
     then obtain t' x'' ln'' where ts't': "thr s' t' = \<lfloor>(x'', ln'')\<rfloor>" 
       and ad: "ad \<in> known_addrs_if t' x''"
       by(rule if.known_addrs_thr_cases)
     show "ad \<in> if.known_addrs_state s \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     proof(cases "thr s t'")
       case None
       with redT_normal \<open>thr s' t' = \<lfloor>(x'', ln'')\<rfloor>\<close>
       obtain m'' where "NewThread t' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
         by(fastforce dest: redT_updTs_new_thread split: if_split_asm)
       with red have "known_addrs_if t' x'' \<subseteq> known_addrs_if t x" by(rule if_red_known_addrs_new_thread)
       also have "\<dots> \<subseteq> known_addrs_if t x \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" by simp
       finally have "ad \<in> known_addrs_if t x \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" using ad by blast
       thus ?thesis using \<open>thr s t = \<lfloor>(x, no_wait_locks)\<rfloor>\<close> by(blast intro: if.known_addrs_stateI)
     next
       case (Some xln)
       show ?thesis
       proof(cases "t = t'")
         case True
         with redT_normal ts't' if_red_known_addrs_new[OF red] ad
         have "ad \<in> known_addrs_if t x \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" by auto
         thus ?thesis using \<open>thr s t = \<lfloor>(x, no_wait_locks)\<rfloor>\<close> by(blast intro: if.known_addrs_stateI)
       next
         case False
         with ts't' redT_normal ad Some show ?thesis
           by(fastforce dest: redT_updTs_Some[where ts="thr s" and t=t'] intro: if.known_addrs_stateI)
       qed
     qed
   qed
 qed
 
 lemma if_redT_read_knows_addr:
   assumes redT: "mthr.if.redT s (t, ta) s'"
   and read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "ad \<in> if.known_addrs_state s"
 using redT
 proof(cases)
   case redT_acquire thus ?thesis using read by auto
 next
   case (redT_normal x x' m')
   with if_red_read_knows_addr[OF \<open>t \<turnstile> (x, shr s) -ta\<rightarrow>i (x', m')\<close> read]
   show ?thesis
     by(auto simp add: if.known_addrs_state_def if.known_addrs_thr_def intro: bexI[where x=t])
 qed
 
 lemma init_fin_redT_known_addrs_subset:
   assumes "mthr.if.redT s (t, ta) s'"
   shows "if.known_addrs_state s' \<subseteq> if.known_addrs_state s \<union> known_addrs_if t (fst (the (thr s' t)))"
 using assms
 apply(cases)
  apply(rule subsetI)
  apply(clarsimp simp add: if.known_addrs_thr_def split: if_split_asm)
  apply(rename_tac status x status' x' m' a ws' t'' status'' x'' ln'')
  apply(case_tac "thr s t''")
   apply(drule (2) redT_updTs_new_thread)
   apply clarsimp
   apply(drule (1) if_red_known_addrs_new_thread)
   apply simp
   apply(drule (1) subsetD)
   apply(rule_tac x="(status, x)" in if.known_addrs_stateI)
    apply(simp)
   apply simp
  apply(frule_tac t="t''" in redT_updTs_Some, assumption)
  apply clarsimp
  apply(rule_tac x="(status'', x'')" in if.known_addrs_stateI)
   apply simp
  apply simp
 apply(auto simp add: if.known_addrs_state_def if.known_addrs_thr_def split: if_split_asm)
 done
 
 lemma w_values_no_write_unchanged:
   assumes no_write: "\<And>w. \<lbrakk> w \<in> set obs; is_write_action w; adal \<in> action_loc_aux P w \<rbrakk> \<Longrightarrow> False"
   shows "w_values P vs obs adal = vs adal"
 using assms
 proof(induct obs arbitrary: vs)
   case Nil show ?case by simp
 next
   case (Cons ob obs)
   from Cons.prems[of ob]
   have "w_value P vs ob adal = vs adal"
     by(cases adal)(cases ob rule: w_value_cases, auto simp add: addr_locs_def split: htype.split_asm, blast+)
   moreover
   have "w_values P (w_value P vs ob) obs adal = w_value P vs ob adal"
   proof(rule Cons.hyps)
     fix w
     assume "w \<in> set obs" "is_write_action w" "adal \<in> action_loc_aux P w"
     with Cons.prems[of w] \<open>w_value P vs ob adal = vs adal\<close>
     show "False" by simp
   qed
   ultimately show ?case by simp
 qed
 
 lemma redT_non_speculative_known_addrs_allocated:
   assumes red: "mthr.if.redT s (t, ta) s'"
   and tasc: "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   and ka: "if.known_addrs_state s \<subseteq> allocated (shr s)"
   and vs: "w_addrs vs \<subseteq> allocated (shr s)"
   shows "if.known_addrs_state s' \<subseteq> allocated (shr s')" (is "?thesis1")
   and "w_addrs (w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) \<subseteq> allocated (shr s')" (is "?thesis2")
 proof -
   have "?thesis1 \<and> ?thesis2" using red
   proof(cases)
     case (redT_acquire x ln n)
     hence "if.known_addrs_state s' = if.known_addrs_state s"
       by(auto 4 4 simp add: if.known_addrs_state_def if.known_addrs_thr_def split: if_split_asm dest: bspec)
     also note ka 
     also from redT_acquire have "shr s = shr s'" by simp
     finally have "if.known_addrs_state s' \<subseteq> allocated (shr s')" .
     moreover have "w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = vs" using redT_acquire
       by(fastforce intro!: w_values_no_write_unchanged del: equalityI dest: convert_RA_not_write)
     ultimately show ?thesis using vs by(simp add: \<open>shr s = shr s'\<close>)
   next
     case (redT_normal x x' m')
     note red = \<open>t \<turnstile> (x, shr s) -ta\<rightarrow>i (x', m')\<close>
       and tst = \<open>thr s t = \<lfloor>(x, no_wait_locks)\<rfloor>\<close>
     have allocated_subset: "allocated (shr s) \<subseteq> allocated (shr s')"
       using \<open>mthr.if.redT s (t, ta) s'\<close> by(rule init_fin_redT_allocated_mono)
     with vs have vs': "w_addrs vs \<subseteq> allocated (shr s')" by blast
     { fix obs obs'
       assume "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = obs @ obs'"
       moreover with tasc have "non_speculative P vs (llist_of obs)"
         by(simp add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
       ultimately have "w_addrs (w_values P vs obs) \<union> new_obs_addrs_if obs \<subseteq> allocated (shr s')" 
         (is "?concl obs")
       proof(induct obs arbitrary: obs' rule: rev_induct)
         case Nil thus ?case using vs' by(simp add: new_obs_addrs_if_def)
       next
         case (snoc ob obs)
         note ta = \<open>\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = (obs @ [ob]) @ obs'\<close>
         note tasc = \<open>non_speculative P vs (llist_of (obs @ [ob]))\<close>
         from snoc have IH: "?concl obs"
           by(simp add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
         hence "?concl (obs @ [ob])"
         proof(cases "ob" rule: mrw_value_cases)
           case (1 ad' al v)
           note ob = \<open>ob = NormalAction (WriteMem ad' al v)\<close>
           with ta have Write: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! length obs = NormalAction (WriteMem ad' al v)" by simp
           show ?thesis
           proof
             fix ad''
             assume "ad'' \<in> w_addrs (w_values P vs (obs @ [ob])) \<union> new_obs_addrs_if (obs @ [ob])"
             hence "ad'' \<in> w_addrs (w_values P vs obs) \<union> new_obs_addrs_if obs \<or> v = Addr ad''"
               by(auto simp add: ob w_addrs_def ran_def new_obs_addrs_if_def split: if_split_asm)
             thus "ad'' \<in> allocated (shr s')"
             proof
               assume "ad'' \<in> w_addrs (w_values P vs obs) \<union> new_obs_addrs_if obs"
               also note IH finally show ?thesis .
             next
               assume v: "v = Addr ad''"
               with Write have "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! length obs = NormalAction (WriteMem ad' al (Addr ad''))" by simp
               with red have "ad'' \<in> known_addrs_if t x \<or> ad'' \<in> new_obs_addrs_if (take (length obs) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
                 by(rule if_red_write_knows_addr)(simp add: ta)
               thus ?thesis
               proof
                 assume "ad'' \<in> known_addrs_if t x"
                 hence "ad'' \<in> if.known_addrs_state s" using tst by(rule if.known_addrs_stateI)
                 with ka allocated_subset show ?thesis by blast
               next
                 assume "ad'' \<in> new_obs_addrs_if (take (length obs) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
                 with ta have "ad'' \<in> new_obs_addrs_if obs" by simp
                 with IH show ?thesis by blast
               qed
             qed
           qed
         next
           case (2 ad hT)
 
           hence ob: "ob = NormalAction (NewHeapElem ad hT)" by simp
           hence "w_addrs (w_values P vs (obs @ [ob])) \<subseteq> w_addrs (w_values P vs obs)"
             by(cases hT)(auto simp add: w_addrs_def default_val_not_Addr Addr_not_default_val)
           moreover from ob ta have "NormalAction (NewHeapElem ad hT) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" by simp
           from init_fin_red_New_allocatedD[OF red this] have "ad \<in> allocated m'" ..
           with redT_normal have "ad \<in> allocated (shr s')" by auto
           ultimately show ?thesis using IH ob by(auto simp add: new_obs_addrs_if_def)
         next
           case (4 ad al v)
           note ob = \<open>ob = NormalAction (ReadMem ad al v)\<close>
           { fix ad'
             assume v: "v = Addr ad'"
             with tasc ob have mrw: "Addr ad' \<in> w_values P vs obs (ad, al)"
               by(auto simp add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend simp del: lappend_llist_of_llist_of)
             hence "ad' \<in> w_addrs (w_values P vs obs)"
               by(auto simp add: w_addrs_def)
             with IH have "ad' \<in> allocated (shr s')" by blast }
           with ob IH show ?thesis by(cases v)(simp_all add: new_obs_addrs_if_def)
         qed(simp_all add: new_obs_addrs_if_def)
         thus ?case by simp
       qed }
     note this[of "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" "[]"]
     moreover have "if.known_addrs_state s' \<subseteq> if.known_addrs_state s \<union> new_obs_addrs_if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
       using \<open>mthr.if.redT s (t, ta) s'\<close> by(rule if_redT_known_addrs_new)
     ultimately show ?thesis using ka allocated_subset by blast
   qed
   thus ?thesis1 ?thesis2 by simp_all
 qed
 
 
 lemma RedT_non_speculative_known_addrs_allocated:
   assumes red: "mthr.if.RedT s ttas s'"
   and tasc: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
   and ka: "if.known_addrs_state s \<subseteq> allocated (shr s)"
   and vs: "w_addrs vs \<subseteq> allocated (shr s)"
   shows "if.known_addrs_state s' \<subseteq> allocated (shr s')" (is "?thesis1 s'")
   and "w_addrs (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) \<subseteq> allocated (shr s')" (is "?thesis2 s' ttas")
 proof -
   from red tasc have "?thesis1 s' \<and> ?thesis2 s' ttas"
   proof(induct rule: mthr.if.RedT_induct')
     case refl thus ?case using ka vs by simp
   next
     case (step ttas s' t ta s'')
     hence "non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
       and "?thesis1 s'" "?thesis2 s' ttas"
       by(simp_all add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
     from redT_non_speculative_known_addrs_allocated[OF \<open>mthr.if.redT s' (t, ta) s''\<close> this]
     show ?case by simp
   qed
   thus "?thesis1 s'" "?thesis2 s' ttas" by simp_all
 qed
 
 lemma read_ex_NewHeapElem [consumes 5, case_names start Red]:
   assumes RedT: "mthr.if.RedT (init_fin_lift_state status (start_state f P C M vs)) ttas s"
   and red: "mthr.if.redT s (t, ta) s'"
   and read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and sc: "non_speculative P (\<lambda>_. {}) (llist_of (map snd (lift_start_obs start_tid start_heap_obs) @ concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
   and known: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   obtains (start) CTn where "NewHeapElem ad CTn \<in> set start_heap_obs"
   | (Red) ttas' s'' t' ta' s''' ttas'' CTn
   where "mthr.if.RedT (init_fin_lift_state status (start_state f P C M vs)) ttas' s''"
   and "mthr.if.redT s'' (t', ta') s'''"
   and "mthr.if.RedT s''' ttas'' s"
   and "ttas = ttas' @ (t', ta') # ttas''"
   and "NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
 proof -
   let ?start_state = "init_fin_lift_state status (start_state f P C M vs)"
   let ?obs_prefix = "lift_start_obs start_tid start_heap_obs"
   let ?vs_start = "w_values P (\<lambda>_. {}) (map snd ?obs_prefix)"
 
   from sc have "non_speculative P (w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs))) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     by(simp add: non_speculative_lappend lappend_llist_of_llist_of[symmetric] del: lappend_llist_of_llist_of)
   with RedT have "if.known_addrs_state s \<subseteq> allocated (shr s)"
   proof(rule RedT_non_speculative_known_addrs_allocated)
     show "if.known_addrs_state ?start_state \<subseteq> allocated (shr ?start_state)"
       using known
       by(auto simp add: if.known_addrs_state_def if.known_addrs_thr_def start_state_def init_fin_lift_state_def split_beta split: if_split_asm)
     
     have "w_addrs ?vs_start \<subseteq> w_addrs (\<lambda>_. {})" by(rule w_addrs_lift_start_heap_obs)
     thus "w_addrs ?vs_start \<subseteq> allocated (shr ?start_state)" by simp
   qed
   also from red read obtain x_ra x'_ra m'_ra 
     where red'_ra: "t \<turnstile> (x_ra, shr s) -ta\<rightarrow>i (x'_ra, m'_ra)"
     and s': "redT_upd s t ta x'_ra m'_ra s'"
     and ts_t: "thr s t = \<lfloor>(x_ra, no_wait_locks)\<rfloor>"
     by cases auto
   from red'_ra read
   have "ad \<in> known_addrs_if t x_ra" by(rule if_red_read_knows_addr)
   hence "ad \<in> if.known_addrs_state s" using ts_t by(rule if.known_addrs_stateI)
   finally have "ad \<in> allocated (shr s)" .
 
   show ?thesis
   proof(cases "ad \<in> allocated start_heap")
     case True
     then obtain CTn where "NewHeapElem ad CTn \<in> set start_heap_obs"
       unfolding start_addrs_allocated by(blast dest: start_addrs_NewHeapElem_start_heap_obsD)
     thus ?thesis by(rule start)
   next
     case False
     hence "ad \<notin> allocated (shr ?start_state)" by(simp add: start_state_def split_beta shr_init_fin_lift_state)
     with RedT \<open>ad \<in> allocated (shr s)\<close> obtain t' ta' CTn
       where tta: "(t', ta') \<in> set ttas"
       and new: "NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
       by(blast dest: init_fin_RedT_allocated_NewHeapElemD)
     from tta obtain ttas' ttas'' where ttas: "ttas = ttas' @ (t', ta') # ttas''" by(auto dest: split_list)
     with RedT obtain s'' s''' 
       where "mthr.if.RedT ?start_state ttas' s''"
       and "mthr.if.redT s'' (t', ta') s'''"
       and "mthr.if.RedT s''' ttas'' s"
       unfolding mthr.if.RedT_def by(auto elim!: rtrancl3p_appendE dest!: converse_rtrancl3p_step)
     thus thesis using ttas new by(rule Red)
   qed
 qed
 
 end
 
 locale known_addrs_typing =
   known_addrs
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     allocated known_addrs
     final r 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 allocated :: "'heap \<Rightarrow> 'addr set"
   and known_addrs :: "'thread_id \<Rightarrow> 'x \<Rightarrow> 'addr set"
   and final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and wfx :: "'thread_id \<Rightarrow> 'x \<Rightarrow> 'heap \<Rightarrow> bool"
   and P :: "'md prog"
   +
   assumes wfs_non_speculative_invar:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m;
      vs_conf P m vs; non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<rbrakk>
   \<Longrightarrow> wfx t x' m'"
   and wfs_non_speculative_spawn:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m;
      vs_conf P m vs; non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>));
      NewThread t'' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> wfx t'' x'' m''"
   and wfs_non_speculative_other:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m;
      vs_conf P m vs; non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>));
      wfx t'' x'' m \<rbrakk>
   \<Longrightarrow> wfx t'' x'' m'"
   and wfs_non_speculative_vs_conf:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m;
      vs_conf P m vs; non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))) \<rbrakk>
   \<Longrightarrow> vs_conf P m' (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   and red_read_typeable:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> 
   \<Longrightarrow> \<exists>T. P,m \<turnstile> ad@al : T"
   and red_NewHeapElemD:
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m; NewHeapElem ad hT \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> typeof_addr m' ad = \<lfloor>hT\<rfloor>"
   and red_hext_incr: 
   "\<lbrakk> t \<turnstile> (x, m) -ta\<rightarrow> (x', m'); wfx t x m; 
      vs_conf P m vs; non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<rbrakk>
   \<Longrightarrow> m \<unlhd> m'"
 begin
 
 lemma redT_wfs_non_speculative_invar:
   assumes redT: "mthr.redT s (t, ta) s'"
   and wfx: "ts_ok wfx (thr s) (shr s)"
   and vs: "vs_conf P (shr s) vs"
   and ns: "non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
   shows "ts_ok wfx (thr s') (shr s')"
 using redT
 proof(cases)
   case (redT_normal x x' m')
   with vs wfx ns show ?thesis
     apply(clarsimp intro!: ts_okI split: if_split_asm)
      apply(erule wfs_non_speculative_invar, auto dest: ts_okD)
     apply(rename_tac t' x' ln ws')
     apply(case_tac "thr s t'")
     apply(frule (2) redT_updTs_new_thread, clarify)
     apply(frule (1) mthr.new_thread_memory)
     apply(auto intro: wfs_non_speculative_other wfs_non_speculative_spawn dest: ts_okD simp add: redT_updTs_Some)
     done
 next
   case (redT_acquire x ln n)
   thus ?thesis using wfx by(auto intro!: ts_okI dest: ts_okD split: if_split_asm)
 qed
 
 lemma redT_wfs_non_speculative_vs_conf:
   assumes redT: "mthr.redT s (t, ta) s'"
   and wfx: "ts_ok wfx (thr s) (shr s)"
   and conf: "vs_conf P (shr s) vs"
   and ns: "non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   shows "vs_conf P (shr s') (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 using redT
 proof(cases)
   case (redT_normal x x' m')
   thus ?thesis using ns conf wfx by(auto dest: wfs_non_speculative_vs_conf ts_okD)
 next
   case (redT_acquire x l ln)
   have "w_values P vs (take n (map NormalAction (convert_RA ln :: ('addr, 'thread_id) obs_event list))) = vs"
     by(fastforce dest: in_set_takeD simp add: convert_RA_not_write intro!: w_values_no_write_unchanged del: equalityI)
   thus ?thesis using conf redT_acquire by(auto)
 qed
 
 lemma if_redT_non_speculative_invar:
   assumes red: "mthr.if.redT s (t, ta) s'"
   and ts_ok: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and sc: "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)" 
   and vs: "vs_conf P (shr s) vs"
   shows "ts_ok (init_fin_lift wfx) (thr s') (shr s')"
 proof -
   let ?s = "\<lambda>s. (locks s, (\<lambda>t. map_option (\<lambda>((status, x), ln). (x, ln)) (thr s t), shr s), wset s, interrupts s)"
   
   from ts_ok have ts_ok': "ts_ok wfx (thr (?s s)) (shr (?s s))" by(auto intro!: ts_okI dest: ts_okD)
   from vs have vs': "vs_conf P (shr (?s s)) vs" by simp
 
   from red show ?thesis
   proof(cases)
     case (redT_normal x x' m)
     note tst = \<open>thr s t = \<lfloor>(x, no_wait_locks)\<rfloor>\<close>
     from \<open>t \<turnstile> (x, shr s) -ta\<rightarrow>i (x', m)\<close>
     show ?thesis 
     proof(cases)
       case (NormalAction X TA X')
       from \<open>ta = convert_TA_initial (convert_obs_initial TA)\<close> \<open>mthr.if.actions_ok s t ta\<close>
       have "mthr.actions_ok (?s s) t TA"
         by(auto elim: rev_iffD1[OF _ thread_oks_ts_change] cond_action_oks_final_change)
 
       with tst NormalAction \<open>redT_upd s t ta x' m s'\<close> have "mthr.redT (?s s) (t, TA) (?s s')"
         using map_redT_updTs[of snd "thr s" "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"]
         by(auto intro!: mthr.redT.intros simp add: split_def map_prod_def o_def fun_eq_iff)
       moreover note ts_ok' vs'
       moreover from \<open>ta = convert_TA_initial (convert_obs_initial TA)\<close> have "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>" by(auto)
       with sc have "non_speculative P vs (llist_of (map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>))" by simp
       ultimately have "ts_ok wfx (thr (?s s')) (shr (?s s'))"
         by(auto dest: redT_wfs_non_speculative_invar)
       thus ?thesis using \<open>\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>\<close> by(auto intro!: ts_okI dest: ts_okD)
     next
       case InitialThreadAction
       with redT_normal ts_ok' vs show ?thesis
         by(auto 4 3 intro!: ts_okI dest: ts_okD split: if_split_asm)
     next
       case ThreadFinishAction
       with redT_normal ts_ok' vs show ?thesis
         by(auto 4 3 intro!: ts_okI dest: ts_okD split: if_split_asm)
     qed
   next
     case (redT_acquire x ln l)
     thus ?thesis using vs ts_ok by(auto 4 3 intro!: ts_okI dest: ts_okD split: if_split_asm)
   qed
 qed
 
 lemma if_redT_non_speculative_vs_conf:
   assumes red: "mthr.if.redT s (t, ta) s'"
   and ts_ok: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and sc: "non_speculative P vs (llist_of (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
   and vs: "vs_conf P (shr s) vs"
   shows "vs_conf P (shr s') (w_values P vs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
 proof -
   let ?s = "\<lambda>s. (locks s, (\<lambda>t. map_option (\<lambda>((status, x), ln). (x, ln)) (thr s t), shr s), wset s, interrupts s)"
   
   from ts_ok have ts_ok': "ts_ok wfx (thr (?s s)) (shr (?s s))" by(auto intro!: ts_okI dest: ts_okD)
   from vs have vs': "vs_conf P (shr (?s s)) vs" by simp
 
   from red show ?thesis
   proof(cases)
     case (redT_normal x x' m)
     note tst = \<open>thr s t = \<lfloor>(x, no_wait_locks)\<rfloor>\<close>
     from \<open>t \<turnstile> (x, shr s) -ta\<rightarrow>i (x', m)\<close>
     show ?thesis 
     proof(cases)
       case (NormalAction X TA X')
       from \<open>ta = convert_TA_initial (convert_obs_initial TA)\<close> \<open>mthr.if.actions_ok s t ta\<close>
       have "mthr.actions_ok (?s s) t TA"
         by(auto elim: rev_iffD1[OF _ thread_oks_ts_change] cond_action_oks_final_change)
 
       with tst NormalAction \<open>redT_upd s t ta x' m s'\<close> have "mthr.redT (?s s) (t, TA) (?s s')"
         using map_redT_updTs[of snd "thr s" "\<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"]
         by(auto intro!: mthr.redT.intros simp add: split_def map_prod_def o_def fun_eq_iff)
       moreover note ts_ok' vs'
       moreover from \<open>ta = convert_TA_initial (convert_obs_initial TA)\<close> have "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>" by(auto)
       with sc have "non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>)))" by simp
       ultimately have "vs_conf P (shr (?s s')) (w_values P vs (take n (map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>)))"
         by(auto dest: redT_wfs_non_speculative_vs_conf)
       thus ?thesis using \<open>\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = map NormalAction \<lbrace>TA\<rbrace>\<^bsub>o\<^esub>\<close> by(auto)
     next
       case InitialThreadAction
       with redT_normal vs show ?thesis by(auto simp add: take_Cons')
     next
       case ThreadFinishAction
       with redT_normal vs show ?thesis by(auto simp add: take_Cons')
     qed
   next
     case (redT_acquire x l ln)
     have "w_values P vs (take n (map NormalAction (convert_RA ln :: ('addr, 'thread_id) obs_event list))) = vs"
       by(fastforce simp add: convert_RA_not_write take_Cons' dest: in_set_takeD intro!: w_values_no_write_unchanged del: equalityI)
     thus ?thesis using vs redT_acquire by auto 
   qed
 qed
 
 lemma if_RedT_non_speculative_invar:
   assumes red: "mthr.if.RedT s ttas s'"
   and tsok: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and sc: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
   and vs: "vs_conf P (shr s) vs"
   shows "ts_ok (init_fin_lift wfx) (thr s') (shr s')" (is ?thesis1)
   and "vs_conf P (shr s') (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))" (is ?thesis2)
 using red tsok sc vs unfolding mthr.if.RedT_def
 proof(induct arbitrary: vs rule: rtrancl3p_converse_induct')
   case refl
   case 1 thus ?case by -
   case 2 thus ?case by simp
 next
   case (step s tta s' ttas)
   obtain t ta where tta: "tta = (t, ta)" by(cases tta)
 
   case 1
   hence sc1: "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     and sc2: "non_speculative P (w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     unfolding lconcat_llist_of[symmetric] lmap_llist_of[symmetric] llist.map_comp o_def llist_of.simps llist.map(2) lconcat_LCons tta
     by(simp_all add: non_speculative_lappend list_of_lconcat o_def)
   from if_redT_non_speculative_invar[OF step(2)[unfolded tta] _ sc1] if_redT_non_speculative_vs_conf[OF step(2)[unfolded tta], where vs = vs and n="length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"] 1 step.hyps(3)[of "w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"] sc2 sc1
   show ?case by simp
 
   case 2
   hence sc1: "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     and sc2: "non_speculative P (w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     unfolding lconcat_llist_of[symmetric] lmap_llist_of[symmetric] llist.map_comp o_def llist_of.simps llist.map(2) lconcat_LCons tta
     by(simp_all add: non_speculative_lappend list_of_lconcat o_def)
   from if_redT_non_speculative_invar[OF step(2)[unfolded tta] _ sc1] if_redT_non_speculative_vs_conf[OF step(2)[unfolded tta], where vs = vs and n="length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"] 2 step.hyps(4)[of "w_values P vs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"] sc2 sc1
   show ?case by(simp add: tta o_def)
 qed
 
 lemma init_fin_hext_incr:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')"
   and "init_fin_lift wfx t x m"
   and "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   and "vs_conf P m vs"
   shows "m \<unlhd> m'"
 using assms
 by(cases)(auto intro: red_hext_incr)
 
 lemma init_fin_redT_hext_incr:
   assumes "mthr.if.redT s (t, ta) s'"
   and "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and "non_speculative P vs (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   and "vs_conf P (shr s) vs"
   shows "shr s \<unlhd> shr s'"
 using assms
 by(cases)(auto dest: init_fin_hext_incr ts_okD)
 
 lemma init_fin_RedT_hext_incr:
   assumes "mthr.if.RedT s ttas s'"
   and "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and sc: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
   and vs: "vs_conf P (shr s) vs"
   shows "shr s \<unlhd> shr s'"
 using assms
 proof(induction rule: mthr.if.RedT_induct')
   case refl thus ?case by simp
 next
   case (step ttas s' t ta s'')
   note ts_ok = \<open>ts_ok (init_fin_lift wfx) (thr s) (shr s)\<close>
   from \<open>non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ttas @ [(t, ta)]))))\<close>
   have ns: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     and ns': "non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     by(simp_all add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
   from ts_ok ns have "shr s \<unlhd> shr s'" 
     using \<open>vs_conf P (shr s) vs\<close> by(rule step.IH)
   also have "ts_ok (init_fin_lift wfx) (thr s') (shr s')"
     using \<open>mthr.if.RedT s ttas s'\<close> ts_ok ns \<open>vs_conf P (shr s) vs\<close>
     by(rule if_RedT_non_speculative_invar)
   with \<open>mthr.if.redT s' (t, ta) s''\<close> 
   have "\<dots> \<unlhd> shr s''" using ns'
   proof(rule init_fin_redT_hext_incr)
     from \<open>mthr.if.RedT s ttas s'\<close> ts_ok ns \<open>vs_conf P (shr s) vs\<close>
     show "vs_conf P (shr s') (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
       by(rule if_RedT_non_speculative_invar)
   qed
   finally show ?case .
 qed
 
 lemma init_fin_red_read_typeable:
   assumes "t \<turnstile> (x, m) -ta\<rightarrow>i (x', m')"
   and "init_fin_lift wfx t x m" "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "\<exists>T. P,m \<turnstile> ad@al : T"
 using assms
 by cases(auto dest: red_read_typeable)
 
 lemma Ex_new_action_for:
   assumes wf: "wf_syscls P"
   and wfx_start: "ts_ok wfx (thr (start_state f P C M vs)) start_heap"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   and E: "E \<in> \<E>_start f P C M vs status"
   and read: "ra \<in> read_actions E"
   and aloc: "adal \<in> action_loc P E ra"
   and sc: "non_speculative P (\<lambda>_. {}) (ltake (enat ra) (lmap snd E))"
   shows "\<exists>wa. wa \<in> new_actions_for P E adal \<and> wa < ra"
 proof -
   let ?obs_prefix = "lift_start_obs start_tid start_heap_obs"
   let ?start_state = "init_fin_lift_state status (start_state f P C M vs)"
 
   from start_state_vs_conf[OF wf]
   have vs_conf_start: "vs_conf P start_heap (w_values P (\<lambda>_. {}) (map NormalAction start_heap_obs))" 
     by(simp add: lift_start_obs_def o_def)
 
   obtain ad al where adal: "adal = (ad, al)" by(cases adal)
   with read aloc obtain v where ra: "action_obs E ra = NormalAction (ReadMem ad al v)"
     and ra_len: "enat ra < llength E"
     by(cases "lnth E ra")(auto elim!: read_actions.cases actionsE)
 
   from E obtain E'' where E: "E = lappend (llist_of ?obs_prefix) E''"
     and E'': "E'' \<in> mthr.if.\<E> ?start_state" by(auto)
   from E'' obtain E' where E': "E'' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
     and \<tau>Runs: "mthr.if.mthr.Runs ?start_state E'" by(rule mthr.if.\<E>.cases)
 
   have ra_len': "length ?obs_prefix \<le> ra"
   proof(rule ccontr)
     assume "\<not> ?thesis"
     hence "ra < length ?obs_prefix" by simp
     moreover with ra ra_len E obtain ra' ad al v 
       where "start_heap_obs ! ra' = ReadMem ad al v" "ra' < length start_heap_obs"
       by(cases ra)(auto simp add: lnth_LCons lnth_lappend1 action_obs_def lift_start_obs_def)
     ultimately have "ReadMem ad al v \<in> set start_heap_obs" unfolding in_set_conv_nth by blast
     thus False by(simp add: start_heap_obs_not_Read)
   qed
   let ?n = "length ?obs_prefix"
   from ra ra_len ra_len' E have "enat (ra - ?n) < llength E''"
     and ra_obs: "action_obs E'' (ra - ?n) = NormalAction (ReadMem ad al v)"
     by(cases "llength E''", auto simp add: action_obs_def lnth_lappend2)
   
   from \<tau>Runs \<open>enat (ra - ?n) < llength E''\<close> obtain ra_m ra_n t_ra ta_ra 
     where E_ra: "lnth E'' (ra - ?n) = (t_ra, \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub> ! ra_n)"
     and ra_n: "ra_n < length \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub>" and ra_m: "enat ra_m < llength E'"
     and ra_conv: "ra - ?n = (\<Sum>i<ra_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + ra_n"
     and E'_ra_m: "lnth E' ra_m = (t_ra, ta_ra)"
     unfolding E' by(rule mthr.if.actions_\<E>E_aux)
     
   let ?E' = "ldropn (Suc ra_m) E'"
     
   have E'_unfold: "E' = lappend (ltake (enat ra_m) E') (LCons (lnth E' ra_m) ?E')"
     unfolding ldropn_Suc_conv_ldropn[OF ra_m] by simp
   hence "mthr.if.mthr.Runs ?start_state (lappend (ltake (enat ra_m) E') (LCons (lnth E' ra_m) ?E'))"
     using \<tau>Runs by simp
   then obtain \<sigma>' where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of (ltake (enat ra_m) E')) \<sigma>'"
     and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' ra_m) ?E')"
     by(rule mthr.if.mthr.Runs_lappendE) simp
   from \<tau>Runs' obtain \<sigma>'' where red_ra: "mthr.if.redT \<sigma>' (t_ra, ta_ra) \<sigma>''"
     and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>'' ?E'"
     unfolding E'_ra_m by cases
 
   from E_ra ra_n ra_obs have "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub>"
     by(auto simp add: action_obs_def in_set_conv_nth)
   with red_ra obtain x_ra x'_ra m'_ra 
     where red'_ra: "mthr.init_fin t_ra (x_ra, shr \<sigma>') ta_ra (x'_ra, m'_ra)"
     and \<sigma>'': "redT_upd \<sigma>' t_ra ta_ra x'_ra m'_ra \<sigma>''"
     and ts_t_a: "thr \<sigma>' t_ra = \<lfloor>(x_ra, no_wait_locks)\<rfloor>"
     by cases auto
   from red'_ra \<open>NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub>\<close>
   obtain ta'_ra X_ra X'_ra
     where x_ra: "x_ra = (Running, X_ra)"
     and x'_ra: "x'_ra = (Running, X'_ra)"
     and ta_ra: "ta_ra = convert_TA_initial (convert_obs_initial ta'_ra)"
     and red''_ra: "t_ra \<turnstile> (X_ra, shr \<sigma>') -ta'_ra\<rightarrow> (X'_ra, m'_ra)"
     by cases fastforce+
 
   from \<open>NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub>\<close> ta_ra 
   have "ReadMem ad al v \<in> set \<lbrace>ta'_ra\<rbrace>\<^bsub>o\<^esub>" by auto
 
   from wfx_start have wfx_start: "ts_ok (init_fin_lift wfx) (thr ?start_state) (shr ?start_state)"
     by(simp add: start_state_def split_beta)
 
   from sc ra_len'
   have "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix))
     (lmap snd (ltake (enat (ra - ?n)) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E'))))"
     unfolding E E' by(simp add: ltake_lappend2 lmap_lappend_distrib non_speculative_lappend)
   also note ra_conv also note plus_enat_simps(1)[symmetric]
   also have "enat (\<Sum>i<ra_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = (\<Sum>i<ra_m. enat (length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>))"
-    by(subst sum_hom[symmetric])(simp_all add: zero_enat_def)
+    by(subst sum_comp_morphism[symmetric])(simp_all add: zero_enat_def)
   also have "\<dots> = (\<Sum>i<ra_m. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i))"
     using ra_m by-(rule sum.cong[OF refl], simp add: le_less_trans[where y="enat ra_m"] split_beta)
   also note ltake_plus_conv_lappend also note lconcat_ltake[symmetric]
   also note lmap_lappend_distrib
   also note non_speculative_lappend
   finally have "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (llist_of (list_of (ltake (enat ra_m) E'))))))"
     by(simp add: split_def)
   hence sc': "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat ra_m) E')))))"
     unfolding lmap_lconcat llist.map_comp o_def lconcat_llist_of[symmetric] lmap_llist_of[symmetric]
     by(simp add: split_beta o_def)
 
   from vs_conf_start have vs_conf_start: "vs_conf P (shr ?start_state) (w_values P (\<lambda>_. {}) (map snd ?obs_prefix))"
     by(simp add:init_fin_lift_state_conv_simps start_state_def split_beta lift_start_obs_def o_def)
   with \<sigma>_\<sigma>' wfx_start sc' have "ts_ok (init_fin_lift wfx) (thr \<sigma>') (shr \<sigma>')"
     unfolding mthr.if.RedT_def[symmetric] by(rule if_RedT_non_speculative_invar)
   with ts_t_a have "wfx t_ra X_ra (shr \<sigma>')" unfolding x_ra by(auto dest: ts_okD)
 
   with red''_ra \<open>ReadMem ad al v \<in> set \<lbrace>ta'_ra\<rbrace>\<^bsub>o\<^esub>\<close>
   obtain T' where type_adal: "P,shr \<sigma>' \<turnstile> ad@al : T'" by(auto dest: red_read_typeable)
 
   from sc ra_len' have "non_speculative P (\<lambda>_. {}) (llist_of (map snd ?obs_prefix))"
     unfolding E by(simp add: ltake_lappend2 lmap_lappend_distrib non_speculative_lappend)
   with sc' have sc'': "non_speculative P (\<lambda>_. {}) (llist_of (map snd (lift_start_obs start_tid start_heap_obs) @ concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat ra_m) E')))))"
     by(simp add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
 
   from \<sigma>_\<sigma>' red_ra \<open>NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta_ra\<rbrace>\<^bsub>o\<^esub>\<close> sc'' ka
   show "\<exists>wa. wa \<in> new_actions_for P E adal \<and> wa < ra"
     unfolding mthr.if.RedT_def[symmetric]
   proof(cases rule: read_ex_NewHeapElem)
     case (start CTn)
     then obtain n where n: "start_heap_obs ! n = NewHeapElem ad CTn" 
       and len: "n < length start_heap_obs"
       unfolding in_set_conv_nth by blast
     from len have "Suc n \<in> actions E" unfolding E by(simp add: actions_def enat_less_enat_plusI)
     moreover
     from \<sigma>_\<sigma>' have hext: "start_heap \<unlhd> shr \<sigma>'" unfolding mthr.if.RedT_def[symmetric]
       using wfx_start sc' vs_conf_start
       by(auto dest!: init_fin_RedT_hext_incr simp add: start_state_def split_beta init_fin_lift_state_conv_simps)
     
     from start have "typeof_addr start_heap ad = \<lfloor>CTn\<rfloor>"
       by(auto dest: NewHeapElem_start_heap_obsD[OF wf])
     with hext have "typeof_addr (shr \<sigma>') ad = \<lfloor>CTn\<rfloor>" by(rule typeof_addr_hext_mono)
     with type_adal have "adal \<in> action_loc P E (Suc n)" using n len unfolding E adal
       by cases(auto simp add: action_obs_def lnth_lappend1 lift_start_obs_def)
     moreover have "is_new_action (action_obs E (Suc n))" using n len unfolding E
       by(simp add: action_obs_def lnth_lappend1 lift_start_obs_def)
     ultimately have "Suc n \<in> new_actions_for P E adal" by(rule new_actionsI)
     moreover have "Suc n < ra" using ra_len' len by(simp)
     ultimately show ?thesis by blast
   next
     case (Red ttas' s'' t' ta' s''' ttas'' CTn)
     
     from \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close>
     obtain obs obs' where obs: "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = obs @ NormalAction (NewHeapElem ad CTn) # obs'"
       by(auto dest: split_list)
     
     let ?wa = "?n + length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs"
     have "enat (length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs) < enat (length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ttas' @ [(t', ta')]))))"
       using obs by simp
     also have "\<dots> = llength (lconcat (lmap llist_of (lmap (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (llist_of (ttas' @ [(t', ta')])))))"
       by(simp del: map_map map_append add: lconcat_llist_of)
     also have "\<dots> \<le> llength (lconcat (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (llist_of (ttas' @ (t', ta') # ttas''))))"
       by(auto simp add: o_def split_def intro: lprefix_llist_ofI intro!: lprefix_lconcatI lprefix_llength_le)
     also note len_less = calculation
     have "\<dots> \<le> (\<Sum>i<ra_m. llength (lnth (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) E') i))"
       unfolding \<open>list_of (ltake (enat ra_m) E') = ttas' @ (t', ta') # ttas''\<close>[symmetric]
       by(simp add: ltake_lmap[symmetric] lconcat_ltake del: ltake_lmap)
     also have "\<dots> = enat (\<Sum>i<ra_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)" using ra_m
-      by(subst sum_hom[symmetric, where f="enat"])(auto intro: sum.cong simp add: zero_enat_def less_trans[where y="enat ra_m"] split_beta)
+      by(subst sum_comp_morphism[symmetric, where h="enat"])(auto intro: sum.cong simp add: zero_enat_def less_trans[where y="enat ra_m"] split_beta)
     also have "\<dots> \<le> enat (ra - ?n)" unfolding ra_conv by simp
     finally have enat_length: "enat (length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs) < enat (ra - length (lift_start_obs start_tid start_heap_obs))" .
     then have wa_ra: "?wa < ra" by simp
     with ra_len have "?wa \<in> actions E" by(cases "llength E")(simp_all add: actions_def)
     moreover
     from \<open>mthr.if.redT s'' (t', ta') s'''\<close> \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close>
     obtain x_wa x_wa' where ts''t': "thr s'' t' = \<lfloor>(x_wa, no_wait_locks)\<rfloor>"
       and red_wa: "mthr.init_fin t' (x_wa, shr s'') ta' (x_wa', shr s''')"
       by(cases) fastforce+
 
     from sc'
     have ns: "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')))"
       and ns': "non_speculative P (w_values P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) (llist_of \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
       and ns'': "non_speculative P (w_values P (w_values P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'')))"
       unfolding \<open>list_of (ltake (enat ra_m) E') = ttas' @ (t', ta') # ttas''\<close>
       by(simp_all add: lappend_llist_of_llist_of[symmetric] lmap_lappend_distrib non_speculative_lappend del: lappend_llist_of_llist_of)
     from \<open>mthr.if.RedT ?start_state ttas' s''\<close> wfx_start ns
     have ts_ok'': "ts_ok (init_fin_lift wfx) (thr s'') (shr s'')"
       using vs_conf_start by(rule if_RedT_non_speculative_invar)
     with ts''t' have wfxt': "wfx t' (snd x_wa) (shr s'')" by(cases x_wa)(auto dest: ts_okD)
 
     {
       have "action_obs E ?wa = 
         snd (lnth (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')) (length (concat (map (\<lambda>(t, y). \<lbrace>y\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs))"
         unfolding E E' by(simp add: action_obs_def lnth_lappend2)
       also from enat_length \<open>enat (ra - ?n) < llength E''\<close>
       have "\<dots> = lnth (lconcat (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) E')) (length (concat (map (\<lambda>(t, y). \<lbrace>y\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs)"
         unfolding E'
         by(subst lnth_lmap[symmetric, where f=snd])(erule (1) less_trans, simp add: lmap_lconcat llist.map_comp split_def o_def)
       also from len_less
       have "enat (length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs) < llength (lconcat (ltake (enat ra_m) (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) E')))"
         unfolding \<open>list_of (ltake (enat ra_m) E') = ttas' @ (t', ta') # ttas''\<close>[symmetric]
         by(simp add: ltake_lmap[symmetric] del: ltake_lmap)
       note lnth_lconcat_ltake[OF this, symmetric]
       also note ltake_lmap
       also have "ltake (enat ra_m) E' = llist_of (list_of (ltake (enat ra_m) E'))" by(simp)
       also note \<open>list_of (ltake (enat ra_m) E') = ttas' @ (t', ta') # ttas''\<close>
       also note lmap_llist_of also have "(\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) = llist_of \<circ> (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
         by(simp add: o_def split_def)
       also note map_map[symmetric] also note lconcat_llist_of
       also note lnth_llist_of 
       also have "concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ttas' @ (t', ta') # ttas'')) ! (length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs) = NormalAction (NewHeapElem ad CTn)"
         by(simp add: nth_append obs)
       finally have "action_obs E ?wa = NormalAction (NewHeapElem ad CTn)" .
     }
     note wa_obs = this
     
     from \<open>mthr.if.RedT ?start_state ttas' s''\<close> wfx_start ns vs_conf_start
     have vs'': "vs_conf P (shr s'') (w_values P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')))"
       by(rule if_RedT_non_speculative_invar)
     from if_redT_non_speculative_vs_conf[OF \<open>mthr.if.redT s'' (t', ta') s'''\<close> ts_ok'' _ vs'', of "length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"] ns'
     have vs''': "vs_conf P (shr s''') (w_values P (w_values P (w_values P (\<lambda>_. {}) (map snd ?obs_prefix)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
       by simp
     
     from \<open>mthr.if.redT s'' (t', ta') s'''\<close> ts_ok'' ns' vs''
     have "ts_ok (init_fin_lift wfx) (thr s''') (shr s''')"
       by(rule if_redT_non_speculative_invar)
     with \<open>mthr.if.RedT s''' ttas'' \<sigma>'\<close>
     have hext: "shr s''' \<unlhd> shr \<sigma>'" using ns'' vs'''
       by(rule init_fin_RedT_hext_incr)
 
     from red_wa have "typeof_addr (shr s''') ad = \<lfloor>CTn\<rfloor>"
       using wfxt' \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close> by cases(auto dest: red_NewHeapElemD)
     with hext have "typeof_addr (shr \<sigma>') ad = \<lfloor>CTn\<rfloor>" by(rule typeof_addr_hext_mono)
     with type_adal have "adal \<in> action_loc P E ?wa" using wa_obs unfolding E adal
       by cases (auto simp add: action_obs_def lnth_lappend1 lift_start_obs_def)
     moreover have "is_new_action (action_obs E ?wa)" using wa_obs by simp
     ultimately have "?wa \<in> new_actions_for P E adal" by(rule new_actionsI)
     thus ?thesis using wa_ra by blast
   qed
 qed
 
 lemma executions_sc_hb:
   assumes "wf_syscls P"
   and "ts_ok wfx (thr (start_state f P C M vs)) start_heap"
   and "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   shows
   "executions_sc_hb (\<E>_start f P C M vs status) P"
   (is "executions_sc_hb ?E P")
 proof
   fix E a adal a'
   assume "E \<in> ?E" "a \<in> new_actions_for P E adal" "a' \<in> new_actions_for P E adal"
   thus "a = a'" by(rule \<E>_new_actions_for_unique)
 next
   fix E ra adal
   assume "E \<in> ?E" "ra \<in> read_actions E" "adal \<in> action_loc P E ra" 
     and "non_speculative P (\<lambda>_. {}) (ltake (enat ra) (lmap snd E))"
   with assms show "\<exists>wa. wa \<in> new_actions_for P E adal \<and> wa < ra"
     by(rule Ex_new_action_for)
 qed
 
 lemma executions_aux:
   assumes wf: "wf_syscls P"
   and wfx_start: "ts_ok wfx (thr (start_state f P C M vs)) start_heap" (is "ts_ok wfx (thr ?start_state) _")
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   shows "executions_aux (\<E>_start f P C M vs status) P"
   (is "executions_aux ?\<E> P")
 proof
   fix E a adal a'
   assume "E \<in> ?\<E>" "a \<in> new_actions_for P E adal" "a' \<in> new_actions_for P E adal"
   thus "a = a'" by(rule \<E>_new_actions_for_unique)
 next
   fix E ws r adal
   assume E: "E \<in> ?\<E>"
     and wf_exec: "P \<turnstile> (E, ws) \<surd>" 
     and read: "r \<in> read_actions E" "adal \<in> action_loc P E r"
     and sc: "\<And>a. \<lbrakk>a < r; a \<in> read_actions E\<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
 
   interpret jmm: executions_sc_hb ?\<E> P
     using wf wfx_start ka by(rule executions_sc_hb)
 
   from E wf_exec sc
   have "ta_seq_consist P Map.empty (ltake (enat r) (lmap snd E))"
     unfolding ltake_lmap by(rule jmm.ta_seq_consist_mrwI) simp
   hence "non_speculative P (\<lambda>_. {}) (ltake (enat r) (lmap snd E))"
     by(rule ta_seq_consist_into_non_speculative) simp
   with wf wfx_start ka E read
   have "\<exists>i. i \<in> new_actions_for P E adal \<and> i < r"
     by(rule Ex_new_action_for)
   thus "\<exists>i<r. i \<in> new_actions_for P E adal" by blast
 qed
 
 lemma drf:
   assumes cut_and_update:
     "if.cut_and_update
        (init_fin_lift_state status (start_state f P C M vs))
        (mrw_values P Map.empty (map snd (lift_start_obs start_tid start_heap_obs)))"
     (is "if.cut_and_update ?start_state (mrw_values _ _ (map _ ?start_heap_obs))")
   and wf: "wf_syscls P"
   and wfx_start: "ts_ok wfx (thr (start_state f P C M vs)) start_heap"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   shows "drf (\<E>_start f P C M vs status) P" (is "drf ?\<E> _")
 proof -
   interpret jmm: executions_sc_hb "?\<E>" P
     using wf wfx_start ka by(rule executions_sc_hb)
 
   let ?n = "length ?start_heap_obs"
   let ?\<E>' = "lappend (llist_of ?start_heap_obs) ` mthr.if.\<E> ?start_state"
 
   show ?thesis 
   proof
     fix E ws r
     assume E: "E \<in> ?\<E>'"
       and wf: "P \<turnstile> (E, ws) \<surd>"
       and mrw: "\<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
     show "\<exists>E'\<in>?\<E>'. \<exists>ws'. P \<turnstile> (E', ws') \<surd> \<and> ltake (enat r) E = ltake (enat r) E' \<and>
                            sequentially_consistent P (E', ws') \<and>
                            action_tid E r = action_tid E' r \<and> action_obs E r \<approx> action_obs E' r \<and>
                            (r \<in> actions E \<longrightarrow> r \<in> actions E')"
     proof(cases "\<exists>r'. r' \<in> read_actions E \<and> r \<le> r'")
       case False
       have "sequentially_consistent P (E, ws)"
       proof(rule sequentially_consistentI)
         fix a
         assume "a \<in> read_actions E"
         with False have "a < r" by auto
         thus "P,E \<turnstile> a \<leadsto>mrw ws a" using \<open>a \<in> read_actions E\<close> by(rule mrw)
       qed
       moreover have "action_obs E r \<approx> action_obs E r" by(rule sim_action_refl)
       ultimately show ?thesis using wf E by blast
     next
       case True
       let ?P = "\<lambda>r'. r' \<in> read_actions E \<and> r \<le> r'"
       let ?r = "Least ?P"
       from True obtain r' where r': "?P r'" by blast
       hence r: "?P ?r" by(rule LeastI)
       {
         fix a
         assume "a < ?r" "a \<in> read_actions E"
         have "P,E \<turnstile> a \<leadsto>mrw ws a"
         proof(cases "a < r")
           case True
           thus ?thesis using \<open>a \<in> read_actions E\<close> by(rule mrw)
         next
           case False
           with \<open>a \<in> read_actions E\<close> have "?P a" by simp
           hence "?r \<le> a" by(rule Least_le)
           with \<open>a < ?r\<close> have False by simp
           thus ?thesis ..
         qed }
       note mrw' = this
 
       from E obtain E'' where E: "E = lappend (llist_of ?start_heap_obs) E''"
         and E'': "E'' \<in> mthr.if.\<E> ?start_state" by auto
 
       from E'' obtain E' where E': "E'' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
         and \<tau>Runs: "mthr.if.mthr.Runs ?start_state E'"
         by(rule mthr.if.\<E>.cases)
 
       have r_len: "length ?start_heap_obs \<le> ?r"
       proof(rule ccontr)
         assume "\<not> ?thesis"
         hence "?r < length ?start_heap_obs" by simp
         moreover with r E obtain t ad al v where "?start_heap_obs ! ?r = (t, NormalAction (ReadMem ad al v))"
           by(cases "?start_heap_obs ! ?r")(fastforce elim!: read_actions.cases simp add: actions_def action_obs_def lnth_lappend1)
         ultimately have "(t, NormalAction (ReadMem ad al v)) \<in> set ?start_heap_obs" unfolding in_set_conv_nth by blast
         thus False by(auto simp add: start_heap_obs_not_Read)
       qed
       let ?n = "length ?start_heap_obs"
       from r r_len E have r: "?r - ?n \<in> read_actions E''"
         by(fastforce elim!: read_actions.cases simp add: actions_lappend action_obs_def lnth_lappend2 elim: actionsE intro: read_actions.intros)
       
       from r have "?r - ?n \<in> actions E''" by(auto)
       hence "enat (?r - ?n) < llength E''" by(rule actionsE)
       with \<tau>Runs obtain r_m r_n t_r ta_r 
         where E_r: "lnth E'' (?r - ?n) = (t_r, \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n)"
         and r_n: "r_n < length \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>" and r_m: "enat r_m < llength E'"
         and r_conv: "?r - ?n = (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + r_n"
         and E'_r_m: "lnth E' r_m = (t_r, ta_r)"
         unfolding E' by(rule mthr.if.actions_\<E>E_aux)
 
       let ?E' = "ldropn (Suc r_m) E'"
       let ?r_m_E' = "ltake (enat r_m) E'"
       have E'_unfold: "E' = lappend (ltake (enat r_m) E') (LCons (lnth E' r_m) ?E')"
         unfolding ldropn_Suc_conv_ldropn[OF r_m] by simp
       hence "mthr.if.mthr.Runs ?start_state (lappend ?r_m_E' (LCons (lnth E' r_m) ?E'))"
         using \<tau>Runs by simp
       then obtain \<sigma>' where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of ?r_m_E') \<sigma>'"
         and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' r_m) ?E')"
         by(rule mthr.if.mthr.Runs_lappendE) simp
       from \<tau>Runs' obtain \<sigma>''' where red_ra: "mthr.if.redT \<sigma>' (t_r, ta_r) \<sigma>'''"
         and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>''' ?E'"
         unfolding E'_r_m by cases
 
       let ?vs = "mrw_values P Map.empty (map snd ?start_heap_obs)"
       { fix a
         assume "enat a < enat ?r"
           and "a \<in> read_actions E"
         have "a < r"
         proof(rule ccontr)
           assume "\<not> a < r"
           with \<open>a \<in> read_actions E\<close> have "?P a" by simp
           hence "?r \<le> a" by(rule Least_le)
           with \<open>enat a < enat ?r\<close> show False by simp
         qed
         hence "P,E \<turnstile> a \<leadsto>mrw ws a" using \<open>a \<in> read_actions E\<close> by(rule mrw) }
       with \<open>E \<in> ?\<E>'\<close> wf have "ta_seq_consist P Map.empty (lmap snd (ltake (enat ?r) E))"
         by(rule jmm.ta_seq_consist_mrwI)
 
       hence start_sc: "ta_seq_consist P Map.empty (llist_of (map snd ?start_heap_obs))"
         and "ta_seq_consist P ?vs (lmap snd (ltake (enat (?r - ?n)) E''))"
         using \<open>?n \<le> ?r\<close> unfolding E ltake_lappend lmap_lappend_distrib
         by(simp_all add: ta_seq_consist_lappend o_def)
 
       note this(2) also from r_m
       have r_m_sum_len_eq: "(\<Sum>i<r_m. llength (lnth (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E') i)) = enat (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)"
-        by(subst sum_hom[symmetric, where f=enat])(auto simp add: zero_enat_def split_def less_trans[where y="enat r_m"] intro: sum.cong)
+        by(subst sum_comp_morphism[symmetric, where h=enat])(auto simp add: zero_enat_def split_def less_trans[where y="enat r_m"] intro: sum.cong)
       hence "ltake (enat (?r - ?n)) E'' = 
             lappend (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?r_m_E')) 
                     (ltake (enat r_n) (ldrop (enat (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) E''))"
         unfolding ltake_lmap[symmetric] lconcat_ltake r_conv plus_enat_simps(1)[symmetric] ltake_plus_conv_lappend
         unfolding E' by simp
       finally have "ta_seq_consist P ?vs (lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?r_m_E')))"
         and sc_ta_r: "ta_seq_consist P (mrw_values P ?vs (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?r_m_E'))))) (lmap snd (ltake (enat r_n) (ldropn (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) E'')))"
         unfolding lmap_lappend_distrib by(simp_all add: ta_seq_consist_lappend split_def ldrop_enat)
       note this(1) also
       have "lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (ltake (enat r_m) E')))
             = llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?r_m_E')))"
         unfolding lmap_lconcat llist.map_comp o_def split_def lconcat_llist_of[symmetric] map_map lmap_llist_of[symmetric]
         by simp
       finally have "ta_seq_consist P ?vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?r_m_E'))))" .
       from if.sequential_completion[OF cut_and_update ta_seq_consist_convert_RA \<sigma>_\<sigma>'[folded mthr.if.RedT_def] this red_ra]
       obtain ta' ttas' 
         where "mthr.if.mthr.Runs \<sigma>' (LCons (t_r, ta') ttas')"
         and sc: "ta_seq_consist P (mrw_values P Map.empty (map snd ?start_heap_obs)) 
                    (lconcat (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (lappend (llist_of (list_of ?r_m_E')) (LCons (t_r, ta') ttas'))))"
           and eq_ta: "eq_upto_seq_inconsist P \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> (mrw_values P ?vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?r_m_E'))))"
           by blast
 
       let ?E_sc' = "lappend (llist_of (list_of ?r_m_E')) (LCons (t_r, ta') ttas')"
       let ?E_sc'' = "lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?E_sc')"
       let ?E_sc = "lappend (llist_of ?start_heap_obs) ?E_sc''"
 
       from \<sigma>_\<sigma>' \<open>mthr.if.mthr.Runs \<sigma>' (LCons (t_r, ta') ttas')\<close>
       have "mthr.if.mthr.Runs ?start_state ?E_sc'" by(rule mthr.if.mthr.Trsys_into_Runs)
       hence "?E_sc'' \<in> mthr.if.\<E> ?start_state" by(rule mthr.if.\<E>.intros)
       hence "?E_sc \<in> ?\<E>" by(rule imageI)
       moreover from \<open>?E_sc'' \<in> mthr.if.\<E> ?start_state\<close>
       have tsa_ok: "thread_start_actions_ok ?E_sc" by(rule thread_start_actions_ok_init_fin) 
         
       from sc have "ta_seq_consist P Map.empty (lmap snd ?E_sc)"
         by(simp add: lmap_lappend_distrib o_def lmap_lconcat llist.map_comp split_def ta_seq_consist_lappend start_sc)
       from ta_seq_consist_imp_sequentially_consistent[OF tsa_ok jmm.\<E>_new_actions_for_fun[OF \<open>?E_sc \<in> ?\<E>\<close>] this]
       obtain ws_sc where "sequentially_consistent P (?E_sc, ws_sc)"
         and "P \<turnstile> (?E_sc, ws_sc) \<surd>" unfolding start_heap_obs_def[symmetric] by iprover
       moreover {
         have enat_sum_r_m_eq: "enat (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) = llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?r_m_E'))"
-          by(auto intro: sum.cong simp add: less_trans[OF _ r_m] lnth_ltake llength_lconcat_lfinite_conv_sum sum_hom[symmetric, where f=enat] zero_enat_def[symmetric] split_beta)
+          by(auto intro: sum.cong simp add: less_trans[OF _ r_m] lnth_ltake llength_lconcat_lfinite_conv_sum sum_comp_morphism[symmetric, where h=enat] zero_enat_def[symmetric] split_beta)
         also have "\<dots> \<le> llength E''" unfolding E'
           by(blast intro: lprefix_llength_le lprefix_lconcatI lmap_lprefix)
         finally have r_m_E: "ltake (enat (?n + (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>))) E = ltake (enat (?n + (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>))) ?E_sc"
           by(simp add: ltake_lappend lappend_eq_lappend_conv lmap_lappend_distrib r_m_sum_len_eq ltake_lmap[symmetric] min_def zero_enat_def[symmetric] E E' lconcat_ltake ltake_all del: ltake_lmap)
 
         have drop_r_m_E: "ldropn (?n + (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) E = lappend (llist_of (map (Pair t_r) \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (ldropn (Suc r_m) E')))"
           (is "_ = ?drop_r_m_E") using E'_r_m unfolding E E'
           by(subst (2) E'_unfold)(simp add: ldropn_lappend2 lmap_lappend_distrib enat_sum_r_m_eq[symmetric])
 
         have drop_r_m_E_sc: "ldropn (?n + (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) ?E_sc =
           lappend (llist_of (map (Pair t_r) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas'))"
           by(simp add: ldropn_lappend2 lmap_lappend_distrib enat_sum_r_m_eq[symmetric])
 
         let ?vs_r_m = "mrw_values P ?vs (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?r_m_E'))))"
         note sc_ta_r also
         from drop_r_m_E have "ldropn (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) E'' = ?drop_r_m_E"
           unfolding E by(simp add: ldropn_lappend2)
         also have "lmap snd (ltake (enat r_n) \<dots>) = llist_of (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)" using r_n
           by(simp add: ltake_lappend lmap_lappend_distrib ltake_lmap[symmetric] take_map o_def zero_enat_def[symmetric] del: ltake_lmap)
         finally have sc_ta_r: "ta_seq_consist P ?vs_r_m (llist_of (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))" .
         note eq_ta
         also have "\<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> = take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> @ drop r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>" by simp
         finally have "eq_upto_seq_inconsist P (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> @ drop r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ?vs_r_m"
           by(simp add: list_of_lconcat split_def o_def map_concat)
         from eq_upto_seq_inconsist_appendD[OF this sc_ta_r]
         have r_n': "r_n \<le> length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
           and take_r_n_eq: "take r_n \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>"
           and eq_r_n: "eq_upto_seq_inconsist P (drop r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>) (drop r_n \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (mrw_values P ?vs_r_m (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))"
           using r_n by(simp_all add: min_def)
         from r_conv \<open>?n \<le> ?r\<close> have r_conv': "?r = (?n + (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>)) + r_n" by simp
         from r_n' r_n take_r_n_eq r_m_E drop_r_m_E drop_r_m_E_sc
         have take_r'_eq: "ltake (enat ?r) E = ltake (enat ?r) ?E_sc" unfolding r_conv'
           apply(subst (1 2) plus_enat_simps(1)[symmetric])
           apply(subst (1 2) ltake_plus_conv_lappend)
           apply(simp add: lappend_eq_lappend_conv ltake_lappend1 ldrop_enat take_map)
           done
         hence take_r_eq: "ltake (enat r) E = ltake (enat r) ?E_sc"
           by(rule ltake_eq_ltake_antimono)(simp add: \<open>?P ?r\<close>)
         
         from eq_r_n Cons_nth_drop_Suc[OF r_n, symmetric]
         have "drop r_n \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<noteq> []" by(auto simp add: eq_upto_seq_inconsist_simps)
         hence r_n': "r_n < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" by simp
         hence eq_r_n: "\<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n \<approx> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! r_n"
           using eq_r_n Cons_nth_drop_Suc[OF r_n, symmetric] Cons_nth_drop_Suc[OF r_n', symmetric]
           by(simp add: eq_upto_seq_inconsist_simps split: action.split_asm obs_event.split_asm if_split_asm)
         obtain tid_eq: "action_tid E r = action_tid ?E_sc r" 
           and obs_eq: "action_obs E r \<approx> action_obs ?E_sc r"
         proof(cases "r < ?r")
           case True
           { from True have "action_tid E r = action_tid (ltake (enat ?r) E) r"
               by(simp add: action_tid_def lnth_ltake)
             also note take_r'_eq
             also have "action_tid (ltake (enat ?r) ?E_sc) r = action_tid ?E_sc r"
               using True by(simp add: action_tid_def lnth_ltake)
             finally have "action_tid E r = action_tid ?E_sc r" . }
           moreover
           { from True have "action_obs E r = action_obs (ltake (enat ?r) E) r"
               by(simp add: action_obs_def lnth_ltake)
             also note take_r'_eq
             also have "action_obs (ltake (enat ?r) ?E_sc) r = action_obs ?E_sc r"
               using True by(simp add: action_obs_def lnth_ltake)
             finally have "action_obs E r \<approx> action_obs ?E_sc r" by simp }
           ultimately show thesis by(rule that)
         next
           case False
           with \<open>?P ?r\<close> have r_eq: "r = ?r" by simp
           hence "lnth E r = (t_r, \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n)" using E_r r_conv' E by(simp add: lnth_lappend2)
           moreover have "lnth ?E_sc r = (t_r, \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! r_n)" using \<open>?n \<le> ?r\<close> r_n'
             by(subst r_eq)(simp add: r_conv lnth_lappend2 lmap_lappend_distrib enat_sum_r_m_eq[symmetric] lnth_lappend1 del: length_lift_start_obs)
           ultimately have "action_tid E r = action_tid ?E_sc r" "action_obs E r \<approx> action_obs ?E_sc r"
             using eq_r_n by(simp_all add: action_tid_def action_obs_def)
           thus thesis by(rule that)
         qed
         
         have "enat r < enat ?n + llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (lappend ?r_m_E' (LCons (t_r, ta') LNil))))"
           using \<open>?P ?r\<close> r_n' unfolding lmap_lappend_distrib
           by(simp add: enat_sum_r_m_eq[symmetric] r_conv')
         also have "llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (lappend ?r_m_E' (LCons (t_r, ta') LNil)))) \<le> llength ?E_sc''"
           by(rule lprefix_llength_le[OF lprefix_lconcatI])(simp add: lmap_lprefix)
         finally have "r \<in> actions ?E_sc" by(simp add: actions_def add_left_mono)
         note this tid_eq obs_eq take_r_eq }
       ultimately show ?thesis by blast
     qed
   qed(rule \<E>_new_actions_for_unique)
 qed
 
 lemma sc_legal:
   assumes hb_completion:
     "if.hb_completion (init_fin_lift_state status (start_state f P C M vs)) (lift_start_obs start_tid start_heap_obs)"
     (is "if.hb_completion ?start_state ?start_heap_obs")
   and wf: "wf_syscls P"
   and wfx_start: "ts_ok wfx (thr (start_state f P C M vs)) start_heap"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
   shows "sc_legal (\<E>_start f P C M vs status) P"
   (is "sc_legal ?\<E> P")
 proof -
   interpret jmm: executions_sc_hb ?\<E> P
     using wf wfx_start ka by(rule executions_sc_hb)
 
   interpret jmm: executions_aux ?\<E> P
     using wf wfx_start ka by(rule executions_aux)
 
   show ?thesis
   proof
     fix E ws r
     assume E: "E \<in> ?\<E>" and wf_exec: "P \<turnstile> (E, ws) \<surd>"
       and mrw: "\<And>a. \<lbrakk>a < r; a \<in> read_actions E\<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
 
 
     from E obtain E'' where E: "E = lappend (llist_of ?start_heap_obs) E''"
       and E'': "E'' \<in> mthr.if.\<E> ?start_state" by auto
     
     from E'' obtain E' where E': "E'' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E')"
       and \<tau>Runs: "mthr.if.mthr.Runs ?start_state E'"
       by(rule mthr.if.\<E>.cases)
     
     show "\<exists>E'\<in>?\<E>. \<exists>ws'. P \<turnstile> (E', ws') \<surd> \<and> ltake (enat r) E = ltake (enat r) E' \<and>
                          (\<forall>a\<in>read_actions E'. if a < r then ws' a = ws a else P,E' \<turnstile> ws' a \<le>hb a) \<and>
                          action_tid E' r = action_tid E r \<and>
                          (if r \<in> read_actions E then sim_action else (=)) (action_obs E' r) (action_obs E r) \<and>
                          (r \<in> actions E \<longrightarrow> r \<in> actions E')"
       (is "\<exists>E'\<in>?\<E>. \<exists>ws'. _ \<and> ?same E' \<and> ?read E' ws' \<and> ?tid E' \<and> ?obs E' \<and> ?actions E'")
     proof(cases "r < length ?start_heap_obs")
       case True
 
       from if.hb_completion_Runs[OF hb_completion ta_hb_consistent_convert_RA]
       obtain ttas where Runs: "mthr.if.mthr.Runs ?start_state ttas"
         and hb: "ta_hb_consistent P ?start_heap_obs (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas))"
         by blast
 
       from Runs have \<E>: "lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas) \<in> mthr.if.\<E> ?start_state"
         by(rule mthr.if.\<E>.intros)
         
       let ?E = "lappend (llist_of ?start_heap_obs) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas))"
       from \<E> have E': "?E \<in> ?\<E>" by blast
 
       from \<E> have tsa: "thread_start_actions_ok ?E" by(rule thread_start_actions_ok_init_fin)
 
       from start_heap_obs_not_Read
       have ws: "is_write_seen P (llist_of (lift_start_obs start_tid start_heap_obs)) ws"
         by(unfold in_set_conv_nth)(rule is_write_seenI, auto simp add: action_obs_def actions_def lift_start_obs_def lnth_LCons elim!: read_actions.cases split: nat.split_asm)
 
       with hb tsa
       have "\<exists>ws'. P \<turnstile> (?E, ws') \<surd> \<and>
                   (\<forall>n. n \<in> read_actions ?E \<longrightarrow> length ?start_heap_obs \<le> n \<longrightarrow> P,?E \<turnstile> ws' n \<le>hb n) \<and>
                   (\<forall>n<length ?start_heap_obs. ws' n = ws n)"
         by(rule ta_hb_consistent_Read_hb)(rule jmm.\<E>_new_actions_for_fun[OF E'])
       then obtain ws' where wf_exec': "P \<turnstile> (?E, ws') \<surd>" 
         and read_hb: "\<And>n. \<lbrakk> n \<in> read_actions ?E; length ?start_heap_obs \<le> n \<rbrakk> \<Longrightarrow> P,?E \<turnstile> ws' n \<le>hb n"
         and same: "\<And>n. n<length ?start_heap_obs \<Longrightarrow> ws' n = ws n" by blast
 
       from True have "?same ?E" unfolding E by(simp add: ltake_lappend1)
       moreover {
         fix a
         assume a: "a \<in> read_actions ?E"
         have "if a < r then ws' a = ws a else P,?E \<turnstile> ws' a \<le>hb a"
         proof(cases "a < length ?start_heap_obs")
           case True
           with a have False using start_heap_obs_not_Read
             by cases(auto simp add: action_obs_def actions_def lnth_lappend1 lift_start_obs_def lnth_LCons in_set_conv_nth split: nat.split_asm)
           thus ?thesis ..
         next
           case False
           with read_hb[of a] True a show ?thesis by auto
         qed }
       hence "?read ?E ws'" by blast
       moreover from True E have "?tid ?E" by(simp add: action_tid_def lnth_lappend1)
       moreover from True E have "?obs ?E" by(simp add: action_obs_def lnth_lappend1)
       moreover from True have "?actions ?E" by(simp add: actions_def enat_less_enat_plusI)
       ultimately show ?thesis using E' wf_exec' by blast
     next
       case False
       hence r: "length ?start_heap_obs \<le> r" by simp
 
       show ?thesis
       proof(cases "enat r < llength E")
         case False
         then obtain "?same E" "?read E ws" "?tid E" "?obs E" "?actions E"
           by(cases "llength E")(fastforce elim!: read_actions.cases simp add: actions_def split: if_split_asm)+
         with wf_exec \<open>E \<in> ?\<E>\<close> show ?thesis by blast
       next
         case True
         note r' = this
 
         let ?r = "r - length ?start_heap_obs"
         from E r r' have "enat ?r < llength E''" by(cases "llength E''")(auto)
         with \<tau>Runs obtain r_m r_n t_r ta_r 
           where E_r: "lnth E'' ?r = (t_r, \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n)"
           and r_n: "r_n < length \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>" and r_m: "enat r_m < llength E'"
           and r_conv: "?r = (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + r_n"
           and E'_r_m: "lnth E' r_m = (t_r, ta_r)"
           unfolding E' by(rule mthr.if.actions_\<E>E_aux)
 
         let ?E' = "ldropn (Suc r_m) E'"
         let ?r_m_E' = "ltake (enat r_m) E'"
         have E'_unfold: "E' = lappend (ltake (enat r_m) E') (LCons (lnth E' r_m) ?E')"
           unfolding ldropn_Suc_conv_ldropn[OF r_m] by simp
         hence "mthr.if.mthr.Runs ?start_state (lappend ?r_m_E' (LCons (lnth E' r_m) ?E'))"
           using \<tau>Runs by simp
         then obtain \<sigma>' where \<sigma>_\<sigma>': "mthr.if.mthr.Trsys ?start_state (list_of ?r_m_E') \<sigma>'"
           and \<tau>Runs': "mthr.if.mthr.Runs \<sigma>' (LCons (lnth E' r_m) ?E')"
           by(rule mthr.if.mthr.Runs_lappendE) simp
         from \<tau>Runs' obtain \<sigma>''' where red_ra: "mthr.if.redT \<sigma>' (t_r, ta_r) \<sigma>'''"
           and \<tau>Runs'': "mthr.if.mthr.Runs \<sigma>''' ?E'"
           unfolding E'_r_m by cases
 
         let ?vs = "mrw_values P Map.empty (map snd ?start_heap_obs)"
         from \<open>E \<in> ?\<E>\<close> wf_exec have "ta_seq_consist P Map.empty (lmap snd (ltake (enat r) E))"
           by(rule jmm.ta_seq_consist_mrwI)(simp add: mrw)
         hence ns: "non_speculative P (\<lambda>_. {}) (lmap snd (ltake (enat r) E))"
           by(rule ta_seq_consist_into_non_speculative) simp
         also note E also note ltake_lappend2 also note E'
         also note E'_unfold also note lmap_lappend_distrib also note lmap_lappend_distrib 
         also note lconcat_lappend also note llist.map(2) also note E'_r_m also note prod.simps(2)
         also note ltake_lappend2 also note lconcat_LCons also note ltake_lappend1
         also note non_speculative_lappend also note lmap_lappend_distrib also note non_speculative_lappend
         also have "lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (ltake (enat r_m) E')) = 
                   llist_of (concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))))"
           by(simp add: lconcat_llist_of[symmetric] lmap_llist_of[symmetric] llist.map_comp o_def split_def del: lmap_llist_of)
         ultimately
         have "non_speculative P (\<lambda>_. {}) (lmap snd (llist_of ?start_heap_obs))"
           and "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?start_heap_obs)) 
                  (lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (ltake (enat r_m) E'))))"
           and ns': "non_speculative P (w_values P (w_values P (\<lambda>_. {}) (map snd ?start_heap_obs)) (map snd (concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))))))
                (lmap snd (ltake (enat r_n) (llist_of (map (Pair t_r) \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))))"
           using r r_conv r_m r_n
           by(simp_all add: length_concat o_def split_def sum_list_sum_nth length_list_of_conv_the_enat less_min_eq1 atLeast0LessThan lnth_ltake split: if_split_asm cong: sum.cong_simp)
         hence ns: "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?start_heap_obs)) 
                      (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E')))))"
           unfolding lconcat_llist_of[symmetric] lmap_lconcat lmap_llist_of[symmetric] llist.map_comp o_def split_def
           by(simp)
 
         from ns'
         have ns': "non_speculative P (w_values P (w_values P (\<lambda>_. {}) (map snd ?start_heap_obs))  (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))))) (llist_of (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))"
           unfolding map_concat map_map by(simp add: take_map[symmetric] o_def split_def)
 
         let ?hb = "\<lambda>ta'_r  :: ('addr, 'thread_id, status \<times> 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event action) thread_action. 
              ta_hb_consistent P (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)) (llist_of (map (Pair t_r) (drop r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>)))"
         let ?sim = "\<lambda>ta'_r. (if \<exists>ad al v. \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n = NormalAction (ReadMem ad al v) then sim_action else (=)) (\<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n) (\<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub> ! r_n)"
 
         from red_ra obtain ta'_r \<sigma>''''
           where red_ra': "mthr.if.redT \<sigma>' (t_r, ta'_r) \<sigma>''''"
           and eq: "take r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub> = take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>"
           and hb: "?hb ta'_r"
           and r_n': "r_n < length \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>"
           and sim: "?sim ta'_r"
         proof(cases)
           case (redT_normal x x' m')
           note tst = \<open>thr \<sigma>' t_r = \<lfloor>(x, no_wait_locks)\<rfloor>\<close>
             and red = \<open>t_r \<turnstile> (x, shr \<sigma>') -ta_r\<rightarrow>i (x', m')\<close>
             and aok = \<open>mthr.if.actions_ok \<sigma>' t_r ta_r\<close>
             and \<sigma>''' = \<open>redT_upd \<sigma>' t_r ta_r x' m' \<sigma>'''\<close>
           from if.hb_completionD[OF hb_completion \<sigma>_\<sigma>'[folded mthr.if.RedT_def] ns tst red aok ns'] r_n
           obtain ta'_r x'' m''
             where red': "t_r \<turnstile> (x, shr \<sigma>') -ta'_r\<rightarrow>i (x'', m'')"
             and aok': "mthr.if.actions_ok \<sigma>' t_r ta'_r"
             and eq': "take r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub> = take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>"
             and hb: "?hb ta'_r" 
             and r_n': "r_n < length \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>"
             and sim: "?sim ta'_r" by blast
           from redT_updWs_total[of t_r "wset \<sigma>'" "\<lbrace>ta'_r\<rbrace>\<^bsub>w\<^esub>"]
           obtain \<sigma>'''' where "redT_upd \<sigma>' t_r ta'_r x'' m'' \<sigma>''''" by fastforce
           with red' tst aok' have "mthr.if.redT \<sigma>' (t_r, ta'_r) \<sigma>''''" ..
           thus thesis using eq' hb r_n' sim by(rule that)
         next
           case (redT_acquire x n ln)
           hence "?hb ta_r" using set_convert_RA_not_Read[where ln=ln]
             by -(rule ta_hb_consistent_not_ReadI, fastforce simp del: set_convert_RA_not_Read dest!: in_set_dropD)
           with red_ra r_n show ?thesis by(auto intro: that)
         qed
         from hb
         have "non_speculative P (w_values P (\<lambda>_. {}) (map snd (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)))) (lmap snd (llist_of (map (Pair t_r) (drop r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>))))"
           by(rule ta_hb_consistent_into_non_speculative)
         with ns' eq[symmetric] have "non_speculative P (w_values P (\<lambda>_. {}) (map snd (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E')))))) (llist_of (map snd (map (Pair t_r) \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>)))"
           by(subst append_take_drop_id[where xs="\<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>" and n=r_n, symmetric])(simp add: o_def map_concat split_def lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: append_take_drop_id lappend_llist_of_llist_of)
         with ns have ns'': "non_speculative P (w_values P (\<lambda>_. {}) (map snd ?start_heap_obs)) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E') @ [(t_r, ta'_r)]))))"
           unfolding lconcat_llist_of[symmetric] map_append lappend_llist_of_llist_of[symmetric] lmap_llist_of[symmetric] llist.map_comp
           by(simp add: o_def split_def non_speculative_lappend list_of_lconcat map_concat)
         from \<sigma>_\<sigma>' red_ra' have "mthr.if.RedT ?start_state (list_of ?r_m_E' @ [(t_r, ta'_r)]) \<sigma>''''"
           unfolding mthr.if.RedT_def ..
         with hb_completion
         have hb_completion': "if.hb_completion \<sigma>'''' (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E') @ [(t_r, ta'_r)])))"
           using ns'' by(rule if.hb_completion_shift)
         from if.hb_completion_Runs[OF hb_completion' ta_hb_consistent_convert_RA]
         obtain ttas' where Runs': "mthr.if.mthr.Runs \<sigma>'''' ttas'"
           and hb': "ta_hb_consistent P (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E') @ [(t_r, ta'_r)]))) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas'))"
           by blast
 
         let ?E = "lappend (llist_of ?start_heap_obs) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (lappend (ltake (enat r_m) E') (LCons (t_r, ta'_r) ttas'))))"
 
         have \<E>: "lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (lappend (ltake (enat r_m) E') (LCons (t_r, ta'_r) ttas'))) \<in> mthr.if.\<E> ?start_state"
           by(subst (4) llist_of_list_of[symmetric])(simp, blast intro: mthr.if.\<E>.intros mthr.if.mthr.Trsys_into_Runs \<sigma>_\<sigma>' mthr.if.mthr.Runs.Step red_ra' Runs')
         hence \<E>': "?E \<in> ?\<E>" by blast
 
         from \<E> have tsa: "thread_start_actions_ok ?E" by(rule thread_start_actions_ok_init_fin)
         also let ?E' = "lappend (llist_of (lift_start_obs start_tid start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))) (lappend (llist_of (map (Pair t_r) (drop r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>))) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas')))"
         have "?E = ?E'"
           using eq[symmetric]
           by(simp add: lmap_lappend_distrib lappend_assoc lappend_llist_of_llist_of[symmetric] lconcat_llist_of[symmetric] lmap_llist_of[symmetric] llist.map_comp o_def split_def del: lmap_llist_of)(simp add: lappend_assoc[symmetric] lmap_lappend_distrib[symmetric] map_append[symmetric] lappend_llist_of_llist_of del: map_append)
         finally have tsa': "thread_start_actions_ok ?E'" .
 
         from hb hb' eq[symmetric]
         have HB: "ta_hb_consistent P (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)) (lappend (llist_of (map (Pair t_r) (drop r_n \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub>))) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas')))"
           by -(rule ta_hb_consistent_lappendI, simp_all add: take_map[symmetric] drop_map[symmetric])
         
         define EE where "EE = llist_of (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>))"
 
         from r r_conv have r_conv': "r = (\<Sum>i<r_m. length \<lbrace>snd (lnth E' i)\<rbrace>\<^bsub>o\<^esub>) + r_n + length ?start_heap_obs" by auto
         hence len_EE: "llength EE = enat r" using r_m r_n
           by(auto simp add: EE_def length_concat sum_list_sum_nth atLeast0LessThan lnth_ltake less_min_eq1 split_def min_def length_list_of_conv_the_enat cong: sum.cong_simp)
         
         from r_conv r_m
         have r_conv3: "llength (lconcat (lmap (\<lambda>x. llist_of (map (Pair (fst x)) \<lbrace>snd x\<rbrace>\<^bsub>o\<^esub>)) (ltake (enat r_m) E'))) = enat (r - Suc (length start_heap_obs) - r_n)" 
           apply(simp add: llength_lconcat_lfinite_conv_sum lnth_ltake cong: sum.cong_simp conj_cong)
-          apply(auto simp add: sum_hom[where f=enat, symmetric] zero_enat_def less_trans[where y="enat r_m"] intro: sum.cong)
+          apply(auto simp add: sum_comp_morphism[where h=enat, symmetric] zero_enat_def less_trans[where y="enat r_m"] intro: sum.cong)
           done            
 
         have is_ws: "is_write_seen P EE ws"
         proof(rule is_write_seenI)
           fix a ad al v
           assume a: "a \<in> read_actions EE"
             and a_obs: "action_obs EE a = NormalAction (ReadMem ad al v)"
           from a have a_r: "a < r" by cases(simp add: len_EE actions_def)
 
           from r E'_r_m r_m r_n r_conv3
           have eq: "ltake (enat r) EE = ltake (enat r) E"
             unfolding E E' EE_def
             apply(subst (2) E'_unfold)
             apply(simp add: ltake_lappend2 lappend_llist_of_llist_of[symmetric] lappend_eq_lappend_conv lmap_lappend_distrib lconcat_llist_of[symmetric] o_def split_def lmap_llist_of[symmetric] del: lappend_llist_of_llist_of lmap_llist_of)
             apply(subst ltake_lappend1)
             defer
             apply(simp add: ltake_lmap[symmetric] take_map[symmetric] ltake_llist_of[symmetric] del: ltake_lmap ltake_llist_of)
             apply(auto simp add: min_def)
             done
           hence sim: "ltake (enat r) EE [\<approx>] ltake (enat r) E" by(rule eq_into_sim_actions)
           
           from a sim have a': "a \<in> read_actions E"
             by(rule read_actions_change_prefix)(simp add: a_r)
           from action_obs_change_prefix_eq[OF eq, of a] a_r a_obs
           have a_obs': "action_obs E a = NormalAction (ReadMem ad al v)" by simp
           
           have a_mrw: "P,E \<turnstile> a \<leadsto>mrw ws a" using a_r a' by(rule mrw)
           with \<open>E \<in> ?\<E>\<close> wf_exec have ws_a_a: "ws a < a"
             by(rule jmm.mrw_before)(auto intro: a_r less_trans mrw)
           hence [simp]: "ws a < r" using a_r by simp
 
           from wf_exec have ws: "is_write_seen P E ws" by(rule wf_exec_is_write_seenD)
           from is_write_seenD[OF this a' a_obs']
           have "ws a \<in> write_actions E"
             and "(ad, al) \<in> action_loc P E (ws a)"
             and "value_written P E (ws a) (ad, al) = v"
             and "\<not> P,E \<turnstile> a \<le>hb ws a"
             and "is_volatile P al \<Longrightarrow> \<not> P,E \<turnstile> a \<le>so ws a"
             and between: "\<And>a'. \<lbrakk> a' \<in> write_actions E; (ad, al) \<in> action_loc P E a'; 
                         P,E \<turnstile> ws a \<le>hb a' \<and> P,E \<turnstile> a' \<le>hb a \<or> is_volatile P al \<and> P,E \<turnstile> ws a \<le>so a' \<and> P,E \<turnstile> a' \<le>so a \<rbrakk>
                       \<Longrightarrow> a' = ws a" by simp_all
 
           from \<open>ws a \<in> write_actions E\<close> sim[symmetric]
           show "ws a \<in> write_actions EE" by(rule write_actions_change_prefix) simp
           
           from action_loc_change_prefix[OF sim, of "ws a" P] \<open>(ad, al) \<in> action_loc P E (ws a)\<close>
           show "(ad, al) \<in> action_loc P EE (ws a)" by(simp)
 
           from value_written_change_prefix[OF eq, of "ws a" P] \<open>value_written P E (ws a) (ad, al) = v\<close>
           show "value_written P EE (ws a) (ad, al) = v" by simp
           
            from wf_exec have tsa_E: "thread_start_actions_ok E"
               by(rule wf_exec_thread_start_actions_okD)
 
           from \<open>\<not> P,E \<turnstile> a \<le>hb ws a\<close> show "\<not> P,EE \<turnstile> a \<le>hb ws a"
           proof(rule contrapos_nn)
             assume "P,EE \<turnstile> a \<le>hb ws a"
             thus "P,E \<turnstile> a \<le>hb ws a" using tsa_E sim
               by(rule happens_before_change_prefix)(simp_all add: a_r)
           qed
 
           { assume "is_volatile P al"
             hence "\<not> P,E \<turnstile> a \<le>so ws a" by fact
             thus "\<not> P,EE \<turnstile> a \<le>so ws a"
               by(rule contrapos_nn)(rule sync_order_change_prefix[OF _ sim], simp_all add: a_r) }
           
           fix a'
           assume "a' \<in> write_actions EE" "(ad, al) \<in> action_loc P EE a'"
           moreover
           hence [simp]: "a' < r" by cases(simp add: actions_def len_EE)
           ultimately have a': "a' \<in> write_actions E" "(ad, al) \<in> action_loc P E a'"
             using sim action_loc_change_prefix[OF sim, of a' P]
             by(auto intro: write_actions_change_prefix)
           { assume "P,EE \<turnstile> ws a \<le>hb a'" "P,EE \<turnstile> a' \<le>hb a"
             hence "P,E \<turnstile> ws a \<le>hb a'" "P,E \<turnstile> a' \<le>hb a"
               using tsa_E sim a_r by(auto elim!: happens_before_change_prefix)
             with between[OF a'] show "a' = ws a" by simp }
           { assume "is_volatile P al " "P,EE \<turnstile> ws a \<le>so a'" "P,EE \<turnstile> a' \<le>so a"
             with sim a_r between[OF a'] show "a' = ws a"
               by(fastforce elim: sync_order_change_prefix intro!: disjI2 del: disjCI) }
         qed
 
         with HB tsa'
         have "\<exists>ws'. P \<turnstile> (?E', ws') \<surd> \<and>
                     (\<forall>n. n \<in> read_actions ?E' \<longrightarrow> length (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)) \<le> n \<longrightarrow> P,?E' \<turnstile> ws' n \<le>hb n) \<and>
                     (\<forall>n<length (lift_start_obs start_tid start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)). ws' n = ws n)"
           unfolding EE_def
           by(rule ta_hb_consistent_Read_hb)(rule jmm.\<E>_new_actions_for_fun[OF \<E>'[unfolded \<open>?E = ?E'\<close>]])
         also have r_conv'': "length (?start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of (ltake (enat r_m) E'))) @ map (Pair t_r) (take r_n \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>)) = r"
           using r_n r_m unfolding r_conv'
           by(auto simp add: length_concat sum_list_sum_nth atLeast0LessThan lnth_ltake split_def o_def less_min_eq1 min_def length_list_of_conv_the_enat cong: sum.cong_simp)
         finally obtain ws' where wf_exec': "P \<turnstile> (?E', ws') \<surd>" 
           and read_hb: "\<And>n. \<lbrakk> n \<in> read_actions ?E'; r \<le> n \<rbrakk> \<Longrightarrow> P,?E' \<turnstile> ws' n \<le>hb n"
           and read_same: "\<And>n. n < r \<Longrightarrow> ws' n = ws n" by blast
 
         have "?same ?E'"
           apply(subst ltake_lappend1, simp add: r_conv''[symmetric] length_list_of_conv_the_enat)
           unfolding E E' lappend_llist_of_llist_of[symmetric]
           apply(subst (1 2) ltake_lappend2, simp add: r[simplified])
           apply(subst lappend_eq_lappend_conv, simp)
           apply safe
           apply(subst E'_unfold)
           unfolding lmap_lappend_distrib 
           apply(subst lconcat_lappend, simp)
           apply(subst lconcat_llist_of[symmetric])
           apply(subst (3) lmap_llist_of[symmetric])
           apply(subst (3) lmap_llist_of[symmetric])
           apply(subst llist.map_comp)
           apply(simp only: split_def o_def)
           apply(subst llist_of_list_of, simp)
           apply(subst (1 2) ltake_lappend2, simp add: r_conv3)
           apply(subst lappend_eq_lappend_conv, simp)
           apply safe
           unfolding llist.map(2) lconcat_LCons E'_r_m snd_conv fst_conv take_map
           apply(subst ltake_lappend1)
            defer
            apply(subst append_take_drop_id[where xs="\<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub>" and n=r_n, symmetric])
            unfolding map_append lappend_llist_of_llist_of[symmetric]
            apply(subst ltake_lappend1)
             using r_n
             apply(simp add: min_def r_conv3)
            apply(rule refl)
           apply(simp add: r_conv3)
           using r_n by arith
 
         moreover {
           fix a
           assume "a \<in> read_actions ?E'"
           with read_hb[of a] read_same[of a]
           have "if a < r then ws' a = ws a else P,?E' \<turnstile> ws' a \<le>hb a" by simp }
         hence "?read ?E' ws'" by blast
         moreover from r_m r_n r_n'
         have E'_r: "lnth ?E' r = (t_r, \<lbrace>ta'_r\<rbrace>\<^bsub>o\<^esub> ! r_n)" unfolding r_conv'
           by(auto simp add: lnth_lappend nth_append length_concat sum_list_sum_nth atLeast0LessThan split_beta lnth_ltake less_min_eq1 length_list_of_conv_the_enat cong: sum.cong_simp)
         from E_r r have E_r: "lnth E r = (t_r, \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n)"
           unfolding E by(simp add: lnth_lappend)
         have "r \<in> read_actions E \<longleftrightarrow> (\<exists>ad al v. \<lbrace>ta_r\<rbrace>\<^bsub>o\<^esub> ! r_n = NormalAction (ReadMem ad al v))" using True
           by(auto elim!: read_actions.cases simp add: action_obs_def E_r actions_def intro!: read_actions.intros)
         with sim E'_r E_r have "?tid ?E'" "?obs ?E'"
           by(auto simp add: action_tid_def action_obs_def)
         moreover have "?actions ?E'" using r_n r_m r_n' unfolding r_conv'
           by(cases "llength ?E'")(auto simp add: actions_def less_min_eq2 length_concat sum_list_sum_nth atLeast0LessThan split_beta lnth_ltake less_min_eq1 length_list_of_conv_the_enat enat_plus_eq_enat_conv cong: sum.cong_simp)
         ultimately show ?thesis using wf_exec' \<E>'
           unfolding \<open>?E = ?E'\<close> by blast
       qed
     qed
   qed
 qed
 
 end
 
 lemma w_value_mrw_value_conf:
   assumes "set_option (vs' adal) \<subseteq> vs adal \<times> UNIV"
   shows "set_option (mrw_value P vs' ob adal) \<subseteq> w_value P vs ob adal \<times> UNIV"
 using assms by(cases adal)(cases ob rule: w_value_cases, auto)
 
 lemma w_values_mrw_values_conf:
   assumes "set_option (vs' adal) \<subseteq> vs adal \<times> UNIV"
   shows "set_option (mrw_values P vs' obs adal) \<subseteq> w_values P vs obs adal \<times> UNIV"
 using assms
 by(induct obs arbitrary: vs' vs)(auto del: subsetI intro: w_value_mrw_value_conf)
 
 lemma w_value_mrw_value_dom_eq_preserve:
   assumes "dom vs' = {adal. vs adal \<noteq> {}}"
   shows "dom (mrw_value P vs' ob) = {adal. w_value P vs ob adal \<noteq> {}}"
 using assms
 apply(cases ob rule: w_value_cases)
 apply(simp_all add: dom_def split_beta del: not_None_eq)
 apply(blast elim: equalityE dest: subsetD)+
 done
 
 lemma w_values_mrw_values_dom_eq_preserve:
   assumes "dom vs' = {adal. vs adal \<noteq> {}}"
   shows "dom (mrw_values P vs' obs) = {adal. w_values P vs obs adal \<noteq> {}}"
 using assms
 by(induct obs arbitrary: vs vs')(auto del: equalityI intro: w_value_mrw_value_dom_eq_preserve)
 
 context jmm_multithreaded begin
 
 definition non_speculative_read :: 
   "nat \<Rightarrow> ('l, 'thread_id, 'x, 'm, 'w) state \<Rightarrow> ('addr \<times> addr_loc \<Rightarrow> 'addr val set) \<Rightarrow> bool"
 where
   "non_speculative_read n s vs \<longleftrightarrow>
    (\<forall>ttas s' t x ta x' m' i ad al v v'.
        s -\<triangleright>ttas\<rightarrow>* s' \<longrightarrow> non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) \<longrightarrow>
        thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor> \<longrightarrow> t \<turnstile> (x, shr s') -ta\<rightarrow> (x', m') \<longrightarrow> actions_ok s' t ta \<longrightarrow> 
        i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<longrightarrow> 
        non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<longrightarrow>
        \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v) \<longrightarrow> 
        v' \<in> w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ad, al) \<longrightarrow>
        (\<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow> (x'', m'') \<and> actions_ok s' t ta' \<and>
                       i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v') \<and>
                       length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))" 
 
 lemma non_speculative_readI [intro?]:
   "(\<And>ttas s' t x ta x' m' i ad al v v'. 
     \<lbrakk> s -\<triangleright>ttas\<rightarrow>* s'; non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)));
      thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>; t \<turnstile> (x, shr s') -ta\<rightarrow> (x', m'); actions_ok s' t ta;
      i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>));
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v);
      v' \<in> w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ad, al) \<rbrakk>
     \<Longrightarrow> \<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow> (x'', m'') \<and> actions_ok s' t ta' \<and>
                       i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v') \<and>
                       length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))
   \<Longrightarrow> non_speculative_read n s vs"
 unfolding non_speculative_read_def by blast
 
 lemma non_speculative_readD:
   "\<lbrakk> non_speculative_read n s vs; s -\<triangleright>ttas\<rightarrow>* s'; non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)));
      thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>; t \<turnstile> (x, shr s') -ta\<rightarrow> (x', m'); actions_ok s' t ta;
      i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)); 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v);
      v' \<in> w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ad, al) \<rbrakk>
   \<Longrightarrow> \<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow> (x'', m'') \<and> actions_ok s' t ta' \<and>
                       i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v') \<and>
                       length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 unfolding non_speculative_read_def by blast
 
 end
 
 subsection \<open>@{term "non_speculative"} generalises @{term "cut_and_update"} and @{term "ta_hb_consistent"}\<close>
 
 context known_addrs_typing begin
 
 lemma read_non_speculative_new_actions_for:
   fixes status f C M params E
   defines "E \<equiv> lift_start_obs start_tid start_heap_obs"
   and "vs \<equiv> w_values P (\<lambda>_. {}) (map snd E)"
   and "s \<equiv> init_fin_lift_state status (start_state f P C M params)"
   assumes wf: "wf_syscls P"
   and RedT: "mthr.if.RedT s ttas s'"
   and redT: "mthr.if.redT s' (t, ta') s''"
   and read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
   and ns: "non_speculative P (\<lambda>_. {}) (llist_of (map snd E @ concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) params) \<subseteq> allocated start_heap"
   and wt: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and type_adal: "P,shr s' \<turnstile> ad@al : T"
   shows "\<exists>w. w \<in> new_actions_for P (llist_of (E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (ad, al)"
   (is "\<exists>w. ?new_w w")
 using RedT redT read ns[unfolded E_def] ka unfolding s_def
 proof(cases rule: read_ex_NewHeapElem)
   case (start CTn)
   then obtain n where n: "start_heap_obs ! n = NewHeapElem ad CTn"
     and len: "n < length start_heap_obs"
     unfolding in_set_conv_nth by blast
   from ns have "non_speculative P (w_values P (\<lambda>_. {}) (map snd E)) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     unfolding lappend_llist_of_llist_of[symmetric]
     by(simp add: non_speculative_lappend del: lappend_llist_of_llist_of)
   with RedT wt have hext: "start_heap \<unlhd> shr s'"
     unfolding s_def E_def using start_state_vs_conf[OF wf]
     by(auto dest!: init_fin_RedT_hext_incr simp add: start_state_def split_beta init_fin_lift_state_conv_simps)
   
   from start have "typeof_addr start_heap ad = \<lfloor>CTn\<rfloor>"
     by(auto dest: NewHeapElem_start_heap_obsD[OF wf])
   with hext have "typeof_addr (shr s') ad = \<lfloor>CTn\<rfloor>" by(rule typeof_addr_hext_mono)
   with type_adal have "(ad, al) \<in> action_loc_aux P (NormalAction (NewHeapElem ad CTn))" using n len 
     by cases (auto simp add: action_obs_def lnth_lappend1 lift_start_obs_def)
   with n len have "?new_w (Suc n)"
     by(simp add: new_actions_for_def actions_def E_def action_obs_def lift_start_obs_def nth_append)
   thus ?thesis ..
 next
   case (Red ttas' s'' t' ta' s''' ttas'' CTn)
   note ttas = \<open>ttas = ttas' @ (t', ta') # ttas''\<close>
   
   from \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close>
   obtain obs obs' where obs: "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = obs @ NormalAction (NewHeapElem ad CTn) # obs'"
     by(auto dest: split_list)
   
   let ?n = "length (lift_start_obs start_tid start_heap_obs)"
   let ?wa = "?n + length (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs"
   
   have "?wa = ?n + length (concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')) + length obs"
     by(simp add: length_concat o_def split_def)
   also have "\<dots> < length (E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))"
     using obs ttas by(simp add: E_def)
   also
   from ttas obs
   have "(E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)) ! ?wa = (t', NormalAction (NewHeapElem ad CTn))"
     by(auto simp add: E_def lift_start_obs_def nth_append o_def split_def length_concat)
   moreover
   from \<open>mthr.if.redT s'' (t', ta') s'''\<close> \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close>
   obtain x_wa x_wa' where ts''t': "thr s'' t' = \<lfloor>(x_wa, no_wait_locks)\<rfloor>"
     and red_wa: "mthr.init_fin t' (x_wa, shr s'') ta' (x_wa', shr s''')"
     by(cases) fastforce+
 
   from start_state_vs_conf[OF wf]
   have vs: "vs_conf P (shr s) vs" unfolding vs_def E_def s_def
     by(simp add: init_fin_lift_state_conv_simps start_state_def split_def)
   
   from ns
   have ns: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')))"
     and ns': "non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) (llist_of \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
     and ns'': "non_speculative P (w_values P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'')))"
     unfolding ttas vs_def
     by(simp_all add: lappend_llist_of_llist_of[symmetric] non_speculative_lappend del: lappend_llist_of_llist_of)
   from \<open>mthr.if.RedT (init_fin_lift_state status (start_state f P C M params)) ttas' s''\<close> wt ns
   have ts_ok'': "ts_ok (init_fin_lift wfx) (thr s'') (shr s'')" using vs unfolding vs_def s_def
     by(rule if_RedT_non_speculative_invar)
   with ts''t' have wfxt': "wfx t' (snd x_wa) (shr s'')" by(cases x_wa)(auto dest: ts_okD)
 
   from \<open>mthr.if.RedT (init_fin_lift_state status (start_state f P C M params)) ttas' s''\<close> wt ns
   have vs'': "vs_conf P (shr s'') (w_values P (w_values P (\<lambda>_. {}) (map snd E)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas')))"
     unfolding s_def E_def vs_def
     by(rule if_RedT_non_speculative_invar)(simp add: start_state_def split_beta init_fin_lift_state_conv_simps start_state_vs_conf[OF wf])
   from if_redT_non_speculative_vs_conf[OF \<open>mthr.if.redT s'' (t', ta') s'''\<close> ts_ok'' _ vs'', of "length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"] ns'
   have vs''': "vs_conf P (shr s''') (w_values P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas'))) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
     by(simp add: vs_def)
 
   from \<open>mthr.if.redT s'' (t', ta') s'''\<close> ts_ok'' ns' vs''
   have "ts_ok (init_fin_lift wfx) (thr s''') (shr s''')" 
     unfolding vs_def by(rule if_redT_non_speculative_invar)
   with \<open>mthr.if.RedT s''' ttas'' s'\<close>
   have hext: "shr s''' \<unlhd> shr s'" using ns'' vs'''
     by(rule init_fin_RedT_hext_incr)
   
   from red_wa have "typeof_addr (shr s''') ad = \<lfloor>CTn\<rfloor>"
     using wfxt' \<open>NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>\<close> by cases(auto dest: red_NewHeapElemD)
   with hext have "typeof_addr (shr s') ad = \<lfloor>CTn\<rfloor>" by(rule typeof_addr_hext_mono)
   with type_adal have "(ad, al) \<in> action_loc_aux P (NormalAction (NewHeapElem ad CTn))" by cases auto
   ultimately have "?new_w ?wa"
     by(simp add: new_actions_for_def actions_def action_obs_def)
   thus ?thesis ..
 qed
 
 lemma non_speculative_read_into_cut_and_update:
   fixes status f C M params E
   defines "E \<equiv> lift_start_obs start_tid start_heap_obs"
   and "vs \<equiv> w_values P (\<lambda>_. {}) (map snd E)"
   and "s \<equiv> init_fin_lift_state status (start_state f P C M params)"
   and "vs' \<equiv> mrw_values P Map.empty (map snd E)"
   assumes wf: "wf_syscls P"
   and nsr: "if.non_speculative_read n s vs"
   and wt: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) params) \<subseteq> allocated start_heap"
   shows "if.cut_and_update s vs'"
 proof(rule if.cut_and_updateI)
   fix ttas s' t x ta x' m'
   assume Red: "mthr.if.RedT s ttas s'"
     and sc: "ta_seq_consist P vs' (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     and tst: "thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>"
     and red: "t \<turnstile> (x, shr s') -ta\<rightarrow>i (x', m')"
     and aok: "mthr.if.actions_ok s' t ta"
   let ?vs = "w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))"
   let ?vs' = "mrw_values P vs' (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))"
 
   from start_state_vs_conf[OF wf]
   have vs: "vs_conf P (shr s) vs" unfolding vs_def E_def s_def
     by(simp add: init_fin_lift_state_conv_simps start_state_def split_def)
 
   from sc have ns: "non_speculative P vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     by(rule ta_seq_consist_into_non_speculative)(auto simp add: vs'_def vs_def del: subsetI intro: w_values_mrw_values_conf)
 
   from ns have ns': "non_speculative P (\<lambda>_. {}) (llist_of (map snd (lift_start_obs start_tid start_heap_obs) @ concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     unfolding lappend_llist_of_llist_of[symmetric] vs_def
     by(simp add: non_speculative_lappend E_def non_speculative_start_heap_obs del: lappend_llist_of_llist_of)
 
   have vs_vs'': "\<And>adal. set_option (?vs' adal) \<subseteq> ?vs adal \<times> UNIV"
     by(rule w_values_mrw_values_conf)(auto simp add: vs'_def vs_def del: subsetI intro: w_values_mrw_values_conf)
   from Red wt ns vs
   have wt': "ts_ok (init_fin_lift wfx) (thr s') (shr s')"
     by(rule if_RedT_non_speculative_invar)
   hence wtt: "init_fin_lift wfx t x (shr s')" using tst by(rule ts_okD)
 
   { fix i
     have "\<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'') \<and> mthr.if.actions_ok s' t ta' \<and>
                         length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) \<and>
                         ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) \<and>
                         eq_upto_seq_inconsist P (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) ?vs' \<and>
                         (ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<longrightarrow> ta' = ta)"
     proof(induct i)
       case 0 
       show ?case using red aok
         by(auto simp del: split_paired_Ex simp add: eq_upto_seq_inconsist_simps)
     next
       case (Suc i)
       then obtain ta' x'' m''
         where red': "t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'')"
         and aok': "mthr.if.actions_ok s' t ta'"
         and len: "length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
         and sc': "ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))"
         and eusi: "eq_upto_seq_inconsist P (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) ?vs'" 
         and ta'_ta: "ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<Longrightarrow> ta' = ta"
         by blast
       let ?vs'' = "mrw_values P ?vs' (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
       show ?case
       proof(cases "i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> \<not> ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) \<and> \<not> ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))")
         case True
         hence i: "i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" and "\<not> ta_seq_consist P ?vs'' (LCons (\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i) LNil)" using sc'
           by(auto simp add: take_Suc_conv_app_nth lappend_llist_of_llist_of[symmetric] ta_seq_consist_lappend simp del: lappend_llist_of_llist_of)
         then obtain ad al v where ta'_i: "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v)"
           by(auto split: action.split_asm obs_event.split_asm)
         from ta'_i True have read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" by(auto simp add: in_set_conv_nth)
         with red' have "ad \<in> known_addrs_if t x" by(rule if_red_read_knows_addr)
         hence "ad \<in> if.known_addrs_state s'" using tst by(rule if.known_addrs_stateI)
         moreover from init_fin_red_read_typeable[OF red' wtt read]
         obtain T where type_adal: "P,shr s' \<turnstile> ad@al : T" ..
 
         from redT_updWs_total[of t "wset s'" "\<lbrace>ta'\<rbrace>\<^bsub>w\<^esub>"] red' tst aok'
         obtain s'' where redT': "mthr.if.redT s' (t, ta') s''" by(auto dest!: mthr.if.redT.redT_normal)
         with wf Red
         have "\<exists>w. w \<in> new_actions_for P (llist_of (E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (ad, al)"
           (is "\<exists>w. ?new_w w")
           using read ns' ka wt type_adal unfolding s_def E_def by(rule read_non_speculative_new_actions_for)
         then obtain w where w: "?new_w w" ..
         have "(ad, al) \<in> dom ?vs'"
         proof(cases "w < length E")
           case True
           with w have "(ad, al) \<in> dom vs'" unfolding vs'_def new_actions_for_def
             by(clarsimp)(erule mrw_values_new_actionD[rotated 1], auto simp del: split_paired_Ex simp add: set_conv_nth action_obs_def nth_append intro!: exI[where x=w])
           also have "dom vs' \<subseteq> dom ?vs'" by(rule mrw_values_dom_mono)
           finally show ?thesis .
         next
           case False
           with w show ?thesis unfolding new_actions_for_def
             apply(clarsimp)
             apply(erule mrw_values_new_actionD[rotated 1])
             apply(simp_all add: set_conv_nth action_obs_def nth_append actions_def)
             apply(rule exI[where x="w - length E"])
             apply(subst nth_map[where f=snd, symmetric])
             apply(simp_all add: length_concat o_def split_def map_concat)
             done
         qed
         hence "(ad, al) \<in> dom (mrw_values P ?vs' (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))"
           by(rule subsetD[OF mrw_values_dom_mono])
         then obtain v' b where v': "mrw_values P ?vs' (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (ad, al) = \<lfloor>(v', b)\<rfloor>" by auto
         moreover from vs_vs''[of "(ad, al)"]
         have "set_option (mrw_values P ?vs' (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (ad, al)) \<subseteq> w_values P ?vs (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (ad, al) \<times> UNIV"
           by(rule w_values_mrw_values_conf)
         ultimately have "v' \<in> w_values P ?vs (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (ad, al)" by simp
         moreover from sc'
         have "non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))"
           by(blast intro: ta_seq_consist_into_non_speculative vs_vs'' del: subsetI)
         ultimately obtain ta'' x'' m''
           where red'': "t \<turnstile> (x, shr s') -ta''\<rightarrow>i (x'', m'')"
           and aok'': "mthr.if.actions_ok s' t ta''"
           and i': "i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>"
           and eq: "take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
           and ta''_i: "\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v')"
           and len': "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)"
           using if.non_speculative_readD[OF nsr Red ns tst red' aok' i _ ta'_i, of v'] by auto
         from len' len have "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)" by simp
         moreover have "ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>))"
           using eq sc' i' ta''_i v'
           by(simp add: take_Suc_conv_app_nth lappend_llist_of_llist_of[symmetric] ta_seq_consist_lappend del: lappend_llist_of_llist_of)
         moreover
         have eusi': "eq_upto_seq_inconsist P (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take (Suc i) \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>) ?vs'"
         proof(cases "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>")
           case True
           with i' i len eq eusi ta'_i ta''_i v' show ?thesis
             by(auto simp add: take_Suc_conv_app_nth ta'_ta eq_upto_seq_inconsist_simps intro: eq_upto_seq_inconsist_appendI)
         next
           case False
           with i ta'_ta have "\<not> ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))" by auto
           then show ?thesis using False i' eq eusi
             by(simp add: take_Suc_conv_app_nth eq_upto_seq_inconsist_append2)
         qed
         moreover {
           assume "ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
           with True have "ta'' = ta" by simp }
         ultimately show ?thesis using red'' aok'' True by blast
       next
         case False
         hence "ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) \<or> 
                length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> i \<or> 
                ta_seq_consist P ?vs' (llist_of (take (Suc i) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))" 
           (is "?case1 \<or> ?case2 \<or> ?case3") by auto
         thus ?thesis
         proof(elim disjCE)
           assume "?case1"
           moreover
           hence "eq_upto_seq_inconsist P (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ?vs'"
             by(rule ta_seq_consist_imp_eq_upto_seq_inconsist_refl)
           ultimately show ?thesis using red aok by fastforce
         next
           assume "?case2" and "\<not> ?case1"
           have "eq_upto_seq_inconsist P (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take (Suc i) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) ?vs'"
           proof(cases "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>")
             case True
             from \<open>?case2\<close> \<open>\<not> ?case1\<close> have "\<not> ta_seq_consist P ?vs' (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))" by(auto simp add: ta'_ta)
             hence "eq_upto_seq_inconsist P (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> @ [\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i]) (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> @ []) ?vs'"
               by(blast intro: eq_upto_seq_inconsist_appendI[OF eusi])
             thus ?thesis using True \<open>?case2\<close> by(simp add: take_Suc_conv_app_nth)
           next
             case False with eusi \<open>?case2\<close> show ?thesis by simp
           qed
           with red' aok' len sc' eusi \<open>?case2\<close> \<open>\<not> ?case1\<close>show ?thesis
             by (fastforce simp add: take_all simp del: split_paired_Ex)
         next
           assume "?case3" and "\<not> ?case1" and "\<not> ?case2"
           with len eusi ta'_ta
           have "eq_upto_seq_inconsist P (take (Suc i) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (take (Suc i) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) ?vs'"
             by(cases "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>")(auto simp add: take_Suc_conv_app_nth lappend_llist_of_llist_of[symmetric] ta_seq_consist_lappend intro: eq_upto_seq_inconsist_appendI eq_upto_seq_inconsist_append2 cong: action.case_cong obs_event.case_cong)
           with red' aok' \<open>?case3\<close> len \<open>\<not> ?case1\<close> show ?thesis by blast
         qed
       qed
     qed }
   from this[of "max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"]
   show "\<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'') \<and> mthr.if.actions_ok s' t ta' \<and> ta_seq_consist P ?vs' (llist_of \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) \<and> eq_upto_seq_inconsist P \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ?vs'"
     by(auto simp del: split_paired_Ex cong: conj_cong)
 qed
 
 lemma non_speculative_read_into_hb_completion:
   fixes status f C M params E
   defines "E \<equiv> lift_start_obs start_tid start_heap_obs"
   and "vs \<equiv> w_values P (\<lambda>_. {}) (map snd E)"
   and "s \<equiv> init_fin_lift_state status (start_state f P C M params)"
   assumes wf: "wf_syscls P"
   and nsr: "if.non_speculative_read n s vs"
   and wt: "ts_ok (init_fin_lift wfx) (thr s) (shr s)"
   and ka: "known_addrs start_tid (f (fst (method P C M)) M (fst (snd (method P C M))) (fst (snd (snd (method P C M)))) (the (snd (snd (snd (method P C M))))) params) \<subseteq> allocated start_heap"
   shows "if.hb_completion s E"
 proof
   fix ttas s' t x ta x' m' i
   assume Red: "mthr.if.RedT s ttas s'"
     and ns: "non_speculative P (w_values P (\<lambda>_. {}) (map snd E)) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     and tst: "thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>"
     and red: "t \<turnstile> (x, shr s') -ta\<rightarrow>i (x', m')"
     and aok: "mthr.if.actions_ok s' t ta"
     and nsi: "non_speculative P (w_values P (w_values P (\<lambda>_. {}) (map snd E)) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
 
   let ?E = "E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ map (Pair t) (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   let ?vs = "w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))"
 
   from ns have ns': "non_speculative P (\<lambda>_. {}) (llist_of (map snd (lift_start_obs start_tid start_heap_obs) @ concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     unfolding lappend_llist_of_llist_of[symmetric]
     by(simp add: non_speculative_lappend E_def non_speculative_start_heap_obs del: lappend_llist_of_llist_of)
 
   from start_state_vs_conf[OF wf]
   have vs: "vs_conf P (shr s) vs" unfolding vs_def E_def s_def
     by(simp add: init_fin_lift_state_conv_simps start_state_def split_def)
 
   from Red wt ns vs
   have wt': "ts_ok (init_fin_lift wfx) (thr s') (shr s')"
     unfolding vs_def by(rule if_RedT_non_speculative_invar)
   hence wtt: "init_fin_lift wfx t x (shr s')" using tst by(rule ts_okD)
 
   { fix j
     have "\<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'') \<and> mthr.if.actions_ok s' t ta' \<and> length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) \<and>
                         take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
                         ta_hb_consistent P ?E (llist_of (map (Pair t) (take j (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)))) \<and>
                         (i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<longrightarrow> i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) \<and>
                         (if \<exists>ad al v. \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v) then sim_action else (=)) (\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i) (\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i)"
     proof(induct j)
       case 0 from red aok show ?case by(fastforce simp del: split_paired_Ex)
     next
       case (Suc j)
       then obtain ta' x'' m''
         where red': "t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'')"
         and aok': "mthr.if.actions_ok s' t ta'"
         and len: "length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
         and eq: "take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
         and hb: "ta_hb_consistent P ?E (llist_of (map (Pair t) (take j (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))))"
         and len_i: "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<longrightarrow> i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
         and sim_i: "(if \<exists>ad al v. \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v) then sim_action else (=)) (\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i) (\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i)"
         by blast
       show ?case
       proof(cases "i + j < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>")
         case False
         with red' aok' len eq hb len_i sim_i show ?thesis by(fastforce simp del: split_paired_Ex)
       next
         case True
         note j = this
         show ?thesis
         proof(cases "\<exists>ad al v. \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! (i + j) = NormalAction (ReadMem ad al v)")
           case True
           then obtain ad al v where ta'_j: "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! (i + j) = NormalAction (ReadMem ad al v)" by blast
           hence read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" using j by(auto simp add: in_set_conv_nth)
           with red' have "ad \<in> known_addrs_if t x" by(rule if_red_read_knows_addr)
           hence "ad \<in> if.known_addrs_state s'" using tst by(rule if.known_addrs_stateI)
           from init_fin_red_read_typeable[OF red' wtt read] obtain T 
             where type_adal: "P,shr s' \<turnstile> ad@al : T" ..
 
           from redT_updWs_total[of t "wset s'" "\<lbrace>ta'\<rbrace>\<^bsub>w\<^esub>"] red' tst aok'
           obtain s'' where redT': "mthr.if.redT s' (t, ta') s''" by(auto dest!: mthr.if.redT.redT_normal)
           with wf Red
           have "\<exists>w. w \<in> new_actions_for P (llist_of (E @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (ad, al)"
             (is "\<exists>w. ?new_w w")
             using read ns' ka wt type_adal unfolding s_def E_def
             by(rule read_non_speculative_new_actions_for)
           then obtain w where w: "?new_w w" ..
 
           define E'' where "E'' = ?E @ map (Pair t) (take (Suc j) (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))"
 
           from Red redT' have "mthr.if.RedT s (ttas @ [(t, ta')]) s''" unfolding mthr.if.RedT_def ..
           hence tsa: "thread_start_actions_ok (llist_of (lift_start_obs start_tid start_heap_obs @ concat (map (\<lambda>(t, ta). map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ttas @ [(t, ta')]))))"
             unfolding s_def by(rule thread_start_actions_ok_init_fin_RedT)
           hence "thread_start_actions_ok (llist_of E'')" unfolding E_def[symmetric] E''_def
             by(rule thread_start_actions_ok_prefix)(rule lprefix_llist_ofI, simp, metis append_take_drop_id eq map_append)
           moreover from w have "w \<in> actions (llist_of E'')"
             unfolding E''_def by(auto simp add: new_actions_for_def actions_def)
           moreover have "length ?E + j \<in> actions (llist_of E'')" using j by(auto simp add: E''_def actions_def)
           moreover from w have "is_new_action (action_obs (llist_of E'') w)"
             by(auto simp add: new_actions_for_def action_obs_def actions_def nth_append E''_def)
           moreover have "\<not> is_new_action (action_obs (llist_of E'') (length ?E + j))"
             using j ta'_j by(auto simp add: action_obs_def nth_append min_def E''_def)(subst (asm) nth_map, simp_all)
           ultimately have hb_w: "P,llist_of E'' \<turnstile> w \<le>hb length ?E + j"
             by(rule happens_before_new_not_new)
           
           define writes where
             "writes = {w. P,llist_of E'' \<turnstile> w \<le>hb length ?E + j \<and> w \<in> write_actions (llist_of E'') \<and> 
                  (ad, al) \<in> action_loc P (llist_of E'') w}"
 
           define w' where "w' = Max_torder (action_order (llist_of E'')) writes"
 
           have writes_actions: "writes \<subseteq> actions (llist_of E'')" unfolding writes_def actions_def
             by(auto dest!: happens_before_into_action_order elim!: action_orderE simp add: actions_def)
           also have "finite \<dots>" by(simp add: actions_def)
           finally (finite_subset) have "finite writes" .
           moreover from hb_w w have w_writes: "w \<in> writes"
             by(auto 4 3 simp add: writes_def new_actions_for_def action_obs_def actions_def nth_append E''_def intro!: write_actions.intros elim!: is_new_action.cases)
           hence "writes \<noteq> {}" by auto
 
           with torder_action_order \<open>finite writes\<close> 
           have w'_writes: "w' \<in> writes" using writes_actions unfolding w'_def by(rule Max_torder_in_set)
           moreover
           { fix w''
             assume "w'' \<in> writes"
             with torder_action_order \<open>finite writes\<close>
             have "llist_of E'' \<turnstile> w'' \<le>a w'" using writes_actions unfolding w'_def by(rule Max_torder_above) }
           note w'_maximal = this
 
           define v' where "v' = value_written P (llist_of E'') w' (ad, al)"
 
           from nsi ta_hb_consistent_into_non_speculative[OF hb]
           have nsi': "non_speculative P (w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take (i + j) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))"
             unfolding take_add lappend_llist_of_llist_of[symmetric] non_speculative_lappend vs_def eq
             by(simp add: non_speculative_lappend o_def map_concat split_def del: lappend_llist_of_llist_of)
             
           from w'_writes have adal_w': "(ad, al) \<in> action_loc P (llist_of E'') w'" by(simp add: writes_def)
           from w'_writes have "w' \<in> write_actions (llist_of E'')"
             unfolding writes_def by blast
           then obtain "is_write_action (action_obs (llist_of E'') w')" 
             and w'_actions: "w' \<in> actions (llist_of E'')" by cases
           hence "v' \<in> w_values P (\<lambda>_. {}) (map snd E'') (ad, al)"
           proof cases
             case (NewHeapElem ad' CTn)
             hence "NormalAction (NewHeapElem ad' CTn) \<in> set (map snd E'')"
               using w'_actions unfolding in_set_conv_nth
               by(auto simp add: actions_def action_obs_def cong: conj_cong)
             moreover have "ad' = ad" 
               and "(ad, al) \<in> action_loc_aux P (NormalAction (NewHeapElem ad CTn))"
               using adal_w' NewHeapElem by auto
             ultimately show ?thesis using NewHeapElem unfolding v'_def
               by(simp add: value_written.simps w_values_new_actionD)
           next
             case (WriteMem ad' al' v'')
             hence "NormalAction (WriteMem ad' al' v'') \<in> set (map snd E'')"
               using w'_actions unfolding in_set_conv_nth
               by(auto simp add: actions_def action_obs_def cong: conj_cong)
             moreover have "ad' = ad" "al' = al" using adal_w' WriteMem by auto
             ultimately show ?thesis using WriteMem unfolding v'_def
               by(simp add: value_written.simps w_values_WriteMemD)
           qed
           hence "v' \<in> w_values P vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take (i + j) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) (ad, al)"
             using j ta'_j eq unfolding E''_def vs_def
             by(simp add: o_def split_def map_concat take_add take_Suc_conv_app_nth)
           from if.non_speculative_readD[OF nsr Red ns[folded vs_def] tst red' aok' j nsi' ta'_j this]
           obtain ta'' x'' m'' 
             where red'': "t \<turnstile> (x, shr s') -ta''\<rightarrow>i (x'', m'')"
             and aok'': "mthr.if.actions_ok s' t ta''"
             and j': "i + j < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>"
             and eq': "take (i + j) \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take (i + j) \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
             and ta''_j: "\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! (i + j) = NormalAction (ReadMem ad al v')"
             and len': "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)" by blast
 
           define EE where "EE = ?E @ map (Pair t) (take j (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>))"
           define E' where "E' = ?E @ map (Pair t) (take j (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>)) @ [(t, NormalAction (ReadMem ad al v'))]"
 
           from len' len have "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)" by simp
           moreover from eq' eq j j' have "take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
             by(auto simp add: take_add min_def)
           moreover {
             note hb
             also have eq'': "take j (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) = take j (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>)"
               using eq' j j' by(simp add: take_add min_def)
             also have "ta_hb_consistent P (?E @ list_of (llist_of (map (Pair t) (take j (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>))))) (llist_of [(t, \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! (i + j))])"
               unfolding llist_of.simps ta_hb_consistent_LCons ta_hb_consistent_LNil ta''_j prod.simps action.simps obs_event.simps list_of_llist_of append_assoc E'_def[symmetric, unfolded append_assoc]
               unfolding EE_def[symmetric, unfolded append_assoc]
             proof(intro conjI TrueI exI[where x=w'] strip)
               have "llist_of E'' [\<approx>] llist_of E'" using j len eq'' ta'_j unfolding E''_def E'_def
                 by(auto simp add: sim_actions_def list_all2_append List.list_all2_refl split_beta take_Suc_conv_app_nth take_map[symmetric])
               moreover have "length E'' = length E'" using j j' by(simp add: E''_def E'_def)
               ultimately have sim: "ltake (enat (length E')) (llist_of E'') [\<approx>] ltake (enat (length E')) (llist_of E')" by simp
 
               from w'_actions \<open>length E'' = length E'\<close>
               have w'_len: "w' < length E'" by(simp add: actions_def)
 
               from \<open>w' \<in> write_actions (llist_of E'')\<close> sim
               show "w' \<in> write_actions (llist_of E')" by(rule write_actions_change_prefix)(simp add: w'_len)
               from adal_w' action_loc_change_prefix[OF sim, of w' P]
               show "(ad, al) \<in> action_loc P (llist_of E') w'" by(simp add: w'_len)
 
               from ta'_j j have "length ?E + j \<in> read_actions (llist_of E'')"
                 by(auto intro!: read_actions.intros simp add: action_obs_def actions_def E''_def min_def nth_append)(auto)
               hence "w' \<noteq> length ?E + j" using \<open>w' \<in> write_actions (llist_of E'')\<close>
                 by(auto dest: read_actions_not_write_actions)
               with w'_len have "w' < length ?E + j" by(simp add: E'_def)
               from j j' len' eq''
               have "ltake (enat (length ?E + j)) (llist_of E'') = ltake (enat (length ?E + j)) (llist_of E')"
                 by(auto simp add: E''_def E'_def min_def take_Suc_conv_app_nth)
               from value_written_change_prefix[OF this, of w' P] \<open>w' < length ?E + j\<close>
               show "value_written P (llist_of E') w' (ad, al) = v'" unfolding v'_def by simp
 
               from \<open>thread_start_actions_ok (llist_of E'')\<close> \<open>llist_of E'' [\<approx>] llist_of E'\<close>
               have tsa'': "thread_start_actions_ok (llist_of E')"
                 by(rule thread_start_actions_ok_change)
                 
               from w'_writes j j' len len' have "P,llist_of E'' \<turnstile> w' \<le>hb length EE"
                 by(auto simp add: EE_def writes_def min_def ac_simps)
               thus "P,llist_of E' \<turnstile> w' \<le>hb length EE" using tsa'' sim
                 by(rule happens_before_change_prefix)(simp add: w'_len, simp add: EE_def E'_def)
               
               fix w''
               assume w'': "w'' \<in> write_actions (llist_of E')"
                 and adal_w'': "(ad, al) \<in> action_loc P (llist_of E') w''"
 
               from w'' have w''_len: "w'' < length E'" by(cases)(simp add: actions_def)
               
               from w'' sim[symmetric] have w'': "w'' \<in> write_actions (llist_of E'')"
                 by(rule write_actions_change_prefix)(simp add: w''_len)
               from adal_w'' action_loc_change_prefix[OF sim[symmetric], of w'' P] w''_len
               have adal_w'': "(ad, al) \<in> action_loc P (llist_of E'') w''" by simp
               {
                 presume w'_w'': "llist_of E' \<turnstile> w' \<le>a w''"
                   and w''_hb: "P,llist_of E' \<turnstile> w'' \<le>hb length EE"
                 from w''_hb \<open>thread_start_actions_ok (llist_of E'')\<close> sim[symmetric]
                 have "P,llist_of E'' \<turnstile> w'' \<le>hb length EE"
                   by(rule happens_before_change_prefix)(simp add: w''_len, simp add: E'_def EE_def)
                 with w'' adal_w'' j j' len len' have "w'' \<in> writes"
                   by(auto simp add: writes_def EE_def min_def ac_simps split: if_split_asm)
                 hence "llist_of E'' \<turnstile> w'' \<le>a w'" by(rule w'_maximal)
                 hence "llist_of E' \<turnstile> w'' \<le>a w'" using sim
                   by(rule action_order_change_prefix)(simp_all add: w'_len w''_len)
                 thus "w'' = w'" "w'' = w'" using w'_w'' by(rule antisymPD[OF antisym_action_order])+ 
               }
 
               { assume "P,llist_of E' \<turnstile> w' \<le>hb w'' \<and> P,llist_of E' \<turnstile> w'' \<le>hb length EE"
                 thus "llist_of E' \<turnstile> w' \<le>a w''" "P,llist_of E' \<turnstile> w'' \<le>hb length EE"
                   by(blast dest: happens_before_into_action_order)+ }
               { assume "is_volatile P al \<and> P,llist_of E' \<turnstile> w' \<le>so w'' \<and> P,llist_of E' \<turnstile> w'' \<le>so length EE"
                 then obtain vol: "is_volatile P al"
                   and so: "P,llist_of E' \<turnstile> w' \<le>so w''" 
                   and so': "P,llist_of E' \<turnstile> w'' \<le>so length EE" by blast
                 from so show "llist_of E' \<turnstile> w' \<le>a w''" by(blast elim: sync_orderE)
 
                 show "P,llist_of E' \<turnstile> w'' \<le>hb length EE"
                 proof(cases "is_new_action (action_obs (llist_of E') w'')")
                   case True
                   with \<open>w'' \<in> write_actions (llist_of E')\<close> ta''_j show ?thesis
                     by cases(rule happens_before_new_not_new[OF tsa''], auto simp add: actions_def EE_def E'_def action_obs_def min_def nth_append)
                 next
                   case False
                   with \<open>w'' \<in> write_actions (llist_of E')\<close> \<open>(ad, al) \<in> action_loc P (llist_of E') w''\<close>
                   obtain v'' where "action_obs (llist_of E') w'' = NormalAction (WriteMem ad al v'')"
                     by cases(auto elim: is_write_action.cases)
                   with ta''_j w'' j j' len len'
                   have "P \<turnstile> (action_tid (llist_of E') w'', action_obs (llist_of E') w'') \<leadsto>sw (action_tid (llist_of E') (length EE), action_obs (llist_of E') (length EE))"
                     by(auto simp add: E'_def EE_def action_obs_def min_def nth_append Volatile)
                   with so' have "P,llist_of E' \<turnstile> w'' \<le>sw length EE" by(rule sync_withI)
                   thus ?thesis unfolding po_sw_def [abs_def] by(blast intro: tranclp.r_into_trancl)
                 qed }
             qed
             ultimately have "ta_hb_consistent P ?E (lappend (llist_of (map (Pair t) (take j (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>)))) (llist_of ([(t, \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! (i + j))])))"
               by(rule ta_hb_consistent_lappendI) simp
             hence "ta_hb_consistent P ?E (llist_of (map (Pair t) (take (Suc j) (drop i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>))))"
               using j' unfolding lappend_llist_of_llist_of by(simp add: take_Suc_conv_app_nth) }
           moreover from len_i have "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<longrightarrow> i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>" using eq' j' by auto
           moreover from sim_i eq' ta''_j ta'_j
           have "(if \<exists>ad al v. \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v) then sim_action else (=)) (\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i) (\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i)"
             by(cases "j = 0")(auto split: if_split_asm, (metis add_strict_left_mono add_0_right nth_take)+)
           ultimately show ?thesis using red'' aok'' by blast
         next
           case False
           hence "ta_hb_consistent P (?E @ list_of (llist_of (map (Pair t) (take j (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))))) (llist_of [(t, \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! (i + j))])"
             by(simp add: ta_hb_consistent_LCons split: action.split obs_event.split)
           with hb
           have "ta_hb_consistent P ?E (lappend (llist_of (map (Pair t) (take j (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)))) (llist_of ([(t, \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! (i + j))])))"
             by(rule ta_hb_consistent_lappendI) simp
           hence "ta_hb_consistent P ?E (llist_of (map (Pair t) (take (Suc j) (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))))"
             using j unfolding lappend_llist_of_llist_of by(simp add: take_Suc_conv_app_nth)
           with red' aok' len eq len_i sim_i show ?thesis by blast
         qed
       qed
     qed }
   from this[of "max n (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"]
   show "\<exists>ta' x'' m''. t \<turnstile> (x, shr s') -ta'\<rightarrow>i (x'', m'') \<and> mthr.if.actions_ok s' t ta' \<and> 
                       take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
                       ta_hb_consistent P ?E (llist_of (map (Pair t) (drop i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>))) \<and> 
                       (i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<longrightarrow> i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>) \<and>
                       (if \<exists>ad al v. \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v) then sim_action else (=)) (\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i) (\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i)"
     by(simp del: split_paired_Ex cong: conj_cong split del: if_split) blast
 qed
 
 end
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Spec.thy b/thys/JinjaThreads/MM/JMM_Spec.thy
--- a/thys/JinjaThreads/MM/JMM_Spec.thy
+++ b/thys/JinjaThreads/MM/JMM_Spec.thy
@@ -1,2069 +1,2069 @@
 (*  Title:      JinjaThreads/MM/JMM_Spec.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Axiomatic specification of the JMM\<close>
 
 theory JMM_Spec
 imports
   Orders
   "../Common/Observable_Events"
   Coinductive.Coinductive_List
 begin
 
 subsection \<open>Definitions\<close>
 
 type_synonym JMM_action = nat
 type_synonym ('addr, 'thread_id) execution = "('thread_id \<times> ('addr, 'thread_id) obs_event action) llist"
 
 definition "actions" :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action set"
 where "actions E = {n. enat n < llength E}"
 
 definition action_tid :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> 'thread_id"
 where "action_tid E a = fst (lnth E a)"
 
 definition action_obs :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> ('addr, 'thread_id) obs_event action"
 where "action_obs E a = snd (lnth E a)"
 
 definition tactions :: "('addr, 'thread_id) execution \<Rightarrow> 'thread_id \<Rightarrow> JMM_action set"
 where "tactions E t = {a. a \<in> actions E \<and> action_tid E a = t}"
 
 inductive is_new_action :: "('addr, 'thread_id) obs_event action \<Rightarrow> bool"
 where
   NewHeapElem: "is_new_action (NormalAction (NewHeapElem a hT))"
 
 inductive is_write_action :: "('addr, 'thread_id) obs_event action \<Rightarrow> bool"
 where
   NewHeapElem: "is_write_action (NormalAction (NewHeapElem ad hT))"
 | WriteMem: "is_write_action (NormalAction (WriteMem ad al v))"
 
 text \<open>
   Initialisation actions are synchronisation actions iff they initialize volatile
   fields -- cf. JMM mailing list, message no. 62 (5 Nov. 2006).
   However, intuitively correct programs might not be correctly synchronized:
 \begin{verbatim}
      x = 0
 ---------------
 r1 = x | r2 = x
 \end{verbatim}
   Here, if x is not volatile, the initial write can belong to at most one thread.
   Hence, it is happens-before to either r1 = x or r2 = x, but not both.
   In any sequentially consistent execution, both reads must read from the initilisation
   action x = 0, but it is not happens-before ordered to one of them.
 
   Moreover, if only volatile initialisations synchronize-with all thread-start actions,
   this breaks the proof of the DRF guarantee since it assumes that the happens-before relation
   $<=hb$ a for an action $a$ in a topologically sorted action sequence depends only on the 
   actions before it. Counter example: (y is volatile)
 
   [(t1, start), (t1, init x), (t2, start), (t1, init y), ...
 
   Here, (t1, init x) $<=hb$ (t2, start) via: (t1, init x) $<=po$ (t1, init y) $<=sw$ (t2, start),
   but in [(t1, start), (t1, init x), (t2, start)], not (t1, init x) $<=hb$ (t2, start).
 
   Sevcik speculated that one might add an initialisation thread which performs all initialisation
   actions. All normal threads' start action would then synchronize on the final action of the initialisation thread.
   However, this contradicts the memory chain condition in the final field extension to the JMM
   (threads must read addresses of objects that they have not created themselves before they can
   access the fields of the object at that address) -- not modelled here.
 
   Instead, we leave every initialisation action in the thread it belongs to, but order it explicitly
   before the thread's start action and add synchronizes-with edges from \emph{all} initialisation
   actions to \emph{all} thread start actions.
 \<close>
 
 inductive saction :: "'m prog \<Rightarrow> ('addr, 'thread_id) obs_event action \<Rightarrow> bool"
 for P :: "'m prog"
 where
   NewHeapElem: "saction P (NormalAction (NewHeapElem a hT))"
 | Read: "is_volatile P al \<Longrightarrow> saction P (NormalAction (ReadMem a al v))"
 | Write: "is_volatile P al \<Longrightarrow> saction P (NormalAction (WriteMem a al v))"
 | ThreadStart: "saction P (NormalAction (ThreadStart t))"
 | ThreadJoin: "saction P (NormalAction (ThreadJoin t))"
 | SyncLock: "saction P (NormalAction (SyncLock a))"
 | SyncUnlock: "saction P (NormalAction (SyncUnlock a))"
 | ObsInterrupt: "saction P (NormalAction (ObsInterrupt t))"
 | ObsInterrupted: "saction P (NormalAction (ObsInterrupted t))"
 | InitialThreadAction: "saction P InitialThreadAction"
 | ThreadFinishAction: "saction P ThreadFinishAction"
 
 
 definition sactions :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action set"
 where "sactions P E = {a. a \<in> actions E \<and> saction P (action_obs E a)}"
 
 inductive_set write_actions :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action set"
 for E :: "('addr, 'thread_id) execution"
 where 
   write_actionsI: "\<lbrakk> a \<in> actions E; is_write_action (action_obs E a) \<rbrakk> \<Longrightarrow> a \<in> write_actions E"
 
 text \<open>
   @{term NewObj} and @{term NewArr} actions only initialize those fields and array cells that
   are in fact in the object or array. Hence, they are not a write for
   - reads from addresses for which no object/array is created during the whole execution
   - reads from fields/cells that are not part of the object/array at the specified address.
 \<close>
 
 primrec addr_locs :: "'m prog \<Rightarrow> htype \<Rightarrow> addr_loc set"
 where 
   "addr_locs P (Class_type C) = {CField D F|D F. \<exists>fm T. P \<turnstile> C has F:T (fm) in D}"
 | "addr_locs P (Array_type T n) = ({ACell n'|n'. n' < n} \<union> {CField Object F|F. \<exists>fm T. P \<turnstile> Object has F:T (fm) in Object})"
 
 text \<open>
   \<open>action_loc_aux\<close> would naturally be an inductive set,
   but inductive\_set does not allow to pattern match on parameters.
   Hence, specify it using function and derive the setup manually.
 \<close>
 
 fun action_loc_aux :: "'m prog \<Rightarrow> ('addr, 'thread_id) obs_event action \<Rightarrow> ('addr \<times> addr_loc) set"
 where
   "action_loc_aux P (NormalAction (NewHeapElem ad (Class_type C))) = 
   {(ad, CField D F)|D F T fm. P \<turnstile> C has F:T (fm) in D}"
 | "action_loc_aux P (NormalAction (NewHeapElem ad (Array_type T n'))) = 
   {(ad, ACell n)|n. n < n'} \<union> {(ad, CField D F)|D F T fm. P \<turnstile> Object has F:T (fm) in D}"
 | "action_loc_aux P (NormalAction (WriteMem ad al v)) = {(ad, al)}"
 | "action_loc_aux P (NormalAction (ReadMem ad al v)) = {(ad, al)}"
 | "action_loc_aux _ _ = {}"
 
 lemma action_loc_aux_intros [intro?]:
   "P \<turnstile> class_type_of hT has F:T (fm) in D \<Longrightarrow> (ad, CField D F) \<in> action_loc_aux P (NormalAction (NewHeapElem ad hT))"
   "n < n' \<Longrightarrow> (ad, ACell n) \<in> action_loc_aux P (NormalAction (NewHeapElem ad (Array_type T n')))"
   "(ad, al) \<in> action_loc_aux P (NormalAction (WriteMem ad al v))"
   "(ad, al) \<in> action_loc_aux P (NormalAction (ReadMem ad al v))"
 by(cases hT) auto
 
 lemma action_loc_aux_cases [elim?, cases set: action_loc_aux]:
   assumes "adal \<in> action_loc_aux P obs"
   obtains (NewHeapElem) hT F T fm D ad where "obs = NormalAction (NewHeapElem ad hT)" "adal = (ad, CField D F)" "P \<turnstile> class_type_of hT has F:T (fm) in D"
   | (NewArr) n n' ad T where "obs = NormalAction (NewHeapElem ad (Array_type T n'))" "adal = (ad, ACell n)" "n < n'"
   | (WriteMem) ad al v where "obs = NormalAction (WriteMem ad al v)" "adal = (ad, al)"
   | (ReadMem) ad al v where "obs = NormalAction (ReadMem ad al v)" "adal = (ad, al)"
 using assms by(cases "(P, obs)" rule: action_loc_aux.cases) fastforce+
 
 lemma action_loc_aux_simps [simp]:
   "(ad', al') \<in> action_loc_aux P (NormalAction (NewHeapElem ad hT)) \<longleftrightarrow> 
    (\<exists>D F T fm. ad = ad' \<and> al' = CField D F \<and> P \<turnstile> class_type_of hT has F:T (fm) in D) \<or> 
    (\<exists>n T n'. ad = ad' \<and> al' = ACell n \<and> hT = Array_type T n' \<and> n < n')"
   "(ad', al') \<in> action_loc_aux P (NormalAction (WriteMem ad al v)) \<longleftrightarrow> ad = ad' \<and> al = al'"
   "(ad', al') \<in> action_loc_aux P (NormalAction (ReadMem ad al v)) \<longleftrightarrow> ad = ad' \<and> al = al'"
   "(ad', al') \<notin> action_loc_aux P InitialThreadAction"
   "(ad', al') \<notin> action_loc_aux P ThreadFinishAction"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (ExternalCall a m vs v))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (ThreadStart t))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (ThreadJoin t))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (SyncLock a))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (SyncUnlock a))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (ObsInterrupt t))"
   "(ad', al') \<notin> action_loc_aux P (NormalAction (ObsInterrupted t))"
 by(cases hT) auto
 
 declare action_loc_aux.simps [simp del]
 
 abbreviation action_loc :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> ('addr \<times> addr_loc) set"
 where "action_loc P E a \<equiv> action_loc_aux P (action_obs E a)"
 
 inductive_set read_actions :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action set"
 for E :: "('addr, 'thread_id) execution"
 where 
   ReadMem: "\<lbrakk> a \<in> actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk> \<Longrightarrow> a \<in> read_actions E"
 
 fun addr_loc_default :: "'m prog \<Rightarrow> htype \<Rightarrow> addr_loc \<Rightarrow> 'addr val"
 where
   "addr_loc_default P (Class_type C) (CField D F) = default_val (fst (the (map_of (fields P C) (F, D))))"
 | "addr_loc_default P (Array_type T n) (ACell n') = default_val T"
 | addr_loc_default_Array_CField: 
   "addr_loc_default P (Array_type T n) (CField D F) = default_val (fst (the (map_of (fields P Object) (F, Object))))"
 | "addr_loc_default P _ _ = undefined"
 
 definition new_actions_for :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> ('addr \<times> addr_loc) \<Rightarrow> JMM_action set"
 where 
   "new_actions_for P E adal =
    {a. a \<in> actions E \<and> adal \<in> action_loc P E a \<and> is_new_action (action_obs E a)}"
 
 inductive_set external_actions :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action set"
 for E :: "('addr, 'thread_id) execution"
 where
   "\<lbrakk> a \<in> actions E; action_obs E a = NormalAction (ExternalCall ad M vs v) \<rbrakk> 
   \<Longrightarrow> a \<in> external_actions E"
 
 fun value_written_aux :: "'m prog \<Rightarrow> ('addr, 'thread_id) obs_event action \<Rightarrow> addr_loc \<Rightarrow> 'addr val"
 where
   "value_written_aux P (NormalAction (NewHeapElem ad' hT)) al = addr_loc_default P hT al"
 | value_written_aux_WriteMem':
   "value_written_aux P (NormalAction (WriteMem ad al' v)) al = (if al = al' then v else undefined)"
 | value_written_aux_undefined:
   "value_written_aux P _ al = undefined"
 
 primrec value_written :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> ('addr \<times> addr_loc) \<Rightarrow> 'addr val"
 where "value_written P E a (ad, al) = value_written_aux P (action_obs E a) al"
 
 definition value_read :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> 'addr val"
 where
   "value_read E a = 
   (case action_obs E a of
      NormalAction obs \<Rightarrow>
         (case obs of
            ReadMem ad al v \<Rightarrow> v
          | _ \<Rightarrow> undefined)
    | _ \<Rightarrow> undefined)"
 
 definition action_order :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool" ("_ \<turnstile> _ \<le>a _" [51,0,50] 50)
 where
   "E \<turnstile> a \<le>a a' \<longleftrightarrow>
    a \<in> actions E \<and> a' \<in> actions E \<and> 
    (if is_new_action (action_obs E a)
     then is_new_action (action_obs E a') \<longrightarrow> a \<le> a'
     else \<not> is_new_action (action_obs E a') \<and> a \<le> a')"
 
 definition program_order :: "('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool" ("_ \<turnstile> _ \<le>po _" [51,0,50] 50)
 where
   "E \<turnstile> a \<le>po a' \<longleftrightarrow> E \<turnstile> a \<le>a a' \<and> action_tid E a = action_tid E a'"
 
 inductive synchronizes_with :: 
   "'m prog 
   \<Rightarrow> ('thread_id \<times> ('addr, 'thread_id) obs_event action) \<Rightarrow> ('thread_id \<times> ('addr, 'thread_id) obs_event action) \<Rightarrow> bool" 
   ("_ \<turnstile> _ \<leadsto>sw _" [51, 51, 51] 50)
   for P :: "'m prog"
 where
   ThreadStart: "P \<turnstile> (t, NormalAction (ThreadStart t')) \<leadsto>sw (t', InitialThreadAction)"
 | ThreadFinish: "P \<turnstile> (t, ThreadFinishAction) \<leadsto>sw (t', NormalAction (ThreadJoin t))"
 | UnlockLock: "P \<turnstile> (t, NormalAction (SyncUnlock a)) \<leadsto>sw (t', NormalAction (SyncLock a))"
 | \<comment> \<open>Only volatile writes synchronize with volatile reads. 
        We could check volatility of @{term "al"} here, but this is checked by @{term "sactions"}
        in @{text sync_with} anyway.\<close>
   Volatile: "P \<turnstile> (t, NormalAction (WriteMem a al v)) \<leadsto>sw (t', NormalAction (ReadMem a al v'))"
 | VolatileNew: "
     al \<in> addr_locs P hT
     \<Longrightarrow> P \<turnstile> (t, NormalAction (NewHeapElem a hT)) \<leadsto>sw (t', NormalAction (ReadMem a al v))"
 | NewHeapElem: "P \<turnstile> (t, NormalAction (NewHeapElem a hT)) \<leadsto>sw (t', InitialThreadAction)"
 | Interrupt: "P \<turnstile> (t, NormalAction (ObsInterrupt t')) \<leadsto>sw (t'', NormalAction (ObsInterrupted t'))"
 
 definition sync_order :: 
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool"
   ("_,_ \<turnstile> _ \<le>so _" [51,0,0,50] 50)
 where
   "P,E \<turnstile> a \<le>so a' \<longleftrightarrow> a \<in> sactions P E \<and> a' \<in> sactions P E \<and> E \<turnstile> a \<le>a a'"
 
 definition sync_with :: 
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool"
   ("_,_ \<turnstile> _ \<le>sw _" [51, 0, 0, 50] 50)
 where
   "P,E \<turnstile> a \<le>sw a' \<longleftrightarrow>
    P,E \<turnstile> a \<le>so a' \<and> P \<turnstile> (action_tid E a, action_obs E a) \<leadsto>sw (action_tid E a', action_obs E a')"
 
 definition po_sw :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool"
 where "po_sw P E a a' \<longleftrightarrow> E \<turnstile> a \<le>po a' \<or> P,E \<turnstile> a \<le>sw a'"
 
 abbreviation happens_before :: 
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool"
   ("_,_ \<turnstile> _ \<le>hb _" [51, 0, 0, 50] 50)
 where "happens_before P E \<equiv> (po_sw P E)^++"
 
 type_synonym write_seen = "JMM_action \<Rightarrow> JMM_action"
 
 definition is_write_seen :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> write_seen \<Rightarrow> bool" where 
   "is_write_seen P E ws \<longleftrightarrow>
    (\<forall>a \<in> read_actions E. \<forall>ad al v. action_obs E a = NormalAction (ReadMem ad al v) \<longrightarrow> 
        ws a \<in> write_actions E \<and> (ad, al) \<in> action_loc P E (ws a) \<and>
        value_written P E (ws a) (ad, al) = v \<and> \<not> P,E \<turnstile> a \<le>hb ws a \<and>
        (is_volatile P al \<longrightarrow> \<not> P,E \<turnstile> a \<le>so ws a) \<and>
        (\<forall>w' \<in> write_actions E. (ad, al) \<in> action_loc P E w' \<longrightarrow> 
           (P,E \<turnstile> ws a \<le>hb w' \<and> P,E \<turnstile> w' \<le>hb a \<or> is_volatile P al \<and> P,E \<turnstile> ws a \<le>so w' \<and> P,E \<turnstile> w' \<le>so a) \<longrightarrow>
           w' = ws a))"
 
 definition thread_start_actions_ok :: "('addr, 'thread_id) execution \<Rightarrow> bool"
 where
   "thread_start_actions_ok E \<longleftrightarrow> 
   (\<forall>a \<in> actions E. \<not> is_new_action (action_obs E a) \<longrightarrow> 
      (\<exists>i. i \<le> a \<and> action_obs E i = InitialThreadAction \<and> action_tid E i = action_tid E a))"
 
 primrec wf_exec :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> bool" ("_ \<turnstile> _ \<surd>" [51, 50] 51)
 where "P \<turnstile> (E, ws) \<surd> \<longleftrightarrow> is_write_seen P E ws \<and> thread_start_actions_ok E"
 
 inductive most_recent_write_for :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool"
   ("_,_ \<turnstile> _ \<leadsto>mrw _" [50, 0, 51] 51)
 for P :: "'m prog" and E :: "('addr, 'thread_id) execution" and ra :: JMM_action and wa :: JMM_action
 where
   "\<lbrakk> ra \<in> read_actions E; adal \<in> action_loc P E ra; E \<turnstile> wa \<le>a ra;
      wa \<in> write_actions E; adal \<in> action_loc P E wa;
      \<And>wa'. \<lbrakk> wa' \<in> write_actions E; adal \<in> action_loc P E wa' \<rbrakk>
      \<Longrightarrow> E \<turnstile> wa' \<le>a wa \<or> E \<turnstile> ra \<le>a wa' \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> ra \<leadsto>mrw wa"
 
 primrec sequentially_consistent :: "'m prog \<Rightarrow> (('addr, 'thread_id) execution \<times> write_seen) \<Rightarrow> bool"
 where 
   "sequentially_consistent P (E, ws) \<longleftrightarrow> (\<forall>r \<in> read_actions E. P,E \<turnstile> r \<leadsto>mrw ws r)"
 
 
 subsection \<open>Actions\<close>
 
 inductive_cases is_new_action_cases [elim!]:
   "is_new_action (NormalAction (ExternalCall a M vs v))"
   "is_new_action (NormalAction (ReadMem a al v))"
   "is_new_action (NormalAction (WriteMem a al v))"
   "is_new_action (NormalAction (NewHeapElem a hT))"
   "is_new_action (NormalAction (ThreadStart t))"
   "is_new_action (NormalAction (ThreadJoin t))"
   "is_new_action (NormalAction (SyncLock a))"
   "is_new_action (NormalAction (SyncUnlock a))"
   "is_new_action (NormalAction (ObsInterrupt t))"
   "is_new_action (NormalAction (ObsInterrupted t))"
   "is_new_action InitialThreadAction"
   "is_new_action ThreadFinishAction"
 
 inductive_simps is_new_action_simps [simp]:
   "is_new_action (NormalAction (NewHeapElem a hT))"
   "is_new_action (NormalAction (ExternalCall a M vs v))"
   "is_new_action (NormalAction (ReadMem a al v))"
   "is_new_action (NormalAction (WriteMem a al v))"
   "is_new_action (NormalAction (ThreadStart t))"
   "is_new_action (NormalAction (ThreadJoin t))"
   "is_new_action (NormalAction (SyncLock a))"
   "is_new_action (NormalAction (SyncUnlock a))"
   "is_new_action (NormalAction (ObsInterrupt t))"
   "is_new_action (NormalAction (ObsInterrupted t))"
   "is_new_action InitialThreadAction"
   "is_new_action ThreadFinishAction"
 
 lemmas is_new_action_iff = is_new_action.simps
 
 inductive_simps is_write_action_simps [simp]:
   "is_write_action InitialThreadAction"
   "is_write_action ThreadFinishAction"
   "is_write_action (NormalAction (ExternalCall a m vs v))"
   "is_write_action (NormalAction (ReadMem a al v))"
   "is_write_action (NormalAction (WriteMem a al v))"
   "is_write_action (NormalAction (NewHeapElem a hT))"
   "is_write_action (NormalAction (ThreadStart t))"
   "is_write_action (NormalAction (ThreadJoin t))"
   "is_write_action (NormalAction (SyncLock a))"
   "is_write_action (NormalAction (SyncUnlock a))"
   "is_write_action (NormalAction (ObsInterrupt t))"
   "is_write_action (NormalAction (ObsInterrupted t))"
 
 declare saction.intros [intro!]
 
 inductive_cases saction_cases [elim!]:
   "saction P (NormalAction (ExternalCall a M vs v))"
   "saction P (NormalAction (ReadMem a al v))"
   "saction P (NormalAction (WriteMem a al v))"
   "saction P (NormalAction (NewHeapElem a hT))"
   "saction P (NormalAction (ThreadStart t))"
   "saction P (NormalAction (ThreadJoin t))"
   "saction P (NormalAction (SyncLock a))"
   "saction P (NormalAction (SyncUnlock a))"
   "saction P (NormalAction (ObsInterrupt t))"
   "saction P (NormalAction (ObsInterrupted t))"
   "saction P InitialThreadAction"
   "saction P ThreadFinishAction"
 
 inductive_simps saction_simps [simp]:
   "saction P (NormalAction (ExternalCall a M vs v))"
   "saction P (NormalAction (ReadMem a al v))"
   "saction P (NormalAction (WriteMem a al v))"
   "saction P (NormalAction (NewHeapElem a hT))"
   "saction P (NormalAction (ThreadStart t))"
   "saction P (NormalAction (ThreadJoin t))"
   "saction P (NormalAction (SyncLock a))"
   "saction P (NormalAction (SyncUnlock a))"
   "saction P (NormalAction (ObsInterrupt t))"
   "saction P (NormalAction (ObsInterrupted t))"
   "saction P InitialThreadAction"
   "saction P ThreadFinishAction"
 
 lemma new_action_saction [simp, intro]: "is_new_action a \<Longrightarrow> saction P a"
 by(blast elim: is_new_action.cases)
 
 lemmas saction_iff = saction.simps
 
 lemma actionsD: "a \<in> actions E \<Longrightarrow> enat a < llength E"
 unfolding actions_def by blast
 
 lemma actionsE: 
   assumes "a \<in> actions E"
   obtains "enat a < llength E"
 using assms unfolding actions_def by blast
 
 lemma actions_lappend:
   "llength xs = enat n \<Longrightarrow> actions (lappend xs ys) = actions xs \<union> ((+) n) ` actions ys"
 unfolding actions_def
 apply safe
   apply(erule contrapos_np)
   apply(rule_tac x="x - n" in image_eqI)
    apply simp_all
   apply(case_tac [!] "llength ys")
  apply simp_all
 done
 
 lemma tactionsE:
   assumes "a \<in> tactions E t"
   obtains obs where "a \<in> actions E" "action_tid E a = t" "action_obs E a = obs"
 using assms
 by(cases "lnth E a")(auto simp add: tactions_def action_tid_def action_obs_def)
 
 lemma sactionsI:
   "\<lbrakk> a \<in> actions E; saction P (action_obs E a) \<rbrakk> \<Longrightarrow> a \<in> sactions P E"
 unfolding sactions_def by blast
 
 lemma sactionsE:
   assumes "a \<in> sactions P E"
   obtains "a \<in> actions E" "saction P (action_obs E a)"
 using assms unfolding sactions_def by blast
 
 lemma sactions_actions [simp]:
   "a \<in> sactions P E \<Longrightarrow> a \<in> actions E"
 by(rule sactionsE)
 
 lemma value_written_aux_WriteMem [simp]:
   "value_written_aux P (NormalAction (WriteMem ad al v)) al = v"
 by simp
 
 declare value_written_aux_undefined [simp del]
 declare value_written_aux_WriteMem' [simp del]
 
 inductive_simps is_write_action_iff:
   "is_write_action a"
 
 inductive_simps write_actions_iff:
   "a \<in> write_actions E"
 
 lemma write_actions_actions [simp]:
   "a \<in> write_actions E \<Longrightarrow> a \<in> actions E"
 by(rule write_actions.induct)
 
 inductive_simps read_actions_iff:
   "a \<in> read_actions E"
 
 lemma read_actions_actions [simp]:
   "a \<in> read_actions E \<Longrightarrow> a \<in> actions E"
 by(rule read_actions.induct)
 
 lemma read_action_action_locE:
   assumes "r \<in> read_actions E"
   obtains ad al where "(ad, al) \<in> action_loc P E r"
 using assms by cases auto
 
 lemma read_actions_not_write_actions:
   "\<lbrakk> a \<in> read_actions E; a \<in> write_actions E \<rbrakk> \<Longrightarrow> False"
 by(auto elim!: read_actions.cases write_actions.cases)
 
 lemma read_actions_Int_write_actions [simp]:
   "read_actions E \<inter> write_actions E = {}"
   "write_actions E \<inter> read_actions E = {}"
 by(blast dest: read_actions_not_write_actions)+
 
 lemma action_loc_addr_fun:
   "\<lbrakk> (ad, al) \<in> action_loc P E a; (ad', al') \<in> action_loc P E a \<rbrakk> \<Longrightarrow> ad = ad'"
 by(auto elim!: action_loc_aux_cases)
 
 lemma value_written_cong [cong]:
   "\<lbrakk> P = P'; a = a'; action_obs E a' = action_obs E' a' \<rbrakk> 
   \<Longrightarrow> value_written P E a = value_written P' E' a'"
 by(rule ext)(auto split: action.splits)
 
 declare value_written.simps [simp del]
 
 lemma new_actionsI:
   "\<lbrakk> a \<in> actions E; adal \<in> action_loc P E a; is_new_action (action_obs E a) \<rbrakk>
   \<Longrightarrow> a \<in> new_actions_for P E adal"
 unfolding new_actions_for_def by blast
 
 lemma new_actionsE:
   assumes "a \<in> new_actions_for P E adal"
   obtains "a \<in> actions E" "adal \<in> action_loc P E a" "is_new_action (action_obs E a)"
 using assms unfolding new_actions_for_def by blast
 
 lemma action_loc_read_action_singleton:
   "\<lbrakk> r \<in> read_actions E; adal \<in> action_loc P E r; adal' \<in> action_loc P E r \<rbrakk> \<Longrightarrow> adal = adal'"
 by(cases adal, cases adal')(fastforce elim: read_actions.cases action_loc_aux_cases)
 
 lemma addr_locsI:
   "P \<turnstile> class_type_of hT has F:T (fm) in D \<Longrightarrow> CField D F \<in> addr_locs P hT"
   "\<lbrakk> hT = Array_type T n; n' < n \<rbrakk> \<Longrightarrow> ACell n' \<in> addr_locs P hT"
 by(cases hT)(auto dest: has_field_decl_above)
 
 subsection \<open>Orders\<close>
 subsection \<open>Action order\<close>
 
 lemma action_orderI:
   assumes "a \<in> actions E" "a' \<in> actions E"
   and "\<lbrakk> is_new_action (action_obs E a); is_new_action (action_obs E a') \<rbrakk> \<Longrightarrow> a \<le> a'"
   and "\<not> is_new_action (action_obs E a) \<Longrightarrow> \<not> is_new_action (action_obs E a') \<and> a \<le> a'"
   shows "E \<turnstile> a \<le>a a'"
 using assms unfolding action_order_def by simp
 
 lemma action_orderE:
   assumes "E \<turnstile> a \<le>a a'"
   obtains "a \<in> actions E" "a' \<in> actions E" 
           "is_new_action (action_obs E a)" "is_new_action (action_obs E a') \<longrightarrow> a \<le> a'"
         | "a \<in> actions E" "a' \<in> actions E" 
           "\<not> is_new_action (action_obs E a)" "\<not> is_new_action (action_obs E a')" "a \<le> a'"
 using assms unfolding action_order_def by(simp split: if_split_asm)
 
 lemma refl_action_order:
   "refl_onP (actions E) (action_order E)"
 by(rule refl_onPI)(auto elim: action_orderE intro: action_orderI)
 
 lemma antisym_action_order:
   "antisymp (action_order E)"
 by(rule antisympI)(auto elim!: action_orderE)
 
 lemma trans_action_order:
   "transp (action_order E)"
 by(rule transpI)(auto elim!: action_orderE intro: action_orderI)
 
 lemma porder_action_order:
   "porder_on (actions E) (action_order E)"
 by(blast intro: porder_onI refl_action_order antisym_action_order trans_action_order)
 
 lemma total_action_order:
   "total_onP (actions E) (action_order E)"
 by(rule total_onPI)(auto simp add: action_order_def)
 
 lemma torder_action_order:
   "torder_on (actions E) (action_order E)"
 by(blast intro: torder_onI total_action_order porder_action_order)
 
 lemma wf_action_order: "wfP (action_order E)\<^sup>\<noteq>\<^sup>\<noteq>"
 unfolding wfP_eq_minimal
 proof(intro strip)
   fix Q and x :: JMM_action
   assume "x \<in> Q"
   show "\<exists>z \<in> Q. \<forall>y. (action_order E)\<^sup>\<noteq>\<^sup>\<noteq> y z \<longrightarrow> y \<notin> Q"
   proof(cases "\<exists>a \<in> Q. a \<in> actions E \<and> is_new_action (action_obs E a)")
     case True
     then obtain a where a: "a \<in> actions E \<and> is_new_action (action_obs E a) \<and> a \<in> Q" by blast
     define a' where "a' = (LEAST a'. a' \<in> actions E \<and> is_new_action (action_obs E a') \<and> a' \<in> Q)"
     from a have a': "a' \<in> actions E \<and> is_new_action (action_obs E a') \<and> a' \<in> Q"
       unfolding a'_def by(rule LeastI)
     { fix y
       assume y_le_a': "(action_order E)\<^sup>\<noteq>\<^sup>\<noteq> y a'"
       have "y \<notin> Q"
       proof
         assume "y \<in> Q"
         with y_le_a' a' have y: "y \<in> actions E \<and> is_new_action (action_obs E y) \<and> y \<in> Q"
           by(auto elim: action_orderE)
         hence "a' \<le> y" unfolding a'_def by(rule Least_le)
         with y_le_a' a' show False by(auto elim: action_orderE)
       qed }
     with a' show ?thesis by blast
   next
     case False
     hence not_new: "\<And>a. \<lbrakk> a \<in> Q; a \<in> actions E \<rbrakk> \<Longrightarrow> \<not> is_new_action (action_obs E a)" by blast
     show ?thesis
     proof(cases "Q \<inter> actions E = {}")
       case True
       with \<open>x \<in> Q\<close> show ?thesis by(auto elim: action_orderE)
     next
       case False
       define a' where "a' = (LEAST a'. a' \<in> Q \<and> a' \<in> actions E \<and> \<not> is_new_action (action_obs E a'))"
       from False obtain a where "a \<in> Q" "a \<in> actions E" by blast
       with not_new[OF this] have "a \<in> Q \<and> a \<in> actions E \<and> \<not> is_new_action (action_obs E a)" by blast
       hence a': "a' \<in> Q \<and> a' \<in> actions E \<and> \<not> is_new_action (action_obs E a')"
         unfolding a'_def by(rule LeastI)
       { fix y
         assume y_le_a': "(action_order E)\<^sup>\<noteq>\<^sup>\<noteq> y a'"
         hence "y \<in> actions E" by(auto elim: action_orderE)
         have "y \<notin> Q"
         proof
           assume "y \<in> Q"
           hence y_not_new: "\<not> is_new_action (action_obs E y)"
             using \<open>y \<in> actions E\<close> by(rule not_new)
           with \<open>y \<in> Q\<close> \<open>y \<in> actions E\<close> have "a' \<le> y"
             unfolding a'_def by -(rule Least_le, blast)
           with y_le_a' y_not_new show False by(auto elim: action_orderE)
         qed }
       with a' show ?thesis by blast
     qed
   qed
 qed
 
 lemma action_order_is_new_actionD:
   "\<lbrakk> E \<turnstile> a \<le>a a'; is_new_action (action_obs E a') \<rbrakk> \<Longrightarrow> is_new_action (action_obs E a)"
 by(auto elim: action_orderE)
 
 subsection \<open>Program order\<close>
 
 lemma program_orderI:
   assumes "E \<turnstile> a \<le>a a'" and "action_tid E a = action_tid E a'"
   shows "E \<turnstile> a \<le>po a'"
 using assms unfolding program_order_def by auto
 
 lemma program_orderE:
   assumes "E \<turnstile> a \<le>po a'"
   obtains t obs obs'
   where "E \<turnstile> a \<le>a a'"
   and "action_tid E a = t" "action_obs E a = obs"
   and "action_tid E a' = t" "action_obs E a' = obs'"
 using assms unfolding program_order_def
 by(cases "lnth E a")(cases "lnth E a'", auto simp add: action_obs_def action_tid_def)
 
 lemma refl_on_program_order:
   "refl_onP (actions E) (program_order E)"
 by(rule refl_onPI)(auto elim: action_orderE program_orderE intro: program_orderI refl_onPD[OF refl_action_order])
 
 lemma antisym_program_order:
   "antisymp (program_order E)"
 using antisympD[OF antisym_action_order]
 by(auto intro: antisympI elim!: program_orderE)
 
 lemma trans_program_order:
   "transp (program_order E)"
 by(rule transpI)(auto elim!: program_orderE intro: program_orderI dest: transPD[OF trans_action_order])
 
 lemma porder_program_order:
   "porder_on (actions E) (program_order E)"
 by(blast intro: porder_onI refl_on_program_order antisym_program_order trans_program_order)
 
 lemma total_program_order_on_tactions:
   "total_onP (tactions E t) (program_order E)"
 by(rule total_onPI)(auto elim: tactionsE simp add: program_order_def dest: total_onD[OF total_action_order])
 
 
 subsection \<open>Synchronization order\<close>
 
 lemma sync_orderI:
   "\<lbrakk> E \<turnstile> a \<le>a a'; a \<in> sactions P E; a' \<in> sactions P E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<le>so a'"
 unfolding sync_order_def by blast
 
 lemma sync_orderE:
   assumes "P,E \<turnstile> a \<le>so a'"
   obtains "a \<in> sactions P E" "a' \<in> sactions P E" "E \<turnstile> a \<le>a a'"
 using assms unfolding sync_order_def by blast
 
 lemma refl_on_sync_order:
   "refl_onP (sactions P E) (sync_order P E)"
 by(rule refl_onPI)(fastforce elim: sync_orderE intro: sync_orderI refl_onPD[OF refl_action_order])+
 
 lemma antisym_sync_order:
   "antisymp (sync_order P E)"
 using antisympD[OF antisym_action_order]
 by(rule antisympI)(auto elim!: sync_orderE)
 
 lemma trans_sync_order:
   "transp (sync_order P E)"
 by(rule transpI)(auto elim!: sync_orderE intro: sync_orderI dest: transPD[OF trans_action_order])
 
 lemma porder_sync_order:
   "porder_on (sactions P E) (sync_order P E)"
 by(blast intro: porder_onI refl_on_sync_order antisym_sync_order trans_sync_order)
 
 lemma total_sync_order:
   "total_onP (sactions P E) (sync_order P E)"
 apply(rule total_onPI)
 apply(simp add: sync_order_def)
 apply(rule total_onPD[OF total_action_order])
 apply simp_all
 done
 
 lemma torder_sync_order:
   "torder_on (sactions P E) (sync_order P E)"
 by(blast intro: torder_onI porder_sync_order total_sync_order)
 
 subsection \<open>Synchronizes with\<close>
 
 lemma sync_withI:
   "\<lbrakk> P,E \<turnstile> a \<le>so a'; P \<turnstile> (action_tid E a, action_obs E a) \<leadsto>sw (action_tid E a', action_obs E a') \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> a \<le>sw a'"
 unfolding sync_with_def by blast
 
 lemma sync_withE:
   assumes "P,E \<turnstile> a \<le>sw a'"
   obtains "P,E \<turnstile> a \<le>so a'" "P \<turnstile> (action_tid E a, action_obs E a) \<leadsto>sw (action_tid E a', action_obs E a')"
 using assms unfolding sync_with_def by blast
 
 lemma irrefl_synchronizes_with:
   "irreflP (synchronizes_with P)"
 by(rule irreflPI)(auto elim: synchronizes_with.cases)
 
 lemma irrefl_sync_with:
   "irreflP (sync_with P E)"
 by(rule irreflPI)(auto elim: sync_withE intro: irreflPD[OF irrefl_synchronizes_with])
 
 lemma anitsym_sync_with:
   "antisymp (sync_with P E)"
 using antisymPD[OF antisym_sync_order, of P E]
 by -(rule antisymPI, auto elim: sync_withE)
 
 lemma consistent_program_order_sync_order:
   "order_consistent (program_order E) (sync_order P E)"
 apply(rule order_consistent_subset)
 apply(rule antisym_order_consistent_self[OF antisym_action_order[of E]])
 apply(blast elim: program_orderE sync_orderE)+
 done
 
 lemma consistent_program_order_sync_with:
   "order_consistent (program_order E) (sync_with P E)"
 by(rule order_consistent_subset[OF consistent_program_order_sync_order])(blast elim: sync_withE)+
 
 subsection \<open>Happens before\<close>
 
 lemma porder_happens_before:
   "porder_on (actions E) (happens_before P E)"
 unfolding po_sw_def [abs_def]
 by(rule porder_on_sub_torder_on_tranclp_porder_onI[OF porder_program_order torder_sync_order consistent_program_order_sync_order])(auto elim: sync_withE)
 
 lemma porder_tranclp_po_so:
   "porder_on (actions E) (\<lambda>a a'. program_order E a a' \<or> sync_order P E a a')^++"
 by(rule porder_on_torder_on_tranclp_porder_onI[OF porder_program_order torder_sync_order consistent_program_order_sync_order]) auto
 
 lemma happens_before_refl:
   assumes "a \<in> actions E"
   shows "P,E \<turnstile> a \<le>hb a"
 using porder_happens_before[of E P]
 by(rule porder_onE)(erule refl_onPD[OF _ assms])
 
 lemma happens_before_into_po_so_tranclp:
   assumes "P,E \<turnstile> a \<le>hb a'"
   shows "(\<lambda>a a'. E \<turnstile> a \<le>po a' \<or> P,E \<turnstile> a \<le>so a')^++ a a'"
 using assms unfolding po_sw_def [abs_def]
 by(induct)(blast elim: sync_withE intro: tranclp.trancl_into_trancl)+
 
 lemma po_sw_into_action_order:
   "po_sw P E a a' \<Longrightarrow> E \<turnstile> a \<le>a a'"
 by(auto elim: program_orderE sync_withE sync_orderE simp add: po_sw_def)
 
 lemma happens_before_into_action_order:
   assumes "P,E \<turnstile> a \<le>hb a'"
   shows "E \<turnstile> a \<le>a a'"
 using assms
 by induct(blast intro: po_sw_into_action_order transPD[OF trans_action_order])+
 
 lemma action_order_consistent_with_happens_before:
   "order_consistent (action_order E) (happens_before P E)"
 by(blast intro: order_consistent_subset antisym_order_consistent_self antisym_action_order happens_before_into_action_order)
 
 lemma happens_before_new_actionD:
   assumes hb: "P,E \<turnstile> a \<le>hb a'"
   and new: "is_new_action (action_obs E a')"
   shows "is_new_action (action_obs E a)" "action_tid E a = action_tid E a'" "a \<le> a'"
 using hb
 proof(induct rule: converse_tranclp_induct)
   case (base a)
 
   case 1 from new base show ?case
     by(auto dest: po_sw_into_action_order elim: action_orderE)
   case 2 from new base show ?case
     by(auto simp add: po_sw_def elim!: sync_withE elim: program_orderE synchronizes_with.cases)
   case 3 from new base show ?case
     by(auto dest: po_sw_into_action_order elim: action_orderE)
 next
   case (step a a'')
   
   note po_sw = \<open>po_sw P E a a''\<close>
     and new = \<open>is_new_action (action_obs E a'')\<close>
     and tid = \<open>action_tid E a'' = action_tid E a'\<close>
   
   case 1 from new po_sw show ?case
     by(auto dest: po_sw_into_action_order elim: action_orderE)
   case 2 from new po_sw tid show ?case
     by(auto simp add: po_sw_def elim!: sync_withE elim: program_orderE synchronizes_with.cases)
   case 3 from new po_sw \<open>a'' \<le> a'\<close> show ?case
     by(auto dest!: po_sw_into_action_order elim!: action_orderE)
 qed
 
 lemma external_actions_not_new:
   "\<lbrakk> a \<in> external_actions E; is_new_action (action_obs E a) \<rbrakk> \<Longrightarrow> False"
 by(erule external_actions.cases)(simp)
 
 subsection \<open>Most recent writes and sequential consistency\<close>
 
 lemma most_recent_write_for_fun:
   "\<lbrakk> P,E \<turnstile> ra \<leadsto>mrw wa; P,E \<turnstile> ra \<leadsto>mrw wa' \<rbrakk> \<Longrightarrow> wa = wa'"
 apply(erule most_recent_write_for.cases)+
 apply clarsimp
 apply(erule meta_allE)+
 apply(erule meta_impE)
  apply(rotate_tac 3)
  apply assumption
 apply(erule (1) meta_impE)
 apply(frule (1) action_loc_read_action_singleton)
  apply(rotate_tac 1)
  apply assumption
 apply(fastforce dest: antisymPD[OF antisym_action_order] elim: write_actions.cases read_actions.cases)
 done
 
 lemma THE_most_recent_writeI: "P,E \<turnstile> r \<leadsto>mrw w \<Longrightarrow> (THE w. P,E \<turnstile> r \<leadsto>mrw w) = w"
 by(blast dest: most_recent_write_for_fun)+
 
 lemma most_recent_write_for_write_actionsD:
   assumes "P,E \<turnstile> ra \<leadsto>mrw wa"
   shows "wa \<in> write_actions E"
 using assms by cases
 
 lemma most_recent_write_recent:
   "\<lbrakk> P,E \<turnstile> r \<leadsto>mrw w; adal \<in> action_loc P E r; w' \<in> write_actions E; adal \<in> action_loc P E w' \<rbrakk> 
   \<Longrightarrow> E \<turnstile> w' \<le>a w \<or> E \<turnstile> r \<le>a w'"
 apply(erule most_recent_write_for.cases)
 apply(drule (1) action_loc_read_action_singleton)
  apply(rotate_tac 1)
  apply assumption
 apply clarsimp
 done
 
 lemma is_write_seenI:
   "\<lbrakk> \<And>a ad al v. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
      \<Longrightarrow> ws a \<in> write_actions E;
      \<And>a ad al v. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
      \<Longrightarrow> (ad, al) \<in> action_loc P E (ws a);
      \<And>a ad al v. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
      \<Longrightarrow> value_written P E (ws a) (ad, al) = v;
      \<And>a ad al v. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
      \<Longrightarrow> \<not> P,E \<turnstile> a \<le>hb ws a;
      \<And>a ad al v. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v); is_volatile P al \<rbrakk>
      \<Longrightarrow> \<not> P,E \<turnstile> a \<le>so ws a;
      \<And>a ad al v a'. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v);
                       a' \<in> write_actions E; (ad, al) \<in> action_loc P E a'; P,E \<turnstile> ws a \<le>hb a';
                       P,E \<turnstile> a' \<le>hb a \<rbrakk> \<Longrightarrow> a' = ws a;
      \<And>a ad al v a'. \<lbrakk> a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v);
                       a' \<in> write_actions E; (ad, al) \<in> action_loc P E a'; is_volatile P al; P,E \<turnstile> ws a \<le>so a';
                       P,E \<turnstile> a' \<le>so a \<rbrakk> \<Longrightarrow> a' = ws a \<rbrakk>
   \<Longrightarrow> is_write_seen P E ws"
 unfolding is_write_seen_def
 by(blast 30)
 
 lemma is_write_seenD:
   "\<lbrakk> is_write_seen P E ws; a \<in> read_actions E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
   \<Longrightarrow> ws a \<in> write_actions E \<and> (ad, al) \<in> action_loc P E (ws a) \<and> value_written P E (ws a) (ad, al) = v \<and> \<not> P,E \<turnstile> a \<le>hb ws a \<and> (is_volatile P al \<longrightarrow> \<not> P,E \<turnstile> a \<le>so ws a) \<and>
      (\<forall>a' \<in> write_actions E. (ad, al) \<in> action_loc P E a' \<and> (P,E \<turnstile> ws a \<le>hb a' \<and> P,E \<turnstile> a' \<le>hb a \<or> is_volatile P al \<and> P,E \<turnstile> ws a \<le>so a' \<and> P,E \<turnstile> a' \<le>so a) \<longrightarrow> a' = ws a)"
 unfolding is_write_seen_def by blast
 
 lemma thread_start_actions_okI:
   "(\<And>a. \<lbrakk> a \<in> actions E; \<not> is_new_action (action_obs E a) \<rbrakk> 
     \<Longrightarrow> \<exists>i. i \<le> a \<and> action_obs E i = InitialThreadAction \<and> action_tid E i = action_tid E a)
   \<Longrightarrow> thread_start_actions_ok E"
 unfolding thread_start_actions_ok_def by blast
 
 lemma thread_start_actions_okD:
   "\<lbrakk> thread_start_actions_ok E; a \<in> actions E; \<not> is_new_action (action_obs E a) \<rbrakk> 
   \<Longrightarrow> \<exists>i. i \<le> a \<and> action_obs E i = InitialThreadAction \<and> action_tid E i = action_tid E a"
 unfolding thread_start_actions_ok_def by blast
 
 lemma thread_start_actions_ok_prefix:
   "\<lbrakk> thread_start_actions_ok E'; lprefix E E' \<rbrakk> \<Longrightarrow> thread_start_actions_ok E"
   apply(clarsimp simp add: lprefix_conv_lappend)
   apply(rule thread_start_actions_okI)
   apply(drule_tac a=a in thread_start_actions_okD)
     apply(simp add: actions_def)
     apply(auto simp add: action_obs_def lnth_lappend1 actions_def action_tid_def le_less_trans[where y="enat a" for a])
   apply (metis add.right_neutral add_strict_mono not_gr_zero)
   done
 
 lemma wf_execI [intro?]:
   "\<lbrakk> is_write_seen P E ws;
     thread_start_actions_ok E \<rbrakk>
   \<Longrightarrow> P \<turnstile> (E, ws) \<surd>"
 by simp
 
 lemma wf_exec_is_write_seenD:
   "P \<turnstile> (E, ws) \<surd> \<Longrightarrow> is_write_seen P E ws"
 by simp
 
 lemma wf_exec_thread_start_actions_okD:
   "P \<turnstile> (E, ws) \<surd> \<Longrightarrow> thread_start_actions_ok E"
 by simp
 
 lemma sequentially_consistentI:
   "(\<And>r. r \<in> read_actions E \<Longrightarrow> P,E \<turnstile> r \<leadsto>mrw ws r)
   \<Longrightarrow> sequentially_consistent P (E, ws)"
 by simp
 
 lemma sequentially_consistentE:
   assumes "sequentially_consistent P (E, ws)" "a \<in> read_actions E"
   obtains "P,E \<turnstile> a \<leadsto>mrw ws a"
 using assms by simp
 
 declare sequentially_consistent.simps [simp del]
 
 subsection \<open>Similar actions\<close>
 
 text \<open>Similar actions differ only in the values written/read.\<close>
 
 inductive sim_action :: 
   "('addr, 'thread_id) obs_event action \<Rightarrow> ('addr, 'thread_id) obs_event action \<Rightarrow> bool" 
   ("_ \<approx> _" [50, 50] 51)
 where
   InitialThreadAction: "InitialThreadAction \<approx> InitialThreadAction"
 | ThreadFinishAction: "ThreadFinishAction \<approx> ThreadFinishAction"
 | NewHeapElem: "NormalAction (NewHeapElem a hT) \<approx> NormalAction (NewHeapElem a hT)"
 | ReadMem: "NormalAction (ReadMem ad al v) \<approx> NormalAction (ReadMem ad al v')"
 | WriteMem: "NormalAction (WriteMem ad al v) \<approx> NormalAction (WriteMem ad al v')"
 | ThreadStart: "NormalAction (ThreadStart t) \<approx> NormalAction (ThreadStart t)"
 | ThreadJoin: "NormalAction (ThreadJoin t) \<approx> NormalAction (ThreadJoin t)"
 | SyncLock: "NormalAction (SyncLock a) \<approx> NormalAction (SyncLock a)"
 | SyncUnlock: "NormalAction (SyncUnlock a) \<approx> NormalAction (SyncUnlock a)"
 | ExternalCall: "NormalAction (ExternalCall a M vs v) \<approx> NormalAction (ExternalCall a M vs v)"
 | ObsInterrupt: "NormalAction (ObsInterrupt t) \<approx> NormalAction (ObsInterrupt t)"
 | ObsInterrupted: "NormalAction (ObsInterrupted t) \<approx> NormalAction (ObsInterrupted t)"
 
 definition sim_actions :: "('addr, 'thread_id) execution \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> bool" ("_ [\<approx>] _" [51, 50] 51)
 where "sim_actions = llist_all2 (\<lambda>(t, a) (t', a'). t = t' \<and> a \<approx> a')"
 
 lemma sim_action_refl [intro!, simp]:
   "obs \<approx> obs"
 apply(cases obs)
  apply(rename_tac obs')
  apply(case_tac "obs'")
 apply(auto intro: sim_action.intros)
 done
 
 inductive_cases sim_action_cases [elim!]:
   "InitialThreadAction \<approx> obs"
   "ThreadFinishAction \<approx> obs"
   "NormalAction (NewHeapElem a hT) \<approx> obs"
   "NormalAction (ReadMem ad al v) \<approx> obs"
   "NormalAction (WriteMem ad al v) \<approx> obs"
   "NormalAction (ThreadStart t) \<approx> obs"
   "NormalAction (ThreadJoin t) \<approx> obs"
   "NormalAction (SyncLock a) \<approx> obs"
   "NormalAction (SyncUnlock a) \<approx> obs"
   "NormalAction (ObsInterrupt t) \<approx> obs"
   "NormalAction (ObsInterrupted t) \<approx> obs"
   "NormalAction (ExternalCall a M vs v) \<approx> obs"
 
   "obs \<approx> InitialThreadAction"
   "obs \<approx> ThreadFinishAction"
   "obs \<approx> NormalAction (NewHeapElem a hT)"
   "obs \<approx> NormalAction (ReadMem ad al v')"
   "obs \<approx> NormalAction (WriteMem ad al v')"
   "obs \<approx> NormalAction (ThreadStart t)"
   "obs \<approx> NormalAction (ThreadJoin t)"
   "obs \<approx> NormalAction (SyncLock a)"
   "obs \<approx> NormalAction (SyncUnlock a)"
   "obs \<approx> NormalAction (ObsInterrupt t)"
   "obs \<approx> NormalAction (ObsInterrupted t)"
   "obs \<approx> NormalAction (ExternalCall a M vs v)"
 
 inductive_simps sim_action_simps [simp]:
   "InitialThreadAction \<approx> obs"
   "ThreadFinishAction \<approx> obs"
   "NormalAction (NewHeapElem a hT) \<approx> obs"
   "NormalAction (ReadMem ad al v) \<approx> obs"
   "NormalAction (WriteMem ad al v) \<approx> obs"
   "NormalAction (ThreadStart t) \<approx> obs"
   "NormalAction (ThreadJoin t) \<approx> obs"
   "NormalAction (SyncLock a) \<approx> obs"
   "NormalAction (SyncUnlock a) \<approx> obs"
   "NormalAction (ObsInterrupt t) \<approx> obs"
   "NormalAction (ObsInterrupted t) \<approx> obs"
   "NormalAction (ExternalCall a M vs v) \<approx> obs"
 
   "obs \<approx> InitialThreadAction"
   "obs \<approx> ThreadFinishAction"
   "obs \<approx> NormalAction (NewHeapElem a hT)"
   "obs \<approx> NormalAction (ReadMem ad al v')"
   "obs \<approx> NormalAction (WriteMem ad al v')"
   "obs \<approx> NormalAction (ThreadStart t)"
   "obs \<approx> NormalAction (ThreadJoin t)"
   "obs \<approx> NormalAction (SyncLock a)"
   "obs \<approx> NormalAction (SyncUnlock a)"
   "obs \<approx> NormalAction (ObsInterrupt t)"
   "obs \<approx> NormalAction (ObsInterrupted t)"
   "obs \<approx> NormalAction (ExternalCall a M vs v)"
 
 lemma sim_action_trans [trans]:
   "\<lbrakk> obs \<approx> obs'; obs' \<approx> obs'' \<rbrakk> \<Longrightarrow> obs \<approx> obs''"
 by(erule sim_action.cases) auto
 
 lemma sim_action_sym [sym]:
   assumes "obs \<approx> obs'"
   shows "obs' \<approx> obs"
 using assms by cases simp_all
 
 lemma sim_actions_sym [sym]:
   "E [\<approx>] E' \<Longrightarrow> E' [\<approx>] E"
 unfolding sim_actions_def
 by(auto simp add: llist_all2_conv_all_lnth split_beta intro: sim_action_sym)
 
 lemma sim_actions_action_obsD:
   "E [\<approx>] E' \<Longrightarrow> action_obs E a \<approx> action_obs E' a"
 unfolding sim_actions_def action_obs_def
 by(cases "enat a < llength E")(auto dest: llist_all2_lnthD llist_all2_llengthD simp add: split_beta lnth_beyond split: enat.split)
 
 lemma sim_actions_action_tidD:
   "E [\<approx>] E' \<Longrightarrow> action_tid E a = action_tid E' a"
 unfolding sim_actions_def action_tid_def
 by(cases "enat a < llength E")(auto dest: llist_all2_lnthD llist_all2_llengthD simp add: lnth_beyond split: enat.split)
 
 lemma action_loc_aux_sim_action:
   "a \<approx> a' \<Longrightarrow> action_loc_aux P a = action_loc_aux P a'"
 by(auto elim!: action_loc_aux_cases intro: action_loc_aux_intros)
 
 lemma eq_into_sim_actions: 
   assumes "E = E'"
   shows "E [\<approx>] E'"
 unfolding sim_actions_def assms
 by(rule llist_all2_reflI)(auto)
 
 subsection \<open>Well-formedness conditions for execution sets\<close>
 
 locale executions_base =
   fixes \<E> :: "('addr, 'thread_id) execution set"
   and P :: "'m prog"
 
 locale drf =
   executions_base \<E> P
   for \<E> :: "('addr, 'thread_id) execution set"
   and P :: "'m prog" +
   assumes \<E>_new_actions_for_fun:
   "\<lbrakk> E \<in> \<E>; a \<in> new_actions_for P E adal; a' \<in> new_actions_for P E adal \<rbrakk> \<Longrightarrow> a = a'"
   and \<E>_sequential_completion:
   "\<lbrakk> E \<in> \<E>; P \<turnstile> (E, ws) \<surd>; \<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a \<rbrakk>
   \<Longrightarrow> \<exists>E' \<in> \<E>. \<exists>ws'. P \<turnstile> (E', ws') \<surd> \<and> ltake (enat r) E = ltake (enat r) E' \<and> sequentially_consistent P (E', ws') \<and>
                  action_tid E r = action_tid E' r \<and> action_obs E r \<approx> action_obs E' r \<and>
                  (r \<in> actions E \<longrightarrow> r \<in> actions E')"
 
 locale executions_aux =
   executions_base \<E> P
   for \<E> :: "('addr, 'thread_id) execution set"
   and P :: "'m prog" +
   assumes init_before_read:
   "\<lbrakk>  E \<in> \<E>; P \<turnstile> (E, ws) \<surd>; r \<in> read_actions E; adal \<in> action_loc P E r; 
       \<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a \<rbrakk>
   \<Longrightarrow> \<exists>i<r. i \<in> new_actions_for P E adal"
   and \<E>_new_actions_for_fun:
   "\<lbrakk> E \<in> \<E>; a \<in> new_actions_for P E adal; a' \<in> new_actions_for P E adal \<rbrakk> \<Longrightarrow> a = a'"
 
 locale sc_legal =
   executions_aux \<E> P
   for \<E> :: "('addr, 'thread_id) execution set"
   and P :: "'m prog" +
   assumes \<E>_hb_completion:
   "\<lbrakk> E \<in> \<E>; P \<turnstile> (E, ws) \<surd>; \<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a \<rbrakk>
   \<Longrightarrow> \<exists>E' \<in> \<E>. \<exists>ws'. P \<turnstile> (E', ws') \<surd> \<and> ltake (enat r) E = ltake (enat r) E' \<and>
                  (\<forall>a \<in> read_actions E'. if a < r then ws' a = ws a else P,E' \<turnstile> ws' a \<le>hb a) \<and>
                  action_tid E' r = action_tid E r \<and> 
                  (if r \<in> read_actions E then sim_action else (=)) (action_obs E' r) (action_obs E r) \<and>
                  (r \<in> actions E \<longrightarrow> r \<in> actions E')"
 
 locale jmm_consistent =
   drf?: drf \<E> P +
   sc_legal \<E> P
   for \<E> :: "('addr, 'thread_id) execution set"
   and P :: "'m prog"
 
 subsection \<open>Legal executions\<close>
 
 record ('addr, 'thread_id) pre_justifying_execution =
   committed :: "JMM_action set"
   justifying_exec :: "('addr, 'thread_id) execution"
   justifying_ws :: "write_seen"
 
 record ('addr, 'thread_id) justifying_execution = 
   "('addr, 'thread_id) pre_justifying_execution" +
   action_translation :: "JMM_action \<Rightarrow> JMM_action"
 
 type_synonym ('addr, 'thread_id) justification = "nat \<Rightarrow> ('addr, 'thread_id) justifying_execution"
 
 definition wf_action_translation_on :: 
   "('addr, 'thread_id) execution \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action set \<Rightarrow> (JMM_action \<Rightarrow> JMM_action) \<Rightarrow> bool"
 where
   "wf_action_translation_on E E' A f \<longleftrightarrow>
    inj_on f (actions E) \<and> 
    (\<forall>a \<in> A. action_tid E a = action_tid E' (f a) \<and> action_obs E a \<approx> action_obs E' (f a))"
 
 abbreviation wf_action_translation :: "('addr, 'thread_id) execution \<Rightarrow> ('addr, 'thread_id) justifying_execution \<Rightarrow> bool"
 where
   "wf_action_translation E J \<equiv> 
    wf_action_translation_on (justifying_exec J) E (committed J) (action_translation J)"
 
 context
   fixes P :: "'m prog"
   and E :: "('addr, 'thread_id) execution"
   and ws :: "write_seen"
   and J :: "('addr, 'thread_id) justification"
 begin
 
 text \<open>
   This context defines the causality constraints for the JMM.
   The weak versions are for the fixed JMM as presented by Sevcik and Aspinall at ECOOP 2008.
 \<close>
 
 text \<open>Committed actions are an ascending chain with all actions of E as a limit\<close>
 definition is_commit_sequence :: bool where 
   "is_commit_sequence \<longleftrightarrow> 
    committed (J 0) = {} \<and>
    (\<forall>n. action_translation (J n) ` committed (J n) \<subseteq> action_translation (J (Suc n)) ` committed (J (Suc n))) \<and>
    actions E = (\<Union>n. action_translation (J n) ` committed (J n))"
 
 definition justification_well_formed :: bool where
   "justification_well_formed \<longleftrightarrow> (\<forall>n. P \<turnstile> (justifying_exec (J n), justifying_ws (J n)) \<surd>)"
 
 definition committed_subset_actions :: bool where \<comment> \<open>JMM constraint 1\<close>
   "committed_subset_actions \<longleftrightarrow> (\<forall>n. committed (J n) \<subseteq> actions (justifying_exec (J n)))"
 
 definition happens_before_committed :: bool where \<comment> \<open>JMM constraint 2\<close>
   "happens_before_committed \<longleftrightarrow> 
   (\<forall>n. happens_before P (justifying_exec (J n)) |` committed (J n) =
        inv_imageP (happens_before P E) (action_translation (J n)) |` committed (J n))"
 
 definition happens_before_committed_weak :: bool where \<comment> \<open>relaxed JMM constraint\<close>
   "happens_before_committed_weak \<longleftrightarrow>
   (\<forall>n. \<forall>r \<in> read_actions (justifying_exec (J n)) \<inter> committed (J n).
        let r' = action_translation (J n) r;
            w' = ws r';
            w = inv_into (actions (justifying_exec (J n))) (action_translation (J n)) w' in
          (P,E \<turnstile> w' \<le>hb r' \<longleftrightarrow> P,justifying_exec (J n) \<turnstile> w \<le>hb r) \<and>
          \<not> P,justifying_exec (J n) \<turnstile> r \<le>hb w)"
 
 definition sync_order_committed :: bool where \<comment> \<open>JMM constraint 3\<close>
   "sync_order_committed \<longleftrightarrow>
   (\<forall>n. sync_order P (justifying_exec (J n)) |` committed (J n) =
        inv_imageP (sync_order P E) (action_translation (J n)) |` committed (J n))"
 
 definition value_written_committed :: bool where \<comment> \<open>JMM constraint 4\<close>
   "value_written_committed \<longleftrightarrow>
   (\<forall>n. \<forall>w \<in> write_actions (justifying_exec (J n)) \<inter> committed (J n). 
        let w' = action_translation (J n) w
        in (\<forall>adal \<in> action_loc P E w'. value_written P (justifying_exec (J n)) w adal = value_written P E w' adal))"
 
 definition write_seen_committed :: bool where \<comment> \<open>JMM constraint 5\<close>
   "write_seen_committed \<longleftrightarrow>
   (\<forall>n. \<forall>r' \<in> read_actions (justifying_exec (J n)) \<inter> committed (J n).
        let r = action_translation (J n) r';
            r'' = inv_into (actions (justifying_exec (J (Suc n)))) (action_translation (J (Suc n))) r
        in action_translation (J (Suc n)) (justifying_ws (J (Suc n)) r'') = ws r)"
 
 text \<open>uncommited reads see writes that happen before them -- JMM constraint 6\<close>
 (* this constraint does not apply to the 0th justifying execution, so reads may see arbitrary writes,
    but this cannot be exploited because reads cannot be committed in the 1st justifying execution
    since no writes are committed in the 0th execution *)
 definition uncommitted_reads_see_hb :: bool where
   "uncommitted_reads_see_hb \<longleftrightarrow>
   (\<forall>n. \<forall>r' \<in> read_actions (justifying_exec (J (Suc n))).
        action_translation (J (Suc n)) r' \<in> action_translation (J n) ` committed (J n) \<or> 
        P,justifying_exec (J (Suc n)) \<turnstile> justifying_ws (J (Suc n)) r' \<le>hb r')"
 
 text \<open>
   newly committed reads see already committed writes and write-seen
   relationship must not change any more  -- JMM constraint 7
 \<close>
 definition committed_reads_see_committed_writes :: bool where
   "committed_reads_see_committed_writes \<longleftrightarrow>
   (\<forall>n. \<forall>r' \<in> read_actions (justifying_exec (J (Suc n))) \<inter> committed (J (Suc n)).
        let r = action_translation (J (Suc n)) r';
            committed_n = action_translation (J n) ` committed (J n)
        in r \<in> committed_n \<or>
           (action_translation (J (Suc n)) (justifying_ws (J (Suc n)) r') \<in> committed_n \<and> ws r \<in> committed_n))"
 definition committed_reads_see_committed_writes_weak :: bool where
   "committed_reads_see_committed_writes_weak \<longleftrightarrow>
   (\<forall>n. \<forall>r' \<in> read_actions (justifying_exec (J (Suc n))) \<inter> committed (J (Suc n)).
        let r = action_translation (J (Suc n)) r';
            committed_n = action_translation (J n) ` committed (J n)
        in r \<in> committed_n \<or> ws r \<in> committed_n)"
 
 text \<open>external actions must be committed as soon as hb-subsequent actions are committed  -- JMM constraint 9\<close>
 definition external_actions_committed :: bool where
   "external_actions_committed \<longleftrightarrow>
   (\<forall>n. \<forall>a \<in> external_actions (justifying_exec (J n)). \<forall>a' \<in> committed (J n).
        P,justifying_exec (J n) \<turnstile> a \<le>hb a' \<longrightarrow> a \<in> committed (J n))"
 
 text \<open>well-formedness conditions for action translations\<close>
 definition wf_action_translations :: bool where
   "wf_action_translations \<longleftrightarrow>
   (\<forall>n. wf_action_translation_on (justifying_exec (J n)) E (committed (J n)) (action_translation (J n)))"
 
 end
 
 text \<open>
   Rule 8 of the justification for the JMM is incorrect because there might be no
   transitive reduction of the happens-before relation for an infinite execution, if
   infinitely many initialisation actions have to be ordered before the start
   action of every thread.
   Hence, \<open>is_justified_by\<close> omits this constraint.
 \<close>
 
 primrec is_justified_by ::
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> ('addr, 'thread_id) justification \<Rightarrow> bool" 
   ("_ \<turnstile> _ justified'_by _" [51, 50, 50] 50)
 where
   "P \<turnstile> (E, ws) justified_by J \<longleftrightarrow>
    is_commit_sequence E J \<and>
    justification_well_formed P J \<and>
    committed_subset_actions J \<and>
    happens_before_committed P E J \<and>
    sync_order_committed P E J \<and>
    value_written_committed P E J \<and>
    write_seen_committed ws J \<and> 
    uncommitted_reads_see_hb P J \<and>
    committed_reads_see_committed_writes ws J \<and> 
    external_actions_committed P J \<and> 
    wf_action_translations E J"
 
 text \<open>
   Sevcik requires in the fixed JMM that external actions may
   only be committed when everything that happens before has 
   already been committed. On the level of legality, this constraint
   is vacuous because it is always possible to delay committing
   external actions, so we omit it here.
 \<close>
 primrec is_weakly_justified_by ::
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> ('addr, 'thread_id) justification \<Rightarrow> bool" 
   ("_ \<turnstile> _ weakly'_justified'_by _" [51, 50, 50] 50)
 where
   "P \<turnstile> (E, ws) weakly_justified_by J \<longleftrightarrow>
    is_commit_sequence E J \<and>
    justification_well_formed P J \<and>
    committed_subset_actions J \<and>
    happens_before_committed_weak P E ws J \<and>
    \<comment> \<open>no \<open>sync_order\<close> constraint\<close>
    value_written_committed P E J \<and>
    write_seen_committed ws J \<and> 
    uncommitted_reads_see_hb P J \<and>
    committed_reads_see_committed_writes_weak ws J \<and> 
    wf_action_translations E J"
 
 text \<open>
   Notion of conflict is strengthened to explicitly exclude volatile locations.
   Otherwise, the following program is not correctly synchronised:
 
 \begin{verbatim}
   volatile x = 0;
   ---------------
   r = x; | x = 1;
 \end{verbatim}
 
   because in the SC execution [Init x 0, (t1, Read x 0), (t2, Write x 1)],
   the read and write are unrelated in hb, because synchronises-with is 
   asymmetric for volatiles.
 
   The JLS considers conflicting volatiles for data races, but this is only a 
   remark on the DRF guarantee. See JMM mailing list posts \#2477 to 2488.
 \<close>
 (* Problem already exists in Sevcik's formalisation *)
 
 definition non_volatile_conflict ::
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution \<Rightarrow> JMM_action \<Rightarrow> JMM_action \<Rightarrow> bool" 
   ("_,_ \<turnstile>/(_)\<dagger>(_)" [51,50,50,50] 51)
 where 
   "P,E \<turnstile> a \<dagger> a' \<longleftrightarrow>
    (a \<in> read_actions E \<and> a' \<in> write_actions E \<or>
     a \<in> write_actions E \<and> a' \<in> read_actions E \<or>
     a \<in> write_actions E \<and> a' \<in> write_actions E) \<and>
    (\<exists>ad al. (ad, al) \<in> action_loc P E a \<inter> action_loc P E a' \<and> \<not> is_volatile P al)"
 
 definition correctly_synchronized :: "'m prog \<Rightarrow> ('addr, 'thread_id) execution set \<Rightarrow> bool"
 where
   "correctly_synchronized P \<E> \<longleftrightarrow>
   (\<forall>E \<in> \<E>. \<forall>ws. P \<turnstile> (E, ws) \<surd> \<longrightarrow> sequentially_consistent P (E, ws) 
     \<longrightarrow> (\<forall>a \<in> actions E. \<forall>a' \<in> actions E. P,E \<turnstile> a \<dagger> a' 
           \<longrightarrow> P,E \<turnstile> a \<le>hb a' \<or> P,E \<turnstile> a' \<le>hb a))"
 
 primrec gen_legal_execution ::
   "('m prog \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> ('addr, 'thread_id) justification \<Rightarrow> bool)
   \<Rightarrow> 'm prog \<Rightarrow> ('addr, 'thread_id) execution set \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> bool"
 where
   "gen_legal_execution is_justification P \<E> (E, ws) \<longleftrightarrow>
    E \<in> \<E> \<and> P \<turnstile> (E, ws) \<surd> \<and> 
    (\<exists>J. is_justification P (E, ws) J \<and> range (justifying_exec \<circ> J) \<subseteq> \<E>)"
 
 abbreviation legal_execution :: 
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution set \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> bool"
 where
   "legal_execution \<equiv> gen_legal_execution is_justified_by"
 
 abbreviation weakly_legal_execution :: 
   "'m prog \<Rightarrow> ('addr, 'thread_id) execution set \<Rightarrow> ('addr, 'thread_id) execution \<times> write_seen \<Rightarrow> bool"
 where
   "weakly_legal_execution \<equiv> gen_legal_execution is_weakly_justified_by"
 
 declare gen_legal_execution.simps [simp del]
 
 lemma sym_non_volatile_conflict:
   "symP (non_volatile_conflict P E)"
 unfolding non_volatile_conflict_def
 by(rule symPI) blast
 
 lemma legal_executionI:
   "\<lbrakk> E \<in> \<E>; P \<turnstile> (E, ws) \<surd>; is_justification P (E, ws) J; range (justifying_exec \<circ> J) \<subseteq> \<E> \<rbrakk>
   \<Longrightarrow> gen_legal_execution is_justification P \<E> (E, ws)"
 unfolding gen_legal_execution.simps by blast
 
 lemma legal_executionE:
   assumes "gen_legal_execution is_justification P \<E> (E, ws)"
   obtains J where "E \<in> \<E>" "P \<turnstile> (E, ws) \<surd>" "is_justification P (E, ws) J" "range (justifying_exec \<circ> J) \<subseteq> \<E>"
 using assms unfolding gen_legal_execution.simps by blast
 
 lemma legal_\<E>D: "gen_legal_execution is_justification P \<E> (E, ws) \<Longrightarrow> E \<in> \<E>"
 by(erule legal_executionE)
 
 lemma legal_wf_execD:
   "gen_legal_execution is_justification P \<E> Ews \<Longrightarrow> P \<turnstile> Ews \<surd>"
 by(cases Ews)(auto elim: legal_executionE)
 
 lemma correctly_synchronizedD:
   "\<lbrakk> correctly_synchronized P \<E>; E \<in> \<E>; P \<turnstile> (E, ws) \<surd>; sequentially_consistent P (E, ws) \<rbrakk>
   \<Longrightarrow> \<forall>a a'. a \<in> actions E \<longrightarrow> a' \<in> actions E \<longrightarrow> P,E \<turnstile> a \<dagger> a' \<longrightarrow> P,E \<turnstile> a \<le>hb a' \<or> P,E \<turnstile> a' \<le>hb a"
 unfolding correctly_synchronized_def by blast
 
 lemma wf_action_translation_on_actionD:
   "\<lbrakk> wf_action_translation_on E E' A f; a \<in> A \<rbrakk> 
   \<Longrightarrow> action_tid E a = action_tid E' (f a) \<and> action_obs E a \<approx> action_obs E' (f a)"
 unfolding wf_action_translation_on_def by blast
 
 lemma wf_action_translation_on_inj_onD:
   "wf_action_translation_on E E' A f \<Longrightarrow> inj_on f (actions E)"
 unfolding wf_action_translation_on_def by simp
 
 lemma wf_action_translation_on_action_locD:
   "\<lbrakk> wf_action_translation_on E E' A f; a \<in> A \<rbrakk>
   \<Longrightarrow> action_loc P E a = action_loc P E' (f a)"
 apply(drule (1) wf_action_translation_on_actionD)
 apply(cases "(P, action_obs E a)" rule: action_loc_aux.cases)
 apply auto
 done
 
 lemma weakly_justified_write_seen_hb_read_committed:
   assumes J: "P \<turnstile> (E, ws) weakly_justified_by J"
   and r: "r \<in> read_actions (justifying_exec (J n))" "r \<in> committed (J n)"
   shows "ws (action_translation (J n) r) \<in> action_translation (J n) ` committed (J n)"
 using r
 proof(induct n arbitrary: r)
   case 0
   from J have [simp]: "committed (J 0) = {}"
     by(simp add: is_commit_sequence_def)
   with 0 show ?case by simp
 next
   case (Suc n)
   let ?E = "\<lambda>n. justifying_exec (J n)"
     and ?ws = "\<lambda>n. justifying_ws (J n)"
     and ?C = "\<lambda>n. committed (J n)"
     and ?\<phi> = "\<lambda>n. action_translation (J n)"
     
   note r = \<open>r \<in> read_actions (?E (Suc n))\<close>
   hence "r \<in> actions (?E (Suc n))" by simp
   
   from J have wfan: "wf_action_translation_on (?E n) E (?C n) (?\<phi> n)"
     and wfaSn: "wf_action_translation_on (?E (Suc n)) E (?C (Suc n)) (?\<phi> (Suc n))"
     by(simp_all add: wf_action_translations_def)
   
   from wfaSn have injSn: "inj_on (?\<phi> (Suc n)) (actions (?E (Suc n)))"
     by(rule wf_action_translation_on_inj_onD)
   from J have C_sub_A: "?C (Suc n) \<subseteq> actions (?E (Suc n))"
     by(simp add: committed_subset_actions_def)
   from J have CnCSn: "?\<phi> n ` ?C n \<subseteq> ?\<phi> (Suc n) ` ?C (Suc n)"
     by(simp add: is_commit_sequence_def)
     
   from J have wsSn: "is_write_seen P (?E (Suc n)) (?ws (Suc n))"
     by(simp add: justification_well_formed_def)
   from r obtain ad al v where "action_obs (?E (Suc n)) r = NormalAction (ReadMem ad al v)" by cases
   from is_write_seenD[OF wsSn r this]
   have wsSn: "?ws (Suc n) r \<in> actions (?E (Suc n))" by simp
 
   show ?case
   proof(cases "?\<phi> (Suc n) r \<in> ?\<phi> n ` ?C n")
     case True
     then obtain r' where r': "r' \<in> ?C n"
       and r_r': "?\<phi> (Suc n) r = ?\<phi> n r'" by(auto)
     from r' wfan have "action_tid (?E n) r' = action_tid E (?\<phi> n r')"
       and "action_obs (?E n) r' \<approx> action_obs E (?\<phi> n r')"
       by(blast dest: wf_action_translation_on_actionD)+
     moreover from r' CnCSn have "?\<phi> (Suc n) r \<in> ?\<phi> (Suc n) ` ?C (Suc n)" 
       unfolding r_r' by auto
     hence "r \<in> ?C (Suc n)"
-      unfolding inj_on_image_mem_iff[OF injSn C_sub_A \<open>r \<in> actions (?E (Suc n))\<close>] .
+      unfolding inj_on_image_mem_iff[OF injSn \<open>r \<in> actions (?E (Suc n))\<close> C_sub_A] .
     with wfaSn have "action_tid (?E (Suc n)) r = action_tid E (?\<phi> (Suc n) r)"
       and "action_obs (?E (Suc n)) r \<approx> action_obs E (?\<phi> (Suc n) r)"
       by(blast dest: wf_action_translation_on_actionD)+
     ultimately have tid: "action_tid (?E n) r' = action_tid (?E (Suc n)) r"
       and obs: "action_obs (?E n) r' \<approx> action_obs (?E (Suc n)) r"
       unfolding r_r' by(auto intro: sim_action_trans sim_action_sym)
     
     from J have "?C n \<subseteq> actions (?E n)" by(simp add: committed_subset_actions_def)
     with r' have "r' \<in> actions (?E n)" by blast
     with r obs have "r' \<in> read_actions (?E n)"
       by cases(auto intro: read_actions.intros)
     hence ws: "ws (?\<phi> n r') \<in> ?\<phi> n ` ?C n" using r' by(rule Suc)
 
     have r_conv_inv: "r = inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) (?\<phi> n r')"
       using \<open>r \<in> actions (?E (Suc n))\<close> unfolding r_r'[symmetric]
       by(simp add: inv_into_f_f[OF injSn])
     with \<open>r' \<in> ?C n\<close> r J \<open>r' \<in> read_actions (?E n)\<close>
     have ws_eq: "?\<phi> (Suc n) (?ws (Suc n) r) = ws (?\<phi> n r')"
       by(simp add: Let_def write_seen_committed_def)
     with ws CnCSn have "?\<phi> (Suc n) (?ws (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)" by auto
     hence "?ws (Suc n) r \<in> ?C (Suc n)"
-      by(subst (asm) inj_on_image_mem_iff[OF injSn C_sub_A wsSn])
+      by(subst (asm) inj_on_image_mem_iff[OF injSn wsSn C_sub_A])
     moreover from ws CnCSn have "ws (?\<phi> (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
       unfolding r_r' by auto
     ultimately show ?thesis by simp
   next
     case False
     with r \<open>r \<in> ?C (Suc n)\<close> J
     have "ws (?\<phi> (Suc n) r) \<in> ?\<phi> n ` ?C n"
       unfolding is_weakly_justified_by.simps Let_def committed_reads_see_committed_writes_weak_def
       by blast
     hence "ws (?\<phi> (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
       using CnCSn by blast+
-    thus ?thesis by(simp add: inj_on_image_mem_iff[OF injSn C_sub_A wsSn])
+    thus ?thesis by(simp add: inj_on_image_mem_iff[OF injSn wsSn C_sub_A])
   qed
 qed
 
 lemma justified_write_seen_hb_read_committed:
   assumes J: "P \<turnstile> (E, ws) justified_by J"
   and r: "r \<in> read_actions (justifying_exec (J n))" "r \<in> committed (J n)"
   shows "justifying_ws (J n) r \<in> committed (J n)" (is ?thesis1)
   and "ws (action_translation (J n) r) \<in> action_translation (J n) ` committed (J n)" (is ?thesis2)
 proof -
   have "?thesis1 \<and> ?thesis2" using r
   proof(induct n arbitrary: r)
     case 0
     from J have [simp]: "committed (J 0) = {}"
       by(simp add: is_commit_sequence_def)
     with 0 show ?case by simp
   next
     case (Suc n)
     let ?E = "\<lambda>n. justifying_exec (J n)"
       and ?ws = "\<lambda>n. justifying_ws (J n)"
       and ?C = "\<lambda>n. committed (J n)"
       and ?\<phi> = "\<lambda>n. action_translation (J n)"
     
     note r = \<open>r \<in> read_actions (?E (Suc n))\<close>
     hence "r \<in> actions (?E (Suc n))" by simp
     
     from J have wfan: "wf_action_translation_on (?E n) E (?C n) (?\<phi> n)"
       and wfaSn: "wf_action_translation_on (?E (Suc n)) E (?C (Suc n)) (?\<phi> (Suc n))"
       by(simp_all add: wf_action_translations_def)
     
     from wfaSn have injSn: "inj_on (?\<phi> (Suc n)) (actions (?E (Suc n)))"
       by(rule wf_action_translation_on_inj_onD)
     from J have C_sub_A: "?C (Suc n) \<subseteq> actions (?E (Suc n))"
       by(simp add: committed_subset_actions_def)
     from J have CnCSn: "?\<phi> n ` ?C n \<subseteq> ?\<phi> (Suc n) ` ?C (Suc n)"
       by(simp add: is_commit_sequence_def)
     
     from J have wsSn: "is_write_seen P (?E (Suc n)) (?ws (Suc n))"
       by(simp add: justification_well_formed_def)
     from r obtain ad al v where "action_obs (?E (Suc n)) r = NormalAction (ReadMem ad al v)" by cases
     from is_write_seenD[OF wsSn r this]
     have wsSn: "?ws (Suc n) r \<in> actions (?E (Suc n))" by simp
 
     show ?case
     proof(cases "?\<phi> (Suc n) r \<in> ?\<phi> n ` ?C n")
       case True
       then obtain r' where r': "r' \<in> ?C n"
         and r_r': "?\<phi> (Suc n) r = ?\<phi> n r'" by(auto)
       from r' wfan have "action_tid (?E n) r' = action_tid E (?\<phi> n r')"
         and "action_obs (?E n) r' \<approx> action_obs E (?\<phi> n r')"
         by(blast dest: wf_action_translation_on_actionD)+
       moreover from r' CnCSn have "?\<phi> (Suc n) r \<in> ?\<phi> (Suc n) ` ?C (Suc n)" 
         unfolding r_r' by auto
       hence "r \<in> ?C (Suc n)"
-        unfolding inj_on_image_mem_iff[OF injSn C_sub_A \<open>r \<in> actions (?E (Suc n))\<close>] .
+        unfolding inj_on_image_mem_iff[OF injSn \<open>r \<in> actions (?E (Suc n))\<close> C_sub_A] .
       with wfaSn have "action_tid (?E (Suc n)) r = action_tid E (?\<phi> (Suc n) r)"
         and "action_obs (?E (Suc n)) r \<approx> action_obs E (?\<phi> (Suc n) r)"
         by(blast dest: wf_action_translation_on_actionD)+
       ultimately have tid: "action_tid (?E n) r' = action_tid (?E (Suc n)) r"
         and obs: "action_obs (?E n) r' \<approx> action_obs (?E (Suc n)) r"
         unfolding r_r' by(auto intro: sim_action_trans sim_action_sym)
       
       from J have "?C n \<subseteq> actions (?E n)" by(simp add: committed_subset_actions_def)
       with r' have "r' \<in> actions (?E n)" by blast
       with r obs have "r' \<in> read_actions (?E n)"
         by cases(auto intro: read_actions.intros)
       hence "?ws n r' \<in> ?C n \<and> ws (?\<phi> n r') \<in> ?\<phi> n ` ?C n" using r' by(rule Suc)
       then obtain ws: "ws (?\<phi> n r') \<in> ?\<phi> n ` ?C n" ..
 
       have r_conv_inv: "r = inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) (?\<phi> n r')"
         using \<open>r \<in> actions (?E (Suc n))\<close> unfolding r_r'[symmetric]
         by(simp add: inv_into_f_f[OF injSn])
       with \<open>r' \<in> ?C n\<close> r J \<open>r' \<in> read_actions (?E n)\<close>
       have ws_eq: "?\<phi> (Suc n) (?ws (Suc n) r) = ws (?\<phi> n r')"
         by(simp add: Let_def write_seen_committed_def)
       with ws CnCSn have "?\<phi> (Suc n) (?ws (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)" by auto
       hence "?ws (Suc n) r \<in> ?C (Suc n)"
-        by(subst (asm) inj_on_image_mem_iff[OF injSn C_sub_A wsSn])
+        by(subst (asm) inj_on_image_mem_iff[OF injSn wsSn C_sub_A])
       moreover from ws CnCSn have "ws (?\<phi> (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
         unfolding r_r' by auto
       ultimately show ?thesis by simp
     next
       case False
       with r \<open>r \<in> ?C (Suc n)\<close> J
       have "?\<phi> (Suc n) (?ws (Suc n) r) \<in> ?\<phi> n ` ?C n" 
         and "ws (?\<phi> (Suc n) r) \<in> ?\<phi> n ` ?C n"
         unfolding is_justified_by.simps Let_def committed_reads_see_committed_writes_def
         by blast+
       hence "?\<phi> (Suc n) (?ws (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
         and "ws (?\<phi> (Suc n) r) \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
         using CnCSn by blast+
-      thus ?thesis by(simp add: inj_on_image_mem_iff[OF injSn C_sub_A wsSn])
+      thus ?thesis by(simp add: inj_on_image_mem_iff[OF injSn wsSn C_sub_A])
     qed
   qed
   thus ?thesis1 ?thesis2 by simp_all
 qed
 
 lemma is_justified_by_imp_is_weakly_justified_by:
   assumes justified: "P \<turnstile> (E, ws) justified_by J"
   and wf: "P \<turnstile> (E, ws) \<surd>"
   shows "P \<turnstile> (E, ws) weakly_justified_by J"
   unfolding is_weakly_justified_by.simps
 proof(intro conjI)
   let ?E = "\<lambda>n. justifying_exec (J n)"
     and ?ws = "\<lambda>n. justifying_ws (J n)"
     and ?C = "\<lambda>n. committed (J n)"
     and ?\<phi> = "\<lambda>n. action_translation (J n)"
 
   from justified
   show "is_commit_sequence E J" "justification_well_formed P J" "committed_subset_actions J"
     "value_written_committed P E J" "write_seen_committed ws J" "uncommitted_reads_see_hb P J"
     "wf_action_translations E J" by(simp_all)
   
   show "happens_before_committed_weak P E ws J"
     unfolding happens_before_committed_weak_def Let_def
   proof(intro strip conjI)
     fix n r
     assume "r \<in> read_actions (?E n) \<inter> ?C n"
     hence read: "r \<in> read_actions (?E n)" and committed: "r \<in> ?C n" by simp_all
     with justified have committed_ws: "?ws n r \<in> ?C n"
       and committed_ws': "ws (?\<phi> n r) \<in> ?\<phi> n ` ?C n"
       by(rule justified_write_seen_hb_read_committed)+
     from committed_ws' obtain w where w: "ws (?\<phi> n r) = ?\<phi> n w"
       and committed_w: "w \<in> ?C n" by blast
 
     from committed_w justified have "w \<in> actions (?E n)" by(auto simp add: committed_subset_actions_def)
     moreover from justified have "inj_on (?\<phi> n) (actions (?E n))"
       by(auto simp add: wf_action_translations_def dest: wf_action_translation_on_inj_onD)
     ultimately have w_def: "w = inv_into (actions (?E n)) (?\<phi> n) (ws (?\<phi> n r))"
       by(simp_all add: w)
 
     from committed committed_w
     have "P,?E n \<turnstile> w \<le>hb r \<longleftrightarrow> (happens_before P (?E n) |` ?C n) w r" by auto
     also have "\<dots> \<longleftrightarrow> (inv_imageP (happens_before P E) (?\<phi> n) |` ?C n) w r"
       using justified by(simp add: happens_before_committed_def)
     also have "\<dots> \<longleftrightarrow> P,E \<turnstile> ?\<phi> n w \<le>hb ?\<phi> n r" using committed committed_w by auto
     finally show "P,E \<turnstile> ws (?\<phi> n r) \<le>hb ?\<phi> n r \<longleftrightarrow> P,?E n \<turnstile> inv_into (actions (?E n)) (?\<phi> n) (ws (?\<phi> n r)) \<le>hb r"
       unfolding w[symmetric] unfolding w_def ..
 
     have "P,?E n\<turnstile> r \<le>hb w \<longleftrightarrow> (happens_before P (?E n) |` ?C n) r w" 
       using committed committed_w by auto
     also have "\<dots> \<longleftrightarrow> (inv_imageP (happens_before P E) (?\<phi> n) |` ?C n) r w"
       using justified by(simp add: happens_before_committed_def)
     also have "\<dots> \<longleftrightarrow> P,E \<turnstile> ?\<phi> n r \<le>hb ws (?\<phi> n r)" using w committed committed_w by auto
     also {
       from read obtain ad al v where "action_obs (?E n) r = NormalAction (ReadMem ad al v)" by cases auto
       with justified committed obtain v' where obs': "action_obs E (?\<phi> n r) = NormalAction (ReadMem ad al v')"
         by(fastforce simp add: wf_action_translations_def dest!: wf_action_translation_on_actionD)
       moreover from committed justified have "?\<phi> n r \<in> actions E"
         by(auto simp add: is_commit_sequence_def)
       ultimately have read': "?\<phi> n r \<in> read_actions E" by(auto intro: read_actions.intros)
       from wf have "is_write_seen P E ws" by(rule wf_exec_is_write_seenD)
       from is_write_seenD[OF this read' obs']
       have "\<not> P,E \<turnstile> ?\<phi> n r \<le>hb ws (?\<phi> n r)" by simp }
     ultimately show "\<not> P,?E n \<turnstile> r \<le>hb inv_into (actions (?E n)) (?\<phi> n) (ws (?\<phi> n r))"
       unfolding w_def by simp
   qed
 
   from justified have "committed_reads_see_committed_writes ws J" by simp
   thus "committed_reads_see_committed_writes_weak ws J"
     by(auto simp add: committed_reads_see_committed_writes_def committed_reads_see_committed_writes_weak_def)
 qed
 
 corollary legal_imp_weakly_legal_execution:
   "legal_execution P \<E> Ews \<Longrightarrow> weakly_legal_execution P \<E> Ews"
 by(cases Ews)(auto 4 4 simp add: gen_legal_execution.simps simp del: is_justified_by.simps is_weakly_justified_by.simps intro: is_justified_by_imp_is_weakly_justified_by)
 
 lemma drop_0th_justifying_exec:
   assumes "P \<turnstile> (E, ws) justified_by J"
   and wf: "P \<turnstile> (E', ws') \<surd>"
   shows "P \<turnstile> (E, ws) justified_by (J(0 := \<lparr>committed = {}, justifying_exec = E', justifying_ws = ws', action_translation = id\<rparr>))"
   (is "_ \<turnstile> _ justified_by ?J")
 using assms
 unfolding is_justified_by.simps is_commit_sequence_def
   justification_well_formed_def committed_subset_actions_def happens_before_committed_def
   sync_order_committed_def value_written_committed_def write_seen_committed_def uncommitted_reads_see_hb_def
   committed_reads_see_committed_writes_def external_actions_committed_def wf_action_translations_def
 proof(intro conjI strip)
   let ?E = "\<lambda>n. justifying_exec (?J n)"
     and ?\<phi> = "\<lambda>n. action_translation (?J n)"
     and ?C = "\<lambda>n. committed (?J n)"
     and ?ws = "\<lambda>n. justifying_ws (?J n)"
 
   show "?C 0 = {}" by simp
 
   from assms have C_0: "committed (J 0) = {}" by(simp add: is_commit_sequence_def)
   hence "(\<Union>n. ?\<phi> n ` ?C n) = (\<Union>n. action_translation (J n) ` committed (J n))"
     by -(rule SUP_cong, simp_all)
   also have "\<dots> = actions E" using assms by(simp add: is_commit_sequence_def)
   finally show "actions E = (\<Union>n. ?\<phi> n ` ?C n)" .. 
 
   fix n
   { fix r'
     assume "r' \<in> read_actions (?E (Suc n))"
     thus "?\<phi> (Suc n) r' \<in> ?\<phi> n ` ?C n \<or> P,?E (Suc n) \<turnstile> ?ws (Suc n) r' \<le>hb r'"
       using assms by(auto dest!: bspec simp add: uncommitted_reads_see_hb_def is_commit_sequence_def) }
   { fix r'
     assume r': "r' \<in> read_actions (?E (Suc n)) \<inter> ?C (Suc n)"
 
     have "n \<noteq> 0"
     proof
       assume "n = 0"
       hence "r' \<in> read_actions (justifying_exec (J 1)) \<inter> committed (J 1)" using r' by simp
       hence "action_translation (J 1) r' \<in> action_translation (J 0) ` committed (J 0) \<or> 
              ws (action_translation (J 1) r') \<in> action_translation (J 0) ` committed (J 0)" using assms
         unfolding One_nat_def is_justified_by.simps Let_def committed_reads_see_committed_writes_def
         by(metis (lifting))
       thus False unfolding C_0 by simp
     qed
     thus "let r = ?\<phi> (Suc n) r'; committed_n = ?\<phi> n ` ?C n
        in r \<in> committed_n \<or>
           (?\<phi> (Suc n) (?ws (Suc n) r') \<in> committed_n \<and> ws r \<in> committed_n)"
       using assms r' by(simp add: committed_reads_see_committed_writes_def) }
   { fix a a'
     assume "a \<in> external_actions (?E n)" 
       and "a' \<in> ?C n" "P,?E n \<turnstile> a \<le>hb a'"
     moreover hence "n > 0" by(simp split: if_split_asm)
     ultimately show "a \<in> ?C n" using assms
       by(simp add: external_actions_committed_def) blast }
     
   from assms have "wf_action_translation E (?J 0)"
     by(simp add: wf_action_translations_def wf_action_translation_on_def)
   thus "wf_action_translation E (?J n)" using assms by(simp add: wf_action_translations_def)
 qed auto
 
 lemma drop_0th_weakly_justifying_exec:
   assumes "P \<turnstile> (E, ws) weakly_justified_by J"
   and wf: "P \<turnstile> (E', ws') \<surd>"
   shows "P \<turnstile> (E, ws) weakly_justified_by (J(0 := \<lparr>committed = {}, justifying_exec = E', justifying_ws = ws', action_translation = id\<rparr>))"
   (is "_ \<turnstile> _ weakly_justified_by ?J")
 using assms
 unfolding is_weakly_justified_by.simps is_commit_sequence_def
   justification_well_formed_def committed_subset_actions_def happens_before_committed_weak_def
   value_written_committed_def write_seen_committed_def uncommitted_reads_see_hb_def
   committed_reads_see_committed_writes_weak_def external_actions_committed_def wf_action_translations_def
 proof(intro conjI strip)
   let ?E = "\<lambda>n. justifying_exec (?J n)"
     and ?\<phi> = "\<lambda>n. action_translation (?J n)"
     and ?C = "\<lambda>n. committed (?J n)"
     and ?ws = "\<lambda>n. justifying_ws (?J n)"
 
   show "?C 0 = {}" by simp
 
   from assms have C_0: "committed (J 0) = {}" by(simp add: is_commit_sequence_def)
   hence "(\<Union>n. ?\<phi> n ` ?C n) = (\<Union>n. action_translation (J n) ` committed (J n))"
     by -(rule SUP_cong, simp_all)
   also have "\<dots> = actions E" using assms by(simp add: is_commit_sequence_def)
   finally show "actions E = (\<Union>n. ?\<phi> n ` ?C n)" .. 
 
   fix n
   { fix r'
     assume "r' \<in> read_actions (?E (Suc n))"
     thus "?\<phi> (Suc n) r' \<in> ?\<phi> n ` ?C n \<or> P,?E (Suc n) \<turnstile> ?ws (Suc n) r' \<le>hb r'"
       using assms by(auto dest!: bspec simp add: uncommitted_reads_see_hb_def is_commit_sequence_def) }
   { fix r'
     assume r': "r' \<in> read_actions (?E (Suc n)) \<inter> ?C (Suc n)"
 
     have "n \<noteq> 0"
     proof
       assume "n = 0"
       hence "r' \<in> read_actions (justifying_exec (J 1)) \<inter> committed (J 1)" using r' by simp
       hence "action_translation (J 1) r' \<in> action_translation (J 0) ` committed (J 0) \<or> 
              ws (action_translation (J 1) r') \<in> action_translation (J 0) ` committed (J 0)" using assms
         unfolding One_nat_def is_weakly_justified_by.simps Let_def committed_reads_see_committed_writes_weak_def
         by(metis (lifting))
       thus False unfolding C_0 by simp
     qed
     thus "let r = ?\<phi> (Suc n) r'; committed_n = ?\<phi> n ` ?C n
        in r \<in> committed_n \<or> ws r \<in> committed_n"
       using assms r' by(simp add: committed_reads_see_committed_writes_weak_def) }
     
   from assms have "wf_action_translation E (?J 0)"
     by(simp add: wf_action_translations_def wf_action_translation_on_def)
   thus "wf_action_translation E (?J n)" using assms by(simp add: wf_action_translations_def)
 qed auto
 
 subsection \<open>Executions with common prefix\<close>
 
 lemma actions_change_prefix:
   assumes read: "a \<in> actions E"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and rn: "enat a < n"
   shows "a \<in> actions E'"
 using llist_all2_llengthD[OF prefix[unfolded sim_actions_def]] read rn
 by(simp add: actions_def min_def split: if_split_asm)
 
 lemma action_obs_change_prefix:
   assumes prefix: "ltake n E [\<approx>] ltake n E'"
   and rn: "enat a < n"
   shows "action_obs E a \<approx> action_obs E' a"
 proof -
   from rn have "action_obs E a = action_obs (ltake n E) a"
     by(simp add: action_obs_def lnth_ltake)
   also from prefix have "\<dots> \<approx> action_obs (ltake n E') a"
     by(rule sim_actions_action_obsD)
   also have "\<dots> = action_obs E' a" using rn
     by(simp add: action_obs_def lnth_ltake)
   finally show ?thesis .
 qed
 
 lemma action_obs_change_prefix_eq:
   assumes prefix: "ltake n E = ltake n E'"
   and rn: "enat a < n"
   shows "action_obs E a = action_obs E' a"
 proof -
   from rn have "action_obs E a = action_obs (ltake n E) a"
     by(simp add: action_obs_def lnth_ltake)
   also from prefix have "\<dots> = action_obs (ltake n E') a"
     by(simp add: action_obs_def)
   also have "\<dots> = action_obs E' a" using rn
     by(simp add: action_obs_def lnth_ltake)
   finally show ?thesis .
 qed
 
 lemma read_actions_change_prefix:
   assumes read: "r \<in> read_actions E"
   and prefix: "ltake n E [\<approx>] ltake n E'" "enat r < n"
   shows "r \<in> read_actions E'"
 using read action_obs_change_prefix[OF prefix] actions_change_prefix[OF _ prefix]
 by(cases)(auto intro: read_actions.intros)
 
 lemma sim_action_is_write_action_eq:
   assumes "obs \<approx> obs'"
   shows "is_write_action obs \<longleftrightarrow> is_write_action obs'"
 using assms by cases simp_all
 
 lemma write_actions_change_prefix:
   assumes "write": "w \<in> write_actions E"
   and prefix: "ltake n E [\<approx>] ltake n E'" "enat w < n"
   shows "w \<in> write_actions E'"
 using "write" action_obs_change_prefix[OF prefix] actions_change_prefix[OF _ prefix]
 by(cases)(auto intro: write_actions.intros dest: sim_action_is_write_action_eq)
 
 lemma action_loc_change_prefix:
   assumes "ltake n E [\<approx>] ltake n E'" "enat a < n"
   shows "action_loc P E a = action_loc P E' a"
 using action_obs_change_prefix[OF assms]
 by(fastforce elim!: action_loc_aux_cases intro: action_loc_aux_intros)
 
 lemma sim_action_is_new_action_eq:
   assumes "obs \<approx> obs'"
   shows "is_new_action obs = is_new_action obs'"
 using assms by cases auto
 
 lemma action_order_change_prefix:
   assumes ao: "E \<turnstile> a \<le>a a'"
   and prefix: "ltake n E [\<approx>] ltake n E'" 
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "E' \<turnstile> a \<le>a a'"
 using ao actions_change_prefix[OF _ prefix an] actions_change_prefix[OF _ prefix a'n] action_obs_change_prefix[OF prefix an] action_obs_change_prefix[OF prefix a'n]
 by(auto simp add: action_order_def split: if_split_asm dest: sim_action_is_new_action_eq)
 
 
 lemma value_written_change_prefix:
   assumes eq: "ltake n E = ltake n E'"
   and an: "enat a < n"
   shows "value_written P E a = value_written P E' a"
 using action_obs_change_prefix_eq[OF eq an]
 by(simp add: value_written_def fun_eq_iff)
 
 lemma action_tid_change_prefix:
   assumes prefix: "ltake n E [\<approx>] ltake n E'" 
   and an: "enat a < n"
   shows "action_tid E a = action_tid E' a"
 proof -
   from an have "action_tid E a = action_tid (ltake n E) a"
     by(simp add: action_tid_def lnth_ltake)
   also from prefix have "\<dots> = action_tid (ltake n E') a"
     by(rule sim_actions_action_tidD)
   also from an have "\<dots> = action_tid E' a"
     by(simp add: action_tid_def lnth_ltake)
   finally show ?thesis .
 qed
 
 lemma program_order_change_prefix:
   assumes po: "E \<turnstile> a \<le>po a'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "E' \<turnstile> a \<le>po a'"
 using po action_order_change_prefix[OF _ prefix an a'n]
   action_tid_change_prefix[OF prefix an] action_tid_change_prefix[OF prefix a'n]
 by(auto elim!: program_orderE intro: program_orderI)
 
 lemma sim_action_sactionD:
   assumes "obs \<approx> obs'"
   shows "saction P obs \<longleftrightarrow> saction P obs'"
 using assms by cases simp_all
 
 lemma sactions_change_prefix:
   assumes sync: "a \<in> sactions P E"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and rn: "enat a < n"
   shows "a \<in> sactions P E'"
 using sync action_obs_change_prefix[OF prefix rn] actions_change_prefix[OF _ prefix rn]
 unfolding sactions_def by(simp add: sim_action_sactionD)
 
 lemma sync_order_change_prefix:
   assumes so: "P,E \<turnstile> a \<le>so a'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "P,E' \<turnstile> a \<le>so a'"
 using so action_order_change_prefix[OF _ prefix an a'n] sactions_change_prefix[OF _ prefix an, of P] sactions_change_prefix[OF _ prefix a'n, of P]
 by(simp add: sync_order_def)
 
 lemma sim_action_synchronizes_withD:
   assumes "obs \<approx> obs'" "obs'' \<approx> obs'''"
   shows "P \<turnstile> (t, obs) \<leadsto>sw (t', obs'') \<longleftrightarrow> P \<turnstile> (t, obs') \<leadsto>sw (t', obs''')"
 using assms
 by(auto elim!: sim_action.cases synchronizes_with.cases intro: synchronizes_with.intros)
 
 lemma sync_with_change_prefix:
   assumes sw: "P,E \<turnstile> a \<le>sw a'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "P,E' \<turnstile> a \<le>sw a'"
 using sw sync_order_change_prefix[OF _ prefix an a'n, of P] 
   action_tid_change_prefix[OF prefix an] action_tid_change_prefix[OF prefix a'n]
   action_obs_change_prefix[OF prefix an] action_obs_change_prefix[OF prefix a'n]
 by(auto simp add: sync_with_def dest: sim_action_synchronizes_withD)
 
 
 lemma po_sw_change_prefix:
   assumes posw: "po_sw P E a a'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "po_sw P E' a a'"
 using posw sync_with_change_prefix[OF _ prefix an a'n, of P] program_order_change_prefix[OF _ prefix an a'n]
 by(auto simp add: po_sw_def)
 
 
 lemma happens_before_new_not_new:
   assumes tsa_ok: "thread_start_actions_ok E"
   and a: "a \<in> actions E" 
   and a': "a' \<in> actions E"
   and new_a: "is_new_action (action_obs E a)"
   and new_a': "\<not> is_new_action (action_obs E a')"
   shows "P,E \<turnstile> a \<le>hb a'"
 proof -
   from thread_start_actions_okD[OF tsa_ok a' new_a']
   obtain i where "i \<le> a'"
     and obs_i: "action_obs E i = InitialThreadAction" 
     and "action_tid E i = action_tid E a'" by auto
   from \<open>i \<le> a'\<close> a' have "i \<in> actions E"
     by(auto simp add: actions_def le_less_trans[where y="enat a'"])
   with \<open>i \<le> a'\<close> obs_i a' new_a' have "E \<turnstile> i \<le>a a'" by(simp add: action_order_def)
   hence "E \<turnstile> i \<le>po a'" using \<open>action_tid E i = action_tid E a'\<close>
     by(rule program_orderI)
   
   moreover {
     from \<open>i \<in> actions E\<close> obs_i
     have "i \<in> sactions P E" by(auto intro: sactionsI)
     from a \<open>i \<in> actions E\<close> new_a obs_i have "E \<turnstile> a \<le>a i" by(simp add: action_order_def)
     moreover from a new_a have "a \<in> sactions P E" by(auto intro: sactionsI)
     ultimately have "P,E \<turnstile> a \<le>so i" using \<open>i \<in> sactions P E\<close> by(rule sync_orderI)
     moreover from new_a obs_i have "P \<turnstile> (action_tid E a, action_obs E a) \<leadsto>sw (action_tid E i, action_obs E i)"
       by cases(auto intro: synchronizes_with.intros)
     ultimately have "P,E \<turnstile> a \<le>sw i" by(rule sync_withI) }
   ultimately show ?thesis unfolding po_sw_def [abs_def] by(blast intro: tranclp.r_into_trancl tranclp_trans)
 qed
 
 lemma happens_before_change_prefix:
   assumes hb: "P,E \<turnstile> a \<le>hb a'"
   and tsa_ok: "thread_start_actions_ok E'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat a < n"
   and a'n: "enat a' < n"
   shows "P,E' \<turnstile> a \<le>hb a'"
 using hb an a'n
 proof induct
   case (base a')
   thus ?case by(rule tranclp.r_into_trancl[where r="po_sw P E'", OF po_sw_change_prefix[OF _ prefix]])
 next
   case (step a' a'')
   show ?case
   proof(cases "is_new_action (action_obs E a') \<and> \<not> is_new_action (action_obs E a'')")
     case False
     from \<open>po_sw P E a' a''\<close> have "E \<turnstile> a' \<le>a a''" by(rule po_sw_into_action_order)
     with \<open>enat a'' < n\<close> False have "enat a' < n"
       by(safe elim!: action_orderE)(metis Suc_leI Suc_n_not_le_n enat_ord_simps(2) le_trans nat_neq_iff xtrans(10))+
     with \<open>enat a < n\<close> have "P,E' \<turnstile> a \<le>hb a'" by(rule step)
     moreover from \<open>po_sw P E a' a''\<close> prefix \<open>enat a' < n\<close> \<open>enat a'' < n\<close>
     have "po_sw P E' a' a''" by(rule po_sw_change_prefix)
     ultimately show ?thesis ..
   next
     case True
     then obtain new_a': "is_new_action (action_obs E a')"
       and "\<not> is_new_action (action_obs E a'')" ..
     from \<open>P,E \<turnstile> a \<le>hb a'\<close> new_a'
     have new_a: "is_new_action (action_obs E a)"
       and tid: "action_tid E a = action_tid E a'"
       and "a \<le> a'" by(rule happens_before_new_actionD)+
     
     note tsa_ok moreover
     from porder_happens_before[of E P] have "a \<in> actions E"
       by(rule porder_onE)(erule refl_onPD1, rule \<open>P,E \<turnstile> a \<le>hb a'\<close>)
     hence "a \<in> actions E'" using an by(rule actions_change_prefix[OF _ prefix])
     moreover
     from \<open>po_sw P E a' a''\<close> refl_on_program_order[of E] refl_on_sync_order[of P E]
     have "a'' \<in> actions E"
       unfolding po_sw_def by(auto dest: refl_onPD2 elim!: sync_withE)
     hence "a'' \<in> actions E'" using \<open>enat a'' < n\<close> by(rule actions_change_prefix[OF _ prefix])
     moreover
     from new_a action_obs_change_prefix[OF prefix an] 
     have "is_new_action (action_obs E' a)" by(cases) auto
     moreover
     from \<open>\<not> is_new_action (action_obs E a'')\<close> action_obs_change_prefix[OF prefix \<open>enat a'' < n\<close>]
     have "\<not> is_new_action (action_obs E' a'')" by(auto elim: is_new_action.cases)
     ultimately show "P,E' \<turnstile> a \<le>hb a''" by(rule happens_before_new_not_new)
   qed
 qed
 
 lemma thread_start_actions_ok_change:
   assumes tsa: "thread_start_actions_ok E"
   and sim: "E [\<approx>] E'"
   shows "thread_start_actions_ok E'"
 proof(rule thread_start_actions_okI)
   fix a
   assume "a \<in> actions E'" "\<not> is_new_action (action_obs E' a)"
   from sim have len_eq: "llength E = llength E'" by(simp add: sim_actions_def)(rule llist_all2_llengthD)
   with sim have sim': "ltake (llength E) E [\<approx>] ltake (llength E) E'" by(simp add: ltake_all)
 
   from \<open>a \<in> actions E'\<close> len_eq have "enat a < llength E" by(simp add: actions_def)
   with \<open>a \<in> actions E'\<close> sim'[symmetric] have "a \<in> actions E" by(rule actions_change_prefix)
   moreover have "\<not> is_new_action (action_obs E a)"
     using action_obs_change_prefix[OF sim' \<open>enat a < llength E\<close>] \<open>\<not> is_new_action (action_obs E' a)\<close>
     by(auto elim!: is_new_action.cases)
   ultimately obtain i where "i \<le> a" "action_obs E i = InitialThreadAction" "action_tid E i = action_tid E a"
     by(blast dest: thread_start_actions_okD[OF tsa])
   thus "\<exists>i \<le> a. action_obs E' i = InitialThreadAction \<and> action_tid E' i = action_tid E' a"
     using action_tid_change_prefix[OF sim', of i] action_tid_change_prefix[OF sim', of a] \<open>enat a < llength E\<close>
       action_obs_change_prefix[OF sim', of i]
     by(cases "llength E")(auto intro!: exI[where x=i])
 qed
 
 context executions_aux begin
 
 lemma \<E>_new_same_addr_singleton:
   assumes E: "E \<in> \<E>"
   shows "\<exists>a. new_actions_for P E adal \<subseteq> {a}"
 by(blast dest: \<E>_new_actions_for_fun[OF E])
 
 lemma new_action_before_read:
   assumes E: "E \<in> \<E>"
   and wf: "P \<turnstile> (E, ws) \<surd>"
   and ra: "ra \<in> read_actions E"
   and adal: "adal \<in> action_loc P E ra"
   and new: "wa \<in> new_actions_for P E adal"
   and sc: "\<And>a. \<lbrakk> a < ra; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
   shows "wa < ra"
 using \<E>_new_same_addr_singleton[OF E, of adal] init_before_read[OF E wf ra adal sc] new
 by auto
 
 lemma mrw_before:
   assumes E: "E \<in> \<E>"
   and wf: "P \<turnstile> (E, ws) \<surd>"
   and mrw: "P,E \<turnstile> r \<leadsto>mrw w"
   and sc: "\<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
   shows "w < r"
 using mrw read_actions_not_write_actions[of r E]
 apply cases
 apply(erule action_orderE)
  apply(erule (1) new_action_before_read[OF E wf])
   apply(simp add: new_actions_for_def)
  apply(erule (1) sc)
 apply(cases "w = r")
 apply auto
 done
 
 lemma mrw_change_prefix:
   assumes E': "E' \<in> \<E>"
   and mrw: "P,E \<turnstile> r \<leadsto>mrw w"
   and tsa_ok: "thread_start_actions_ok E'"
   and prefix: "ltake n E [\<approx>] ltake n E'"
   and an: "enat r < n"
   and a'n: "enat w < n"
   shows "P,E' \<turnstile> r \<leadsto>mrw w"
 using mrw
 proof cases
   fix adal
   assume r: "r \<in> read_actions E"
     and adal_r: "adal \<in> action_loc P E r"
     and war: "E \<turnstile> w \<le>a r"
     and w: "w \<in> write_actions E"
     and adal_w: "adal \<in> action_loc P E w"
     and mrw: "\<And>wa'. \<lbrakk>wa' \<in> write_actions E; adal \<in> action_loc P E wa'\<rbrakk>
               \<Longrightarrow> E \<turnstile> wa' \<le>a w \<or> E \<turnstile> r \<le>a wa'"
   show ?thesis
   proof(rule most_recent_write_for.intros)
     from r prefix an show r': "r \<in> read_actions E'"
       by(rule read_actions_change_prefix)
     from adal_r show "adal \<in> action_loc P E' r"
       by(simp add: action_loc_change_prefix[OF prefix[symmetric] an])
     from war prefix a'n an show "E' \<turnstile> w \<le>a r" by(rule action_order_change_prefix)
     from w prefix a'n show w': "w \<in> write_actions E'" by(rule write_actions_change_prefix)
     from adal_w show adal_w': "adal \<in> action_loc P E' w" by(simp add: action_loc_change_prefix[OF prefix[symmetric] a'n])
 
     fix wa'
     assume wa': "wa' \<in> write_actions E'" 
       and adal_wa': "adal \<in> action_loc P E' wa'"
     show "E' \<turnstile> wa' \<le>a w \<or> E' \<turnstile> r \<le>a wa'"
     proof(cases "enat wa' < n")
       case True
       note wa'n = this
       with wa' prefix[symmetric] have "wa' \<in> write_actions E" by(rule write_actions_change_prefix)
       moreover from adal_wa' have "adal \<in> action_loc P E wa'"
         by(simp add: action_loc_change_prefix[OF prefix wa'n])
       ultimately have "E \<turnstile> wa' \<le>a w \<or> E \<turnstile> r \<le>a wa'" by(rule mrw)
       thus ?thesis
       proof
         assume "E \<turnstile> wa' \<le>a w"
         hence "E' \<turnstile> wa' \<le>a w" using prefix wa'n a'n by(rule action_order_change_prefix)
         thus ?thesis ..
       next
         assume "E \<turnstile> r \<le>a wa'"
         hence "E' \<turnstile> r \<le>a wa'" using prefix an wa'n by(rule action_order_change_prefix)
         thus ?thesis ..
       qed
     next
       case False note wa'n = this
       show ?thesis
       proof(cases "is_new_action (action_obs E' wa')")
         case False
         hence "E' \<turnstile> r \<le>a wa'" using wa'n r' wa' an
           by(auto intro!: action_orderI) (metis enat_ord_code(1) linorder_le_cases order_le_less_trans)
         thus ?thesis ..
       next
         case True
         with wa' adal_wa' have new: "wa' \<in> new_actions_for P E' adal" by(simp add: new_actions_for_def)
         show ?thesis
         proof(cases "is_new_action (action_obs E' w)")
           case True
           with adal_w' a'n w' have "w \<in> new_actions_for P E' adal" by(simp add: new_actions_for_def)
           with E' new have "wa' = w" by(rule \<E>_new_actions_for_fun)
           thus ?thesis using w' by(auto intro: refl_onPD[OF refl_action_order])
         next
           case False
           with True wa' w' show ?thesis by(auto intro!: action_orderI)
         qed
       qed
     qed
   qed
 qed
 
 lemma action_order_read_before_write:
   assumes E: "E \<in> \<E>" "P \<turnstile> (E, ws) \<surd>"
   and ao: "E \<turnstile> w \<le>a r"
   and r: "r \<in> read_actions E"
   and w: "w \<in> write_actions E"
   and adal: "adal \<in> action_loc P E r" "adal \<in> action_loc P E w"
   and sc: "\<And>a. \<lbrakk> a < r; a \<in> read_actions E \<rbrakk> \<Longrightarrow> P,E \<turnstile> a \<leadsto>mrw ws a"
   shows "w < r"
 using ao
 proof(cases rule: action_orderE)
   case 1
   from init_before_read[OF E r adal(1) sc]
   obtain i where "i < r" "i \<in> new_actions_for P E adal" by blast
   moreover from \<open>is_new_action (action_obs E w)\<close> adal(2) \<open>w \<in> actions E\<close>
   have "w \<in> new_actions_for P E adal" by(simp add: new_actions_for_def)
   ultimately show "w < r" using E by(auto dest: \<E>_new_actions_for_fun)
 next
   case 2
   with r w show ?thesis
     by(cases "w = r")(auto dest: read_actions_not_write_actions)
 qed
 
 end
 
 end
diff --git a/thys/JinjaThreads/MM/JMM_Typesafe.thy b/thys/JinjaThreads/MM/JMM_Typesafe.thy
--- a/thys/JinjaThreads/MM/JMM_Typesafe.thy
+++ b/thys/JinjaThreads/MM/JMM_Typesafe.thy
@@ -1,948 +1,948 @@
 (*  Title:      JinjaThreads/MM/JMM_Typesafe.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Type-safety proof for the Java memory model\<close>
 
 theory JMM_Typesafe 
 imports
   JMM_Framework
 begin
 
 text \<open>
   Create a dynamic list \<open>heap_independent\<close> of theorems for replacing 
   heap-dependent constants by heap-independent ones. 
 \<close>
 ML \<open>
 structure Heap_Independent_Rules = Named_Thms
 (
   val name = @{binding heap_independent}
   val description = "Simplification rules for heap-independent constants"
 )
 \<close>
 setup \<open>Heap_Independent_Rules.setup\<close>
 
 locale heap_base' = 
   h: heap_base 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate "\<lambda>_. typeof_addr" heap_read heap_write
   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 :: "'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
 
 definition typeof_h :: "'addr val \<Rightarrow> ty option"
 where "typeof_h = h.typeof_h undefined"
 lemma typeof_h_conv_typeof_h [heap_independent, iff]: "h.typeof_h h = typeof_h"
 by(rule ext)(case_tac x, simp_all add: typeof_h_def)
 lemmas typeof_h_simps [simp] = h.typeof_h.simps [unfolded heap_independent]
 
 definition cname_of :: "'addr \<Rightarrow> cname"
 where "cname_of = h.cname_of undefined"
 lemma cname_of_conv_cname_of [heap_independent, iff]: "h.cname_of h = cname_of"
 by(simp add: cname_of_def h.cname_of_def[abs_def])
 
 definition addr_loc_type :: "'m prog \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> ty \<Rightarrow> bool"
 where "addr_loc_type P = h.addr_loc_type P undefined"
 notation addr_loc_type ("_ \<turnstile> _@_ : _" [50, 50, 50, 50] 51)
 lemma addr_loc_type_conv_addr_loc_type [heap_independent, iff]: 
   "h.addr_loc_type P h = addr_loc_type P"
 by(simp add: addr_loc_type_def h.addr_loc_type_def)
 lemmas addr_loc_type_cases [cases pred: addr_loc_type] = 
   h.addr_loc_type.cases[unfolded heap_independent]
 lemmas addr_loc_type_intros = h.addr_loc_type.intros[unfolded heap_independent]
 
 definition typeof_addr_loc :: "'m prog \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> ty"
 where "typeof_addr_loc P = h.typeof_addr_loc P undefined"
 lemma typeof_addr_loc_conv_typeof_addr_loc [heap_independent, iff]:
   "h.typeof_addr_loc P h = typeof_addr_loc P"
 by(simp add: typeof_addr_loc_def h.typeof_addr_loc_def[abs_def])
 
 definition conf :: "'a prog \<Rightarrow> 'addr val \<Rightarrow> ty \<Rightarrow> bool"
 where "conf P \<equiv> h.conf P undefined"
 notation conf ("_ \<turnstile> _ :\<le> _"  [51,51,51] 50)
 lemma conf_conv_conf [heap_independent, iff]: "h.conf P h = conf P"
 by(simp add: conf_def heap_base.conf_def[abs_def])
 lemmas defval_conf [simp] = h.defval_conf[unfolded heap_independent]
 
 definition lconf :: "'m prog \<Rightarrow> (vname \<rightharpoonup> 'addr val) \<Rightarrow> (vname \<rightharpoonup> ty) \<Rightarrow> bool" 
 where "lconf P = h.lconf P undefined"
 notation lconf ("_ \<turnstile> _ '(:\<le>') _" [51,51,51] 50)
 lemma lconf_conv_lconf [heap_independent, iff]: "h.lconf P h = lconf P"
 by(simp add: lconf_def h.lconf_def[abs_def])
 
 definition confs :: "'m prog \<Rightarrow> 'addr val list \<Rightarrow> ty list \<Rightarrow> bool"
 where "confs P = h.confs P undefined"
 notation confs ("_ \<turnstile> _ [:\<le>] _" [51,51,51] 50)
 lemma confs_conv_confs [heap_independent, iff]: "h.confs P h = confs P"
 by(simp add: confs_def)
 
 definition tconf :: "'m prog \<Rightarrow> 'thread_id \<Rightarrow> bool" 
 where "tconf P = h.tconf P undefined"
 notation tconf ("_ \<turnstile> _ \<surd>t" [51,51] 50)
 lemma tconf_conv_tconf [heap_independent, iff]: "h.tconf P h = tconf P"
 by(simp add: tconf_def h.tconf_def[abs_def])
 
 definition vs_conf :: "'m prog \<Rightarrow> ('addr \<times> addr_loc \<Rightarrow> 'addr val set) \<Rightarrow> bool"
 where "vs_conf P = h.vs_conf P undefined"
 lemma vs_conf_conv_vs_conf [heap_independent, iff]: "h.vs_conf P h = vs_conf P"
 by(simp add: vs_conf_def h.vs_conf_def[abs_def])
 
 lemmas vs_confI = h.vs_confI[unfolded heap_independent]
 lemmas vs_confD = h.vs_confD[unfolded heap_independent]
 
 text \<open>
   use non-speculativity to express that only type-correct values are read
 \<close>
 
 primrec vs_type_all :: "'m prog \<Rightarrow> 'addr \<times> addr_loc \<Rightarrow> 'addr val set"
 where "vs_type_all P (ad, al) = {v. \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T}"
 
 lemma vs_conf_vs_type_all [simp]: "vs_conf P (vs_type_all P)"
 by(rule h.vs_confI[unfolded heap_independent])(simp)
 
 lemma w_addrs_vs_type_all: "w_addrs (vs_type_all P) \<subseteq> dom typeof_addr"
 by(auto simp add: w_addrs_def h.conf_def[unfolded heap_independent])
 
 lemma w_addrs_vs_type_all_in_vs_type_all:
   "(\<Union>ad \<in> w_addrs (vs_type_all P). {(ad, al)|al. \<exists>T. P \<turnstile> ad@al : T}) \<subseteq> {adal. vs_type_all P adal \<noteq> {}}"
 by(auto simp add: w_addrs_def vs_type_all_def intro: defval_conf)
 
 declare vs_type_all.simps [simp del]
 
 lemmas vs_conf_insert_iff = h.vs_conf_insert_iff[unfolded heap_independent]
 
 end
 
 
 locale heap' =
   h: heap
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate "\<lambda>_. typeof_addr" heap_read heap_write
     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 :: "'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 P :: "'m prog"
 
 sublocale heap' < heap_base' .
 
 context heap' begin
 
 lemma vs_conf_w_value_WriteMemD: 
   "\<lbrakk> vs_conf P (w_value P vs ob); ob = NormalAction (WriteMem ad al v) \<rbrakk>
   \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 by(auto elim: vs_confD)
 
 lemma vs_conf_w_values_WriteMemD:
   "\<lbrakk> vs_conf P (w_values P vs obs); NormalAction (WriteMem ad al v) \<in> set obs \<rbrakk>
   \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 apply(induct obs arbitrary: vs)
 apply(auto 4 3 elim: vs_confD intro: w_values_mono[THEN subsetD])
 done
 
 lemma w_values_vs_type_all_start_heap_obs:
   assumes wf: "wf_syscls P"
   shows "w_values P (vs_type_all P) (map snd (lift_start_obs h.start_tid h.start_heap_obs)) = vs_type_all P"
   (is "?lhs = ?rhs")
 proof(rule antisym, rule le_funI, rule subsetI)
   fix adal v
   assume v: "v \<in> ?lhs adal"
   obtain ad al where adal: "adal = (ad, al)" by(cases adal)
   show "v \<in> ?rhs adal"
   proof(rule ccontr)
     assume v': "\<not> ?thesis"
     from in_w_valuesD[OF v[unfolded adal] this[unfolded adal]]
     obtain obs' wa obs''
       where eq: "map snd (lift_start_obs h.start_tid h.start_heap_obs) = obs' @ wa # obs''"
       and "write": "is_write_action wa"
       and loc: "(ad, al) \<in> action_loc_aux P wa"
       and vwa: "value_written_aux P wa al = v"
       by blast+
     from "write" show False
     proof cases
       case (WriteMem ad' al' v')
       with vwa loc eq have "WriteMem ad al v \<in> set h.start_heap_obs"
         by(auto simp add: map_eq_append_conv Cons_eq_append_conv lift_start_obs_def)
       from h.start_heap_write_typeable[OF this] v' adal
       show ?thesis by(auto simp add: vs_type_all_def)
     next
       case (NewHeapElem ad' hT)
       with vwa loc eq have "NewHeapElem ad hT \<in> set h.start_heap_obs"
         by(auto simp add: map_eq_append_conv Cons_eq_append_conv lift_start_obs_def)
       hence "typeof_addr ad = \<lfloor>hT\<rfloor>"
         by(rule h.NewHeapElem_start_heap_obsD[OF wf])
       with v' adal loc vwa NewHeapElem show ?thesis
         by(auto  simp add: vs_type_all_def intro: addr_loc_type_intros h.addr_loc_default_conf[unfolded heap_independent])
     qed
   qed
 qed(rule w_values_greater)
 
 end
 
 
 lemma lprefix_lappend2I: "lprefix xs ys \<Longrightarrow> lprefix xs (lappend ys zs)"
 by(auto simp add: lappend_assoc lprefix_conv_lappend)
 
 locale known_addrs_typing' =
   h: known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate "\<lambda>_. typeof_addr" heap_read heap_write 
     allocated known_addrs 
     final r wfx
     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 :: "'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 allocated :: "'heap \<Rightarrow> 'addr set"
   and known_addrs :: "'thread_id \<Rightarrow> 'x \<Rightarrow> 'addr set"
   and final :: "'x \<Rightarrow> bool"
   and r :: "('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) semantics" ("_ \<turnstile> _ -_\<rightarrow> _" [50,0,0,50] 80) 
   and wfx :: "'thread_id \<Rightarrow> 'x \<Rightarrow> 'heap \<Rightarrow> bool"
   and P :: "'md prog"
   +
   assumes NewHeapElem_typed: \<comment> \<open>Should this be moved to known\_addrs\_typing?\<close>
   "\<lbrakk> t \<turnstile> (x, h) -ta\<rightarrow> (x', h'); NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 
 sublocale known_addrs_typing' < heap' by unfold_locales
 
 context known_addrs_typing' begin
 
 lemma known_addrs_typeable_in_vs_type_all:
   "h.if.known_addrs_state s \<subseteq> dom typeof_addr 
   \<Longrightarrow> (\<Union>a \<in> h.if.known_addrs_state s. {(a, al)|al. \<exists>T. P \<turnstile> a@al : T}) \<subseteq> {adal. vs_type_all P adal \<noteq> {}}"
 by(auto 4 4 dest: subsetD simp add: vs_type_all.simps intro: defval_conf)
 
 lemma if_NewHeapElem_typed: 
   "\<lbrakk> t \<turnstile> xh -ta\<rightarrow>i x'h'; NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(cases rule: h.mthr.init_fin.cases)(auto dest: NewHeapElem_typed)
 
 lemma if_redT_NewHeapElem_typed:
   "\<lbrakk> h.mthr.if.redT s (t, ta) s'; NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; typeof_addr ad \<noteq> None \<rbrakk>
   \<Longrightarrow> typeof_addr ad = \<lfloor>CTn\<rfloor>"
 by(cases rule: h.mthr.if.redT.cases)(auto dest: if_NewHeapElem_typed)
 
 lemma non_speculative_written_value_typeable:
   assumes wfx_start: "ts_ok wfx (thr (h.start_state f P C M vs)) h.start_heap" 
   and wfP: "wf_syscls P"
   and E: "E \<in> h.\<E>_start f P C M vs status"
   and "write": "w \<in> write_actions E"
   and adal: "(ad, al) \<in> action_loc P E w"
   and ns: "non_speculative P (vs_type_all P) (lmap snd (ltake (enat w) E))"
   shows "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> value_written P E w (ad, al) :\<le> T"
 proof -
   let ?start_state = "init_fin_lift_state status (h.start_state f P C M vs)"
     and ?start_obs = "lift_start_obs h.start_tid h.start_heap_obs"
     and ?v = "value_written P E w (ad, al)"
 
   from "write" have iwa: "is_write_action (action_obs E w)" by cases
 
   from E obtain E' where E': "E = lappend (llist_of ?start_obs) E'"
     and \<E>: "E' \<in> h.mthr.if.\<E> ?start_state" by blast
   from \<E> obtain E'' where E'': "E' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E'')"
     and Runs: "h.mthr.if.mthr.Runs ?start_state E''"
     by-(rule h.mthr.if.\<E>.cases[OF \<E>])
   
   have wfx': "ts_ok (init_fin_lift wfx) (thr ?start_state) (shr ?start_state)"
     using wfx_start by(simp add: h.shr_start_state)
 
   from ns E'
   have ns: "non_speculative P (vs_type_all P) (lmap snd (ldropn (length (lift_start_obs h.start_tid h.start_heap_obs)) (ltake (enat w) E)))"
     by(subst (asm) lappend_ltake_ldrop[where n="enat (length (lift_start_obs h.start_tid h.start_heap_obs))", symmetric])(simp add: non_speculative_lappend min_def ltake_lappend1 w_values_vs_type_all_start_heap_obs[OF wfP] ldrop_enat split: if_split_asm)
 
   show ?thesis
   proof(cases "w < length ?start_obs")
     case True
     hence in_start: "action_obs E w \<in> set (map snd ?start_obs)"
       unfolding in_set_conv_nth E' by(simp add: lnth_lappend action_obs_def map_nth exI[where x="w"])
     
     from iwa show ?thesis
     proof(cases)
       case (WriteMem ad' al' v')
       with adal have "ad' = ad" "al' = al" "?v = v'" by(simp_all add: value_written.simps)
       with WriteMem in_start have "WriteMem ad al ?v \<in> set h.start_heap_obs" by auto
       thus ?thesis by(rule h.start_heap_write_typeable[unfolded heap_independent])
     next
       case (NewHeapElem ad' CTn)
       with adal have [simp]: "ad' = ad" by auto
       with NewHeapElem in_start have "NewHeapElem ad CTn \<in> set h.start_heap_obs" by auto
       with wfP have "typeof_addr ad = \<lfloor>CTn\<rfloor>" by(rule h.NewHeapElem_start_heap_obsD)
       with adal NewHeapElem show ?thesis
         by(cases al)(auto simp add: value_written.simps intro: addr_loc_type_intros h.addr_loc_default_conf[unfolded heap_independent])
     qed
   next
     case False
     define w' where "w' = w - length ?start_obs"
     with "write" False have w'_len: "enat w' < llength E'"
       by(cases "llength E'")(auto simp add: actions_def E' elim: write_actions.cases)
     with Runs obtain m_w n_w t_w ta_w 
       where E'_w: "lnth E' w' = (t_w, \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub> ! n_w)"
       and n_w: "n_w < length \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>"
       and m_w: "enat m_w < llength E''"
       and w_sum: "w' = (\<Sum>i<m_w. length \<lbrace>snd (lnth E'' i)\<rbrace>\<^bsub>o\<^esub>) + n_w"
       and E''_m_w: "lnth E'' m_w = (t_w, ta_w)"
       unfolding E'' by(rule h.mthr.if.actions_\<E>E_aux)
 
     from E'_w have obs_w: "action_obs E w = \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub> ! n_w"
       using False E' w'_def by(simp add: action_obs_def lnth_lappend)
     
     let ?E'' = "ldropn (Suc m_w) E''"
     let ?m_E'' = "ltake (enat m_w) E''"
     have E'_unfold: "E'' = lappend ?m_E'' (LCons (lnth E'' m_w) ?E'')"
       unfolding ldropn_Suc_conv_ldropn[OF m_w] by simp
     hence "h.mthr.if.mthr.Runs ?start_state (lappend ?m_E'' (LCons (lnth E'' m_w) ?E''))"
       using Runs by simp
     then obtain \<sigma>' where \<sigma>_\<sigma>': "h.mthr.if.mthr.Trsys ?start_state (list_of ?m_E'') \<sigma>'"
       and Runs': "h.mthr.if.mthr.Runs \<sigma>' (LCons (lnth E'' m_w) ?E'')"
       by(rule h.mthr.if.mthr.Runs_lappendE) simp
     from Runs' obtain \<sigma>''' where red_w: "h.mthr.if.redT \<sigma>' (t_w, ta_w) \<sigma>'''"
       and Runs'': "h.mthr.if.mthr.Runs \<sigma>''' ?E''"
       unfolding E''_m_w by cases
 
     let ?EE'' = "lmap snd (lappend (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E'')) (llist_of (map (Pair t_w) (take (n_w + 1) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>))))"
     have len_EE'': "llength ?EE'' = enat (w' + 1)" using n_w m_w
       apply(simp add: w_sum)
       apply(subst llength_lconcat_lfinite_conv_sum)
       apply(simp_all add: split_beta plus_enat_simps(1)[symmetric] add_Suc_right[symmetric] del: plus_enat_simps(1) add_Suc_right)
-      apply(subst sum_hom[symmetric, where f=enat])
+      apply(subst sum_comp_morphism[symmetric, where h=enat])
       apply(simp_all add: zero_enat_def min_def le_Suc_eq)
       apply(rule sum.cong)
       apply(auto simp add: lnth_ltake less_trans[where y="enat m_w"])
       done
     have prefix: "lprefix ?EE'' (lmap snd E')" unfolding E''
       by(subst (2) E'_unfold)(rule lmap_lprefix, clarsimp simp add: lmap_lappend_distrib E''_m_w lprefix_lappend2I[OF lprefix_llist_ofI[OF exI[where x="map (Pair t_w) (drop (n_w + 1) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>)"]]] map_append[symmetric])
 
     from iwa False have iwa': "is_write_action (action_obs E' w')" by(simp add: E' action_obs_def lnth_lappend w'_def)
     from ns False
     have "non_speculative P (vs_type_all P) (lmap snd (ltake (enat w') E'))"
       by(simp add: E' ltake_lappend lmap_lappend_distrib non_speculative_lappend ldropn_lappend2 w'_def)
     with iwa'
     have "non_speculative P (vs_type_all P) (lappend (lmap snd (ltake (enat w') E')) (LCons (action_obs E' w') LNil))"
       by cases(simp_all add: non_speculative_lappend)
     also have "lappend (lmap snd (ltake (enat w') E')) (LCons (action_obs E' w') LNil) = lmap snd (ltake (enat (w' + 1)) E')"
       using w'_len by(simp add: ltake_Suc_conv_snoc_lnth lmap_lappend_distrib action_obs_def)
     also {
       have "lprefix (lmap snd (ltake (enat (w' + 1)) E')) (lmap snd E')" by(rule lmap_lprefix) simp
       with prefix have "lprefix ?EE'' (lmap snd (ltake (enat (w' + 1)) E')) \<or> 
         lprefix (lmap snd (ltake (enat (w' + 1)) E')) ?EE''"
         by(rule lprefix_down_linear)
       moreover have "llength (lmap snd (ltake (enat (w' + 1)) E')) = enat (w' + 1)"
         using w'_len by(cases "llength E'") simp_all
       ultimately have "lmap snd (ltake (enat (w' + 1)) E') = ?EE''"
         using len_EE'' by(auto dest: lprefix_llength_eq_imp_eq) }
     finally
     have ns1: "non_speculative P (vs_type_all P) (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?m_E''))))"
       and ns2: "non_speculative P (w_values P (vs_type_all P) (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E''))))) (llist_of (take (Suc n_w) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>))"
       by(simp_all add: lmap_lappend_distrib non_speculative_lappend split_beta lconcat_llist_of[symmetric] lmap_lconcat llist.map_comp o_def split_def list_of_lmap[symmetric] del: list_of_lmap)
 
     have "vs_conf P (vs_type_all P)" by simp
     with \<sigma>_\<sigma>' wfx' ns1
     have wfx': "ts_ok (init_fin_lift wfx) (thr \<sigma>') (shr \<sigma>')"
       and vs_conf: "vs_conf P (w_values P (vs_type_all P) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?m_E''))))"
       by(rule h.if_RedT_non_speculative_invar[unfolded h.mthr.if.RedT_def heap_independent])+
     
     have "concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?m_E'')) = map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E'')))"
       by(simp add: split_def lmap_lconcat llist.map_comp o_def list_of_lconcat map_concat)
     with vs_conf have "vs_conf P (w_values P (vs_type_all P) \<dots>)" by simp
     with red_w wfx' ns2
     have vs_conf': "vs_conf P (w_values P (w_values P (vs_type_all P) (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E''))))) (take (Suc n_w) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>))"
       (is "vs_conf _ ?vs'")
       by(rule h.if_redT_non_speculative_vs_conf[unfolded heap_independent])
 
     from len_EE'' have "enat w' < llength ?EE''" by simp
     from w'_len have "lnth ?EE'' w' = action_obs E' w'"
       using lprefix_lnthD[OF prefix \<open>enat w' < llength ?EE''\<close>] by(simp add: action_obs_def)
     hence "\<dots> \<in> lset ?EE''" using \<open>enat w' < llength ?EE''\<close> unfolding lset_conv_lnth by(auto intro!: exI)
     also have "\<dots> \<subseteq> set (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E''))) @ take (Suc n_w) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>)"
       by(auto 4 4 intro: rev_image_eqI rev_bexI simp add: split_beta lset_lconcat_lfinite dest: lset_lappend[THEN subsetD])
     also have "action_obs E' w' = action_obs E w"
       using False by(simp add: E' w'_def lnth_lappend action_obs_def)
     also note obs_w_in_set = calculation and calculation = nothing
 
     from iwa have "?v \<in> w_values P (vs_type_all P) (map snd (list_of (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ?m_E''))) @ take (Suc n_w) \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>) (ad, al)"
     proof(cases)
       case (WriteMem ad' al' v')
       with adal have "ad' = ad" "al' = al" "?v = v'" by(simp_all add: value_written.simps)
       with obs_w_in_set WriteMem show ?thesis
         by -(rule w_values_WriteMemD, simp)
     next
       case (NewHeapElem ad' CTn)
       with adal have [simp]: "ad' = ad" and v: "?v = addr_loc_default P CTn al" 
         by(auto simp add: value_written.simps)
       with obs_w_in_set NewHeapElem adal show ?thesis
         by(unfold v)(rule w_values_new_actionD, simp_all)
     qed
     hence "?v \<in> ?vs' (ad, al)" by simp
     with vs_conf' show "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> ?v :\<le> T"
       by(rule h.vs_confD[unfolded heap_independent])
   qed
 qed
 
 lemma hb_read_value_typeable:
   assumes wfx_start: "ts_ok wfx (thr (h.start_state f P C M vs)) h.start_heap" 
     (is "ts_ok wfx (thr ?start_state) _")
   and wfP: "wf_syscls P"
   and E: "E \<in> h.\<E>_start f P C M vs status"
   and wf: "P \<turnstile> (E, ws) \<surd>"
   and races: "\<And>a ad al v. \<lbrakk> enat a < llength E; action_obs E a = NormalAction (ReadMem ad al v); \<not> P,E \<turnstile> ws a \<le>hb a \<rbrakk>
               \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
   and r: "enat a < llength E"
   and read: "action_obs E a = NormalAction (ReadMem ad al v)"
   shows "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 using r read
 proof(induction a arbitrary: ad al v rule: less_induct)
   case (less a)
   note r = \<open>enat a < llength E\<close>
     and read = \<open>action_obs E a = NormalAction (ReadMem ad al v)\<close>
   show ?case
   proof(cases "P,E \<turnstile> ws a \<le>hb a")
     case False with r read show ?thesis by(rule races)
   next
     case True
     note hb = this
     hence ao: "E \<turnstile> ws a \<le>a a" by(rule happens_before_into_action_order)
 
     from wf have ws: "is_write_seen P E ws" by(rule wf_exec_is_write_seenD)
     from r have "a \<in> actions E" by(simp add: actions_def)
     hence "a \<in> read_actions E" using read ..
     from is_write_seenD[OF ws this read]
     have "write": "ws a \<in> write_actions E" 
       and adal_w: "(ad, al) \<in> action_loc P E (ws a)"
       and written: "value_written P E (ws a) (ad, al) = v" by simp_all
     from "write" have iwa: "is_write_action (action_obs E (ws a))" by cases
 
     let ?start_state = "init_fin_lift_state status (h.start_state f P C M vs)"
       and ?start_obs = "lift_start_obs h.start_tid h.start_heap_obs"
 
     show ?thesis
     proof(cases "ws a < a")
       case True
       let ?EE'' = "lmap snd (ltake (enat (ws a)) E)"
 
       have "non_speculative P (vs_type_all P) ?EE''"
       proof(rule non_speculative_nthI)
         fix i ad' al' v'
         assume i: "enat i < llength ?EE''"
           and nth_i: "lnth ?EE'' i = NormalAction (ReadMem ad' al' v')"
         
         from i have "i < ws a" by simp
         hence i': "i < a" using True by(simp)
         moreover
         with r have "enat i < llength E" by(metis enat_ord_code(2) order_less_trans) 
         moreover
         with nth_i i \<open>i < ws a\<close>
         have "action_obs E i = NormalAction (ReadMem ad' al' v')"
           by(simp add: action_obs_def lnth_ltake ac_simps)
         ultimately have "\<exists>T. P \<turnstile> ad'@al' : T \<and> P \<turnstile> v' :\<le> T" by(rule less.IH)
         hence "v' \<in> vs_type_all P (ad', al')" by(simp add: vs_type_all.simps)
         thus "v' \<in> w_values P (vs_type_all P) (list_of (ltake (enat i) ?EE'')) (ad', al')"
           by(rule w_values_mono[THEN subsetD])
       qed
       with wfx_start wfP E "write" adal_w
       show ?thesis unfolding written[symmetric] by(rule non_speculative_written_value_typeable)
     next
       case False
       
       from E obtain E' where E': "E = lappend (llist_of ?start_obs) E'"
         and \<E>: "E' \<in> h.mthr.if.\<E> ?start_state" by blast
       from \<E> obtain E'' where E'': "E' = lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E'')"
         and Runs: "h.mthr.if.mthr.Runs ?start_state E''"
         by-(rule h.mthr.if.\<E>.cases[OF \<E>])
 
       have wfx': "ts_ok (init_fin_lift wfx) (thr ?start_state) (shr ?start_state)"
         using wfx_start by(simp add: h.shr_start_state)
 
       have a_start: "\<not> a < length ?start_obs"
       proof
         assume "a < length ?start_obs"
         with read have "NormalAction (ReadMem ad al v) \<in> snd ` set ?start_obs"
           unfolding set_map[symmetric] in_set_conv_nth
           by(auto simp add: E' lnth_lappend action_obs_def)
         hence "ReadMem ad al v \<in> set h.start_heap_obs" by auto
         thus False by(simp add: h.start_heap_obs_not_Read)
       qed
       hence ws_a_not_le: "\<not> ws a < length ?start_obs" using False by simp
 
       define w where "w = ws a - length ?start_obs"
       from "write" ws_a_not_le w_def
       have "enat w < llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E''))"
         by(cases "llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E''))")(auto simp add: actions_def E' E'' elim: write_actions.cases)
       with Runs obtain m_w n_w t_w ta_w 
         where E'_w: "lnth E' w = (t_w, \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub> ! n_w)"
         and n_w: "n_w < length \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>"
         and m_w: "enat m_w < llength E''"
         and w_sum: "w = (\<Sum>i<m_w. length \<lbrace>snd (lnth E'' i)\<rbrace>\<^bsub>o\<^esub>) + n_w"
         and E''_m_w: "lnth E'' m_w = (t_w, ta_w)"
         unfolding E'' by(rule h.mthr.if.actions_\<E>E_aux)
 
       from E'_w have obs_w: "action_obs E (ws a) = \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub> ! n_w"
         using ws_a_not_le E' w_def by(simp add: action_obs_def lnth_lappend)
 
       let ?E'' = "ldropn (Suc m_w) E''"
       let ?m_E'' = "ltake (enat m_w) E''"
       have E'_unfold: "E'' = lappend ?m_E'' (LCons (lnth E'' m_w) ?E'')"
         unfolding ldropn_Suc_conv_ldropn[OF m_w] by simp
       hence "h.mthr.if.mthr.Runs ?start_state (lappend ?m_E'' (LCons (lnth E'' m_w) ?E''))"
         using Runs by simp
       then obtain \<sigma>' where \<sigma>_\<sigma>': "h.mthr.if.mthr.Trsys ?start_state (list_of ?m_E'') \<sigma>'"
         and Runs': "h.mthr.if.mthr.Runs \<sigma>' (LCons (lnth E'' m_w) ?E'')"
         by(rule h.mthr.if.mthr.Runs_lappendE) simp
       from Runs' obtain \<sigma>''' where red_w: "h.mthr.if.redT \<sigma>' (t_w, ta_w) \<sigma>'''"
         and Runs'': "h.mthr.if.mthr.Runs \<sigma>''' ?E''"
         unfolding E''_m_w by cases
 
       from "write" \<open>a \<in> read_actions E\<close> have "ws a \<noteq> a" by(auto dest: read_actions_not_write_actions)
       with False have "ws a > a" by simp
       with ao have new: "is_new_action (action_obs E (ws a))"
         by(simp add: action_order_def split: if_split_asm)
       then obtain CTn where obs_w': "action_obs E (ws a) = NormalAction (NewHeapElem ad CTn)" 
         using adal_w by cases auto
 
       define a' where "a' = a - length ?start_obs"
       with False w_def
       have "enat a' < llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E''))"
         by(simp add: le_less_trans[OF _ \<open>enat w < llength (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) E''))\<close>])
       with Runs obtain m_a n_a t_a ta_a 
         where E'_a: "lnth E' a' = (t_a, \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub> ! n_a)"
         and n_a: "n_a < length \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>"
         and m_a: "enat m_a < llength E''"
         and a_sum: "a' = (\<Sum>i<m_a. length \<lbrace>snd (lnth E'' i)\<rbrace>\<^bsub>o\<^esub>) + n_a"
         and E''_m_a: "lnth E'' m_a = (t_a, ta_a)"
         unfolding E'' by(rule h.mthr.if.actions_\<E>E_aux)
         
       from a_start E'_a read have obs_a: "\<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub> ! n_a = NormalAction (ReadMem ad al v)"
         using E' w_def by(simp add: action_obs_def lnth_lappend a'_def)
       
       let ?E'' = "ldropn (Suc m_a) E''"
       let ?m_E'' = "ltake (enat m_a) E''"
       have E'_unfold: "E'' = lappend ?m_E'' (LCons (lnth E'' m_a) ?E'')"
         unfolding ldropn_Suc_conv_ldropn[OF m_a] by simp
       hence "h.mthr.if.mthr.Runs ?start_state (lappend ?m_E'' (LCons (lnth E'' m_a) ?E''))"
         using Runs by simp
       then obtain \<sigma>'' where \<sigma>_\<sigma>'': "h.mthr.if.mthr.Trsys ?start_state (list_of ?m_E'') \<sigma>''"
         and Runs'': "h.mthr.if.mthr.Runs \<sigma>'' (LCons (lnth E'' m_a) ?E'')"
         by(rule h.mthr.if.mthr.Runs_lappendE) simp
       from Runs'' obtain \<sigma>''' where red_a: "h.mthr.if.redT \<sigma>'' (t_a, ta_a) \<sigma>'''"
         and Runs'': "h.mthr.if.mthr.Runs \<sigma>''' ?E''"
         unfolding E''_m_a by cases
 
       let ?EE'' = "llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?m_E'')))"
       from m_a have "enat m_a \<le> llength E''" by simp
       hence len_EE'': "llength ?EE'' = enat (a' - n_a)"
         by(simp add: a_sum length_concat sum_list_sum_nth atLeast0LessThan length_list_of_conv_the_enat min_def split_beta lnth_ltake)
       have prefix: "lprefix ?EE'' (lmap snd E')" unfolding E''
         by(subst (2) E'_unfold)(simp add: lmap_lappend_distrib  lmap_lconcat llist.map_comp o_def split_def lconcat_llist_of[symmetric] lmap_llist_of[symmetric] lprefix_lappend2I del: lmap_llist_of)
       
       have ns: "non_speculative P (vs_type_all P) ?EE''"
       proof(rule non_speculative_nthI)
         fix i ad' al' v'
         assume i: "enat i < llength ?EE''"
           and lnth_i: "lnth ?EE'' i = NormalAction (ReadMem ad' al' v')"
           and "non_speculative P (vs_type_all P) (ltake (enat i) ?EE'')"
         
         let ?i = "i + length ?start_obs"
         
         from i len_EE'' have "i < a'" by simp
         hence i': "?i < a" by(simp add: a'_def)
         moreover
         hence "enat ?i < llength E" using \<open>enat a < llength E\<close> by(simp add: less_trans[where y="enat a"])
         moreover have "enat i < llength E'" using i
           by -(rule less_le_trans[OF _ lprefix_llength_le[OF prefix], simplified], simp)          
         from lprefix_lnthD[OF prefix i] lnth_i
         have "lnth (lmap snd E') i = NormalAction (ReadMem ad' al' v')" by simp
         hence "action_obs E ?i = NormalAction (ReadMem ad' al' v')" using \<open>enat i < llength E'\<close>
           by(simp add: E' action_obs_def lnth_lappend E'')
         ultimately have "\<exists>T. P \<turnstile> ad'@al' : T \<and> P \<turnstile> v' :\<le> T" by(rule less.IH)
         hence "v' \<in> vs_type_all P (ad', al')" by(simp add: vs_type_all.simps)
         thus "v' \<in> w_values P (vs_type_all P) (list_of (ltake (enat i) ?EE'')) (ad', al')"
           by(rule w_values_mono[THEN subsetD])
       qed
         
       have "vs_conf P (vs_type_all P)" by simp
       with \<sigma>_\<sigma>'' wfx' ns
       have wfx'': "ts_ok (init_fin_lift wfx) (thr \<sigma>'') (shr \<sigma>'')" 
         and vs'': "vs_conf P (w_values P (vs_type_all P) (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (list_of ?m_E''))))"
         by(rule h.if_RedT_non_speculative_invar[unfolded heap_independent h.mthr.if.RedT_def])+
 
       note red_w moreover
       from n_w obs_w obs_w' have "NormalAction (NewHeapElem ad CTn) \<in> set \<lbrace>ta_w\<rbrace>\<^bsub>o\<^esub>"
         unfolding in_set_conv_nth by auto
       moreover
       have ta_a_read: "NormalAction (ReadMem ad al v) \<in> set \<lbrace>ta_a\<rbrace>\<^bsub>o\<^esub>"
         using n_a obs_a unfolding in_set_conv_nth by blast
       from red_a have "\<exists>T. P \<turnstile> ad@al : T"
       proof(cases)
         case (redT_normal x x' h')
         from wfx'' \<open>thr \<sigma>'' t_a = \<lfloor>(x, no_wait_locks)\<rfloor>\<close>
         have "init_fin_lift wfx t_a x (shr \<sigma>'')" by(rule ts_okD)
         with \<open>t_a \<turnstile> (x, shr \<sigma>'') -ta_a\<rightarrow>i (x', h')\<close>
         show ?thesis using ta_a_read
           by(rule h.init_fin_red_read_typeable[unfolded heap_independent])
       next
         case redT_acquire thus ?thesis using n_a obs_a ta_a_read by auto
       qed
       hence "typeof_addr ad \<noteq> None" by(auto elim: addr_loc_type_cases)
       ultimately have "typeof_addr ad = \<lfloor>CTn\<rfloor>" by(rule if_redT_NewHeapElem_typed)
       with written adal_w obs_w' show ?thesis
         by(cases al)(auto simp add: value_written.simps intro: addr_loc_type_intros h.addr_loc_default_conf[unfolded heap_independent])
     qed
   qed
 qed
 
 theorem 
   assumes wfx_start: "ts_ok wfx (thr (h.start_state f P C M vs)) h.start_heap" 
   and wfP: "wf_syscls P"
   and justified: "P \<turnstile> (E, ws) weakly_justified_by J"
   and J: "range (justifying_exec \<circ> J) \<subseteq> h.\<E>_start f P C M vs status"
   shows read_value_typeable_justifying:
     "\<lbrakk> 0 < n; enat a < llength (justifying_exec (J n));
       action_obs (justifying_exec (J n)) a = NormalAction (ReadMem ad al v) \<rbrakk>
     \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T" 
   and read_value_typeable_justifed:
     "\<lbrakk> E \<in> h.\<E>_start f P C M vs status; P \<turnstile> (E, ws) \<surd>;
        enat a < llength E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
     \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 proof -
   let ?E = "\<lambda>n. justifying_exec (J n)"
     and ?\<phi> = "\<lambda>n. action_translation (J n)"
     and ?C = "\<lambda>n. committed (J n)"
     and ?ws = "\<lambda>n. justifying_ws (J n)"
   let ?\<E> = "h.\<E>_start f P C M vs status"
     and ?start_obs = "lift_start_obs h.start_tid h.start_heap_obs"
   { fix a n
     assume "enat a < llength (justifying_exec (J n))"
       and "action_obs (justifying_exec (J n)) a = NormalAction (ReadMem ad al v)"
       and "n > 0"
     thus "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
     proof(induction n arbitrary: a ad al v)
       case 0 thus ?case by simp
     next
       case (Suc n')
       define n where "n = Suc n'"
       with Suc have n: "0 < n" and a: "enat a < llength (?E n)"
         and a_obs: "action_obs (?E n) a = NormalAction (ReadMem ad al v)"
         by simp_all
       have wf_n: "P \<turnstile> (?E n, ?ws n) \<surd>"
         using justified by(simp add: justification_well_formed_def)
       from J have E: "?E n \<in> ?\<E>" 
         and E': "?E n' \<in> ?\<E>" by auto
       from a a_obs wfx_start wfP E wf_n show ?case
       proof(rule hb_read_value_typeable[rotated -2])
         fix a' ad' al' v'
         assume a': "enat a' < llength (?E n)"
           and a'_obs: "action_obs (?E n) a' = NormalAction (ReadMem ad' al' v')"
           and nhb: "\<not> P,?E n \<turnstile> ?ws n a' \<le>hb a'"
         from a' have "a' \<in> actions (?E n)" by(simp add: actions_def)
         hence read_a': "a' \<in> read_actions (?E n)" using a'_obs ..
         with justified nhb have committed': "?\<phi> n a' \<in> ?\<phi> n' ` ?C n'"
           unfolding is_weakly_justified_by.simps n_def uncommitted_reads_see_hb_def by blast
 
         from justified have wfa_n: "wf_action_translation E (J n)"
           and wfa_n': "wf_action_translation E (J n')" by(simp_all add: wf_action_translations_def)
         hence inj_n: "inj_on (?\<phi> n) (actions (?E n))"
           and inj_n': "inj_on (?\<phi> n') (actions (?E n'))"
           by(blast dest: wf_action_translation_on_inj_onD)+
         from justified have C_n: "?C n \<subseteq> actions (?E n)"
           and C_n': "?C n' \<subseteq> actions (?E n')"
           and wf_n': "P \<turnstile> (?E n', ?ws n') \<surd>"
           by(simp_all add: committed_subset_actions_def justification_well_formed_def)
 
         from justified have "?\<phi> n' ` ?C n' \<subseteq> ?\<phi> n ` ?C n"
           unfolding n_def by(simp add: is_commit_sequence_def)
         with n_def committed' have "?\<phi> n a' \<in> ?\<phi> n ` ?C n" by auto
         with inj_n C_n have committed: "a' \<in> ?C n"
           using \<open>a' \<in> actions (?E n)\<close> by(auto dest: inj_onD)
         with justified read_a' have ws_committed: "ws (?\<phi> n a') \<in> ?\<phi> n ` ?C n"
           by(rule weakly_justified_write_seen_hb_read_committed)
 
         from wf_n have ws_n: "is_write_seen P (?E n) (?ws n)" by(rule wf_exec_is_write_seenD)
         from is_write_seenD[OF this read_a' a'_obs]
         have ws_write: "?ws n a' \<in> write_actions (?E n)"
           and adal: "(ad', al') \<in> action_loc P (?E n) (?ws n a')"
           and written: "value_written P (?E n) (?ws n a') (ad', al') = v'" by simp_all
 
         define a'' where "a'' = inv_into (actions (?E n')) (?\<phi> n') (?\<phi> n a')"
         from C_n' n committed' have "?\<phi> n a' \<in> ?\<phi> n' ` actions (?E n')" by auto
         hence a'': "?\<phi> n' a'' = ?\<phi> n a'"
           and a''_action: "a'' \<in> actions (?E n')" using inj_n' committed' n
           by(simp_all add: a''_def f_inv_into_f inv_into_into)
         hence committed'': "a'' \<in> ?C n'" using committed' n inj_n' C_n' by(fastforce dest: inj_onD)
 
         from committed committed'' wfa_n wfa_n' a'' have "action_obs (?E n') a'' \<approx> action_obs (?E n) a'"
           by(auto dest!: wf_action_translation_on_actionD intro: sim_action_trans sim_action_sym)
         with a'_obs committed'' C_n' have read_a'': "a'' \<in> read_actions (?E n')"
           by(auto intro: read_actions.intros)
 
         then obtain ad'' al'' v'' 
           where a''_obs: "action_obs (?E n') a'' = NormalAction (ReadMem ad'' al'' v'')" by cases
 
         from committed'' have "n' > 0" using justified 
           by(cases n')(simp_all add: is_commit_sequence_def)
         then obtain n'' where n'': "n' = Suc n''" by(cases n') simp_all
 
         from justified have wfa_n'': "wf_action_translation E (J n'')" by(simp add: wf_action_translations_def)
         hence inj_n'': "inj_on (?\<phi> n'') (actions (?E n''))" by(blast dest: wf_action_translation_on_inj_onD)+
         from justified have C_n'': "?C n'' \<subseteq> actions (?E n'')" by(simp add: committed_subset_actions_def)
 
         from justified committed' committed'' n_def read_a' read_a'' n
         have "?\<phi> n (?ws n (inv_into (actions (?E n)) (?\<phi> n) (?\<phi> n' a''))) = ws (?\<phi> n' a'')"
           by(simp add: write_seen_committed_def)
         hence "?\<phi> n (?ws n a') = ws (?\<phi> n a')" using inj_n \<open>a' \<in> actions (?E n)\<close> by(simp add: a'')
 
         from ws_committed obtain w where w: "ws (?\<phi> n a') = ?\<phi> n w" 
           and committed_w: "w \<in> ?C n" by blast
         from committed_w C_n have "w \<in> actions (?E n)" by blast
         hence w_def: "w = ?ws n a'" using \<open>?\<phi> n (?ws n a') = ws (?\<phi> n a')\<close> inj_n ws_write
           unfolding w by(auto dest: inj_onD)
         have committed_ws: "?ws n a' \<in> ?C n" using committed_w by(simp add: w_def)
 
         with wfa_n have sim_ws: "action_obs (?E n) (?ws n a') \<approx> action_obs E (?\<phi> n (?ws n a'))"
           by(blast dest: wf_action_translation_on_actionD)
 
         from wfa_n committed_ws have sim_ws: "action_obs (?E n) (?ws n a') \<approx> action_obs E (?\<phi> n (?ws n a'))"
           by(blast dest: wf_action_translation_on_actionD)
         with adal have adal_E: "(ad', al') \<in> action_loc P E (?\<phi> n (?ws n a'))"
           by(simp add: action_loc_aux_sim_action)
 
         have "\<exists>w \<in> write_actions (?E n'). (ad', al') \<in> action_loc P (?E n') w \<and> value_written P (?E n') w (ad', al') = v'"
         proof(cases "?\<phi> n' a'' \<in> ?\<phi> n'' ` ?C n''")
           case True
           then obtain a''' where a''': "?\<phi> n'' a''' = ?\<phi> n' a''" 
             and committed''': "a''' \<in> ?C n''" by auto
           from committed''' C_n'' have a'''_action: "a''' \<in> actions (?E n'')" by auto
           
           from committed'' committed''' wfa_n' wfa_n'' a''' have "action_obs (?E n'') a''' \<approx> action_obs (?E n') a''"
             by(auto dest!: wf_action_translation_on_actionD intro: sim_action_trans sim_action_sym)
           with read_a'' committed''' C_n'' have read_a''': "a''' \<in> read_actions (?E n'')"
             by cases(auto intro: read_actions.intros)
           
           hence "?\<phi> n' (?ws n' (inv_into (actions (?E n')) (?\<phi> n') (?\<phi> n'' a'''))) = ws (?\<phi> n'' a''')"
             using justified committed'''
             unfolding is_weakly_justified_by.simps n'' Let_def write_seen_committed_def by blast
           also have "inv_into (actions (?E n')) (?\<phi> n') (?\<phi> n'' a''') = a''"
             using a''' inj_n' a''_action by(simp)
           also note a''' also note a''
           finally have \<phi>_n': "?\<phi> n' (?ws n' a'') = ws (?\<phi> n a')" .
           then have "ws (?\<phi> n a') = ?\<phi> n' (?ws n' a'')" ..
           with \<open>?\<phi> n (?ws n a') = ws (?\<phi> n a')\<close>[symmetric]
           have eq_ws: "?\<phi> n' (?ws n' a'') = ?\<phi> n (?ws n a')" by simp
 
           from wf_n'[THEN wf_exec_is_write_seenD, THEN is_write_seenD, OF read_a'' a''_obs]
           have ws_write': "?ws n' a'' \<in> write_actions (?E n')" by simp
 
           from justified read_a'' committed''
           have "ws (?\<phi> n' a'') \<in> ?\<phi> n' ` ?C n'" by(rule weakly_justified_write_seen_hb_read_committed)
           then obtain w' where w': "ws (?\<phi> n' a'') = ?\<phi> n' w'"
             and committed_w': "w' \<in> ?C n'" by blast
           from committed_w' C_n' have "w' \<in> actions (?E n')" by blast
           hence w'_def: "w' = ?ws n' a''" using \<phi>_n' inj_n' ws_write'
             unfolding w' a''[symmetric] by(auto dest: inj_onD)
           with committed_w' have committed_ws'': "?ws n' a'' \<in> committed (J n')" by simp
           with committed_ws wfa_n wfa_n' eq_ws
           have "action_obs (?E n') (?ws n' a'') \<approx> action_obs (?E n) (?ws n a')"
             by(auto dest!: wf_action_translation_on_actionD intro: sim_action_trans sim_action_sym)
           hence adal_eq: "action_loc P (?E n') (?ws n' a'') = action_loc P (?E n) (?ws n a')"
             by(simp add: action_loc_aux_sim_action)
           with adal have adal': "(ad', al') \<in> action_loc P (?E n') (?ws n' a'')" by(simp add: action_loc_aux_sim_action)
           
           from committed_ws'' have "?ws n' a'' \<in> actions (?E n')" using C_n' by blast
           with ws_write \<open>action_obs (?E n') (?ws n' a'') \<approx> action_obs (?E n) (?ws n a')\<close> 
           have ws_write'': "?ws n' a'' \<in> write_actions (?E n')" 
             by(cases)(auto intro: write_actions.intros simp add: sim_action_is_write_action_eq)
           from wfa_n' committed_ws''
           have sim_ws': "action_obs (?E n') (?ws n' a'') \<approx> action_obs E (?\<phi> n' (?ws n' a''))"
             by(blast dest: wf_action_translation_on_actionD)
           with adal' have adal'_E: "(ad', al') \<in> action_loc P E (?\<phi> n' (?ws n' a''))"
             by(simp add: action_loc_aux_sim_action)
           
           from justified committed_ws ws_write adal_E
           have "value_written P (?E n) (?ws n a') (ad', al') = value_written P E (?\<phi> n (?ws n a')) (ad', al')"
             unfolding is_weakly_justified_by.simps Let_def value_written_committed_def by blast
           also note eq_ws[symmetric]
           also from justified committed_ws'' ws_write'' adal'_E
           have "value_written P E (?\<phi> n' (?ws n' a'')) (ad', al') = value_written P (?E n') (?ws n' a'') (ad', al')"
             unfolding is_weakly_justified_by.simps Let_def value_written_committed_def by(blast dest: sym)
           finally show ?thesis using written ws_write'' adal' by auto
         next
           case False
           with justified read_a'' committed''
           have "ws (?\<phi> n' a'') \<in> ?\<phi> n'' ` ?C n''"
             unfolding is_weakly_justified_by.simps Let_def n'' committed_reads_see_committed_writes_weak_def by blast
           with a'' obtain w where w: "?\<phi> n'' w = ws (?\<phi> n a')"
             and committed_w: "w \<in> ?C n''" by auto
           from justified have "?\<phi> n'' ` ?C n'' \<subseteq> ?\<phi> n' ` ?C n'" by(simp add: is_commit_sequence_def n'')
           with committed_w w[symmetric] have "ws (?\<phi> n a') \<in> ?\<phi> n' ` ?C n'" by(auto)
           then obtain w' where w': "ws (?\<phi> n a') = ?\<phi> n' w'" and committed_w': "w' \<in> ?C n'" by blast
           from wfa_n' committed_w' have "action_obs (?E n') w' \<approx> action_obs E (?\<phi> n' w')"
             by(blast dest: wf_action_translation_on_actionD)
           from this[folded w', folded \<open>?\<phi> n (?ws n a') = ws (?\<phi> n a')\<close>] sim_ws[symmetric]
           have sim_w': "action_obs (?E n') w' \<approx> action_obs (?E n) (?ws n a')" by(rule sim_action_trans)
           with ws_write committed_w' C_n' have write_w': "w' \<in> write_actions (?E n')"
             by(cases)(auto intro!: write_actions.intros simp add: sim_action_is_write_action_eq)
           hence "value_written P (?E n') w' (ad', al') = value_written P E (?\<phi> n' w') (ad', al')"
             using adal_E committed_w' justified
             unfolding \<open>?\<phi> n (?ws n a') = ws (?\<phi> n a')\<close> w' is_weakly_justified_by.simps Let_def value_written_committed_def by blast
           also note w'[symmetric] 
           also note \<open>?\<phi> n (?ws n a') = ws (?\<phi> n a')\<close>[symmetric]
           also have "value_written P E (?\<phi> n (?ws n a')) (ad', al') = value_written P (?E n) (?ws n a') (ad', al')"
             using justified committed_ws ws_write adal_E 
             unfolding is_weakly_justified_by.simps Let_def value_written_committed_def by(blast dest: sym)
           also have "(ad', al') \<in> action_loc P (?E n') w'" using sim_w' adal by(simp add: action_loc_aux_sim_action)
           ultimately show ?thesis using written write_w' by auto
         qed
         then obtain w where w: "w \<in> write_actions (?E n')"
           and adal: "(ad', al') \<in> action_loc P (?E n') w"
           and written: "value_written P (?E n') w (ad', al') = v'" by blast
         from w have w_len: "enat w < llength (?E n')"
           by(cases)(simp add: actions_def)
 
         let ?EE'' = "lmap snd (ltake (enat w) (?E n'))"
         have "non_speculative P (vs_type_all P) ?EE''"
         proof(rule non_speculative_nthI)
           fix i ad al v
           assume i: "enat i < llength ?EE''"
             and i_nth: "lnth ?EE'' i = NormalAction (ReadMem ad al v)"
             and ns: "non_speculative P (vs_type_all P) (ltake (enat i) ?EE'')"
 
           from i w_len have "i < w" by(simp add: min_def not_le split: if_split_asm)
           with w_len have "enat i < llength (?E n')" by(simp add: less_trans[where y="enat w"])
           moreover
           from i_nth i \<open>i < w\<close> w_len
           have "action_obs (?E n') i = NormalAction (ReadMem ad al v)"
             by(simp add: action_obs_def ac_simps less_trans[where y="enat w"] lnth_ltake)
           moreover from n'' have "0 < n'" by simp
           ultimately have "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T" by(rule Suc.IH)
           hence "v \<in> vs_type_all P (ad, al)" by(simp add: vs_type_all.simps)
           thus "v \<in> w_values P (vs_type_all P) (list_of (ltake (enat i) ?EE'')) (ad, al)"
             by(rule w_values_mono[THEN subsetD])
         qed
         with wfx_start wfP E' w adal
         show "\<exists>T. P \<turnstile> ad'@al' : T \<and> P \<turnstile> v' :\<le> T"
           unfolding written[symmetric] by(rule non_speculative_written_value_typeable)
       qed
     qed
   }
   note justifying = this
 
   assume a: "enat a < llength E"
     and read: "action_obs E a = NormalAction (ReadMem ad al v)"
     and E: "E \<in> h.\<E>_start f P C M vs status"
     and wf: "P \<turnstile> (E, ws) \<surd>"
   from a have action: "a \<in> actions E" by(auto simp add: actions_def action_obs_def)
   with justified obtain n a' where a': "a = ?\<phi> n a'"
     and committed': "a' \<in> ?C n" by(auto simp add: is_commit_sequence_def)
   from justified have C_n: "?C n \<subseteq> actions (?E n)"
     and C_Sn: "?C (Suc n) \<subseteq> actions (?E (Suc n))"
     and wf_tr: "wf_action_translation E (J n)" 
     and wf_tr': "wf_action_translation E (J (Suc n))"
     by(auto simp add: committed_subset_actions_def wf_action_translations_def)
   from C_n committed' have action': "a' \<in> actions (?E n)" by blast
   from wf_tr committed' a'
   have "action_tid E a = action_tid (?E n) a'" "action_obs E a \<approx> action_obs (?E n) a'"
     by(auto simp add: wf_action_translation_on_def intro: sim_action_sym)
   with read obtain v'
     where "action_obs (?E n) a' = NormalAction (ReadMem ad al v')"
     by(clarsimp simp add: action_obs_def)
   with action' have read': "a' \<in> read_actions (?E n)" ..
 
   from justified have "?\<phi> n ` ?C n \<subseteq> ?\<phi> (Suc n) ` ?C (Suc n)"
     by(simp add: is_commit_sequence_def)
   with committed' a' have "a \<in> \<dots>" by auto
   then obtain a'' where a'': "a = ?\<phi> (Suc n) a''"
     and committed'': "a'' \<in> ?C (Suc n)" by auto
   from committed'' C_Sn have action'': "a'' \<in> actions (?E (Suc n))" by blast
   
   with wf_tr' have "a'' = inv_into (actions (?E (Suc n))) (?\<phi> (Suc n)) a"
     by(simp add: a'' wf_action_translation_on_def)
   with justified read' committed' a' have ws_a: "ws a = ?\<phi> (Suc n) (?ws (Suc n) a'')"
     by(simp add: write_seen_committed_def)
 
   from wf_tr' committed'' a''
   have "action_tid E a = action_tid (?E (Suc n)) a''"
     and "action_obs E a \<approx> action_obs (?E (Suc n)) a''"
     by(auto simp add: wf_action_translation_on_def intro: sim_action_sym)
   with read obtain v''
     where a_obs'': "action_obs (?E (Suc n)) a'' = NormalAction (ReadMem ad al v'')"
     by(clarsimp simp add: action_obs_def)
   with action'' have read'': "a'' \<in> read_actions (?E (Suc n))"
     by(auto intro: read_actions.intros simp add: action_obs_def)
 
   have "a \<in> read_actions E" "action_obs E a = NormalAction (ReadMem ad al v)"
     using action read by(auto intro: read_actions.intros simp add: action_obs_def read)
   from is_write_seenD[OF wf_exec_is_write_seenD[OF wf] this]
   have v_eq: "v = value_written P E (ws a) (ad, al)" 
     and adal: "(ad, al) \<in> action_loc P E (ws a)" by simp_all
 
   from justified have "P \<turnstile> (?E (Suc n), ?ws (Suc n)) \<surd>" by(simp add: justification_well_formed_def)
   from is_write_seenD[OF wf_exec_is_write_seenD[OF this] read'' a_obs'']
   have write'': "?ws (Suc n) a'' \<in> write_actions (?E (Suc n))" 
     and written'': "value_written P (?E (Suc n)) (?ws (Suc n) a'') (ad, al) = v''" 
     by simp_all
 
   from justified read'' committed'' 
   have "ws (?\<phi> (Suc n) a'') \<in> ?\<phi> (Suc n) ` ?C (Suc n)"
     by(rule weakly_justified_write_seen_hb_read_committed)
   then obtain w where w: "ws (?\<phi> (Suc n) a'') = ?\<phi> (Suc n) w"
     and committed_w: "w \<in> ?C (Suc n)" by blast
   with C_Sn have "w \<in> actions (?E (Suc n))" by blast
   moreover have "ws (?\<phi> (Suc n) a'') = ?\<phi> (Suc n) (?ws (Suc n) a'')"
     using ws_a a'' by simp
   ultimately have w_def: "w = ?ws (Suc n) a''"
     using wf_action_translation_on_inj_onD[OF wf_tr'] write''
     unfolding w by(auto dest: inj_onD)
   with committed_w have "?ws (Suc n) a'' \<in> ?C (Suc n)" by simp
   hence "value_written P E (ws a) (ad, al) = value_written P (?E (Suc n)) (?ws (Suc n) a'') (ad, al)"
     using adal justified write'' by(simp add: value_written_committed_def ws_a)
   with v_eq written'' have "v = v''" by simp
 
   from read'' have "enat a'' < llength (?E (Suc n))" by(cases)(simp add: actions_def)
   thus "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
     by(rule justifying)(simp_all add: a_obs'' \<open>v = v''\<close>)
 qed
 
 corollary weakly_legal_read_value_typeable:
   assumes wfx_start: "ts_ok wfx (thr (h.start_state f P C M vs)) h.start_heap" 
   and wfP: "wf_syscls P"
   and legal: "weakly_legal_execution P (h.\<E>_start f P C M vs status) (E, ws)"
   and a: "enat a < llength E"
   and read: "action_obs E a = NormalAction (ReadMem ad al v)"
   shows "\<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 proof -
   from legal obtain J 
     where "P \<turnstile> (E, ws) weakly_justified_by J"
     and "range (justifying_exec \<circ> J) \<subseteq> h.\<E>_start f P C M vs status"
     and "E \<in> h.\<E>_start f P C M vs status"
     and "P \<turnstile> (E, ws) \<surd>" by(rule legal_executionE)
   with wfx_start wfP show ?thesis using a read by(rule read_value_typeable_justifed)
 qed
 
 corollary legal_read_value_typeable:
   "\<lbrakk> ts_ok wfx (thr (h.start_state f P C M vs)) h.start_heap; wf_syscls P;
      legal_execution P (h.\<E>_start f P C M vs status) (E, ws);
      enat a < llength E; action_obs E a = NormalAction (ReadMem ad al v) \<rbrakk>
   \<Longrightarrow> \<exists>T. P \<turnstile> ad@al : T \<and> P \<turnstile> v :\<le> T"
 by(erule (1) weakly_legal_read_value_typeable)(rule legal_imp_weakly_legal_execution)
 
 end
 
 end