(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory ArchDetSchedSchedule_AI
imports DetSchedSchedule_AI
begin

context Arch begin global_naming RISCV64

named_theorems DetSchedSchedule_AI_assms

crunch  prepare_thread_delete_idle_thread[wp, DetSchedSchedule_AI_assms]:
  prepare_thread_delete "\<lambda>(s:: det_ext state). P (idle_thread s)"

crunch valid_etcbs [wp, DetSchedSchedule_AI_assms]:
  arch_switch_to_idle_thread, arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers valid_etcbs
  (simp: crunch_simps)

crunch valid_queues [wp, DetSchedSchedule_AI_assms]:
  switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers valid_queues
  (simp: crunch_simps ignore: set_tcb_queue tcb_sched_action)

crunch weak_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
  switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers "weak_valid_sched_action"
  (simp: crunch_simps)

crunch ct_not_in_q[wp]: set_vm_root "ct_not_in_q"
  (wp: crunch_wps simp: crunch_simps)

crunch ct_not_in_q'[wp]: set_vm_root "\<lambda>s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t"
  (wp: crunch_wps simp: crunch_simps)

lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_queues and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
  apply (simp add: switch_to_idle_thread_def)
  apply wp
   apply (simp add: arch_switch_to_idle_thread_def)
   apply wp+
  apply (fastforce simp: valid_queues_def ct_not_in_q_def not_queued_def
                         valid_idle_def pred_tcb_at_def obj_at_def)
  done

crunch valid_sched_action'[wp]: set_vm_root "\<lambda>s. valid_sched_action_2 (scheduler_action s)
                                                 (ekheap s) (kheap s) thread (cur_domain s)"
  (wp: crunch_wps simp: crunch_simps)

lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_sched_action and valid_idle\<rbrace>
     switch_to_idle_thread
   \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
  apply (simp add: switch_to_idle_thread_def)
  apply wp
   apply (simp add: arch_switch_to_idle_thread_def do_machine_op_def split_def)
   apply wp+
  apply (clarsimp simp: valid_sched_action_def valid_idle_def is_activatable_def
                        pred_tcb_at_def obj_at_def)
  done

crunch ct_in_cur_domain'[wp]: set_vm_root "\<lambda>s. ct_in_cur_domain_2 t (idle_thread s)
                                                   (scheduler_action s) (cur_domain s) (ekheap s)"
  (wp: crunch_wps simp: crunch_simps)

lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
  by (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def
                split_def
      | wp
      | simp add: ct_in_cur_domain_def)+

crunch ct_not_in_q [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers ct_not_in_q
  (simp: crunch_simps wp: crunch_wps)

crunch is_activatable [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers "is_activatable t"
  (simp: crunch_simps)

crunch valid_sched_action [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers valid_sched_action
  (simp: crunch_simps)

crunch valid_sched [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers valid_sched
  (simp: crunch_simps)

crunch exst[wp]: set_vm_root "\<lambda>s. P (exst s)"
  (wp: crunch_wps whenE_wp simp: crunch_simps)

crunch ct_in_cur_domain_2 [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread
  "\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)"
  (simp: crunch_simps wp: assert_inv)

crunch valid_blocked[wp]: set_vm_root valid_blocked
  (simp: crunch_simps)

crunch ct_in_q[wp]: set_vm_root ct_in_q
  (simp: crunch_simps)

crunch etcb_at [wp, DetSchedSchedule_AI_assms]: switch_to_thread "etcb_at P t"

crunch valid_idle [wp, DetSchedSchedule_AI_assms]:
  arch_switch_to_idle_thread "valid_idle"
  (wp: crunch_wps simp: crunch_simps)

crunch etcb_at [wp, DetSchedSchedule_AI_assms]: arch_switch_to_idle_thread "etcb_at P t"

crunch scheduler_action [wp, DetSchedSchedule_AI_assms]:
  arch_switch_to_idle_thread, next_domain "\<lambda>s. P (scheduler_action s)"
  (simp: Let_def)

lemma set_vm_root_valid_blocked_ct_in_q [wp]:
  "\<lbrace>valid_blocked and ct_in_q\<rbrace> set_vm_root p \<lbrace>\<lambda>_. valid_blocked and ct_in_q\<rbrace>"
  by (wp | wpc | auto)+

lemma as_user_ct_in_q[wp]:
  "as_user tp S \<lbrace>ct_in_q\<rbrace>"
  apply (wpsimp simp: as_user_def set_object_def get_object_def)
  apply (clarsimp simp: ct_in_q_def st_tcb_at_def obj_at_def dest!: get_tcb_SomeD)
  done

lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_blocked and ct_in_q\<rbrace> arch_switch_to_thread thread \<lbrace>\<lambda>_. valid_blocked and ct_in_q\<rbrace>"
  by (wpsimp simp: arch_switch_to_thread_def)

lemma switch_to_idle_thread_ct_not_queued [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_queues and valid_etcbs and valid_idle\<rbrace>
     switch_to_idle_thread
   \<lbrace>\<lambda>rv s. not_queued (cur_thread s) s\<rbrace>"
  apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def
                   tcb_sched_action_def | wp)+
  apply (fastforce simp: valid_sched_2_def valid_queues_2_def valid_idle_def
                         pred_tcb_at_def obj_at_def not_queued_def)
  done

crunch valid_blocked_2[wp]: set_vm_root "\<lambda>s.
           valid_blocked_2 (ready_queues s) (kheap s)
            (scheduler_action s) thread"
  (wp: crunch_wps simp: crunch_simps)

lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_blocked and ct_in_q\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv. valid_blocked\<rbrace>"
  apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc)+
  apply clarsimp
  apply (drule(1) ct_in_q_valid_blocked_ct_upd)
  apply simp
  done

crunch exst [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread "\<lambda>s. P (exst s :: det_ext)"

crunch cur_thread[wp]: arch_switch_to_idle_thread "\<lambda>s. P (cur_thread s)"

lemma astit_st_tcb_at[wp]:
  "\<lbrace>st_tcb_at P t\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>rv. st_tcb_at P t\<rbrace>"
  apply (simp add: arch_switch_to_idle_thread_def)
  by (wpsimp)

lemma stit_activatable' [DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv . ct_in_state activatable\<rbrace>"
  apply (simp add: switch_to_idle_thread_def ct_in_state_def do_machine_op_def split_def)
  apply wpsimp
  apply (clarsimp simp: valid_idle_def ct_in_state_def pred_tcb_at_def obj_at_def)
  done

lemma switch_to_idle_thread_cur_thread_idle_thread [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_ s. cur_thread s = idle_thread s\<rbrace>"
  by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+

lemma set_pt_valid_etcbs[wp]:
  "\<lbrace>valid_etcbs\<rbrace> set_pt ptr pt \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
  by (wp hoare_drop_imps valid_etcbs_lift | simp add: set_pt_def)+

lemma set_asid_pool_valid_etcbs[wp]:
  "\<lbrace>valid_etcbs\<rbrace> set_asid_pool ptr pool \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
  by (wp hoare_drop_imps valid_etcbs_lift | simp add: set_asid_pool_def)+

lemma set_pt_valid_sched[wp]:
  "\<lbrace>valid_sched\<rbrace> set_pt ptr pt \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
  by (wp hoare_drop_imps valid_sched_lift | simp add: set_pt_def)+

lemma set_asid_pool_valid_sched[wp]:
  "\<lbrace>valid_sched\<rbrace> set_asid_pool ptr pool \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
  by (wp hoare_drop_imps valid_sched_lift | simp add: set_asid_pool_def)+

crunch ct_not_in_q [wp, DetSchedSchedule_AI_assms]:
  arch_finalise_cap, prepare_thread_delete ct_not_in_q
  (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp
       subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)

crunch valid_etcbs [wp, DetSchedSchedule_AI_assms]:
  arch_finalise_cap, prepare_thread_delete valid_etcbs
  (wp: hoare_drop_imps unless_wp select_inv mapM_x_wp mapM_wp subset_refl
       if_fun_split simp: crunch_simps ignore: set_object thread_set)

crunch simple_sched_action [wp, DetSchedSchedule_AI_assms]:
  arch_finalise_cap, prepare_thread_delete simple_sched_action
  (wp: hoare_drop_imps mapM_x_wp mapM_wp select_wp subset_refl
   simp: unless_def if_fun_split)

crunch valid_sched [wp, DetSchedSchedule_AI_assms]:
  arch_finalise_cap, prepare_thread_delete, arch_invoke_irq_handler, arch_mask_irq_signal
  "valid_sched"
  (ignore: set_object wp: crunch_wps subset_refl simp: if_fun_split)

lemma activate_thread_valid_sched [DetSchedSchedule_AI_assms]:
  "\<lbrace>valid_sched\<rbrace> activate_thread \<lbrace>\<lambda>_. valid_sched\<rbrace>"
  apply (simp add: activate_thread_def)
  apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+
  apply (force elim: st_tcb_weakenE)
  done

crunch valid_sched[wp]:
  perform_page_invocation, perform_page_table_invocation, perform_asid_pool_invocation
  valid_sched
  (wp: mapM_x_wp' mapM_wp' crunch_wps)

lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>invs and valid_sched and ct_active and valid_arch_inv a\<rbrace>
     arch_perform_invocation a
   \<lbrace>\<lambda>_.valid_sched\<rbrace>"
  apply (cases a, simp_all add: arch_perform_invocation_def)
     apply (wp perform_asid_control_invocation_valid_sched | wpc |
            simp add: valid_arch_inv_def invs_valid_idle)+
  done

crunch valid_sched [wp, DetSchedSchedule_AI_assms]:
  handle_arch_fault_reply, handle_vm_fault valid_sched
  (simp: crunch_simps)

crunch not_queued [wp, DetSchedSchedule_AI_assms]:
  handle_vm_fault, handle_arch_fault_reply "not_queued t"
  (simp: crunch_simps)

crunch sched_act_not [wp, DetSchedSchedule_AI_assms]:
  handle_arch_fault_reply, handle_vm_fault "scheduler_act_not t"
  (simp: crunch_simps)

lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace>st_tcb_at P t' \<rbrace> handle_vm_fault t w \<lbrace>\<lambda>rv. st_tcb_at P t' \<rbrace>"
  unfolding handle_vm_fault_def by (cases w; wpsimp)

lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]:
  "\<lbrace> \<lambda>s. st_tcb_at P (cur_thread s) s \<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_ s. st_tcb_at P (cur_thread s) s \<rbrace>"
  unfolding handle_vm_fault_def
  apply (fold ct_in_state_def)
  apply (rule ct_in_state_thread_state_lift; cases f; wpsimp)
  done

crunch valid_sched [wp, DetSchedSchedule_AI_assms]: arch_invoke_irq_control "valid_sched"

crunch valid_list [wp, DetSchedSchedule_AI_assms]:
  arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread "valid_list"

crunch cur_tcb [wp, DetSchedSchedule_AI_assms]:
  handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers
  cur_tcb
  (simp: crunch_simps)

crunch not_cur_thread [wp, DetSchedSchedule_AI_assms]: arch_get_sanitise_register_info, arch_post_modify_registers "not_cur_thread t'"
crunch ready_queues   [wp, DetSchedSchedule_AI_assms]: arch_get_sanitise_register_info, arch_post_modify_registers "\<lambda>s. P (ready_queues s)"
crunch scheduler_action [wp, DetSchedSchedule_AI_assms]: arch_get_sanitise_register_info, arch_post_modify_registers "\<lambda>s. P (scheduler_action s)"

lemma make_arch_fault_msg_inv:
  "make_arch_fault_msg f t \<lbrace>P\<rbrace>"
  by (cases f) wpsimp

declare make_arch_fault_msg_inv[DetSchedSchedule_AI_assms]

lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]:
  "\<lbrace>\<lambda>s::det_ext state. t \<noteq> idle_thread s\<rbrace> arch_post_modify_registers c t \<lbrace>\<lambda>_ s. t \<noteq> idle_thread s\<rbrace>"
  by (wpsimp simp: arch_post_modify_registers_def)

crunches arch_post_cap_deletion
  for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched
  and valid_etcbs[wp, DetSchedSchedule_AI_assms]: valid_etcbs
  and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q
  and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action
  and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t"
  and is_etcb_at[wp, DetSchedSchedule_AI_assms]: "is_etcb_at t"
  and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t"
  and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t"
  and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action
  and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle

crunch delete_asid_pool[wp]: delete_asid_pool "\<lambda>(s:: det_ext state). P (idle_thread s)"
 (wp: crunch_wps simp: if_apply_def2)

crunch arch_finalise_cap[wp, DetSchedSchedule_AI_assms]:
  arch_finalise_cap "\<lambda>(s:: det_ext state). P (idle_thread s)"
  (wp: crunch_wps simp: if_fun_split)

end

global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?)
  qed

context Arch begin global_naming RISCV64

lemma handle_hyp_fault_valid_sched[wp]:
  "\<lbrace>valid_sched and invs and st_tcb_at active t and not_queued t and scheduler_act_not t
      and (ct_active or ct_idle)\<rbrace>
    handle_hypervisor_fault t fault \<lbrace>\<lambda>_. valid_sched\<rbrace>"
  by (cases fault; wpsimp wp: handle_fault_valid_sched simp: valid_fault_def)

lemma handle_reserved_irq_valid_sched:
  "\<lbrace>valid_sched and invs and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow>  scheduler_act_sane s \<and> ct_not_queued s)\<rbrace>
  handle_reserved_irq irq \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
  unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def)

end

global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched)?)
  qed

end


chapter {* Generated by Lem from evm.lem. *}

theory "EvmAuxiliary"

imports
 	 Main "~~/src/HOL/Library/Code_Target_Numeral"
	 "Lem_pervasives"
	 "Lem_word"
	 "Word256"
	 "Word160"
	 "Word8"
	 "Evm"

begin

(****************************************************)
(*                                                  *)
(* Termination Proofs                               *)
(*                                                  *)
(****************************************************)

termination store_byte_list_memory by lexicographic_order

(****************************************************)
(*                                                  *)
(* Lemmata                                          *)
(*                                                  *)
(****************************************************)

lemma uint_to_address_def_lemma:
" ((\<forall> w. word160FromNat (unat w) = Word.ucast w)) "
(* Theorem: uint_to_address_def_lemma*)(* try *) by auto

lemma address_to_uint_def_lemma:
" ((\<forall> w. word256FromNat (unat w) = Word.ucast w)) "
(* Theorem: address_to_uint_def_lemma*)(* try *) by auto

lemma uint_to_byte_def_lemma:
" ((\<forall> w. word8FromNat (unat w) = Word.ucast w)) "
(* Theorem: uint_to_byte_def_lemma*)(* try *) by auto

lemma byte_to_uint_def_lemma:
" ((\<forall> w. word256FromNat (unat w) = Word.ucast w)) "
(* Theorem: byte_to_uint_def_lemma*)(* try *) by auto

lemma word_rsplit_def_lemma:
" ((\<forall> w. word_rsplit_aux (to_bl w) (( 32 :: nat)) = word_rsplit w)) "
(* Theorem: word_rsplit_def_lemma*)(* try *) by auto

lemma address_to_bytes_def_lemma:
" ((\<forall> w. word_rsplit_aux (to_bl w) (( 20 :: nat)) = word_rsplit w)) "
(* Theorem: address_to_bytes_def_lemma*)(* try *) by auto

lemma word_of_bytes_def_lemma:
" ((\<forall> lst. of_bl (List.concat (List.map to_bl lst)) = word_rcat lst)) "
(* Theorem: word_of_bytes_def_lemma*)(* try *) by auto

end


(*  Title:      JinjaThreads/Compiler/J0J1Bisim.thy
    Author:     Andreas Lochbihler

    Reminiscent of the Jinja theory Compiler/Correctness1
*)

header {* \isaheader{The bisimulation relation betwenn source and intermediate language} *}

theory J0J1Bisim imports
  "J1"
  "J1WellForm"
  "Compiler1"
  "../J/JWellForm"
  "J0"
begin

section{*Correctness of program compilation *}

primrec unmod :: "'addr expr1 \<Rightarrow> nat \<Rightarrow> bool"
  and unmods :: "'addr expr1 list \<Rightarrow> nat \<Rightarrow> bool"
where
  "unmod (new C) i = True"
| "unmod (newA T\<lfloor>e\<rceil>) i = unmod e i"
| "unmod (Cast C e) i = unmod e i"
| "unmod (e instanceof T) i = unmod e i"
| "unmod (Val v) i = True"
| "unmod (e1 \<guillemotleft>bop\<guillemotright> e2) i = (unmod e1 i \<and> unmod e2 i)"
| "unmod (Var i) j = True"
| "unmod (i:=e) j = (i \<noteq> j \<and> unmod e j)"
| "unmod (a\<lfloor>i\<rceil>) j = (unmod a j \<and> unmod i j)"
| "unmod (a\<lfloor>i\<rceil>:=e) j = (unmod a j \<and> unmod i j \<and> unmod e j)"
| "unmod (a\<bullet>length) j = unmod a j"
| "unmod (e\<bullet>F{D}) i = unmod e i"
| "unmod (e1\<bullet>F{D}:=e2) i = (unmod e1 i \<and> unmod e2 i)"
| "unmod (e\<bullet>M(es)) i = (unmod e i \<and> unmods es i)"
| "unmod {j:T=vo; e} i = ((i = j \<longrightarrow> vo = None) \<and> unmod e i)"
| "unmod (sync\<^bsub>V\<^esub> (o') e) i = (unmod o' i \<and> unmod e i \<and> i \<noteq> V)"
| "unmod (insync\<^bsub>V\<^esub> (a) e) i = unmod e i"
| "unmod (e1;;e2) i = (unmod e1 i \<and> unmod e2 i)"
| "unmod (if (e) e\<^sub>1 else e\<^sub>2) i = (unmod e i \<and> unmod e\<^sub>1 i \<and> unmod e\<^sub>2 i)"
| "unmod (while (e) c) i = (unmod e i \<and> unmod c i)"
| "unmod (throw e) i = unmod e i"
| "unmod (try e\<^sub>1 catch(C i) e\<^sub>2) j = (unmod e\<^sub>1 j \<and> (if i=j then False else unmod e\<^sub>2 j))"

| "unmods ([]) i = True"
| "unmods (e#es) i = (unmod e i \<and> unmods es i)"

lemma unmods_map_Val [simp]: "unmods (map Val vs) V"
by(induct vs) simp_all

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows hidden_unmod: "hidden Vs i \<Longrightarrow> unmod (compE1 Vs e) i"
  and hidden_unmods: "hidden Vs i \<Longrightarrow> unmods (compEs1 Vs es) i"
apply(induct Vs e and Vs es rule: compE1_compEs1_induct)
apply (simp_all add:hidden_inacc)
apply(auto simp add:hidden_def)
done

lemma unmod_extRet2J [simp]: "unmod e i \<Longrightarrow> unmod (extRet2J e va) i"
by(cases va) simp_all

lemma max_dest: "(n :: nat) + max a b \<le> c \<Longrightarrow> n + a \<le> c \<and> n + b \<le> c"
apply(auto simp add: max_def split: split_if_asm)
done

declare max_dest [dest!]

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows fv_unmod_compE1: "\<lbrakk> i < length Vs; Vs ! i \<notin> fv e \<rbrakk> \<Longrightarrow> unmod (compE1 Vs e) i"
  and fvs_unmods_compEs1: "\<lbrakk> i < length Vs; Vs ! i \<notin> fvs es \<rbrakk> \<Longrightarrow> unmods (compEs1 Vs es) i"
proof(induct Vs e and Vs es rule: compE1_compEs1_induct)
  case (Block Vs V ty vo exp)
  note IH = `\<lbrakk>i < length (Vs @ [V]); (Vs @ [V]) ! i \<notin> fv exp \<rbrakk> \<Longrightarrow> unmod (compE1 (Vs @ [V]) exp) i`
  note len = `i < length Vs`
  hence i: "i < length (Vs @ [V])" by simp
  show ?case
  proof(cases "Vs ! i = V")
    case True
    from len have "hidden (Vs @ [Vs ! i]) i" by(rule hidden_snoc_nth)
    with len True show ?thesis by(auto intro: hidden_unmod)
  next
    case False
    with `Vs ! i \<notin> fv {V:ty=vo; exp}` len have "(Vs @ [V]) ! i \<notin> fv exp"
      by(auto simp add: nth_append)
    from IH[OF i this] len show ?thesis by(auto)
  qed
next
  case (TryCatch Vs e1 C V e2)
  note IH1 = `\<lbrakk>i < length Vs; Vs ! i \<notin> fv e1 \<rbrakk> \<Longrightarrow> unmod (compE1 Vs e1) i`
  note IH2 = `\<lbrakk>i < length (Vs @ [V]); (Vs @ [V]) ! i \<notin> fv e2 \<rbrakk> \<Longrightarrow> unmod (compE1 (Vs @ [V]) e2) i`
  note len = `i < length Vs`
  hence i: "i < length (Vs @ [V])" by simp
  have "unmod (compE1 (Vs @ [V]) e2) i"
  proof(cases "Vs ! i = V")
    case True
    from len have "hidden (Vs @ [Vs ! i]) i" by(rule hidden_snoc_nth)
    with len True show ?thesis by(auto intro: hidden_unmod)
  next
    case False
    with `Vs ! i \<notin> fv (try e1 catch(C V) e2)` len have "(Vs @ [V]) ! i \<notin> fv e2"
      by(auto simp add: nth_append)
    from IH2[OF i this] len show ?thesis by(auto)
  qed
  with IH1[OF len] `Vs ! i \<notin> fv (try e1 catch(C V) e2)` len show ?case by(auto)
qed(auto dest: index_le_lengthD simp add: nth_append)

lemma hidden_lengthD: "hidden Vs i \<Longrightarrow> i < length Vs"
by(simp add: hidden_def)

lemma fixes e :: "'addr expr1" and es :: "'addr expr1 list"
  shows fv_B_unmod: "\<lbrakk> V \<notin> fv e; \<B> e n; V < n \<rbrakk> \<Longrightarrow> unmod e V"
  and fvs_Bs_unmods: "\<lbrakk> V \<notin> fvs es; \<B>s es n; V < n \<rbrakk> \<Longrightarrow> unmods es V"
by(induct e and es arbitrary: n and n rule: unmod.induct unmods.induct) auto

section {* The delay bisimulation relation *}

text {* Delay bisimulation for expressions *}

inductive bisim :: "vname list \<Rightarrow> 'addr expr \<Rightarrow> 'addr expr1 \<Rightarrow> 'addr val list \<Rightarrow> bool"
  and bisims :: "vname list \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr1 list \<Rightarrow> 'addr val list \<Rightarrow> bool"
where
  bisimNew: "bisim Vs (new C) (new C) xs"
| bisimNewArray: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (newA T\<lfloor>e\<rceil>) (newA T\<lfloor>e'\<rceil>) xs"
| bisimCast: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (Cast T e) (Cast T e') xs"
| bisimInstanceOf: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (e instanceof T) (e' instanceof T) xs"
| bisimVal: "bisim Vs (Val v) (Val v) xs"
| bisimBinOp1:
  "\<lbrakk> bisim Vs e e' xs; \<not> is_val e; \<not> contains_insync e'' \<rbrakk> \<Longrightarrow> bisim Vs (e \<guillemotleft>bop\<guillemotright> e'') (e' \<guillemotleft>bop\<guillemotright> compE1 Vs e'') xs"
| bisimBinOp2: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (Val v \<guillemotleft>bop\<guillemotright> e) (Val v \<guillemotleft>bop\<guillemotright> e') xs"
| bisimVar: "bisim Vs (Var V) (Var (index Vs V)) xs"
| bisimLAss: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (V:=e) (index Vs V:=e') xs"
| bisimAAcc1: "\<lbrakk> bisim Vs a a' xs; \<not> is_val a; \<not> contains_insync i \<rbrakk> \<Longrightarrow> bisim Vs (a\<lfloor>i\<rceil>) (a'\<lfloor>compE1 Vs i\<rceil>) xs"
| bisimAAcc2: "bisim Vs i i' xs \<Longrightarrow> bisim Vs (Val v\<lfloor>i\<rceil>) (Val v\<lfloor>i'\<rceil>) xs"
| bisimAAss1:
  "\<lbrakk> bisim Vs a a' xs; \<not> is_val a; \<not> contains_insync i; \<not> contains_insync e \<rbrakk>
  \<Longrightarrow> bisim Vs (a\<lfloor>i\<rceil>:=e) (a'\<lfloor>compE1 Vs i\<rceil>:=compE1 Vs e) xs"
| bisimAAss2: "\<lbrakk> bisim Vs i i' xs; \<not> is_val i; \<not> contains_insync e \<rbrakk> \<Longrightarrow> bisim Vs (Val v\<lfloor>i\<rceil>:=e) (Val v\<lfloor>i'\<rceil>:=compE1 Vs e) xs"
| bisimAAss3: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (Val v\<lfloor>Val i\<rceil> := e) (Val v\<lfloor>Val i\<rceil> := e') xs"
| bisimALength: "bisim Vs a a' xs \<Longrightarrow> bisim Vs (a\<bullet>length) (a'\<bullet>length) xs"
| bisimFAcc: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (e\<bullet>F{D}) (e'\<bullet>F{D}) xs"
| bisimFAss1: "\<lbrakk> bisim Vs e e' xs; \<not> is_val e; \<not> contains_insync e'' \<rbrakk> \<Longrightarrow> bisim Vs (e\<bullet>F{D}:=e'') (e'\<bullet>F{D}:=compE1 Vs e'') xs"
| bisimFAss2: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (Val v\<bullet>F{D} := e) (Val v\<bullet>F{D} := e') xs"
| bisimCallObj: "\<lbrakk> bisim Vs e e' xs; \<not> is_val e; \<not> contains_insyncs es \<rbrakk> \<Longrightarrow> bisim Vs (e\<bullet>M(es)) (e'\<bullet>M(compEs1 Vs es)) xs"
| bisimCallParams: "bisims Vs es es' xs \<Longrightarrow> bisim Vs (Val v\<bullet>M(es)) (Val v\<bullet>M(es')) xs"
| bisimBlockNone: "bisim (Vs@[V]) e e' xs \<Longrightarrow> bisim Vs {V:T=None; e} {(length Vs):T=None; e'} xs"
| bisimBlockSome: "\<lbrakk> bisim (Vs@[V]) e e' (xs[length Vs := v]) \<rbrakk> \<Longrightarrow> bisim Vs {V:T=\<lfloor>v\<rfloor>; e} {(length Vs):T=\<lfloor>v\<rfloor>; e'} xs"
| bisimBlockSomeNone: "\<lbrakk> bisim (Vs@[V]) e e' xs; xs ! (length Vs) = v \<rbrakk> \<Longrightarrow> bisim Vs {V:T=\<lfloor>v\<rfloor>; e} {(length Vs):T=None; e'} xs"
| bisimSynchronized:
  "\<lbrakk> bisim Vs o' o'' xs; \<not> contains_insync e \<rbrakk>
  \<Longrightarrow> bisim Vs (sync(o') e) (sync\<^bsub>length Vs\<^esub>(o'') (compE1 (Vs@[fresh_var Vs]) e)) xs"
| bisimInSynchronized:
  "\<lbrakk> bisim (Vs@[fresh_var Vs]) e e' xs; xs ! length Vs = Addr a \<rbrakk> \<Longrightarrow> bisim Vs (insync(a) e) (insync\<^bsub>length Vs\<^esub>(a) e') xs"
| bisimSeq: "\<lbrakk> bisim Vs e e' xs; \<not> contains_insync e'' \<rbrakk> \<Longrightarrow> bisim Vs (e;;e'') (e';;compE1 Vs e'') xs"
| bisimCond:
  "\<lbrakk> bisim Vs e e' xs; \<not> contains_insync e1; \<not> contains_insync e2 \<rbrakk>
  \<Longrightarrow> bisim Vs (if (e) e1 else e2) (if (e') (compE1 Vs e1) else (compE1 Vs e2)) xs"
| bisimWhile:
  "\<lbrakk> \<not> contains_insync b; \<not> contains_insync e \<rbrakk> \<Longrightarrow> bisim Vs (while (b) e) (while (compE1 Vs b) (compE1 Vs e)) xs"
| bisimThrow: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (throw e) (throw e') xs"
| bisimTryCatch:
  "\<lbrakk> bisim Vs e e' xs; \<not> contains_insync e'' \<rbrakk>
  \<Longrightarrow> bisim Vs (try e catch(C V) e'') (try e' catch(C (length Vs)) compE1 (Vs@[V]) e'') xs"

| bisimsNil: "bisims Vs [] [] xs"
| bisimsCons1: "\<lbrakk> bisim Vs e e' xs; \<not> is_val e; \<not> contains_insyncs es \<rbrakk> \<Longrightarrow> bisims Vs (e # es) (e' # compEs1 Vs es) xs"
| bisimsCons2: "bisims Vs es es' xs \<Longrightarrow> bisims Vs (Val v # es) (Val v # es') xs"

declare bisimNew [iff]
declare bisimVal [iff]
declare bisimVar [iff]
declare bisimWhile [iff]
declare bisimsNil [iff]

declare bisim_bisims.intros [intro!]
declare bisimsCons1 [rule del, intro] bisimsCons2 [rule del, intro]
  bisimBinOp1 [rule del, intro] bisimAAcc1 [rule del, intro]
  bisimAAss1 [rule del, intro] bisimAAss2 [rule del, intro]
  bisimFAss1 [rule del, intro]
  bisimCallObj [rule del, intro]

inductive_cases bisim_safe_cases [elim!]:
  "bisim Vs (new C) e' xs"
  "bisim Vs (newA T\<lfloor>e\<rceil>) e' xs"
  "bisim Vs (Cast T e) e' xs"
  "bisim Vs (e instanceof T) e' xs"
  "bisim Vs (Val v) e' xs"
  "bisim Vs (Var V) e' xs"
  "bisim Vs (V:=e) e' xs"
  "bisim Vs (Val v\<lfloor>i\<rceil>) e' xs"
  "bisim Vs (Val v\<lfloor>Val v'\<rceil> := e) e' xs"
  "bisim Vs (a\<bullet>length) e' xs"
  "bisim Vs (e\<bullet>F{D}) e' xs"
  "bisim Vs (sync(o') e) e' xs"
  "bisim Vs (insync(a) e) e' xs"
  "bisim Vs (e;;e') e'' xs"
  "bisim Vs (if (b) e1 else e2) e' xs"
  "bisim Vs (while (b) e) e' xs"
  "bisim Vs (throw e) e' xs"
  "bisim Vs (try e catch(C V) e') e'' xs"
  "bisim Vs e' (new C) xs"
  "bisim Vs e' (newA T\<lfloor>e\<rceil>) xs"
  "bisim Vs e' (Cast T e) xs"
  "bisim Vs e' (e instanceof T) xs"
  "bisim Vs e' (Val v) xs"
  "bisim Vs e' (Var V) xs"
  "bisim Vs e' (V:=e) xs"
  "bisim Vs e' (Val v\<lfloor>i\<rceil>) xs"
  "bisim Vs e' (Val v\<lfloor>Val v'\<rceil> := e) xs"
  "bisim Vs e' (a\<bullet>length) xs"
  "bisim Vs e' (e\<bullet>F{D}) xs"
  "bisim Vs e' (sync\<^bsub>V\<^esub> (o') e) xs"
  "bisim Vs e' (insync\<^bsub>V\<^esub> (a) e) xs"
  "bisim Vs e'' (e;;e') xs"
  "bisim Vs e' (if (b) e1 else e2) xs"
  "bisim Vs e' (while (b) e) xs"
  "bisim Vs e' (throw e) xs"
  "bisim Vs e'' (try e catch(C V) e') xs"

inductive_cases bisim_cases [elim]:
  "bisim Vs (e1 \<guillemotleft>bop\<guillemotright> e2) e' xs"
  "bisim Vs (a\<lfloor>i\<rceil>) e' xs"
  "bisim Vs (a\<lfloor>i\<rceil>:=e) e' xs"
  "bisim Vs (e\<bullet>F{D}:=e') e'' xs"
  "bisim Vs (e\<bullet>M(es)) e' xs"
  "bisim Vs {V:T=vo; e} e' xs"
  "bisim Vs e' (e1 \<guillemotleft>bop\<guillemotright> e2) xs"
  "bisim Vs e' (a\<lfloor>i\<rceil>) xs"
  "bisim Vs e' (a\<lfloor>i\<rceil>:=e) xs"
  "bisim Vs e'' (e\<bullet>F{D}:=e') xs"
  "bisim Vs e' (e\<bullet>M(es)) xs"
  "bisim Vs e' {V:T=vo; e} xs"

inductive_cases bisims_safe_cases [elim!]:
  "bisims Vs [] es xs"
  "bisims Vs es [] xs"

inductive_cases bisims_cases [elim]:
  "bisims Vs (e # es) es' xs"
  "bisims Vs es' (e # es) xs"

text {* Delay bisimulation for call stacks *}

inductive bisim01 :: "'addr expr \<Rightarrow> 'addr expr1 \<times> 'addr locals1 \<Rightarrow> bool"
where
  "\<lbrakk> bisim [] e e' xs; fv e = {}; \<D> e \<lfloor>{}\<rfloor>; max_vars e' \<le> length xs; call e = \<lfloor>aMvs\<rfloor>; call1 e' = \<lfloor>aMvs\<rfloor> \<rbrakk>
  \<Longrightarrow> bisim01 e (e', xs)"

inductive bisim_list :: "'addr expr list \<Rightarrow> ('addr expr1 \<times> 'addr locals1) list \<Rightarrow> bool"
where
  bisim_listNil: "bisim_list [] []"
| bisim_listCons:
  "\<lbrakk> bisim_list es exs'; bisim [] e e' xs;
     fv e = {}; \<D> e \<lfloor>{}\<rfloor>;
     max_vars e' \<le> length xs;
     call e = \<lfloor>aMvs\<rfloor>; call1 e' = \<lfloor>aMvs\<rfloor> \<rbrakk>
  \<Longrightarrow> bisim_list (e # es) ((e', xs) # exs')"

inductive_cases bisim_list_cases [elim!]:
 "bisim_list [] exs'"
 "bisim_list (ex # exs) exs'"
 "bisim_list exs (ex' # exs')"

fun bisim_list1 ::
  "'addr expr \<times> 'addr expr list \<Rightarrow> ('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list \<Rightarrow> bool"
where
  "bisim_list1 (e, es) ((e1, xs1), exs1) \<longleftrightarrow>
   bisim_list es exs1 \<and> bisim [] e e1 xs1 \<and> fv e = {} \<and> \<D> e \<lfloor>{}\<rfloor> \<and> max_vars e1 \<le> length xs1"

definition bisim_red0_Red1 ::
  "(('addr expr \<times> 'addr expr list) \<times> 'heap)
  \<Rightarrow> ((('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list) \<times> 'heap) \<Rightarrow> bool"
where "bisim_red0_Red1 \<equiv> (\<lambda>(es, h) (exs, h'). bisim_list1 es exs \<and> h = h')"

abbreviation ta_bisim01 ::
  "('addr, 'thread_id, 'heap) J0_thread_action \<Rightarrow> ('addr, 'thread_id, 'heap) J1_thread_action \<Rightarrow> bool"
where
  "ta_bisim01 \<equiv> ta_bisim (\<lambda>t. bisim_red0_Red1)"

definition bisim_wait01 ::
  "('addr expr \<times> 'addr expr list) \<Rightarrow> ('addr expr1 \<times> 'addr locals1) \<times> ('addr expr1 \<times> 'addr locals1) list \<Rightarrow> bool"
where "bisim_wait01 \<equiv> \<lambda>(e0, es0) ((e1, xs1), exs1). call e0 \<noteq> None \<and> call1 e1 \<noteq> None"

lemma bisim_list1I[intro?]:
  "\<lbrakk> bisim_list es exs1; bisim [] e e1 xs1; fv e = {};
     \<D> e \<lfloor>{}\<rfloor>; max_vars e1 \<le> length xs1 \<rbrakk>
  \<Longrightarrow> bisim_list1 (e, es) ((e1, xs1), exs1)"
by simp

lemma bisim_list1E[elim?]:
  assumes "bisim_list1 (e, es) ((e1, xs1), exs1)"
  obtains "bisim_list es exs1" "bisim [] e e1 xs1" "fv e = {}" "\<D> e \<lfloor>{}\<rfloor>" "max_vars e1 \<le> length xs1"
using assms by auto

lemma bisim_list1_elim:
  assumes "bisim_list1 es' exs"
  obtains e es e1 xs1 exs1
  where "es' = (e, es)" "exs = ((e1, xs1), exs1)"
  and "bisim_list es exs1" "bisim [] e e1 xs1" "fv e = {}" "\<D> e \<lfloor>{}\<rfloor>" "max_vars e1 \<le> length xs1"
using assms by(cases es')(cases exs, fastforce)

declare bisim_list1.simps [simp del]

lemma bisims_map_Val_conv [simp]: "bisims Vs (map Val vs) es xs = (es = map Val vs)"
apply(induct vs arbitrary: es)
 apply(fastforce)
apply(simp)
apply(rule iffI)
apply(erule bisims_cases, auto)
done

declare compEs1_conv_map [simp del]

lemma bisim_contains_insync: "bisim Vs e e' xs \<Longrightarrow> contains_insync e = contains_insync e'"
  and bisims_contains_insyncs: "bisims Vs es es' xs \<Longrightarrow> contains_insyncs es = contains_insyncs es'"
by(induct rule: bisim_bisims.inducts)(auto)

lemma bisims_map_Val_Throw:
  "bisims Vs (map Val vs @ Throw a # es) es' xs \<longleftrightarrow> es' = map Val vs @ Throw a # compEs1 Vs es \<and> \<not> contains_insyncs es"
apply(induct vs arbitrary: es')
 apply(simp)
 apply(fastforce simp add: compEs1_conv_map)
apply(fastforce elim!: bisims_cases intro: bisimsCons2)
done

lemma compE1_bisim [intro]: "\<lbrakk> fv e \<subseteq> set Vs; \<not> contains_insync e \<rbrakk> \<Longrightarrow> bisim Vs e (compE1 Vs e) xs"
  and compEs1_bisims [intro]: "\<lbrakk> fvs es \<subseteq> set Vs; \<not> contains_insyncs es \<rbrakk> \<Longrightarrow> bisims Vs es (compEs1 Vs es) xs"
proof(induct Vs e and Vs es arbitrary: xs and xs rule: compE1_compEs1_induct)
  case (BinOp Vs exp1 bop exp2 x)
  thus ?case by(cases "is_val exp1")(auto)
next
  case (AAcc Vs exp1 exp2 x)
  thus ?case by(cases "is_val exp1")(auto)
next
  case (AAss Vs exp1 exp2 exp3 x)
  thus ?case by(cases "is_val exp1", cases "is_val exp2", fastforce+)
next
  case (FAss Vs exp1 F D exp2 x)
  thus ?case by(cases "is_val exp1", auto)
next
  case (Call Vs obj M params x)
  thus ?case by(cases "is_val obj")(auto)
next
  case (Block Vs V T vo exp xs)
  from `fv {V:T=vo; exp} \<subseteq> set Vs` have "fv exp \<subseteq> set (Vs@[V])" by(auto)
  with Block show ?case by(cases vo)(auto)
next
  case (Cons Vs exp list x)
  thus ?case by(cases "is_val exp")(auto intro!: bisimsCons2)
qed(auto)

lemma bisim_hidden_unmod: "\<lbrakk> bisim Vs e e' xs; hidden Vs i \<rbrakk> \<Longrightarrow> unmod e' i"
  and bisims_hidden_unmods: "\<lbrakk> bisims Vs es es' xs; hidden Vs i \<rbrakk> \<Longrightarrow> unmods es' i"
by(induct rule: bisim_bisims.inducts)(auto intro: hidden_unmod hidden_unmods dest: hidden_inacc hidden_lengthD)

lemma bisim_fv_unmod: "\<lbrakk> bisim Vs e e' xs; i < length Vs; Vs ! i \<notin> fv e \<rbrakk> \<Longrightarrow> unmod e' i"
  and bisims_fvs_unmods: "\<lbrakk> bisims Vs es es' xs; i < length Vs; Vs ! i \<notin> fvs es \<rbrakk> \<Longrightarrow> unmods es' i"
proof(induct rule: bisim_bisims.inducts)
  case (bisimBlockNone Vs V e e' xs T)
  note len = `i < length Vs`
  have "unmod e' i"
  proof(cases "Vs ! i = V")
    case True
    from len have "hidden (Vs @ [Vs ! i]) i" by(rule hidden_snoc_nth)
    with len True `bisim (Vs @ [V]) e e' xs` show ?thesis by(auto intro: bisim_hidden_unmod)
  next
    case False
    with bisimBlockNone show ?thesis by(auto simp add: nth_append)
  qed
  thus ?case by simp
next
  case (bisimBlockSome Vs V e e' xs v T)
  note len = `i < length Vs`
  show ?case
  proof(cases "Vs ! i = V")
    case True
    from len have "hidden (Vs @ [Vs ! i]) i" by(rule hidden_snoc_nth)
    with len True `bisim (Vs @ [V]) e e' (xs[length Vs := v])`
    show ?thesis by(auto intro: bisim_hidden_unmod)
  next
    case False
    with bisimBlockSome show ?thesis by(auto simp add: nth_append)
  qed
next
  case (bisimBlockSomeNone Vs V e e' xs v T)
  note len = `i < length Vs`
  show ?case
  proof(cases "Vs ! i = V")
    case True
    from len have "hidden (Vs @ [Vs ! i]) i" by(rule hidden_snoc_nth)
    with len True `bisim (Vs @ [V]) e e' xs`
    show ?thesis by(auto intro: bisim_hidden_unmod)
  next
    case False
    with bisimBlockSomeNone show ?thesis by(auto simp add: nth_append)
  qed
qed(fastforce dest: fv_unmod_compE1 fvs_unmods_compEs1 index_le_lengthD simp add: nth_append)+

lemma bisim_extRet2J [intro!]: "bisim Vs e e' xs \<Longrightarrow> bisim Vs (extRet2J e va) (extRet2J1 e' va) xs"
by(cases va) auto

lemma bisims_map_Val_conv2 [simp]: "bisims Vs es (map Val vs) xs = (es = map Val vs)"
apply(induct vs arbitrary: es)
apply(fastforce elim!: bisims_cases)+
done

lemma bisims_map_Val_Throw2:
  "bisims Vs es' (map Val vs @ Throw a # es) xs \<longleftrightarrow>
   (\<exists>es''. es' = map Val vs @ Throw a # es'' \<and> es = compEs1 Vs es'' \<and> \<not> contains_insyncs es'')"
apply(induct vs arbitrary: es')
 apply(simp)
 apply(fastforce simp add: compEs1_conv_map)
apply(fastforce elim!: bisims_cases)
done

lemma hidden_bisim_unmod: "\<lbrakk> bisim Vs e e' xs; hidden Vs i \<rbrakk> \<Longrightarrow> unmod e' i"
  and hidden_bisims_unmods: "\<lbrakk> bisims Vs es es' xs; hidden Vs i \<rbrakk> \<Longrightarrow> unmods es' i"
apply(induct rule: bisim_bisims.inducts)
apply(auto simp add:hidden_inacc intro: hidden_unmod hidden_unmods)
apply(auto simp add: hidden_def)
done

lemma bisim_list_list_all2_conv:
  "bisim_list es exs' \<longleftrightarrow> list_all2 bisim01 es exs'"
proof
  assume "bisim_list es exs'"
  thus "list_all2 bisim01 es exs'"
    by induct(auto intro!: bisim01.intros)
next
  assume "list_all2 bisim01 es exs'"
  thus "bisim_list es exs'"
    by(induct es arbitrary: exs')(auto intro!: bisim_listCons bisim_listNil elim!: bisim01.cases simp add: list_all2_Cons1)
qed

lemma bisim_list_extTA2J0_extTA2J1:
  assumes wf: "wf_J_prog P"
  and sees: "P \<turnstile> C sees M:[]\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
  shows "bisim_list1 (extNTA2J0 P (C, M, a)) (extNTA2J1 (compP1 P) (C, M, a))"
proof -
  obtain pns body where "meth = (pns, body)" by(cases meth)
  with sees have sees: "P \<turnstile> C sees M:[]\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D" by simp
  moreover let ?xs = "Addr a # replicate (max_vars body) undefined_value"
  let ?e' = "{0:Class D=None; compE1 (this # pns) body}"
  have "bisim_list1 ({this:Class D=\<lfloor>Addr a\<rfloor>; body}, []) ((?e', ?xs), [])"
  proof
    show "bisim_list [] []" ..
    from sees_wf_mdecl[OF wf_prog_wwf_prog[OF wf] sees] have "fv body \<subseteq> set [this]" "pns = []"
      by(auto simp add: wf_mdecl_def)
    thus "fv ({this:Class D=\<lfloor>Addr a\<rfloor>; body}) = {}" by simp
    from sees_wf_mdecl[OF wf sees] obtain T' where "P,[this \<mapsto> Class D] \<turnstile> body :: T'" "this \<notin> set pns"
      and "\<D> body \<lfloor>dom [this \<mapsto> Addr a]\<rfloor>" by(auto simp add: wf_mdecl_def)
    hence "\<not> contains_insync body" by(auto simp add: contains_insync_conv dest: WT_expr_locks)
    with `fv body \<subseteq> set [this]`
    have "bisim ([] @ [this]) body (compE1 (this # pns) body) ?xs"
      unfolding append.simps `pns = []` by(rule compE1_bisim)
    hence "bisim [] {this:Class D=\<lfloor>Addr a\<rfloor>; body} {length ([] :: String.literal list):Class D=None; compE1 (this # pns) body} ?xs"
      by(rule bisimBlockSomeNone)(simp)
    thus "bisim [] ({this:Class D=\<lfloor>Addr a\<rfloor>; body}) ?e' ?xs" by simp
    from `\<D> body \<lfloor>dom [this \<mapsto> Addr a]\<rfloor>` show "\<D> ({this:Class D=\<lfloor>Addr a\<rfloor>; body}) \<lfloor>{}\<rfloor>" by simp
    show "max_vars ?e' \<le> length ?xs" by simp
  qed
  ultimately show ?thesis by(simp)
qed

lemma bisim_max_vars: "bisim Vs e e' xs \<Longrightarrow> max_vars e = max_vars e'"
  and bisims_max_varss: "bisims Vs es es' xs \<Longrightarrow> max_varss es = max_varss es'"
apply(induct rule: bisim_bisims.inducts)
apply(auto simp add: max_vars_compE1 max_varss_compEs1)
done

lemma bisim_call: "bisim Vs e e' xs \<Longrightarrow> call e = call e'"
  and bisims_calls: "bisims Vs es es' xs \<Longrightarrow> calls es = calls es'"
apply(induct rule: bisim_bisims.inducts)
apply(auto simp add: is_vals_conv)
done

lemma bisim_call_None_call1: "\<lbrakk> bisim Vs e e' xs; call e = None \<rbrakk> \<Longrightarrow> call1 e' = None"
  and bisims_calls_None_calls1: "\<lbrakk> bisims Vs es es' xs; calls es = None \<rbrakk> \<Longrightarrow> calls1 es' = None"
by(induct rule: bisim_bisims.inducts)(auto simp add: is_vals_conv split: split_if_asm)

lemma bisim_call1_Some_call:
  "\<lbrakk> bisim Vs e e' xs; call1 e' = \<lfloor>aMvs\<rfloor> \<rbrakk> \<Longrightarrow> call e = \<lfloor>aMvs\<rfloor>"

  and bisims_calls1_Some_calls:
  "\<lbrakk> bisims Vs es es' xs; calls1 es' = \<lfloor>aMvs\<rfloor> \<rbrakk> \<Longrightarrow> calls es = \<lfloor>aMvs\<rfloor>"
by(induct rule: bisim_bisims.inducts)(auto simp add: is_vals_conv split: split_if_asm)

lemma blocks_bisim:
  assumes bisim: "bisim (Vs @ pns) e e' xs"
  and length: "length vs = length pns" "length Ts = length pns"
  and xs: "\<forall>i. i < length vs \<longrightarrow> xs ! (i + length Vs) = vs ! i"
  shows "bisim Vs (blocks pns Ts vs e) (blocks1 (length Vs) Ts e') xs"
using bisim length xs
proof(induct pns Ts vs e arbitrary: e' Vs rule: blocks.induct)
  case (1 V Vs T Ts v vs e e' VS)
  note IH = `\<And>e' Vsa. \<lbrakk>bisim (Vsa @ Vs) e e' xs;
                       length vs = length Vs; length Ts = length Vs; \<forall>i<length vs. xs ! (i + length Vsa) = vs ! i\<rbrakk>
           \<Longrightarrow> bisim Vsa (blocks Vs Ts vs e) (blocks1 (length Vsa) Ts e') xs`
  note xs = `\<forall>i<length (v # vs). xs ! (i + length VS) = (v # vs) ! i`
  hence xs': "\<forall>i<length vs. xs ! (i + length (VS @ [V])) = vs ! i" and v: "xs ! length VS = v" by(auto)
  from `bisim (VS @ V # Vs) e e' xs` have "bisim ((VS @ [V]) @ Vs) e e' xs" by simp
  from IH[OF this _ _ xs'] `length (v # vs) = length (V # Vs)` `length (T # Ts) = length (V # Vs)`
  have "bisim (VS @ [V]) (blocks Vs Ts vs e) (blocks1 (length (VS @ [V])) Ts e') xs"
    by auto
  hence "bisim VS ({V:T=\<lfloor>v\<rfloor>; blocks Vs Ts vs e}) {length VS:T=None; blocks1 (length (VS @ [V])) Ts e'} xs"
    using v by(rule bisimBlockSomeNone)
  thus ?case by simp
qed(auto)

lemma fixes e :: "('a,'b,'addr) exp" and es :: "('a,'b,'addr) exp list"
  shows inline_call_max_vars: "call e = \<lfloor>aMvs\<rfloor> \<Longrightarrow> max_vars (inline_call e' e) \<le> max_vars e + max_vars e'"
  and inline_calls_max_varss: "calls es = \<lfloor>aMvs\<rfloor> \<Longrightarrow> max_varss (inline_calls e' es) \<le> max_varss es + max_vars e'"
by(induct e and es rule: call.induct calls.induct)(auto)

lemma assumes "final E" "bisim VS E E' xs"
  shows inline_call_compE1: "call e = \<lfloor>aMvs\<rfloor> \<Longrightarrow> inline_call E' (compE1 Vs e) = compE1 Vs (inline_call E e)"
  and inline_calls_compEs1: "calls es = \<lfloor>aMvs\<rfloor> \<Longrightarrow> inline_calls E' (compEs1 Vs es) = compEs1 Vs (inline_calls E es)"
proof(induct Vs e and Vs es rule: compE1_compEs1_induct)
  case (Call Vs obj M params)
  note IHobj = `call obj = \<lfloor>aMvs\<rfloor> \<Longrightarrow> inline_call E' (compE1 Vs obj) = compE1 Vs (inline_call E obj)`
  note IHparams = `calls params = \<lfloor>aMvs\<rfloor> \<Longrightarrow> inline_calls E' (compEs1 Vs params) = compEs1 Vs (inline_calls E params)`
  obtain a M' vs where [simp]: "aMvs = (a, M', vs)" by (cases aMvs, auto)
  with `call (obj\<bullet>M(params)) = \<lfloor>aMvs\<rfloor>` have "call (obj\<bullet>M(params)) = \<lfloor>(a, M', vs)\<rfloor>" by simp
  thus ?case
  proof(induct rule: call_callE)
    case CallObj
    with IHobj have "inline_call E' (compE1 Vs obj) = compE1 Vs (inline_call E obj)" by auto
    with CallObj show ?case by auto
  next
    case (CallParams v)
    with IHparams have "inline_calls E' (compEs1 Vs params) = compEs1 Vs (inline_calls E params)" by auto
    with CallParams show ?case by(auto simp add: is_vals_conv)
  next
    case Call
    with `final E` `bisim VS E E' xs` show ?case by(auto simp add: is_vals_conv)
  qed
qed(auto split: split_if_asm)

lemma assumes bisim: "bisim VS E E' XS"
  and final: "final E"
  shows bisim_inline_call:
  "\<lbrakk> bisim Vs e e' xs; call e = \<lfloor>aMvs\<rfloor>; fv e \<subseteq> set Vs \<rbrakk>
  \<Longrightarrow> bisim Vs (inline_call E e) (inline_call E' e') xs"

  and bisims_inline_calls:
  "\<lbrakk> bisims Vs es es' xs; calls es = \<lfloor>aMvs\<rfloor>; fvs es \<subseteq> set Vs \<rbrakk>
  \<Longrightarrow> bisims Vs (inline_calls E es) (inline_calls E' es') xs"
proof(induct rule: bisim_bisims.inducts)
  case (bisimBinOp1 Vs e e' xs bop e'')
  thus ?case by(cases "is_val (inline_call E e)")(fastforce)+
next
  case (bisimAAcc1 Vs a a' xs i)
  thus ?case by(cases "is_val (inline_call E a)")(fastforce)+
next
  case (bisimAAss1 Vs a a' xs i e)
  thus ?case by(cases "is_val (inline_call E a)", cases "is_val i")(fastforce)+
next
  case (bisimAAss2 Vs i i' xs a e)
  thus ?case by(cases "is_val (inline_call E i)")(fastforce)+
next
  case (bisimFAss1 Vs e e' xs F D e'')
  thus ?case by(cases "is_val (inline_call E e)")(fastforce)+
next
  case (bisimCallObj Vs e e' xs es M)
  obtain a M' vs where "aMvs = (a, M', vs)" by(cases aMvs, auto)
  with `call (e\<bullet>M(es)) = \<lfloor>aMvs\<rfloor>` have "call (e\<bullet>M(es)) = \<lfloor>(a, M', vs)\<rfloor>"  by simp
  thus ?case
  proof(induct rule: call_callE)
    case CallObj
    with `fv (e\<bullet>M(es)) \<subseteq> set Vs` `aMvs = (a, M', vs)`
      `\<lbrakk>call e = \<lfloor>aMvs\<rfloor>; fv e \<subseteq> set Vs\<rbrakk> \<Longrightarrow> bisim Vs (inline_call E e) (inline_call E' e') xs`
    have IH': "bisim Vs (inline_call E e) (inline_call E' e') xs" by(auto)
    with `bisim Vs e e' xs` `fv (e\<bullet>M(es)) \<subseteq> set Vs` CallObj `\<not> contains_insyncs es` show ?thesis
      by(cases "is_val (inline_call E e)")(fastforce)+
  next
    case (CallParams v)
    hence "inline_calls E' (compEs1 Vs es) = compEs1 Vs (inline_calls E es)"
      by -(rule inline_calls_compEs1[OF final bisim])
    moreover from `fv (e\<bullet>M(es)) \<subseteq> set Vs` final fvs_inline_calls[of E es]
    have "fvs (inline_calls E es) \<subseteq> set Vs" by(auto elim!: final.cases)
    moreover note CallParams `bisim Vs e e' xs` `fv (e\<bullet>M(es)) \<subseteq> set Vs` `\<not> contains_insyncs es` final
    ultimately show ?case by(auto simp add: is_vals_conv final_iff)
  next
    case Call
    with final bisim `bisim Vs e e' xs` show ?case by(auto simp add: is_vals_conv)
  qed
next
  case (bisimCallParams Vs es es' xs v M)
  obtain a M' vs where [simp]: "aMvs = (a, M', vs)" by(cases aMvs, auto)
  with `call (Val v\<bullet>M(es)) = \<lfloor>aMvs\<rfloor>` have "call (Val v\<bullet>M(es)) = \<lfloor>(a, M', vs)\<rfloor>"  by simp
  thus ?case
  proof(induct rule: call_callE)
    case CallObj thus ?case by simp
  next
    case (CallParams v')
    with ` \<lbrakk>calls es = \<lfloor>aMvs\<rfloor>; fvs es \<subseteq> set Vs\<rbrakk> \<Longrightarrow> bisims Vs (inline_calls E es) (inline_calls E' es') xs` `fv (Val v\<bullet>M(es)) \<subseteq> set Vs`
    have "bisims Vs (inline_calls E es) (inline_calls E' es') xs" by(auto)
    with final bisim `bisims Vs es es' xs` show ?case by(auto simp add: is_vals_conv)
  next
    case Call
    with final bisim `bisims Vs es es' xs` show ?case by(auto)
  qed
next
  case (bisimsCons1 Vs e e' xs es)
  thus ?case by(cases "is_val (inline_call E e)")(fastforce)+
qed(fastforce)+

declare hyperUn_ac [simp del]

lemma sqInt_lem3: "\<lbrakk> A \<sqsubseteq> A'; B \<sqsubseteq> B' \<rbrakk> \<Longrightarrow> A \<sqinter> B \<sqsubseteq> A' \<sqinter> B'"
by(auto simp add: hyperset_defs)

lemma sqUn_lem3: "\<lbrakk> A \<sqsubseteq> A'; B \<sqsubseteq> B' \<rbrakk> \<Longrightarrow> A \<squnion> B \<sqsubseteq> A' \<squnion> B'"
by(auto simp add: hyperset_defs)

lemma A_inline_call: "call e = \<lfloor>aMvs\<rfloor> \<Longrightarrow> \<A> e \<sqsubseteq> \<A> (inline_call e' e)"
  and As_inline_calls: "calls es = \<lfloor>aMvs\<rfloor> \<Longrightarrow>  \<A>s es \<sqsubseteq> \<A>s (inline_calls e' es)"
proof(induct e and es rule: call.induct calls.induct)
  case (Call obj M params)
  obtain a M' vs where [simp]: "aMvs = (a, M', vs)" by(cases aMvs, auto)
  with `call (obj\<bullet>M(params)) = \<lfloor>aMvs\<rfloor>` have "call (obj\<bullet>M(params)) = \<lfloor>(a, M', vs)\<rfloor>"  by simp
  thus ?case
  proof(induct rule: call_callE)
    case CallObj
    with `call obj = \<lfloor>aMvs\<rfloor> \<Longrightarrow> \<A> obj \<sqsubseteq> \<A> (inline_call e' obj)`
    show ?case by(auto intro: sqUn_lem)
  next
    case CallParams
    with `calls params = \<lfloor>aMvs\<rfloor> \<Longrightarrow> \<A>s params \<sqsubseteq> \<A>s (inline_calls e' params)`
    show ?case by(auto intro: sqUn_lem)
  next
    case Call
    thus ?case by(auto simp add: hyperset_defs)
  qed
next
  case Block thus ?case by(fastforce intro: diff_lem)
next
  case throw thus ?case by(simp add: hyperset_defs)
next
  case TryCatch thus ?case by(auto intro: sqInt_lem)
qed(fastforce intro: sqUn_lem sqUn_lem2)+

lemma assumes "final e'"
  shows defass_inline_call: "\<lbrakk> call e = \<lfloor>aMvs\<rfloor>; \<D> e A \<rbrakk> \<Longrightarrow> \<D> (inline_call e' e) A"
  and defasss_inline_calls: "\<lbrakk> calls es = \<lfloor>aMvs\<rfloor>; \<D>s es A \<rbrakk> \<Longrightarrow> \<D>s (inline_calls e' es) A"
proof(induct e and es arbitrary: A and A rule: call.induct calls.induct)
  case (Call obj M params A)
  obtain a M' vs where [simp]: "aMvs = (a, M', vs)" by(cases aMvs, auto)
  with `call (obj\<bullet>M(params)) = \<lfloor>aMvs\<rfloor>` have "call (obj\<bullet>M(params)) = \<lfloor>(a, M', vs)\<rfloor>"  by simp
  thus ?case
  proof(cases rule: call_callE)
    case CallObj
    with `\<D> (obj\<bullet>M(params)) A` `\<lbrakk>call obj = \<lfloor>aMvs\<rfloor>; \<D> obj A\<rbrakk> \<Longrightarrow> \<D> (inline_call e' obj) A`
    have "\<D> (inline_call e' obj) A" by simp
    moreover from A_inline_call[OF CallObj, of e']
    have "A \<squnion> (\<A> obj) \<sqsubseteq> A \<squnion> (\<A> (inline_call e' obj))" by(rule sqUn_lem2)
    with `\<D> (obj\<bullet>M(params)) A` have "\<D>s params (A \<squnion> \<A> (inline_call e' obj))" by(auto elim: Ds_mono')
    ultimately show ?thesis using CallObj by auto
  next
    case (CallParams v)
    with `\<D> (obj\<bullet>M(params)) A` `\<lbrakk>calls params = \<lfloor>aMvs\<rfloor>; \<D>s params A\<rbrakk> \<Longrightarrow> \<D>s (inline_calls e' params) A`
    have "\<D>s (inline_calls e' params) A" by(simp)
    with CallParams show ?thesis by(auto)
  next
    case Call
    with `final e'` show ?thesis by(auto elim!: D_mono' simp add: hyperset_defs)
  qed
next
  case (Cons_exp exp exps A)
  show ?case
  proof(cases "is_val exp")
    case True
    with `\<D>s (exp # exps) A` `\<lbrakk>calls exps = \<lfloor>aMvs\<rfloor>; \<D>s exps A\<rbrakk> \<Longrightarrow> \<D>s (inline_calls e' exps) A`
      `calls (exp # exps) = \<lfloor>aMvs\<rfloor>`
    have "\<D>s (inline_calls e' exps) A" by(auto)
    with True show ?thesis by(auto)
  next
    case False
    with `\<lbrakk>call exp = \<lfloor>aMvs\<rfloor>; \<D> exp A\<rbrakk> \<Longrightarrow> \<D> (inline_call e' exp) A` `calls (exp # exps) = \<lfloor>aMvs\<rfloor>` `\<D>s (exp # exps) A`
    have "\<D> (inline_call e' exp) A" by auto
    moreover from False `calls (exp # exps) = \<lfloor>aMvs\<rfloor>` have "\<A> exp \<sqsubseteq> \<A> (inline_call e' exp)"
      by(auto intro: A_inline_call)
    hence "A \<squnion> \<A> exp \<sqsubseteq> A \<squnion> \<A> (inline_call e' exp)" by(rule sqUn_lem2)
    with `\<D>s (exp # exps) A` have "\<D>s exps (A \<squnion> \<A> (inline_call e' exp))"
      by(auto intro: Ds_mono')
    ultimately show ?thesis using False by(auto)
  qed
qed(fastforce split: split_if_asm elim: D_mono' intro: sqUn_lem2 sqUn_lem A_inline_call)+

lemma bisim_B: "bisim Vs e E xs \<Longrightarrow> \<B> E (length Vs)"
  and bisims_Bs: "bisims Vs es Es xs \<Longrightarrow> \<B>s Es (length Vs)"
apply(induct rule: bisim_bisims.inducts)
apply(auto intro: \<B> \<B>s)
done

lemma bisim_expr_locks_eq: "bisim Vs e e' xs \<Longrightarrow> expr_locks e = expr_locks e'"
  and bisims_expr_lockss_eq: "bisims Vs es es' xs \<Longrightarrow> expr_lockss es = expr_lockss es'"
by(induct rule: bisim_bisims.inducts)(auto intro!: ext)

lemma bisim_list_expr_lockss_eq: "bisim_list es exs' \<Longrightarrow> expr_lockss es = expr_lockss (map fst exs')"
apply(induct rule: bisim_list.induct)
apply(auto dest: bisim_expr_locks_eq)
done

context J1_heap_base begin

lemma \<tau>Move1_compP [simp]: "\<tau>Move1 (compP f P) = \<tau>Move1 P"
by(intro ext) auto

lemma red1_preserves_unmod:
  "\<lbrakk> uf,P,t \<turnstile>1 \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; unmod e i \<rbrakk> \<Longrightarrow> (lcl s') ! i = (lcl s) ! i"

  and reds1_preserves_unmod:
  "\<lbrakk> uf,P,t \<turnstile>1 \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; unmods es i \<rbrakk> \<Longrightarrow> (lcl s') ! i = (lcl s) ! i"
apply(induct rule: red1_reds1.inducts)
apply(auto split: split_if_asm)
done

lemma red1_unmod_preserved:
  "\<lbrakk> uf,P,t \<turnstile>1 \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; unmod e i \<rbrakk> \<Longrightarrow> unmod e' i"
  and reds1_unmods_preserved:
  "\<lbrakk> uf,P,t \<turnstile>1 \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; unmods es i \<rbrakk> \<Longrightarrow> unmods es' i"
by(induct rule: red1_reds1.inducts)(auto split: split_if_asm)

lemma \<tau>red1t_unmod_preserved:
  "\<lbrakk> \<tau>red1gt uf P t h (e, xs) (e', xs'); unmod e i \<rbrakk> \<Longrightarrow> unmod e' i"
by(induct rule: tranclp_induct2)(auto intro: red1_unmod_preserved)

lemma \<tau>red1r_unmod_preserved:
  "\<lbrakk> \<tau>red1gr uf P t h (e, xs) (e', xs'); unmod e i \<rbrakk> \<Longrightarrow> unmod e' i"
by(induct rule: rtranclp_induct2)(auto intro: red1_unmod_preserved)

lemma \<tau>red1t_preserves_unmod:
  "\<lbrakk>\<tau>red1gt uf P t h (e, xs) (e', xs'); unmod e i; i < length xs \<rbrakk>
  \<Longrightarrow> xs' ! i = xs ! i"
apply(induct rule: tranclp_induct2)
 apply(auto dest: red1_preserves_unmod)
apply(drule red1_preserves_unmod)
apply(erule (1) \<tau>red1t_unmod_preserved)
apply(drule \<tau>red1t_preserves_len)
apply auto
done

lemma \<tau>red1'r_preserves_unmod:
  "\<lbrakk>\<tau>red1gr uf P t h (e, xs) (e', xs'); unmod e i; i < length xs \<rbrakk>
  \<Longrightarrow> xs' ! i = xs ! i"
apply(induct rule: converse_rtranclp_induct2)
 apply(auto dest: red1_preserves_unmod red1_unmod_preserved red1_preserves_len)
apply(frule (1) red1_unmod_preserved)
apply(frule red1_preserves_len)
apply(frule (1) red1_preserves_unmod)
apply auto
done

end

context J_heap_base begin

lemma [simp]:
  fixes e :: "('a, 'b, 'addr) exp" and es :: "('a, 'b, 'addr) exp list"
  shows \<tau>move0_compP: "\<tau>move0 (compP f P) h e = \<tau>move0 P h e"
  and \<tau>moves0_compP: "\<tau>moves0 (compP f P) h es = \<tau>moves0 P h es"
by(induct e and es rule: \<tau>move0.induct \<tau>moves0.induct) auto

lemma \<tau>Move0_compP [simp]: "\<tau>Move0 (compP f P) = \<tau>Move0 P"
by(intro ext) auto

end

end