chapter \<open>A Control Flow Graph for Jinja Byte Code\<close>

section \<open>Formalizing the CFG\<close>

theory JVMCFG imports "../StaticInter/BasicDefs" Jinja.BVExample begin

declare lesub_list_impl_same_size [simp del]
declare nlistsE_length [simp del]

subsection \<open>Type definitions\<close>

subsubsection \<open>Wellformed Programs\<close>

definition "wf_jvmprog = {(P, Phi). wf_jvm_prog\<^bsub>Phi\<^esub> P}"

typedef wf_jvmprog = "wf_jvmprog"
proof
  show "(E, Phi) \<in> wf_jvmprog"
    unfolding wf_jvmprog_def by (auto intro: wf_prog)
qed

hide_const Phi E

abbreviation PROG :: "wf_jvmprog \<Rightarrow> jvm_prog"
  where "PROG P \<equiv> fst(Rep_wf_jvmprog(P))"

abbreviation TYPING :: "wf_jvmprog \<Rightarrow> ty\<^sub>P"
  where "TYPING P \<equiv> snd(Rep_wf_jvmprog(P))"

lemma wf_jvmprog_is_wf_typ: "wf_jvm_prog\<^bsub>TYPING P\<^esub> (PROG P)"
using Rep_wf_jvmprog [of P]
  by (auto simp: wf_jvmprog_def split_beta)

lemma wf_jvmprog_is_wf: "wf_jvm_prog (PROG P)"
  using wf_jvmprog_is_wf_typ unfolding wf_jvm_prog_def
  by blast

subsubsection \<open>Interprocedural CFG\<close>

type_synonym jvm_method = "wf_jvmprog \<times> cname \<times> mname"
datatype var = Heap | Local "nat" | Stack "nat" | Exception
datatype val = Hp "heap" | Value "Value.val"

type_synonym state = "var \<rightharpoonup> val"

definition valid_state :: "state \<Rightarrow> bool"
  where "valid_state s \<equiv> (\<forall>val. s Heap \<noteq> Some (Value val))
  \<and> (s Exception = None \<or> (\<exists>addr. s Exception = Some (Value (Addr addr))))
  \<and> (\<forall>var. var \<noteq> Heap \<and> var \<noteq> Exception \<longrightarrow> (\<forall>h. s var \<noteq> Some (Hp h)))"

fun the_Heap :: "val \<Rightarrow> heap"
  where "the_Heap (Hp h) = h"

fun the_Value :: "val \<Rightarrow> Value.val"
  where "the_Value (Value v) = v"

abbreviation heap_of :: "state \<Rightarrow> heap"
  where "heap_of s \<equiv> the_Heap (the (s Heap))"

abbreviation exc_flag :: "state \<Rightarrow> addr option"
  where "exc_flag s \<equiv> case (s Exception) of None \<Rightarrow> None
  | Some v \<Rightarrow> Some (THE a. v = Value (Addr a))"

abbreviation stkAt :: "state \<Rightarrow> nat \<Rightarrow> Value.val"
  where "stkAt s n \<equiv> the_Value (the (s (Stack n)))"

abbreviation locAt :: "state \<Rightarrow> nat \<Rightarrow> Value.val"
  where "locAt s n \<equiv> the_Value (the (s (Local n)))"

datatype nodeType = Enter | Normal | Return | Exceptional "pc option" "nodeType"
type_synonym cfg_node = "cname \<times> mname \<times> pc option \<times> nodeType"

type_synonym
  cfg_edge = "cfg_node \<times> (var, val, cname \<times> mname \<times> pc, cname \<times> mname) edge_kind \<times> cfg_node"

definition ClassMain :: "wf_jvmprog \<Rightarrow> cname"
  where "ClassMain P \<equiv> SOME Name. \<not> is_class (PROG P) Name"

definition MethodMain :: "wf_jvmprog \<Rightarrow> mname"
  where "MethodMain P \<equiv> SOME Name.
  \<forall>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<longrightarrow> (\<forall>m \<in> set ms. Name \<noteq> fst m)"

definition stkLength :: "jvm_method \<Rightarrow> pc \<Rightarrow> nat"
  where
  "stkLength m pc \<equiv> let (P, C, M) = m in (
  if (C = ClassMain P) then 1 else (
    length (fst(the(((TYPING P) C M) ! pc)))
  ))"

definition locLength :: "jvm_method \<Rightarrow> pc \<Rightarrow> nat"
  where
  "locLength m pc \<equiv> let (P, C, M) = m in (
  if (C = ClassMain P) then 1 else (
    length (snd(the(((TYPING P) C M) ! pc)))
  ))"

lemma ex_new_class_name: "\<exists>C. \<not> is_class P C"
proof -
  have "\<not> finite (UNIV :: cname set)"
    by (rule infinite_UNIV_listI)
  hence "\<exists>C. C \<notin> set (map fst P)"
    by -(rule ex_new_if_finite, auto)
  then obtain C where "C \<notin> set (map fst P)"
    by blast
  have "\<not> is_class P C"
  proof
    assume "is_class P C"
    then obtain D fs ms where "class P C = \<lfloor>(D, fs, ms)\<rfloor>"
      by auto
    with \<open>C \<notin> set (map fst P)\<close> show False
      by (auto dest: map_of_SomeD intro!: image_eqI simp: class_def)
  qed
  thus ?thesis
    by blast
qed

lemma ClassMain_unique_in_P:
  assumes "is_class (PROG P) C"
  shows "ClassMain P \<noteq> C"
proof -
  from ex_new_class_name [of "PROG P"] obtain D where "\<not> is_class (PROG P) D"
    by blast
  with \<open>is_class (PROG P) C\<close> show ?thesis
    unfolding ClassMain_def
    by -(rule someI2, fastforce+)
qed

lemma map_of_fstD: "\<lbrakk> map_of xs a = \<lfloor>b\<rfloor>; \<forall>x \<in> set xs. fst x \<noteq> a \<rbrakk> \<Longrightarrow> False"
  by (induct xs, auto)

lemma map_of_fstE: "\<lbrakk> map_of xs a = \<lfloor>b\<rfloor>; \<exists>x \<in> set xs. fst x = a \<Longrightarrow> thesis \<rbrakk> \<Longrightarrow> thesis"
  by (induct xs) (auto split: if_split_asm)

lemma ex_unique_method_name:
  "\<exists>Name. \<forall>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<longrightarrow> (\<forall>m\<in>set ms. Name \<noteq> fst m)"
proof -
  from wf_jvmprog_is_wf [of P]
  have "distinct_fst (PROG P)"
    by (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def wf_prog_def)
  hence "{C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>} = fst ` set (PROG P)"
    by (fastforce elim: map_of_fstE simp: class_def intro: map_of_SomeI)
  hence "finite {C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
    by auto
  moreover have "{ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}
    = snd ` snd ` the ` (\<lambda>C. class (PROG P) C) ` {C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
    by (fastforce intro: rev_image_eqI map_of_SomeI simp: class_def)
  ultimately have "finite {ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
    by auto
  moreover have "\<not> finite (UNIV :: mname set)"
    by (rule infinite_UNIV_listI)
  ultimately
  have "\<exists>Name. Name \<notin> fst ` (\<Union>ms \<in> {ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}. set ms)"
    by -(rule ex_new_if_finite, auto)
  thus ?thesis
    by fastforce
qed

lemma MethodMain_unique_in_P:
  assumes "PROG P \<turnstile> D sees M:Ts\<rightarrow>T = mb in C"
  shows "MethodMain P \<noteq> M"
proof -
  from ex_unique_method_name [of P] obtain M'
    where "\<And>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<Longrightarrow> (\<forall>m \<in> set ms. M' \<noteq> fst m)"
    by blast
  with \<open>PROG P \<turnstile> D sees M:Ts\<rightarrow>T = mb in C\<close>
  show ?thesis
    unfolding MethodMain_def
    by -(rule someI2_ex, fastforce, fastforce dest!: visible_method_exists elim: map_of_fstE)
qed

lemma ClassMain_is_no_class [dest!]: "is_class (PROG P) (ClassMain P) \<Longrightarrow> False"
proof (erule rev_notE)
  from ex_new_class_name [of "PROG P"] obtain C where "\<not> is_class (PROG P) C"
    by blast
  thus "\<not> is_class (PROG P) (ClassMain P)" unfolding ClassMain_def
    by (rule someI)
qed

lemma MethodMain_not_seen [dest!]: "PROG P \<turnstile> C sees (MethodMain P):Ts\<rightarrow>T = mb in D \<Longrightarrow> False"
  by (fastforce dest: MethodMain_unique_in_P)

lemma no_Call_from_ClassMain [dest!]: "PROG P \<turnstile> ClassMain P sees M:Ts\<rightarrow>T = mb in C \<Longrightarrow> False"
  by (fastforce dest: sees_method_is_class)

lemma no_Call_in_ClassMain [dest!]: "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = mb in ClassMain P \<Longrightarrow> False"
  by (fastforce dest: sees_method_idemp)

inductive JVMCFG :: "jvm_method \<Rightarrow> cfg_node \<Rightarrow> (var, val, cname \<times> mname \<times> pc, cname \<times> mname) edge_kind \<Rightarrow> cfg_node \<Rightarrow> bool" (" _ \<turnstile> _ -_\<rightarrow> _")
  and reachable :: "jvm_method \<Rightarrow> cfg_node \<Rightarrow> bool" (" _ \<turnstile> \<Rightarrow>_")
  where
    Entry_reachable: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, None, Enter)"
  | reachable_step: "\<lbrakk> P \<turnstile> \<Rightarrow>n; P \<turnstile> n -(e)\<rightarrow> n' \<rbrakk> \<Longrightarrow> P \<turnstile> \<Rightarrow>n'"
  | Main_to_Call: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)
  \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter) -\<Up>id\<rightarrow> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
  | Main_Call_LFalse: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)
  \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"
  | Main_Call: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal);
     PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D;
     initParams = [(\<lambda>s. s Heap),(\<lambda>s. \<lfloor>Value Null\<rfloor>)];
     ek = (\<lambda>(s, ret). True):(ClassMain P, MethodMain P, 0)\<hookrightarrow>\<^bsub>(D, Main)\<^esub>initParams \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal) -(ek)\<rightarrow> (D, Main, None, Enter)"
  | Main_Return_to_Exit: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)
  \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return) -(\<Up>id)\<rightarrow> (ClassMain P, MethodMain P, None, Return)"
  | Method_LFalse: "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Enter) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (C, M, None, Return)"
  | Method_LTrue: "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Enter) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (C, M, \<lfloor>0\<rfloor>, Enter)"
  | CFG_Load: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Load n;
    ek = \<Up>(\<lambda>s. s(Stack (stkLength (P, C, M) pc) := s (Local n))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Store: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Store n;
    ek = \<Up>(\<lambda>s. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Push: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Push v;
    ek = \<Up>(\<lambda>s. s(Stack (stkLength (P, C, M) pc) \<mapsto> Value v)) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Pop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Pop;
    ek = \<Up>id \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_IAdd: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = IAdd;
    ek = \<Up>(\<lambda>s. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
                   i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
                in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Intg (i1 + i2)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Goto: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Goto i \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -((\<lambda>s. True)\<^sub>\<surd>)\<rightarrow> (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
  | CFG_CmpEq: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = CmpEq;
    ek = \<Up>(\<lambda>s. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
                   e2 = stkAt s (stkLength (P, C, M) pc - 2)
                in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Bool (e1 = e2)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_IfFalse_False: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = IfFalse i;
    i \<noteq> 1;
    ek = (\<lambda>s. stkAt s (stkLength(P, C, M) pc - 1) = Bool False)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
  | CFG_IfFalse_True: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = IfFalse i;
    ek = (\<lambda>s. stkAt s (stkLength(P, C, M) pc - 1) \<noteq> Bool False \<or> i = 1)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_New_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = (\<lambda>s. new_Addr (heap_of s) \<noteq> None)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
  | CFG_New_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    pc' = (case (match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M)) of
             None \<Rightarrow> None
           | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
    ek = (\<lambda>s. new_Addr (heap_of s) = None)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
  | CFG_New_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = \<Up>(\<lambda>s. let a = the (new_Addr (heap_of s))
                in s(Heap \<mapsto> Hp ((heap_of s)(a \<mapsto> blank (PROG P) Cl)),
                    Stack (stkLength(P, C, M) pc) \<mapsto> Value (Addr a))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_New_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt OutOfMemory)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_New_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt OutOfMemory)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Getfield_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
  | CFG_Getfield_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None \<Rightarrow> None
           | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) = Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
  | CFG_Getfield_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = \<Up>(\<lambda>s. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
                 in s(Stack (stkLength(P, C, M) pc - 1) \<mapsto> Value (the (fs (F, Cl))))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Getfield_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Getfield_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Putfield_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
  | CFG_Putfield_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None \<Rightarrow> None
           | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) = Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
  | CFG_Putfield_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = \<Up>(\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
                   r = stkAt s (stkLength (P, C, M) pc - 2);
                   a = the_Addr r;
                   (D, fs) = the (heap_of s a);
                   h' = (heap_of s)(a \<mapsto> (D, fs((F, Cl) \<mapsto> v)))
                 in s(Heap \<mapsto> Hp h')) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Putfield_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Putfield_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Checkcast_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = (\<lambda>s. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Checkcast_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    pc' = (case (match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M)) of
             None \<Rightarrow> None
           | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
    ek = (\<lambda>s. \<not> cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
  | CFG_Checkcast_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt ClassCast)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Checkcast_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt ClassCast)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Throw_Check: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Throw;
    pc' = None \<or> match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(the pc', d)\<rfloor>;
    ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
                  Cl = if (v = Null) then NullPointer else (cname_of (heap_of s) (the_Addr v))
               in case pc' of
                  None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
                | Some pc'' \<Rightarrow> \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M)
                                  = \<lfloor>(pc'', d)\<rfloor>
    )\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"

  | CFG_Throw_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Throw;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (stkAt s (stkLength (P, C, M) pc - 1)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Throw_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    pc' \<noteq> length (instrs_of (PROG P) C M);
    instrs_of (PROG P) C M ! pc = Throw;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (stkAt s (stkLength (P, C, M) pc - 1)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Invoke_Check_NP_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
  | CFG_Invoke_Check_NP_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None \<Rightarrow> None
           | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
    ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
  | CFG_Invoke_NP_prop: "\<lbrakk> C \<noteq> ClassMain P;
    (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Invoke_NP_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = \<Up>(\<lambda>s. (s(Exception := None))
                (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Invoke_Call: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    TYPING P C M ! pc = \<lfloor>(ST, LT)\<rfloor>;
    ST ! n = Class D';
    PROG P \<turnstile> D' sees M':Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D;
    Q = (\<lambda>(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
                        C' = fst (the (heap_of s (the_Addr r)))
                     in D = fst (method (PROG P) C' M'));
    paramDefs = (\<lambda>s. s Heap)
                # (\<lambda>s. s (Stack (stkLength (P, C, M) pc - Suc n)))
                # (rev (map (\<lambda>i. (\<lambda>s. s (Stack (stkLength (P, C, M) pc - Suc i)))) [0..<n]));
    ek = Q:(C, M, pc)\<hookrightarrow>\<^bsub>(D,M')\<^esub>paramDefs
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (D, M', None, Enter)"
  | CFG_Invoke_False: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (\<lambda>s. False)\<^sub>\<surd>
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Return)"
  | CFG_Invoke_Return_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    (TYPING P) C M ! pc = \<lfloor>(ST, LT)\<rfloor>;
    ST ! n \<noteq> NT;
    ek = (\<lambda>s. s Exception = None)\<^sub>\<surd>
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
  | CFG_Invoke_Return_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', diff)\<rfloor>;
    pc' \<noteq> length (instrs_of (PROG P) C M);
    ek = (\<lambda>s. \<exists>v d. s Exception = \<lfloor>v\<rfloor> \<and>
                  match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d)\<rfloor>)\<^sub>\<surd>
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)"
  | CFG_Invoke_Return_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = \<Up>(\<lambda>s. s(Exception := None,
                 Stack (stkLength (P, C, M) pc' - 1) := s Exception)) \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
  | CFG_Invoke_Return_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P;
    (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (\<lambda>s. \<exists>v. s Exception = \<lfloor>v\<rfloor> \<and>
              match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = None)\<^sub>\<surd> \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Return: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
    instrs_of (PROG P) C M ! pc = instr.Return;
    ek = \<Up>(\<lambda>s. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1))))
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, None, Return)"
  | CFG_Return_from_Method: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Return);
    (P, C0, Main) \<turnstile> (C', M', \<lfloor>pc'\<rfloor>, Normal) -(Q':(C', M', pc')\<hookrightarrow>\<^bsub>(C,M)\<^esub>ps)\<rightarrow> (C, M, None, Enter);
    Q = (\<lambda>(s, ret). ret = (C', M', pc'));
    stateUpdate = (\<lambda>s s'. s'(Heap := s Heap,
                            Exception := s Exception,
                            Stack (stkLength (P, C', M') (Suc pc') - 1) := s (Stack 0))
                  );
    ek = Q\<hookleftarrow>\<^bsub>(C, M)\<^esub>stateUpdate
  \<rbrakk>
  \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Return) -(ek)\<rightarrow> (C', M', \<lfloor>pc'\<rfloor>, Return)"

(* This takes veeeery long *)
lemma JVMCFG_edge_det: "\<lbrakk> P \<turnstile> n -(et)\<rightarrow> n'; P \<turnstile> n -(et')\<rightarrow> n' \<rbrakk> \<Longrightarrow> et = et'"
  by (erule JVMCFG.cases) (erule JVMCFG.cases, (fastforce dest: sees_method_fun)+)+

lemma sourcenode_reachable: "P \<turnstile> n -(ek)\<rightarrow> n' \<Longrightarrow> P \<turnstile> \<Rightarrow>n"
  by (erule JVMCFG.cases, auto)

lemma targetnode_reachable:
  assumes edge: "P \<turnstile> n -(ek)\<rightarrow> n'"
  shows "P \<turnstile> \<Rightarrow>n'"
proof -
  from edge have "P \<turnstile> \<Rightarrow>n"
    by -(drule sourcenode_reachable)
  with edge show ?thesis
    by -(rule JVMCFG_reachable.intros)
qed

lemmas JVMCFG_reachable_inducts = JVMCFG_reachable.inducts[split_format (complete)]

lemma ClassMain_imp_MethodMain:
  "(P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (ClassMain P, M, pc, nt) \<Longrightarrow> M = MethodMain P"
  "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, M, pc, nt) \<Longrightarrow> M = MethodMain P"
proof (induct P=="P" C0\<equiv>"C0" Main\<equiv>Main C' M' pc' nt' ek C''=="ClassMain P" M pc nt and
              P=="P" C0\<equiv>"C0" Main\<equiv>Main C'=="ClassMain P" M pc nt
       rule: JVMCFG_reachable_inducts)
  case CFG_Return_from_Method
  thus ?case
    by (fastforce elim: JVMCFG.cases)
qed auto

lemma ClassMain_no_Call_target [dest!]:
  "(P, C0, Main) \<turnstile> (C, M, pc, nt) -Q:(C', M', pc')\<hookrightarrow>\<^bsub>(D,M'')\<^esub>paramDefs\<rightarrow> (ClassMain P, M''', pc'', nt')
  \<Longrightarrow> False"
  and
  "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt) \<Longrightarrow> True"
  by (induct  P C0 Main C M pc nt ek=="Q:(C', M', pc')\<hookrightarrow>\<^bsub>(D,M'')\<^esub>paramDefs"
                         C''=="ClassMain P" M''' pc'' nt' and
               P C0 Main C M pc nt
    rule: JVMCFG_reachable_inducts) auto

lemma method_of_src_and_trg_exists:
  "\<lbrakk> (P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (C, M, pc, nt); C \<noteq> ClassMain P; C' \<noteq> ClassMain P \<rbrakk>
  \<Longrightarrow> (\<exists>Ts T mb. (PROG P) \<turnstile> C sees M:Ts\<rightarrow>T = mb in C) \<and>
     (\<exists>Ts T mb. (PROG P) \<turnstile> C' sees M':Ts\<rightarrow>T = mb in C')"
  and method_of_reachable_node_exists:
  "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P \<rbrakk>
  \<Longrightarrow> \<exists>Ts T mb. (PROG P) \<turnstile> C sees M:Ts\<rightarrow>T = mb in C"
proof (induct rule: JVMCFG_reachable_inducts)
  case CFG_Invoke_Call
  thus ?case
    by (blast dest: sees_method_idemp)
next
  case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
  show ?case
  proof (cases "C = ClassMain P")
    case True
    with \<open>(P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')\<close> \<open>C' \<noteq> ClassMain P\<close>
    show ?thesis
    proof cases
      case Main_Call
      thus ?thesis
        by (blast dest: sees_method_idemp)
    qed auto
  next
    case False
    with reachable_step show ?thesis
      by simp
  qed
qed simp_all

lemma "\<lbrakk> (P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (C, M, pc, nt); C \<noteq> ClassMain P; C' \<noteq> ClassMain P \<rbrakk>
  \<Longrightarrow> (case pc of None \<Rightarrow> True |
    \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C M ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C M)) \<and>
  (case pc' of None \<Rightarrow> True |
    \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C' M' ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C' M'))"
  and instr_of_reachable_node_typable: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P \<rbrakk>
  \<Longrightarrow> case pc of None \<Rightarrow> True |
  \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C M ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C M)"
proof (induct rule: JVMCFG_reachable_inducts)
  case (CFG_Load C P C0 Main M pc n ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Load show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Store C P C0 Main M pc n ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Store show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Push C P C0 Main M pc v ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Push show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Pop C P C0 Main M pc ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Pop show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IAdd C P C0 Main M pc ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IAdd show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Goto C P C0 Main M pc i)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Goto show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_CmpEq C P C0 Main M pc ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_CmpEq show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IfFalse_False C P C0 Main M pc i ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IfFalse_False show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IfFalse_True C P C0 Main M pc i ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IfFalse_True show ?case
    using [[simproc del: list_to_set_comprehension]] by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_New_Update C P C0 Main M pc Cl ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_New_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> New Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = New Cl\<close> obtain d'
    where "match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) OutOfMemory pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Getfield_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Getfield F Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close> obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Putfield_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Putfield F Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close> obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Checkcast_Check_Normal show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Checkcast Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close> obtain d'
    where "match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) ClassCast pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Throw_handle C P C0 Main M pc pc' ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Throw,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Throw\<close> obtain d' Exc
    where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Invoke M' n,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
  hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 where
    "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
    \<turnstile> Invoke M' n,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)\<close> \<open>C \<noteq> ClassMain P\<close>
    \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> obtain d' Exc
    where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
    by cases (fastforce elim: JVMCFG.cases)
  hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Invoke_Return_Check_Normal show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (Method_LTrue P C0 Main C M)
  from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
  obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with Method_LTrue show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_start [OF wf_jvmprog_is_wf_typ] simp: wt_start_def)
next
  case (reachable_step P C0 Main C M opc nt ek C' M' opc' nt')
  thus ?case
    by (cases "C = ClassMain P") (fastforce elim: JVMCFG.cases, simp)
qed simp_all

lemma reachable_node_impl_wt_instr:
  assumes "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nt)"
  and "C \<noteq> ClassMain P"
  shows "\<exists>T mxs mpc xt. PROG P,T,mxs,mpc,xt \<turnstile> (instrs_of (PROG P) C M ! pc),pc :: TYPING P C M"
proof -
  from \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nt)\<close>
    method_of_reachable_node_exists [of P C0 Main C M "\<lfloor>pc\<rfloor>" nt]
    instr_of_reachable_node_typable [of P C0 Main C M "\<lfloor>pc\<rfloor>" nt]
  obtain Ts T mxs mxl\<^sub>0 "is" xt
    where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
    and "TYPING P C M ! pc \<noteq> None"
    and "pc < length (instrs_of (PROG P) C M)"
    by fastforce+
  with wf_jvmprog_is_wf_typ [of P]
  have "PROG P,T,mxs,length is,xt \<turnstile> instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
  thus ?thesis
    by blast
qed

lemma
  "\<lbrakk> (P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt'); C \<noteq> ClassMain P \<or> C' \<noteq> ClassMain P \<rbrakk>
  \<Longrightarrow> \<exists>T mb D. PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = mb in D"
  and reachable_node_impl_Main_ex:
  "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P\<rbrakk>
  \<Longrightarrow> \<exists>T mb D. PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = mb in D"
  by (induct rule: JVMCFG_reachable_inducts) fastforce+

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |              Februaru 2006                |
            |                 March 2007  (modified)    |
            |                 August 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory FNF_F_sf_rest
imports FNF_F_sf_def
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

(*  The following simplification rules are deleted in this theory file *)
(*       P (if Q then x else y) = ((Q --> P x) & (~ Q --> P y))        *)

declare split_if  [split del]

(*****************************************************************

         1. full sequentialization for Depth-restriction (P |. n)
         2.
         3.

 *****************************************************************)

(*============================================================*
 |                                                            |
 |                       Depth_rest                           |
 |                                                            |
 *============================================================*)

(*============================================================*
 |                         Pfun P1 P2                         |
 *============================================================*)

(*** relation ***)

inductive_set
  fsfF_Depth_rest_rel ::
  "(('p,'a) proc * nat * ('p,'a) proc) set"

where
fsfF_Depth_rest_rel_zero:
  "(P1, 0, SDIV) : fsfF_Depth_rest_rel"
|
fsfF_Depth_rest_rel_etc:
  "P1 ~: fsfF_proc
   ==> (P1, Suc n, P1 |. (Suc n)) : fsfF_Depth_rest_rel"
|
fsfF_Depth_rest_rel_int:
  "[| ALL c. if (c: sumset C1)
             then (Rf1 c, Suc m, SRf c) : fsfF_Depth_rest_rel
             else SRf c = DIV ;
      sumset C1 ~= {} ; ALL c: sumset C1. Rf1 c : fsfF_proc |]
   ==>
   ((!! :C1 .. Rf1), Suc m, !! c:C1 .. SRf c)
   : fsfF_Depth_rest_rel"
|
fsfF_Depth_rest_rel_step:
  "[| ALL a. if a:A1
             then (Pf1 a, n, SPf a) : fsfF_Depth_rest_rel
             else SPf a = DIV ;
      ALL a:A1. Pf1 a : fsfF_proc ;
      Q1 = SKIP | Q1 = DIV | Q1 = STOP |]
   ==>
   ((? :A1 -> Pf1) [+] Q1, Suc n, (? :A1 -> SPf) [+] Q1) : fsfF_Depth_rest_rel"

(*** function ***)

definition
  fsfF_Depth_rest ::
  "('p,'a) proc => nat => ('p,'a) proc"   ("(1_ /|.seq _)" [84,900] 84)
  where
  fsfF_Depth_rest_def:
    "P1 |.seq n == THE SP. (P1, n, SP) : fsfF_Depth_rest_rel"

(****************************************************************
 |                      uniquness                               |
 ****************************************************************)

lemma fsfF_Depth_rest_rel_unique_in_lm:
   "(P1, n, SP1) : fsfF_Depth_rest_rel
    ==> (ALL SP2. ((P1, n, SP2) : fsfF_Depth_rest_rel
                   --> SP1 = SP2))"
apply (rule fsfF_Depth_rest_rel.induct[of P1 n SP1])
apply (simp)

(* zero *)
apply (intro allI impI)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases)
apply (simp_all)

(* etc *)
apply (intro allI impI)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases)
apply (simp_all)
apply (simp add: fsfF_proc_int)
apply (simp add: fsfF_proc_ext)

(* step_int *)
apply (intro allI impI)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc_int)

 apply (simp add: fun_eq_iff)
 apply (intro allI)
 apply (drule_tac x="x" in spec)+
 apply (case_tac "x : sumset C1a")
 apply (simp)
 apply (simp)

(* step *)
apply (intro allI impI)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc_ext)

  apply (simp add: fun_eq_iff)
  apply (rule allI)
  apply (drule_tac x="x" in spec)+
  apply (case_tac "x : A1a")
  apply (simp_all)
done

(*-----------------------*
 |        unique         |
 *-----------------------*)

lemma fsfF_Depth_rest_rel_unique:
   "[| (P1, n, SP1) : fsfF_Depth_rest_rel;
       (P1, n, SP2) : fsfF_Depth_rest_rel |]
    ==> SP1 = SP2"
by (simp add: fsfF_Depth_rest_rel_unique_in_lm)

lemma fsfF_Depth_rest_rel_EX1:
   "(EX SP. (P1, n, SP) : fsfF_Depth_rest_rel)
 = (EX! SP. (P1, n, SP) : fsfF_Depth_rest_rel)"
apply (rule iffI)

 apply (erule exE)
 apply (rule_tac a="SP" in ex1I)
 apply (simp)
 apply (simp add: fsfF_Depth_rest_rel_unique)

 apply (elim ex1_implies_exE)
 apply (simp)
done

(*------------------------------------------------------------*
 |                   fsfF_Depth_rest_rel (iff)                |
 *------------------------------------------------------------*)

(* zero *)

lemma fsfF_Depth_rest_rel_zero_iff:
  "(P1, 0, SP) : fsfF_Depth_rest_rel
   = (SP = SDIV)"
apply (rule)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)
apply (simp add: fsfF_Depth_rest_rel_zero)
done

(* etc *)

lemma fsfF_Depth_rest_rel_etc_iff:
  "P1 ~: fsfF_proc
   ==> (P1, Suc n, SP) : fsfF_Depth_rest_rel
       = (SP = P1 |. Suc n)"
apply (rule)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)
 apply (simp add: fsfF_proc_int)
 apply (simp add: fsfF_proc_ext)
apply (simp add: fsfF_Depth_rest_rel_etc)
done

(* int nat *)

lemma fsfF_Depth_rest_rel_int_iff:
  "[| ALL c. if (c: sumset C1)
             then (Rf1 c, Suc m, SRf c) : fsfF_Depth_rest_rel
             else SRf c = DIV ;
      sumset C1 ~= {} ; ALL c: sumset C1. Rf1 c : fsfF_proc |]
   ==>
   ((!! :C1 .. Rf1), Suc m, SP) : fsfF_Depth_rest_rel
   = (SP = !! :C1 .. SRf)"
apply (rule)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc_int)

 apply (simp add: fun_eq_iff)
 apply (rule allI)
 apply (drule_tac x="x" in spec)+
 apply (case_tac "x : sumset C1a")
 apply (simp add: fsfF_Depth_rest_rel_unique)

 apply (simp)
apply (simp add: fsfF_Depth_rest_rel_int)
done

(* step *)

lemma fsfF_Depth_rest_rel_step_iff:
  "[| ALL a. if a:A1
             then (Pf1 a, n, SPf a) : fsfF_Depth_rest_rel
             else SPf a = DIV ;
      ALL a:A1. Pf1 a : fsfF_proc ;
      Q1 = SKIP | Q1 = DIV | Q1 = STOP |]
   ==>
   ((? :A1 -> Pf1) [+] Q1, Suc n, SP) : fsfF_Depth_rest_rel
   = (SP = (? :A1 -> SPf) [+] Q1)"
apply (rule)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc_ext)

 apply (simp add: fun_eq_iff)
 apply (intro allI conjI)
 apply (elim conjE)
 apply (drule_tac x="x" in spec)+
 apply (case_tac "x : A1a")
 apply (simp add: fsfF_Depth_rest_rel_unique)
 apply (simp)
apply (simp add: fsfF_Depth_rest_rel_step)
done

(****************************************************************
 |                      existency                               |
 ****************************************************************)

(*** exists ***)

lemma fsfF_Depth_rest_rel_exists_zero:
   "(EX SP. (P1, 0, SP) : fsfF_Depth_rest_rel)"
apply (rule_tac x="SDIV" in exI)
apply (simp add: fsfF_Depth_rest_rel.intros)
done

lemma fsfF_Depth_rest_rel_exists_notin:
   "P1 ~: fsfF_proc
    ==> (EX SP. (P1, n, SP) : fsfF_Depth_rest_rel)"
apply (insert nat_zero_or_Suc)
apply (drule_tac x="n" in spec)
apply (elim disjE exE)
apply (simp add: fsfF_Depth_rest_rel_exists_zero)
apply (rule_tac x="P1 |. n" in exI)
apply (simp add: fsfF_Depth_rest_rel.intros)
done

(*** in fsfF_proc ***)

(********* P1 and P2 *********)

lemma fsfF_Depth_rest_rel_exists_in:
   "P1 : fsfF_proc
    ==> ALL n. (EX SP. (P1, n, SP) :  fsfF_Depth_rest_rel)"
apply (rule fsfF_proc.induct[of P1])
apply (simp)

(* int nat *)
apply (rule allI)
apply (insert nat_zero_or_Suc)
apply (drule_tac x="n" in spec)
apply (elim disjE exE)
apply (simp add: fsfF_Depth_rest_rel_exists_zero)

apply (erule dist_BALL_conjE)
apply (simp add: exchange_ALL_BALL)
apply (simp add: choice_BALL_EX)
apply (drule_tac x="n" in spec)
apply (elim exE)
apply (rule_tac x="!! c:C .. (if (c : sumset C) then f c else DIV)" in exI)
apply (rule fsfF_Depth_rest_rel.intros)
apply (simp split: split_if)
apply (simp_all)

(* ext *)
apply (rule allI)
apply (drule_tac x="n" in spec)
apply (rotate_tac -1)
apply (erule disjE)
apply (simp add: fsfF_Depth_rest_rel_exists_zero)

apply (elim exE)
apply (erule dist_BALL_conjE)

apply (simp add: exchange_ALL_BALL)
apply (simp add: choice_BALL_EX)
apply (drule_tac x="m" in spec)
apply (elim exE)
apply (rule_tac x="? a:A -> (if (a : A) then (f a) else DIV) [+] Q" in exI)
apply (rule fsfF_Depth_rest_rel.intros)
apply (simp split: split_if)
apply (simp_all)
done

(*-----------------------*
 |        exists         |
 *-----------------------*)

lemma fsfF_Depth_rest_rel_exists:
   "EX SP. (P1, n, SP) :  fsfF_Depth_rest_rel"
apply (case_tac "P1 ~: fsfF_proc")
apply (simp add: fsfF_Depth_rest_rel_exists_notin)
apply (simp add: fsfF_Depth_rest_rel_exists_in)
done

(*-----------------------*
 |    uniquely exists    |
 *-----------------------*)

lemma fsfF_Depth_rest_rel_unique_exists:
   "EX! SP. (P1, n, SP) :  fsfF_Depth_rest_rel"
apply (simp add: fsfF_Depth_rest_rel_EX1[THEN sym])
apply (simp add: fsfF_Depth_rest_rel_exists)
done

(*------------------------------------------------------------*
 |                        in fsfF_proc                        |
 *------------------------------------------------------------*)

lemma fsfF_Depth_rest_rel_zero_in:
  "(P1, 0, SP) : fsfF_Depth_rest_rel ==> SP : fsfF_proc"
apply (simp add: fsfF_Depth_rest_rel_zero_iff)
done

lemma fsfF_Depth_rest_rel_in_lm:
  "P1 : fsfF_proc ==>
   ALL n SP. (P1, n, SP) : fsfF_Depth_rest_rel --> SP : fsfF_proc"
apply (rule fsfF_proc.induct[of P1])
apply (simp)

(* int nat *)
apply (intro allI)
apply (insert nat_zero_or_Suc)
apply (drule_tac x="n" in spec)
apply (elim disjE exE)
apply (simp add: fsfF_Depth_rest_rel_zero_in)

apply (intro impI)
apply (simp)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc.intros)

apply (rule fsfF_proc.intros)
apply (simp_all)
apply (rule ballI)
apply (drule_tac x="c" in spec)
apply (drule_tac x="c" in bspec, simp)
apply (force)

(* ext *)
apply (intro allI)
apply (drule_tac x="n" in spec)
apply (rotate_tac -1)
apply (erule disjE)
apply (simp add: fsfF_Depth_rest_rel_zero_in)

apply (intro impI)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: fsfF_proc.intros)

apply (rule fsfF_proc.intros)
apply (simp_all)
apply (rule ballI)
apply (drule_tac x="a" in spec)
apply (drule_tac x="a" in bspec, simp)
apply (force)
done

(*------------------------------------*
 |                 in                 |
 *------------------------------------*)

lemma fsfF_Depth_rest_rel_in:
  "[| P1 : fsfF_proc ; (P1, n, SP) : fsfF_Depth_rest_rel |]
   ==> SP : fsfF_proc"
apply (insert fsfF_Depth_rest_rel_in_lm[of P1])
apply (blast)
done

(*------------------------------------------------------------*
 |             syntactical transformation to fsfF             |
 *------------------------------------------------------------*)

(*** relation ***)

lemma cspF_fsfF_Depth_rest_rel_eqF_zero:
   "(P1, 0, SP) : fsfF_Depth_rest_rel
     ==> P1 |. 0 =F SP"
apply (simp add: fsfF_Depth_rest_rel_zero_iff)
apply (rule cspF_rw_left)
apply (rule cspF_Depth_rest_Zero)
apply (rule cspF_SDIV_eqF)
done

lemma cspF_fsfF_Depth_rest_rel_eqF_notin:
   "[| P1 ~: fsfF_proc ; (P1, n, SP) : fsfF_Depth_rest_rel |]
    ==> P1 |. n =F SP"
apply (insert nat_zero_or_Suc)
apply (drule_tac x="n" in spec)
apply (elim disjE exE)
apply (simp add: cspF_fsfF_Depth_rest_rel_eqF_zero)
apply (simp add: fsfF_Depth_rest_rel_etc_iff)
done

lemma cspF_fsfF_Depth_rest_rel_eqF_in:
    "P1 : fsfF_proc ==>
     ALL n SP. (P1, n, SP) : fsfF_Depth_rest_rel
                --> P1 |. n =F SP"
apply (rule fsfF_proc.induct[of P1])
apply (simp)

(* int *)
apply (intro allI)
apply (insert nat_zero_or_Suc)
apply (drule_tac x="n" in spec)
apply (elim disjE exE)
apply (simp add: cspF_fsfF_Depth_rest_rel_eqF_zero)

apply (intro impI)
apply (simp)
apply (rotate_tac -1)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)
apply (elim conjE)

apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)
apply (drule_tac x="c" in bspec, simp)
apply (drule_tac x="c" in spec)
apply (simp)

(* ext *)
apply (intro allI)
apply (drule_tac x="n" in spec)
apply (rotate_tac -1)
apply (erule disjE)
apply (simp add: cspF_fsfF_Depth_rest_rel_eqF_zero)

apply (intro impI)
apply (erule fsfF_Depth_rest_rel.cases, simp_all)

apply (rule cspF_rw_left)
apply (rule cspF_Ext_dist)
apply (rule cspF_decompo)

 apply (rule cspF_rw_left)
 apply (rule cspF_step)
 apply (rule cspF_decompo)
 apply (simp)
 apply (simp)
 apply (case_tac "Q = STOP")
 apply (simp add: cspF_STOP_Depth_rest)
 apply (simp add: cspF_SKIP_or_DIV_Depth_rest)
done

(*------------------------------------*
 |                 eqF                |
 *------------------------------------*)

lemma cspF_fsfF_Depth_rest_rel_eqF:
   "(P1, n, SP) : fsfF_Depth_rest_rel ==> P1 |. n =F SP"
apply (case_tac "P1 ~: fsfF_proc")
apply (simp add: cspF_fsfF_Depth_rest_rel_eqF_notin)
apply (simp add: cspF_fsfF_Depth_rest_rel_eqF_in)
done

(*************************************************************
                  relation --> function
 *************************************************************)

lemma fsfF_Depth_rest_in_rel:
    "(P1, n, P1 |.seq n) : fsfF_Depth_rest_rel"
apply (simp add: fsfF_Depth_rest_def)
apply (rule theI'
  [of "(%R. (P1, n, R) : fsfF_Depth_rest_rel)"])
apply (simp add: fsfF_Depth_rest_rel_unique_exists)
done

lemma fsfF_Depth_rest_from_rel:
    "((P1, n, SP) : fsfF_Depth_rest_rel)
   = (P1 |.seq n = SP)"
apply (rule iffI)
apply (simp add: fsfF_Depth_rest_def)
apply (simp add: fsfF_Depth_rest_rel_unique_exists the1_equality)

apply (drule sym)
apply (simp add: fsfF_Depth_rest_in_rel)
done

lemma fsfF_Depth_rest_to_rel:
    "(P1 |.seq n = SP)
   = ((P1, n, SP) : fsfF_Depth_rest_rel)"
by (simp add: fsfF_Depth_rest_from_rel)

(*************************************************************
                          function
 *************************************************************)

lemma fsfF_Depth_rest_zero:
  "P1 |.seq 0 = SDIV"
apply (simp add: fsfF_Depth_rest_to_rel)
apply (simp add: fsfF_Depth_rest_rel_zero_iff)
done

lemma fsfF_Depth_rest_etc:
  "P1 ~: fsfF_proc
   ==> P1 |.seq (Suc n) = P1 |. (Suc n)"
apply (simp add: fsfF_Depth_rest_to_rel)
apply (simp add: fsfF_Depth_rest_rel_etc_iff)
done

lemma fsfF_Depth_rest_int:
  "[| sumset C1 ~= {} ; ALL c: sumset C1. Rf1 c : fsfF_proc |]
   ==>
   (!! :C1 .. Rf1) |.seq (Suc m) =
    !! c:C1 .. (if c: sumset C1 then (Rf1 c |.seq (Suc m)) else DIV)"
apply (simp add: fsfF_Depth_rest_to_rel)
apply (rule fsfF_Depth_rest_rel_int)
apply (simp_all)
apply (simp split: split_if)
apply (simp add: fsfF_Depth_rest_in_rel)
done

lemma fsfF_Depth_rest_step:
  "[| ALL a:A1. Pf1 a : fsfF_proc ; Q1 = SKIP | Q1 = DIV | Q1 = STOP |]
   ==>
    ((? :A1 -> Pf1) [+] Q1) |.seq (Suc n) =
    ((? a:A1 -> (if (a:A1) then (Pf1 a |.seq n) else DIV)) [+] Q1)"
apply (simp add: fsfF_Depth_rest_to_rel)
apply (rule fsfF_Depth_rest_rel_step)
apply (simp_all)
apply (simp split: split_if)
apply (simp add: fsfF_Depth_rest_in_rel)
done

lemmas fsfF_Depth_rest =
       fsfF_Depth_rest_etc
       fsfF_Depth_rest_int
       fsfF_Depth_rest_step

(*------------------------------------------------------------*
 |                        in fsfF_proc                        |
 *------------------------------------------------------------*)

lemma fsfF_Depth_rest_in:
  "P1 : fsfF_proc
   ==> P1 |.seq n : fsfF_proc"
apply (rule fsfF_Depth_rest_rel_in[of P1 n])
apply (simp_all add: fsfF_Depth_rest_in_rel)
done

(*------------------------------------------------------------*
 |             syntactical transformation to fsfF             |
 *------------------------------------------------------------*)

lemma cspF_fsfF_Depth_rest_eqF:
   "P1 |. n =F P1 |.seq n"
apply (rule cspF_fsfF_Depth_rest_rel_eqF)
apply (simp add: fsfF_Depth_rest_in_rel)
done

(****************** to add them again ******************)

declare split_if    [split]
declare disj_not1   [simp]

end


theory javacap_auxiliary
imports
  Main
  javacap_syntax
begin

(* Basic accessors for classes and interfaces *)
definition "class" :: "prog \<Rightarrow> (cname \<rightharpoonup> class)" where
  "class p \<equiv> map_of (pclasses p)"

definition is_class :: "prog \<Rightarrow> cname \<Rightarrow> bool" where
  "is_class p c \<equiv> (class p c) \<noteq> None"

definition interface :: "prog \<Rightarrow> (iname \<rightharpoonup> interface)" where
  "interface p \<equiv> map_of (pinterfaces p)"

definition is_interface :: "prog \<Rightarrow> iname \<Rightarrow> bool" where
  "is_interface p i \<equiv> (interface p i) \<noteq> None"

(* Is this a capability interface? *)
definition is_cap :: "prog \<Rightarrow> iname \<Rightarrow> bool" where
  "is_cap p c \<equiv> (\<exists>iface. interface p c = Some iface \<and> icap iface)"

(* Determines if the specified type exists (is defined) in the given program *)
primrec is_type :: "prog \<Rightarrow> \<tau> \<Rightarrow> bool" where
  "is_type p (ValT t) = True" |
  "is_type p (ClassT c) = is_class p c" |
  "is_type p (IfaceT c) = is_interface p c"

primrec is_cap_type :: "prog \<Rightarrow> \<tau> \<Rightarrow> bool" where
  "is_cap_type p (ValT t) = False" |
  "is_cap_type p (ClassT c) = False" |
  "is_cap_type p (IfaceT i) = is_cap p i"

definition grant :: "prog \<Rightarrow> (cname \<rightharpoonup> label)" where
  "grant p \<equiv> map_of (pgrants p)"

(* utility *)
primrec map_adds :: "('a \<rightharpoonup> 'b) list \<Rightarrow> ('a \<rightharpoonup> 'b)"  where
  "map_adds Nil = empty" |
  "map_adds (x # xs) = x ++ (map_adds xs)"

(* Auxilliary definitions *)
definition direct_subclass :: "prog \<Rightarrow> cname rel"
  where "direct_subclass p \<equiv> {(c,s). c \<noteq> Object \<and> (\<exists>cl. class p c = Some cl \<and> cextends cl = s) }"

definition direct_subinterface :: "prog \<Rightarrow> iname rel"
  where "direct_subinterface p \<equiv> {(c,s). (\<exists>i. interface p c = Some i \<and> s \<in> set (iextends i))}"

(* Reflective transitive closure. *)
abbreviation "subclass" :: "prog \<Rightarrow> cname rel"
  where "subclass p \<equiv> (direct_subclass p)\<^sup>*"

abbreviation subinterface :: "prog \<Rightarrow> iname rel"
  where "subinterface p \<equiv> (direct_subinterface p)\<^sup>*"

(* Note: subtype overrides supertype. *)
(* 'a = cname, 'b = (class \<Rightarrow> ('a \<times> 'b) list) \<Rightarrow> ('a \<rightharpoonup> 'b) *)
definition class_recursion ::"prog \<Rightarrow> cname \<Rightarrow> (cdecl \<Rightarrow> ('a \<rightharpoonup> 'b)) \<Rightarrow> ('a \<rightharpoonup> 'b)"
  where
  "class_recursion p \<equiv> wfrec ((direct_subclass p)\<inverse>) (\<lambda>rec cname f.
     case class p cname of None \<Rightarrow> undefined
        | Some cl \<Rightarrow> (if cname = Object then empty else rec (cextends cl) f) ++ (f (cname,cl)))"
  (* With the map ++ operator, the RHS overrides the LHS. Therefore, the subtype overrides the
     supertype. *)

definition interface_recursion ::  "prog \<Rightarrow> iname \<Rightarrow> (interface \<Rightarrow> ('a \<times> 'b) list) \<Rightarrow> ('a \<rightharpoonup> 'b)"
  where "interface_recursion p \<equiv> wfrec ((direct_subinterface p)\<inverse>) (\<lambda>rec (iname::iname) f.
    case interface p iname of None \<Rightarrow> undefined
        | Some cb \<Rightarrow> map_adds (map (\<lambda>super. rec super f) (iextends cb)) ++ map_of (f cb))"

definition cdeclmethods :: "cdecl \<Rightarrow> (mname \<rightharpoonup> (cname \<times> method))"
  where "cdeclmethods \<equiv> (\<lambda>(cn,cl). map_comp (\<lambda>m. Some (cn,m)) (map_of (cmethods cl)))"
(* equivalent to:  where "cdeclmethods \<equiv> (\<lambda>(cn,cl). map_of (map (\<lambda>(mn,meth). (mn,(cn,meth))) (cmethods cl)))"*)

(* For a given class and program name, returns a mapping
   from method names to a (declaring class name, method declaration) pair.*)
definition cmethod :: "prog \<Rightarrow> cname \<Rightarrow> (mname \<rightharpoonup> (cname \<times> method))"
  where "cmethod p c \<equiv> class_recursion p c cdeclmethods"

definition cmethoddecl :: "prog \<Rightarrow> cname \<Rightarrow> (mname \<rightharpoonup> mdecl)"
  where "cmethoddecl p c \<equiv> map_comp (\<lambda>(cn,m). Some (mdecl m)) (cmethod p c)"

definition imethoddecl :: "prog \<Rightarrow> iname \<Rightarrow> (mname \<rightharpoonup> mdecl)"
  where "imethoddecl p c \<equiv> interface_recursion p c imethods"

definition methoddecl :: "prog \<Rightarrow> \<tau> \<Rightarrow> (mname \<rightharpoonup> mdecl)"
  where "methoddecl p t \<equiv> (case t of ValT t' \<Rightarrow> undefined | ClassT c \<Rightarrow> cmethoddecl p c | IfaceT cb \<Rightarrow> imethoddecl p cb)"

definition field :: "prog \<Rightarrow> cname \<Rightarrow> (fname \<rightharpoonup> fdecl)"
  where "field p c \<equiv> class_recursion p c (\<lambda>(cn,cl). (map_of (cfields cl)))"

(* Gets the minimal label that acts as an identity when intersected with the method parameters
   and return values of this object. *)
definition sum_method_labels :: "mdecl \<Rightarrow> label"
  where "sum_method_labels md \<equiv> (tlabel (mret md)) \<union> (\<Union>p\<in>(set (msig(mpar md))). (tlabel p))"

(* The set of all superinterfaces (including itself) of an interface *)
definition superinterface_set :: "prog \<Rightarrow> iname \<Rightarrow> iname set"
  where "superinterface_set p ifname \<equiv> {ifname'. (ifname, ifname') \<in> (subinterface p)}"

(* The set of capabilities that can be accessed via a capability interface. It is the minimal label that acts
   as an the identity when intersected with the label of any method return value or parameter
   of that interface.  *)
definition cap_label :: "prog \<Rightarrow> iname \<Rightarrow> label"
  where "cap_label p ifname \<equiv> (superinterface_set p ifname) \<union>
         (let meths = imethoddecl p ifname in (\<Union>m\<in>dom(meths). sum_method_labels (the (meths m))))"

(* if x is in the domain of a mapping, and the mapping is in the list,
   then x must be in the domain of the final mapping. *)
lemma map_adds_domain:
  shows "x \<in> dom m \<Longrightarrow> m \<in> (set ms) \<Longrightarrow> x \<in> dom (map_adds ms)"
proof (induction ms)
  case Nil
  then show ?case by auto (* by contradiction; the premises are not possible *)
next
  case a1: (Cons a ms)
  then show ?case
  proof (cases "m \<in> set ms")
    case b1: True
    then have "x \<in> dom (map_adds ms)" using a1 by blast (* by induction *)
    then have "x \<in> dom (map_adds (a # ms))" by auto
    then show ?thesis by simp
  next
    case b1: False
    then have "m = a" using a1 by simp
    then have "x \<in> dom (map_adds (a # ms))" using a1 by auto
    then show ?thesis by simp
  qed
qed

lemma class_unfold:
  assumes wf_subclass: "wf ((direct_subclass P)\<inverse>)"
  assumes class_exist: "class P c = Some cl"
(* prog \<Rightarrow> cname \<Rightarrow> (class \<Rightarrow> ('a \<times> 'b) list) \<Rightarrow> ('a \<rightharpoonup> 'b) *)
(*  (f::(class \<Rightarrow> ('a \<times> 'b) list)) *)
  shows "((class_recursion P c f)::('a \<rightharpoonup> 'b)) =
          (if c = Object then empty else class_recursion P (cextends cl) f) ++ (f (c,cl))"
proof -
  define R where "R = ((direct_subclass P)\<inverse>)"
  define F where "F = (\<lambda>rec cname (f::(cdecl \<Rightarrow> ('a \<rightharpoonup> 'b))).
     case class P cname of None \<Rightarrow> undefined
        | Some cl \<Rightarrow> (if cname = Object then empty else rec (cextends cl) f) ++ (f (cname,cl)))"
  have a1: "class_recursion P = wfrec R F" unfolding R_def F_def class_recursion_def by simp
  have "wf R" unfolding R_def using wf_subclass by simp
  then have "class_recursion P c = F (cut (wfrec R F) R c) c"
    unfolding class_recursion_def using R_def F_def wfrec by simp
  then have "class_recursion P c f = (
      case class P c of None \<Rightarrow> undefined
        | Some cl \<Rightarrow> (if c = Object then empty else
              (if ((cextends cl), c) \<in> (direct_subclass P)\<inverse> then class_recursion P (cextends cl) else undefined) f) ++ (f (c,cl))
       )" using a1 R_def unfolding F_def cut_def by metis
  also have "... = (if c = Object then empty else class_recursion P (cextends cl) f) ++ (f (c,cl))"
    using class_exist unfolding direct_subclass_def by simp
  finally show ?thesis .
qed

lemma interface_unfold:
  assumes wf_subinterface: "wf ((direct_subinterface P)\<inverse>)"
  assumes interface_exist: "interface P c = Some cb"
  shows "((interface_recursion P c f)::('a \<rightharpoonup> 'b)) =
        map_adds (map (\<lambda>super. interface_recursion P super f) (iextends cb)) ++ map_of (f cb)"
proof -
  define R where "R = ((direct_subinterface P)\<inverse>)"
  define F where "F = (\<lambda>rec (iname::iname) (f::(interface \<Rightarrow> ('a \<times> 'b) list)).
    case interface P iname of None \<Rightarrow> undefined
        | Some cb \<Rightarrow>  map_adds (map (\<lambda>super. rec super f) (iextends cb)) ++ map_of (f cb))"
  have a1: "interface_recursion P = wfrec R F" unfolding R_def F_def interface_recursion_def by simp
  have a2: "\<forall>cb'\<in>set (iextends cb). (if (cb', c) \<in> (direct_subinterface P)\<inverse> then (interface_recursion P) cb' else undefined) f = ((interface_recursion P) cb') f"
    unfolding direct_subinterface_def using interface_exist by simp

  have "wf R" unfolding R_def using wf_subinterface by simp
  then have "interface_recursion P c = F (cut (wfrec R F) R c) c"
    unfolding interface_recursion_def using R_def F_def wfrec by simp
  then have "interface_recursion P c f = (
      case interface P c of None \<Rightarrow> undefined
        | Some cb \<Rightarrow> map_adds (map (\<lambda>super. (if (super, c) \<in> (direct_subinterface P)\<inverse> then (interface_recursion P) super else undefined) f) (iextends cb)) ++ map_of (f cb)
       )" using a1 F_def unfolding cut_def R_def by metis
  also have "... = map_adds (map (\<lambda>super. (interface_recursion P) super f) (iextends cb)) ++ map_of (f cb)"
    using interface_exist a2 map_eq_conv option.simps(5) by (metis (no_types, lifting))
  finally show ?thesis .
qed

lemma cmethod_unfold:
  assumes wf_subclass: "wf ((direct_subclass P)\<inverse>)"
  assumes class_exist: "class P c = Some cl"
  shows "cmethod P c = (if c = Object then empty else cmethod P (cextends cl)) ++ (cdeclmethods (c,cl))"
  using assms class_unfold unfolding cmethod_def by metis

lemma cmethod_cmethods:
  assumes wf_subclass: "wf ((direct_subclass P)\<inverse>)"
  assumes class_exist: "class P c = Some cl"
  assumes method_exist: "(map_of (cmethods cl)) mname = Some m"
  shows "cmethod P c mname = Some (c,m)"
proof -
  have "cdeclmethods (c,cl) mname = Some (c,m)"
    unfolding cdeclmethods_def using method_exist by auto
  then show ?thesis using cmethod_unfold wf_subclass class_exist by auto
qed

lemma cmethoddecl_cmethods:
  assumes wf_subclass: "wf ((direct_subclass P)\<inverse>)"
  assumes class_exist: "class P c = Some cl"
  assumes method_exist: "(map_of (cmethods cl)) mname = Some m"
  shows "cmethoddecl P c mname = Some (mdecl m)"
  using cmethod_cmethods assms unfolding cmethoddecl_def by auto

lemma field_unfold:
  assumes wf_subclass: "wf ((direct_subclass P)\<inverse>)"
  assumes class_exist: "class P c = Some cl"
  shows "field P c = (if c = Object then empty else field P (cextends cl)) ++ (map_of (cfields cl))"
proof -
  have "field P c = (if c = Object then empty else field P (cextends cl)) ++ ((\<lambda>(cn,cl). (map_of (cfields cl))) (c,cl))"
    using assms class_unfold unfolding field_def by metis
  then show ?thesis by auto
qed

lemma imethoddecl_unfold:
  assumes wf_subinterface: "wf ((direct_subinterface P)\<inverse>)"
  assumes interface_exist: "interface P c = Some cb"
  shows "imethoddecl P c = map_adds (map (\<lambda>super. imethoddecl P super) (iextends cb)) ++ map_of (imethods cb)"
  using assms interface_unfold unfolding imethoddecl_def by metis

end


(*  Title:      HOL/HOLCF/IOA/meta_theory/SimCorrectness.thy
    Author:     Olaf Müller
*)

section {* Correctness of Simulations in HOLCF/IOA *}

theory SimCorrectness
imports Simulations
begin

definition
  (* Note: s2 instead of s1 in last argument type !! *)
  corresp_ex_simC :: "('a,'s2)ioa => (('s1 * 's2)set) => ('a,'s1)pairs
                   -> ('s2 => ('a,'s2)pairs)" where
  "corresp_ex_simC A R = (fix$(LAM h ex. (%s. case ex of
      nil =>  nil
    | x##xs => (flift1 (%pr. let a = (fst pr); t = (snd pr);
                                 T' = @t'. ? ex1. (t,t'):R & move A ex1 s a t'
                             in
                                (@cex. move A cex s a T')
                                 @@ ((h$xs) T'))
                        $x) )))"

definition
  corresp_ex_sim :: "('a,'s2)ioa => (('s1 *'s2)set) =>
                      ('a,'s1)execution => ('a,'s2)execution" where
  "corresp_ex_sim A R ex == let S'= (@s'.(fst ex,s'):R & s': starts_of A)
                            in
                               (S',(corresp_ex_simC A R$(snd ex)) S')"

subsection "corresp_ex_sim"

lemma corresp_ex_simC_unfold: "corresp_ex_simC A R  = (LAM ex. (%s. case ex of
       nil =>  nil
     | x##xs => (flift1 (%pr. let a = (fst pr); t = (snd pr);
                                  T' = @t'. ? ex1. (t,t'):R & move A ex1 s a t'
                              in
                                 (@cex. move A cex s a T')
                               @@ ((corresp_ex_simC A R $xs) T'))
                         $x) ))"
apply (rule trans)
apply (rule fix_eq2)
apply (simp only: corresp_ex_simC_def)
apply (rule beta_cfun)
apply (simp add: flift1_def)
done

lemma corresp_ex_simC_UU: "(corresp_ex_simC A R$UU) s=UU"
apply (subst corresp_ex_simC_unfold)
apply simp
done

lemma corresp_ex_simC_nil: "(corresp_ex_simC A R$nil) s = nil"
apply (subst corresp_ex_simC_unfold)
apply simp
done

lemma corresp_ex_simC_cons: "(corresp_ex_simC A R$((a,t)>>xs)) s =
           (let T' = @t'. ? ex1. (t,t'):R & move A ex1 s a t'
            in
             (@cex. move A cex s a T')
              @@ ((corresp_ex_simC A R$xs) T'))"
apply (rule trans)
apply (subst corresp_ex_simC_unfold)
apply (simp add: Consq_def flift1_def)
apply simp
done

declare corresp_ex_simC_UU [simp] corresp_ex_simC_nil [simp] corresp_ex_simC_cons [simp]

subsection "properties of move"

declare Let_def [simp del]

lemma move_is_move_sim:
   "[|is_simulation R C A; reachable C s; s -a--C-> t; (s,s'):R|] ==>
      let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
      (t,T'): R & move A (@ex2. move A ex2 s' a T') s' a T'"
apply (unfold is_simulation_def)

(* Does not perform conditional rewriting on assumptions automatically as
   usual. Instantiate all variables per hand. Ask Tobias?? *)
apply (subgoal_tac "? t' ex. (t,t') :R & move A ex s' a t'")
prefer 2
apply simp
apply (erule conjE)
apply (erule_tac x = "s" in allE)
apply (erule_tac x = "s'" in allE)
apply (erule_tac x = "t" in allE)
apply (erule_tac x = "a" in allE)
apply simp
(* Go on as usual *)
apply (erule exE)
apply (drule_tac x = "t'" and P = "%t'. ? ex. (t,t') :R & move A ex s' a t'" in someI)
apply (erule exE)
apply (erule conjE)
apply (simp add: Let_def)
apply (rule_tac x = "ex" in someI)
apply assumption
done

declare Let_def [simp]

lemma move_subprop1_sim:
   "[|is_simulation R C A; reachable C s; s-a--C-> t; (s,s'):R|] ==>
    let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
     is_exec_frag A (s',@x. move A x s' a T')"
apply (cut_tac move_is_move_sim)
defer
apply assumption+
apply (simp add: move_def)
done

lemma move_subprop2_sim:
   "[|is_simulation R C A; reachable C s; s-a--C-> t; (s,s'):R|] ==>
    let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
    Finite (@x. move A x s' a T')"
apply (cut_tac move_is_move_sim)
defer
apply assumption+
apply (simp add: move_def)
done

lemma move_subprop3_sim:
   "[|is_simulation R C A; reachable C s; s-a--C-> t; (s,s'):R|] ==>
    let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
     laststate (s',@x. move A x s' a T') = T'"
apply (cut_tac move_is_move_sim)
defer
apply assumption+
apply (simp add: move_def)
done

lemma move_subprop4_sim:
   "[|is_simulation R C A; reachable C s; s-a--C-> t; (s,s'):R|] ==>
    let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
      mk_trace A$((@x. move A x s' a T')) =
        (if a:ext A then a>>nil else nil)"
apply (cut_tac move_is_move_sim)
defer
apply assumption+
apply (simp add: move_def)
done

lemma move_subprop5_sim:
   "[|is_simulation R C A; reachable C s; s-a--C-> t; (s,s'):R|] ==>
    let T' = @t'. ? ex1. (t,t'):R & move A ex1 s' a t' in
      (t,T'):R"
apply (cut_tac move_is_move_sim)
defer
apply assumption+
apply (simp add: move_def)
done

subsection {* TRACE INCLUSION Part 1: Traces coincide *}

subsubsection "Lemmata for <=="

(* ------------------------------------------------------
                 Lemma 1 :Traces coincide
   ------------------------------------------------------- *)

declare split_if [split del]
lemma traces_coincide_sim [rule_format (no_asm)]:
  "[|is_simulation R C A; ext C = ext A|] ==>
         !s s'. reachable C s & is_exec_frag C (s,ex) & (s,s'): R -->
             mk_trace C$ex = mk_trace A$((corresp_ex_simC A R$ex) s')"

apply (tactic {* pair_induct_tac @{context} "ex" [@{thm is_exec_frag_def}] 1 *})
(* cons case *)
apply auto
apply (rename_tac ex a t s s')
apply (simp add: mk_traceConc)
apply (frule reachable.reachable_n)
apply assumption
apply (erule_tac x = "t" in allE)
apply (erule_tac x = "@t'. ? ex1. (t,t') :R & move A ex1 s' a t'" in allE)
apply (simp add: move_subprop5_sim [unfolded Let_def]
  move_subprop4_sim [unfolded Let_def] split add: split_if)
done
declare split_if [split]

(* ----------------------------------------------------------- *)
(*               Lemma 2 : corresp_ex_sim is execution         *)
(* ----------------------------------------------------------- *)

lemma correspsim_is_execution [rule_format (no_asm)]:
 "[| is_simulation R C A |] ==>
  !s s'. reachable C s & is_exec_frag C (s,ex) & (s,s'):R
  --> is_exec_frag A (s',(corresp_ex_simC A R$ex) s')"

apply (tactic {* pair_induct_tac @{context} "ex" [@{thm is_exec_frag_def}] 1 *})
(* main case *)
apply auto
apply (rename_tac ex a t s s')
apply (rule_tac t = "@t'. ? ex1. (t,t') :R & move A ex1 s' a t'" in lemma_2_1)

(* Finite *)
apply (erule move_subprop2_sim [unfolded Let_def])
apply assumption+
apply (rule conjI)

(* is_exec_frag *)
apply (erule move_subprop1_sim [unfolded Let_def])
apply assumption+
apply (rule conjI)

(* Induction hypothesis  *)
(* reachable_n looping, therefore apply it manually *)
apply (erule_tac x = "t" in allE)
apply (erule_tac x = "@t'. ? ex1. (t,t') :R & move A ex1 s' a t'" in allE)
apply simp
apply (frule reachable.reachable_n)
apply assumption
apply (simp add: move_subprop5_sim [unfolded Let_def])
(* laststate *)
apply (erule move_subprop3_sim [unfolded Let_def, symmetric])
apply assumption+
done

subsection "Main Theorem: TRACE - INCLUSION"

(* -------------------------------------------------------------------------------- *)

  (* generate condition (s,S'):R & S':starts_of A, the first being intereting
     for the induction cases concerning the two lemmas correpsim_is_execution and
     traces_coincide_sim, the second for the start state case.
     S':= @s'. (s,s'):R & s':starts_of A, where s:starts_of C  *)

lemma simulation_starts:
"[| is_simulation R C A; s:starts_of C |]
  ==> let S' = @s'. (s,s'):R & s':starts_of A in
      (s,S'):R & S':starts_of A"
  apply (simp add: is_simulation_def corresp_ex_sim_def Int_non_empty Image_def)
  apply (erule conjE)+
  apply (erule ballE)
  prefer 2 apply (blast)
  apply (erule exE)
  apply (rule someI2)
  apply assumption
  apply blast
  done

lemmas sim_starts1 = simulation_starts [unfolded Let_def, THEN conjunct1]
lemmas sim_starts2 = simulation_starts [unfolded Let_def, THEN conjunct2]

lemma trace_inclusion_for_simulations:
  "[| ext C = ext A; is_simulation R C A |]
           ==> traces C <= traces A"

  apply (unfold traces_def)

  apply (simp (no_asm) add: has_trace_def2)
  apply auto

  (* give execution of abstract automata *)
  apply (rule_tac x = "corresp_ex_sim A R ex" in bexI)

  (* Traces coincide, Lemma 1 *)
  apply (tactic {* pair_tac @{context} "ex" 1 *})
  apply (rename_tac s ex)
  apply (simp (no_asm) add: corresp_ex_sim_def)
  apply (rule_tac s = "s" in traces_coincide_sim)
  apply assumption+
  apply (simp add: executions_def reachable.reachable_0 sim_starts1)

  (* corresp_ex_sim is execution, Lemma 2 *)
  apply (tactic {* pair_tac @{context} "ex" 1 *})
  apply (simp add: executions_def)
  apply (rename_tac s ex)

  (* start state *)
  apply (rule conjI)
  apply (simp add: sim_starts2 corresp_ex_sim_def)

  (* is-execution-fragment *)
  apply (simp add: corresp_ex_sim_def)
  apply (rule_tac s = s in correspsim_is_execution)
  apply assumption
  apply (simp add: reachable.reachable_0 sim_starts1)
  done

end