header {*
\isachapter{A Control Flow Graph for Jinja Byte Code}
\isaheader{Formalizing the CFG}
*}

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

declare lesub_list_impl_same_size [simp del]
declare listE_length [simp del]

subsection {* Type definitions *}

subsubsection {* Wellformed Programs *}

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 {* Interprocedural CFG *}

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 `C \<notin> set (map fst P)` 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 `is_class (PROG P) C` 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: split_if_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 `PROG P \<turnstile> D sees M:Ts\<rightarrow>T = mb in C`
  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 `(P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')` `C' \<noteq> ClassMain P`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = New Cl`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = New Cl` 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 `instrs_of (PROG P) C M ! pc = New Cl`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Getfield F Cl`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Getfield F Cl` 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 `instrs_of (PROG P) C M ! pc = Getfield F Cl`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Putfield F Cl`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Putfield F Cl` 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 `instrs_of (PROG P) C M ! pc = Putfield F Cl`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Checkcast Cl`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Checkcast Cl` 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 `instrs_of (PROG P) C M ! pc = Checkcast Cl`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Throw`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Throw` 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 `instrs_of (PROG P) C M ! pc = Throw`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Invoke M' n`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Invoke M' n` 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 `instrs_of (PROG P) C M ! pc = Invoke M' n`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)` `C \<noteq> ClassMain P`
  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 `pc < length (instrs_of (PROG P) C M)` `instrs_of (PROG P) C M ! pc = Invoke M' n`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)` `C \<noteq> ClassMain P`
    `instrs_of (PROG P) C M ! pc = Invoke M' n` 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 `instrs_of (PROG P) C M ! pc = Invoke M' n`
    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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return)` `C \<noteq> ClassMain P`
  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 `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)` `C \<noteq> ClassMain P`
  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 `C \<noteq> ClassMain P` `(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nt)`
    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


theory NP4_Option_State_Values
  imports
  NP4_Option_State_Syntax
  "~~/src/HOL/Word/Word"
  "~~/src/HOL/Word/Word_Bitwise"
(*  These files contain a minimalistic semantics of P4's action constructs. More complex concepts
    like switch statements are left out. The purpose of this verification effort is to showcase
    the viability of using Isabelle/HOL to verify P4 applications. These files focus on the
    action constructs.

    P4 actions are the code fragments that can read and write data being processed. The action
    constructs are where sequential code resides in P4. To this end the action constructs are the
    main way by which the control-plane can influence the behaviour of the data-plane.

    To this end these files define a small-step semantics of the P4 actions. Then a typing
    environment is built upon this, and the statements are extended with a termination-counter.
    These are used to prove properties like termination, determinism, progression,
    preservation, and more. The semantics can also be used to analyse reachability properties.
    Well-defined and well-typed P4 programs will yield a derivation tree, where as ill-defined
    or ill-typed P4 programs will yield no such tree. *)
begin

(* ============================================================================================================== *)
(*                                              VALUE MAPPINGS                                                    *)
(* ============================================================================================================== *)

(* Contains the value of a single bit, can be cast between bool *)
datatype sbit = ZERO | ONE

(* Mapping to concrete value *)
datatype val = SBIT sbit
  | UINT nat
  | SINT int
  | IINT int
  | VINT nat
  | BOOL bool
  | STRING string
  | ERROR "identifier list"
  | MATCH "identifier list"

(* State is a mapping from variable names to values *)
type_synonym state = "vname \<Rightarrow> val option"

(* ============================================================================================================== *)
(*                                              HELPER FUNCTIONS                                                  *)
(* ============================================================================================================== *)

(* Convert a basetype to a concrete value used for converting the entries of derived types. *)
fun baseToVal :: "baseType \<Rightarrow> val" where
    "baseToVal (BBOOL b)       = (BOOL b)"
  | "baseToVal (BSBIT 0)       = (SBIT ZERO)"
  | "baseToVal (BSBIT (Suc n)) = (SBIT ONE)"
  | "baseToVal (BIINT n)       = (IINT n)"
  | "baseToVal (BUINT n)       = (UINT n)"
  | "baseToVal (BSINT n)       = (SINT n)"
  | "baseToVal (BVINT n)       = (VINT n)"
  | "baseToVal (BERROR e)      = (ERROR e)"
  | "baseToVal (BMATCH m)      = (MATCH m)"
  | "baseToVal (BSTRING s)     = (STRING s)"

(* ============================================================================================================== *)
(*                                   CONCRETE VALUE EVALUATION FUNCTIONS                                          *)
(* ============================================================================================================== *)

inductive eval :: "expression \<Rightarrow> state \<Rightarrow> val \<Rightarrow> bool" where
(* =============== Base types =============== *)
    RBOOL:    "eval (BASE (BBOOL b))       s (BOOL b)"
  | RBIT0:    "eval (BASE (BSBIT 0))       s (SBIT ZERO)"
  | RBIT1:    "eval (BASE (BSBIT (Suc n))) s (SBIT ONE)"
  | RIINT:    "eval (BASE (BIINT n))       s (IINT n)"
  | RUINT:    "eval (BASE (BUINT n))       s (UINT n)"
  | RSINT:    "eval (BASE (BSINT n))       s (SINT n)"
  | RVINT:    "eval (BASE (BVINT n))       s (VINT n)"
  | RERROR:   "eval (BASE (BERROR e))      s (ERROR e)"
  | RMATCH:   "eval (BASE (BMATCH m))      s (MATCH m)"
  | RSTRING:  "eval (BASE (BSTRING str))   s (STRING str)"
(* =============== Miscellaneous expressions =============== *)
  | TERNTRUE:  "eval e1 s (BOOL b) \<Longrightarrow> b = True \<Longrightarrow> eval e2 s v \<Longrightarrow> eval (TernExpr e1 e2 e3) s v"
  | TERNFALSE: "eval e1 s (BOOL b) \<Longrightarrow> b = False \<Longrightarrow> eval e3 s v \<Longrightarrow> eval (TernExpr e1 e2 e3) s v"
(* =============== Variable mapping  =============== *)
  | NAMEDVAR: "(s varName) = (Some v) \<Longrightarrow> eval (NamedVar varName) s v"
(* =============== Operations that yield a single bit (SBIT)  =============== *)
          (* Empty for now *)
(* =============== Operations that yield a boolean (BOOL)  =============== *)
  | ULNEB: "eval e1 s (BOOL b) \<Longrightarrow> eval (UNA_LNE e1) s (BOOL (\<not>b))"
    (* Boolean operations *)
  | BEQUB: "eval e1 s (BOOL b1) \<Longrightarrow> eval e2 s (BOOL b2) \<Longrightarrow> eval (BIN_EQU e1 e2) s (BOOL (b1 = b2))"
(* Boolean equality check yields derivation error; code cannot be generated for inductive predicate eval *)
(*  | BNEQB: "eval e1 s (BOOL b1) \<Longrightarrow> eval e2 s (BOOL b2) \<Longrightarrow> eval (BIN_NEQ e1 e2) s (BOOL (b1 \<noteq> b2))" *)
  | BFANB: "eval e1 s (BOOL b1) \<Longrightarrow> eval e2 s (BOOL b2) \<Longrightarrow> eval (BIN_FAN e1 e2) s (BOOL (b1 \<and> b2))"
  | BFORB: "eval e1 s (BOOL b1) \<Longrightarrow> eval e2 s (BOOL b2) \<Longrightarrow> eval (BIN_FOR e1 e2) s (BOOL (b1 \<or> b2))"
    (* Signed integer opreations *)
  | BEQUS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_EQU e1 e2) s (BOOL (n1 = n2))"
  | BNEQS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_NEQ e1 e2) s (BOOL (n1 \<noteq> n2))"
  | BLEQS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_LEQ e1 e2) s (BOOL (n1 \<le> n2))"
  | BGEQS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_GEQ e1 e2) s (BOOL (n1 \<ge> n2))"
  | BLESS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_LES e1 e2) s (BOOL (n1 < n2))"
  | BGRES: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_GRE e1 e2) s (BOOL (n1 > n2))"
    (* Unsigned integer opreations *)
  | BEQUU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_EQU e1 e2) s (BOOL (n1 = n2))"
  | BNEQU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_NEQ e1 e2) s (BOOL (n1 \<noteq> n2))"
  | BLEQU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_LEQ e1 e2) s (BOOL (n1 \<le> n2))"
  | BGEQU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_GEQ e1 e2) s (BOOL (n1 \<ge> n2))"
  | BLESU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_LES e1 e2) s (BOOL (n1 < n2))"
  | BGREU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_GRE e1 e2) s (BOOL (n1 > n2))"
    (* Infinite precision integer opreations *)
  | BEQUI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_EQU e1 e2) s (BOOL (n1 = n2))"
  | BNEQI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_NEQ e1 e2) s (BOOL (n1 \<noteq> n2))"
  | BLEQI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_LEQ e1 e2) s (BOOL (n1 \<le> n2))"
  | BGEQI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_GEQ e1 e2) s (BOOL (n1 \<ge> n2))"
  | BLESI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_LES e1 e2) s (BOOL (n1 < n2))"
  | BGREI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_GRE e1 e2) s (BOOL (n1 > n2))"
    (* Variable size bitstring opreations *)
  | BEQUV: "eval e1 s (VINT n1) \<Longrightarrow> eval e2 s (VINT n2) \<Longrightarrow> eval (BIN_EQU e1 e2) s (BOOL (n1 = n2))"
  | BNEQV: "eval e1 s (VINT n1) \<Longrightarrow> eval e2 s (VINT n2) \<Longrightarrow> eval (BIN_NEQ e1 e2) s (BOOL (n1 \<noteq> n2))"
(* =============== Operations that yield an unsigned integer (UINT)  =============== *)
  | UNEGU: "eval e1 s (UINT n1) \<Longrightarrow> eval (UNA_NEG e1) s (UINT n1)" (* Incorrect but w/e for now *)
  | UPOSU: "eval e1 s (UINT n1) \<Longrightarrow> eval (UNA_POS e1) s (UINT n1)"
  | UCOMU: "eval e1 s (UINT n1) \<Longrightarrow> eval (UNA_COM e1) s (UINT n1)" (* (nat (NOT (int n1))))" Incorrect but w/e *)
  | BADDU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_ADD e1 e2) s (UINT (n1 + n2))"
  | BMINU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_MIN e1 e2) s (UINT (n1 - n2))"
  | BANDU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_AND e1 e2) s (UINT (nat ((int n1) AND (int n2))))"
  | BXORU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_XOR e1 e2) s (UINT (nat ((int n1) XOR (int n2))))"
  | BLORU: "eval e1 s (UINT n1) \<Longrightarrow> eval e2 s (UINT n2) \<Longrightarrow> eval (BIN_LOR e1 e2) s (UINT (nat ((int n1) OR (int n2))))"
(* =============== Operations that yield a signed integer (SINT)  =============== *)
  | UNEGS: "eval e1 s (SINT n1) \<Longrightarrow> eval (UNA_NEG e1) s (SINT (-n1))"
  | UPOSS: "eval e1 s (SINT n1) \<Longrightarrow> eval (UNA_POS e1) s (SINT n1)"
  | BADDS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_ADD e1 e2) s (SINT (n1 + n2))"
  | BMINS: "eval e1 s (SINT n1) \<Longrightarrow> eval e2 s (SINT n2) \<Longrightarrow> eval (BIN_MIN e1 e2) s (SINT (n1 - n2))"
(* =============== Operations that yield an infinite-precision integer (IINT)  =============== *)
  | UNEGI: "eval e1 s (IINT n1) \<Longrightarrow> eval (UNA_NEG e1) s (IINT (-n1))"
  | UPOSI: "eval e1 s (IINT n1) \<Longrightarrow> eval (UNA_POS e1) s (IINT n1)"
  | BADDI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_ADD e1 e2) s (IINT (n1 + n2))"
  | BMINI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_MIN e1 e2) s (IINT (n1 - n2))"
  | BMULI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_MUL e1 e2) s (IINT (n1 * n2))"
  | BDIVI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_DIV e1 e2) s (IINT (n1 div n2))"
  | BMODI: "eval e1 s (IINT n1) \<Longrightarrow> eval e2 s (IINT n2) \<Longrightarrow> eval (BIN_MOD e1 e2) s (IINT (n1 mod n2))"
(* =============== Operations that yield a variable-width integer (VINT)  =============== *)
      (* Empty for now *)

inductive_cases [elim!]: "eval (BASE b) s v" "eval (TernExpr e1 e2 e3) s v" "eval (NamedVar i) s v"
"eval (UNA_LNE e) s v" "eval (UNA_COM e) s v" "eval (UNA_NEG e) s v" "eval (UNA_POS e) s v" "eval (BIN_MUL e1 e2) s v"
"eval (BIN_DIV e1 e2) s v" "eval (BIN_MOD e1 e2) s v" "eval (BIN_ADD e1 e2) s v" "eval (BIN_MIN e1 e2) s v" "eval (BIN_AND e1 e2) s v"
"eval (BIN_XOR e1 e2) s v" "eval (BIN_LOR e1 e2) s v" "eval (BIN_LEQ e1 e2) s v" "eval (BIN_GEQ e1 e2) s v" "eval (BIN_LES e1 e2) s v"
"eval (BIN_GRE e1 e2) s v" "eval (BIN_NEQ e1 e2) s v" "eval (BIN_EQU e1 e2) s v" "eval (BIN_FAN e1 e2) s v" "eval (BIN_FOR e1 e2) s v"

lemma eval_deterministic: "(eval e s v) \<Longrightarrow> (eval e s v') \<Longrightarrow> (v = v')"
proof (induction arbitrary: v' rule: eval.induct)
  case (NAMEDVAR s varName v)
  then show ?case sorry
qed blast+

code_pred eval .

definition null_state ("<>") where
  "null_state \<equiv> \<lambda>x. (UINT 0)"
syntax
  "_State" :: "updbinds \<Rightarrow> 'a" ("<_>")
translations
  "_State ms" == "_Update <> ms"
  "_State (_updbinds b bs)" <= "_Update (_State b) bs"

end


theory TickTock_Max_Pri

imports
  "TickTock.TickTock_Core"
  "Utils.Event_Priority"
begin

section \<open> Prioritise for maximal TickTock \<close>

definition prirefMaxTT :: "('e ttevent) partialorder \<Rightarrow> ('e ttevent) set \<Rightarrow> ('e ttevent) set" where
"prirefMaxTT p Z = {z. z \<notin> Z \<longrightarrow> (\<exists>b. b \<notin> Z \<and> z <\<^sup>*p b)}"

fun priMaxTT :: "('e ttevent) partialorder \<Rightarrow> ('e ttobs) list \<Rightarrow> ('e ttobs) list \<Rightarrow> ('e ttobs) list \<Rightarrow> ('e ttobs) list set \<Rightarrow> bool" where
"priMaxTT p [] [] s Q = True" |
"priMaxTT p [[R]\<^sub>R] [[S]\<^sub>R] s Q = (prirefMaxTT p S = R)" |
"priMaxTT p ([R]\<^sub>R # [Tock]\<^sub>E # aa) ([S]\<^sub>R # [Tock]\<^sub>E # zz) s Q = ((R = prirefMaxTT p S) \<and> Tock \<notin> R \<and> priMaxTT p aa zz (s @ [[S]\<^sub>R,[Tock]\<^sub>E]) Q)" |
"priMaxTT p ([e\<^sub>1]\<^sub>E # aa) ([e\<^sub>2]\<^sub>E # zz) s Q
 =
 (e\<^sub>1 = e\<^sub>2 \<and> priMaxTT p aa zz (s @ [[e\<^sub>1]\<^sub>E]) Q \<and>
  (maximal(p,e\<^sub>2)
   \<or>
  (\<exists>Z. s @ [[Z]\<^sub>R] \<in> Q \<and> e\<^sub>2 \<notin> Z \<and> \<not>(\<exists>b. b \<notin> Z \<and> e\<^sub>2 <\<^sup>*p b))))" |
"priMaxTT p x y s Q = False"

definition PriMax :: "('e ttevent) partialorder \<Rightarrow> ('e ttobs) list set \<Rightarrow> ('e ttobs) list set" where
"PriMax p P = {t|s t. s \<in> P \<and> priMaxTT p t s [] P}"

subsection \<open> Properties of PriMax and priMaxTT \<close>

lemma priMaxTT_extend_both_refusal_ttWF:
  assumes "priMaxTT p xs ys s P" "ttWF (ys @ [[S]\<^sub>R])"  "prirefMaxTT p S = R"
  shows "priMaxTT p (xs @ [[R]\<^sub>R]) (ys @ [[S]\<^sub>R]) s P"
  using assms apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  apply (metis ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv snoc_eq_iff_butlast)
  by (metis ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv snoc_eq_iff_butlast)

lemma priMaxTT_extend_both_tock_refusal_ttWF:
  assumes "priMaxTT p xs ys s P" "ttWF (ys @ [[S]\<^sub>R,[Tock]\<^sub>E])" "prirefMaxTT p S = R" "Tock \<notin> R"
  shows "priMaxTT p (xs @ [[R]\<^sub>R,[Tock]\<^sub>E]) (ys @ [[S]\<^sub>R,[Tock]\<^sub>E]) s P"
  using assms apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  by (metis append_Cons append_Nil ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv)+

lemma maximal_Tock_then_not_prirefMaxTT [simp]:
  assumes "maximal(p,Tock)" "Tock \<notin> S"
  shows "Tock \<notin> prirefMaxTT p S"
  using assms unfolding prirefMaxTT_def apply auto
  by (simp add: some_higher_not_maximal)

lemma priMaxTT_extend_both_events_eq_size_maximal_ttWF:
  assumes "priMaxTT p xs ys s P" "ttWF (ys @ [[e\<^sub>1]\<^sub>E])" "maximal(p,e\<^sub>1)" "size xs = size ys" "ttWFx_trace (ys @ [[e\<^sub>1]\<^sub>E])"
  shows "priMaxTT p (xs @ [[e\<^sub>1]\<^sub>E]) (ys @ [[e\<^sub>1]\<^sub>E]) s P"
  using assms apply (induct p xs ys s P rule:priMaxTT.induct, auto)
    apply (cases e\<^sub>1, auto)
  using ttWFx_trace_cons_imp_cons
  apply (metis append_Nil ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttWF_prefix_is_ttWF ttevent.exhaust list.exhaust)
  using ttWFx_trace_cons_imp_cons by (metis append_Nil ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttWF_prefix_is_ttWF ttevent.exhaust list.exhaust)

lemma priMaxTT_extend_both_events_maximal_ttWF:
  assumes "priMaxTT p xs ys s P" "ttWF (xs @ [[e\<^sub>1]\<^sub>E])" "ttWF (ys @ [[e\<^sub>1]\<^sub>E])" "maximal(p,e\<^sub>1)" "ttWFx_trace (ys @ [[e\<^sub>1]\<^sub>E])"
  shows "priMaxTT p (xs @ [[e\<^sub>1]\<^sub>E]) (ys @ [[e\<^sub>1]\<^sub>E]) s P"
  using assms apply (induct p xs ys s P rule:priMaxTT.induct, auto)
    apply (cases e\<^sub>1, auto)
  using ttWFx_trace_cons_imp_cons by (metis append_Nil ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttWF_prefix_is_ttWF ttevent.exhaust list.exhaust)+

lemma priMaxTT_same_length:
  assumes "priMaxTT p xs ys s P"
  shows "size xs = size ys"
  using assms by (induct p xs ys s P rule:priMaxTT.induct, auto)

lemma priMaxTT_imp_butlast_of_priMaxTTs:
  assumes "priMaxTT p ar xs [] P"
  shows "priMaxTT p (List.butlast ar) (List.butlast xs) [] P"
  using assms apply (induct p ar xs _ P rule:priMaxTT.induct, auto)
  apply (metis neq_Nil_conv priMaxTT.simps(46))
      apply (metis neq_Nil_conv priMaxTT.simps(28))
     apply (metis neq_Nil_conv priMaxTT.simps(46))
    apply (metis neq_Nil_conv priMaxTT.simps(28))
   apply (metis neq_Nil_conv priMaxTT.simps(46))
  by (metis neq_Nil_conv priMaxTT.simps(28))

lemma priMaxTT_imp_one_butlast_of_priMaxTT:
  assumes "priMaxTT p ar (xs @ [x]) [] P"
  shows "priMaxTT p (List.butlast ar) xs [] P"
  using assms priMaxTT_imp_butlast_of_priMaxTTs
  by fastforce

lemma prirefMaxTT_imp_not_exists_higher_pri:
  assumes "(R = prirefMaxTT p S)" "e\<^sub>2 \<notin> R"
  shows "\<not>(\<exists>b. b \<notin> S \<and> e\<^sub>2 <\<^sup>*p b)"
  using assms unfolding prirefMaxTT_def by auto

lemma priMaxTT_both_cons_extend_refusal_imp_prefix:
  assumes "priMaxTT p (x @ [[xs]\<^sub>R]) (y @ [[ys]\<^sub>R]) zs P"
  shows "priMaxTT p x y zs P"
  using assms apply (induct p x y zs P arbitrary:xs ys rule:priMaxTT.induct, auto)
  apply (metis list.exhaust priMaxTT.simps(57) snoc_eq_iff_butlast)
  by (metis list.exhaust priMaxTT.simps(68) snoc_eq_iff_butlast)

lemma priMaxTT_cannot_extend_refusal_rhs:
  assumes "priMaxTT p x y zs P"
  shows "\<not> priMaxTT p x (y @ [[ys]\<^sub>R]) zs P"
  using assms by (induct p x y zs P rule:priMaxTT.induct, auto)

lemma priMaxTT_cannot_extend_refusal_lhs:
  assumes "priMaxTT p x y zs P"
  shows "\<not> priMaxTT p (x @ [[xs]\<^sub>R]) y zs P"
  using assms by (induct p x y zs P rule:priMaxTT.induct, auto)

lemma not_priMaxTT_concat_refTock:
  assumes "v \<noteq> []"
  shows "\<not> priMaxTT p (v @ [[x]\<^sub>R, [Tock]\<^sub>E]) [[y]\<^sub>R, [Tock]\<^sub>E] z P"
  using assms apply (induct p v "[]:: 'a ttobs list" z P rule:priMaxTT.induct, auto)
  apply (case_tac va, auto, case_tac vb, auto, case_tac x1, auto)
   apply (metis append_Cons append_Nil neq_Nil_conv priMaxTT.simps(28))
  apply (case_tac va, auto, case_tac va, auto, case_tac a, auto, case_tac x1, auto)
  by (metis append_Cons append_Nil neq_Nil_conv priMaxTT.simps(28))

lemma not_priMaxTT_concat_refTock':
  assumes "v \<noteq> []"
  shows "\<not> priMaxTT p [[y]\<^sub>R, [Tock]\<^sub>E] (v @ [[x]\<^sub>R, [Tock]\<^sub>E]) z P"
  using assms apply (induct p "[]:: 'a ttobs list" v z P rule:priMaxTT.induct, auto)
   apply (case_tac va, auto, case_tac va, auto, case_tac a, auto, case_tac x1, auto)
   apply (metis append_Cons neq_Nil_conv priMaxTT.simps(46) self_append_conv2)
  apply (case_tac va, auto, case_tac vb, auto, case_tac x1, auto)
  by (metis append_Cons neq_Nil_conv priMaxTT.simps(46) self_append_conv2)

lemma priMaxTT_both_concat_refTock_imp_prefixes:
  assumes "priMaxTT p (xs @ [[s]\<^sub>R, [Tock]\<^sub>E]) (ys @ [[t]\<^sub>R, [Tock]\<^sub>E]) z P"
  shows "priMaxTT p xs ys z P"
  using assms apply (induct p xs ys z P arbitrary:s t rule:priMaxTT.induct, auto)
  using not_priMaxTT_concat_refTock
     apply (metis append_Cons list.discI)
  using not_priMaxTT_concat_refTock
    apply fastforce
  using not_priMaxTT_concat_refTock'
  by (metis append_Cons list.distinct(1))+

lemma priMaxTT_length_eq:
  assumes "priMaxTT p xs ys z P"
  shows "List.length xs = List.length ys"
  using assms by (induct p xs ys z P rule:priMaxTT.induct, auto)

lemma ttWF_cons_simp:
  assumes "e\<^sub>2 \<noteq> Tock" "e\<^sub>2 \<noteq> Tick" "ttWF ([e\<^sub>2]\<^sub>E # zz)"
  shows "ttWF(zz)"
  using assms
  using ttWF.elims(2) by blast

lemma priMaxTT_concat_dist1:
  assumes "ttWF (ys @ [[S]\<^sub>R,[Tock]\<^sub>E])"
  shows
   "priMaxTT p (xs @ [[R]\<^sub>R,[Tock]\<^sub>E]) (ys @ [[S]\<^sub>R,[Tock]\<^sub>E]) s P
    =
    (priMaxTT p xs ys s P \<and> priMaxTT p [[R]\<^sub>R,[Tock]\<^sub>E] [[S]\<^sub>R,[Tock]\<^sub>E] (s @ ys) P)"
  using assms apply auto
      apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  using priMaxTT_both_concat_refTock_imp_prefixes apply blast+
         apply (metis append_Cons list.distinct(1) not_priMaxTT_concat_refTock)
  using not_priMaxTT_concat_refTock apply fastforce
       apply (metis append_Cons list.distinct(1) not_priMaxTT_concat_refTock')
      apply (metis append_Cons list.distinct(1) not_priMaxTT_concat_refTock')
     apply (induct p xs ys s P rule:priMaxTT.induct, auto)
          apply (metis ttWF.simps(1) ttWF.simps(4) ttWF.simps(6) ttWF.simps(8) ttevent.exhaust neq_Nil_conv)
         apply (metis append.left_neutral ttWF.simps(4) ttWF.simps(6) ttWF.simps(8) ttWF_prefix_is_ttWF ttevent.exhaust neq_Nil_conv)
        apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock)
  using not_priMaxTT_concat_refTock apply fastforce
      apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
     apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
    apply (induct p xs ys s P rule:priMaxTT.induct, auto)
         apply (metis ttWF.simps(1) ttWF.simps(4) ttWF.simps(6) ttWF.simps(8) ttevent.exhaust neq_Nil_conv)
        apply (metis append.left_neutral ttWF.simps(4) ttWF.simps(6) ttWF.simps(8) ttWF_prefix_is_ttWF ttevent.exhaust neq_Nil_conv)
       apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock)
      apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock)
     apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
    apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
   apply (induct p xs ys s P rule:priMaxTT.induct, auto)
        apply (metis ttWF.simps(1) ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv)
       apply (metis ttWF.simps(1) ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv)
      apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock)
     apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock)
    apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
   apply (metis Cons_eq_appendI neq_Nil_conv not_priMaxTT_concat_refTock')
apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  apply (metis Cons_eq_appendI priMaxTT.simps(4) priMaxTT_extend_both_tock_refusal_ttWF)
  by (metis ttWF.simps(1) ttWF.simps(10) ttWF.simps(4) ttWF.simps(6) ttevent.exhaust neq_Nil_conv)

lemma not_priMaxTT_simp1 [elim]:
  assumes "v \<noteq> []"
  shows "\<not> priMaxTT p (v @ [a,b]) [c,d] s Q"
  using assms using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp2 [simp]:
  shows "\<not> priMaxTT p (x # y @ [a,b]) [c,d] s Q"
  using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp2' [simp]:
  shows "\<not> priMaxTT p [c,d] (x # y @ [a,b]) s Q"
  using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp3 [simp]:
  shows "\<not> priMaxTT p (x # y # z @ [a,b]) [c,d] s Q"
  using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp3' [simp]:
  shows "\<not> priMaxTT p [c,d] (x # y # z @ [a,b]) s Q"
  using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp4 [simp]:
  shows "\<not> priMaxTT p [a, b, c] (x # y # z @ [w, u]) s Q"
  using priMaxTT_length_eq by fastforce

lemma not_priMaxTT_simp4' [simp]:
  shows "\<not> priMaxTT p (x # y # z @ [w, u]) [a, b, c]  s Q"
  using priMaxTT_length_eq by fastforce

lemma priMaxTT_concat_dist2:
  assumes "ttWF (ys @ [[S]\<^sub>R,[Tock]\<^sub>E])"
  shows
   "priMaxTT p (xs @ [a,b]) (ys @ [[S]\<^sub>R,[Tock]\<^sub>E]) s P
    =
    (priMaxTT p xs ys s P \<and> priMaxTT p [a,b] [[S]\<^sub>R,[Tock]\<^sub>E] (s @ ys) P)"
  using assms apply auto
    apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  using ttWF.elims(2) apply blast
  using ttWF.elims(2) apply blast
   apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  using ttWF.elims(2) apply blast
  using ttWF.elims(2) apply blast
  apply (induct p xs ys s P rule:priMaxTT.induct, auto)
  using ttWF.elims(2) apply blast
  using ttWF.elims(2) by blast

lemma priMaxTT_FIXME1:
  assumes "priMaxTT p (xs @ [a,b]) (ys @ [[S]\<^sub>R, [Tock]\<^sub>E]) s P" "ttWF (ys @ [[S]\<^sub>R,[Tock]\<^sub>E])"
  shows "priMaxTT p [a,b] [[S]\<^sub>R, [Tock]\<^sub>E] (s@ys) P"
  using assms priMaxTT_concat_dist2 by (simp add:priMaxTT_concat_dist2)

lemma priMaxTT_rhs_refTock_imp_no_gt_Tock_pri:
  assumes "priMaxTT p ar (ys @ [[r1]\<^sub>R, [Tock]\<^sub>E]) [] P" "ttWF (ys @ [[r1]\<^sub>R, [Tock]\<^sub>E])"
  shows "\<not>(\<exists>b. b \<notin> r1 \<and> Tock <\<^sup>*p b)"
  using assms
proof -
  from assms have ll:"List.length ar = List.length (ys @ [[r1]\<^sub>R, [Tock]\<^sub>E])"
    using priMaxTT_length_eq by blast
  then show ?thesis
  using assms(1)
  proof (induct ar rule:rev_induct)
    case Nil
    then show ?case by auto
  next
    case (snoc z zs)
    then show ?case
    proof (induct zs rule:rev_induct)
      case Nil
      then show ?case by auto
    next
      case (snoc x xs)
      then show ?case
        apply (case_tac z, auto)
         apply (case_tac x1, auto)
           apply (case_tac x, auto)
            apply (meson assms(2) priMaxTT.simps(50) priMaxTT_FIXME1)
           apply (meson assms(2) priMaxTT.simps(50) priMaxTT_FIXME1)
          apply (case_tac x, auto)
        using assms(2) priMaxTT.simps(47) priMaxTT_FIXME1 apply blast
          apply (metis assms(2) priMaxTT.simps(3) priMaxTT_FIXME1 prirefMaxTT_imp_not_exists_higher_pri)
         apply (case_tac x, auto)
        using assms(2) priMaxTT.simps(52) priMaxTT_FIXME1 apply blast
        using assms(2) priMaxTT.simps(52) priMaxTT_FIXME1 apply blast
        using assms(2) priMaxTT.simps(17) priMaxTT_FIXME1 by blast
    qed
  qed
qed

lemma priMaxTT_nonmax_Tock_imp_exists_refusal:
  assumes "priMaxTT p ar (ys @ [[e1]\<^sub>E]) s P" "e1 \<noteq> Tock"
          "ttWF (ys @ [[e1]\<^sub>E])" "\<not>maximal(p,e1)"
  shows "(\<exists>Z. s @ ys @ [[Z]\<^sub>R] \<in> P \<and> e1 \<notin> Z \<and> \<not>(\<exists>b. b \<notin> Z \<and> e1 <\<^sup>*p b))"
  using assms apply(induct p ar ys s P rule:priMaxTT.induct, auto)
            apply (metis ttWF.simps(1) ttWF.simps(10) ttWF.simps(6) ttWF_cons_simp neq_Nil_conv)
           apply (metis (full_types) append_Nil assms(2) ttWF.simps(10) ttWF.simps(5) ttWF.simps(6) ttWF_cons_simp ttWF_prefix_is_ttWF list.collapse rotate1.simps(2))
          apply (metis ttobs.exhaust priMaxTT.simps(29) priMaxTT.simps(4))
         apply (metis ttobs.exhaust priMaxTT.simps(29) priMaxTT.simps(4))
        apply (metis ttobs.exhaust priMaxTT.simps(29) priMaxTT.simps(4))
       apply (metis ttobs.exhaust priMaxTT.simps(29) priMaxTT.simps(4))
      apply (case_tac va, auto, case_tac vb, auto, case_tac x1, auto, case_tac e1, auto)
  using ttWF.elims(2) apply blast
  using ttobs.exhaust  priMaxTT.simps(29) priMaxTT.simps(4) apply metis
  apply (case_tac v, auto)
  using ttWF.elims(2) by blast+

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory WP
imports
  "WP_Pre"
  "WPFix"
  "../../Apply_Debug"
  "../../ml-helpers/MLUtils"
begin

definition
  triple_judgement :: "('a \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> bool"
where
 "triple_judgement pre body property = (\<forall>s. pre s \<longrightarrow> property s body)"

definition
  postcondition :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> ('r \<times> 's) set)
            \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
where
 "postcondition P f = (\<lambda>a b. \<forall>(rv, s) \<in> f a b. P rv s)"

definition
  postconditions :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool)"
where
 "postconditions P Q = (\<lambda>a b. P a b \<and> Q a b)"

lemma conj_TrueI: "P \<Longrightarrow> True \<and> P" by simp
lemma conj_TrueI2: "P \<Longrightarrow> P \<and> True" by simp

ML_file "WP-method.ML"

declare [[wp_trace = false, wp_trace_instantiation = false]]

setup WeakestPre.setup

method_setup wp = \<open>WeakestPre.apply_wp_args\<close>
  "applies weakest precondition rules"

end


section \<open> Instantaneous Reactive Designs \<close>

theory utp_rdes_instant
  imports utp_rdes_prog
begin

definition ISRD1 :: "('s,'t::trace,'\<alpha>) hrel_rsp \<Rightarrow> ('s,'t,'\<alpha>) hrel_rsp" where
[upred_defs]: "ISRD1(P) = P \<parallel>\<^sub>R \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> false \<diamondop> ($tr =\<^sub>u $tr\<acute>))"

definition ISRD :: "('s,'t::trace,'\<alpha>) hrel_rsp \<Rightarrow> ('s,'t,'\<alpha>) hrel_rsp" where
[upred_defs]: "ISRD = ISRD1 \<circ> NSRD"

lemma ISRD1_idem: "ISRD1(ISRD1(P)) = ISRD1(P)"
  by (rel_auto)

lemma ISRD1_monotonic: "P \<sqsubseteq> Q \<Longrightarrow> ISRD1(P) \<sqsubseteq> ISRD1(Q)"
  by (rel_auto)

thm R5_def

lemma ISRD1_RHS_design_form:
  assumes "$ok\<acute> \<sharp> P" "$ok\<acute> \<sharp> Q" "$ok\<acute> \<sharp> R"
  shows "ISRD1(\<^bold>R\<^sub>s(P \<turnstile> Q \<diamondop> R)) = \<^bold>R\<^sub>s(P \<turnstile> false \<diamondop> R5(R))"
  using assms by (simp add: ISRD1_def choose_srd_def RHS_tri_design_par unrest, rel_auto)

lemma ISRD1_form:
  "ISRD1(SRD(P)) = \<^bold>R\<^sub>s(pre\<^sub>R(P) \<turnstile> false \<diamondop> (R5(post\<^sub>R(P))))"
  by (simp add: ISRD1_RHS_design_form SRD_as_reactive_tri_design unrest)

lemma ISRD1_rdes_def [rdes_def]:
  "\<lbrakk> P is RR; R is RR \<rbrakk> \<Longrightarrow> ISRD1(\<^bold>R\<^sub>s(P \<turnstile> Q \<diamondop> R)) = \<^bold>R\<^sub>s(P \<turnstile> false \<diamondop> R5(R))"
  by (simp add: ISRD1_def R5_def rdes_def closure rpred)

lemma ISRD_intro:
  assumes "P is NSRD" "peri\<^sub>R(P) = (\<not>\<^sub>r pre\<^sub>R(P))" "($tr\<acute> =\<^sub>u $tr) \<sqsubseteq> post\<^sub>R(P)"
  shows "P is ISRD"
proof -
  have "\<^bold>R\<^sub>s(pre\<^sub>R(P) \<turnstile> peri\<^sub>R(P) \<diamondop> post\<^sub>R(P)) is ISRD1"
    apply (simp add: Healthy_def rdes_def closure assms(1-2))
    using assms(3) least_zero apply (rel_blast)
    done
  hence "P is ISRD1"
    by (simp add: SRD_reactive_tri_design closure assms(1))
  thus ?thesis
    by (simp add: ISRD_def Healthy_comp assms(1))
qed

lemma ISRD1_rdes_intro:
  assumes "P is RR" "Q is RR" "($tr =\<^sub>u $tr\<acute>) \<sqsubseteq> Q"
  shows "\<^bold>R\<^sub>s(P \<turnstile> false \<diamondop> Q) is ISRD1"
  unfolding Healthy_def
  by (simp add: ISRD1_rdes_def R5_def assms closure unrest utp_pred_laws.inf.absorb1)

lemma ISRD_rdes_intro [closure]:
  assumes "P is RC" "Q is RR" "($tr =\<^sub>u $tr\<acute>) \<sqsubseteq> Q"
  shows "\<^bold>R\<^sub>s(P \<turnstile> false \<diamondop> Q) is ISRD"
  unfolding Healthy_def
  by (simp add: ISRD_def R5_def closure Healthy_if ISRD1_rdes_def assms unrest utp_pred_laws.inf.absorb1)

lemma ISRD_implies_ISRD1:
  assumes "P is ISRD"
  shows "P is ISRD1"
proof -
  have "ISRD(P) is ISRD1"
    by (simp add: ISRD_def Healthy_def ISRD1_idem)
  thus ?thesis
    by (simp add: assms Healthy_if)
qed

lemma ISRD_implies_SRD:
  assumes "P is ISRD"
  shows "P is SRD"
proof -
  have 1:"ISRD(P) = \<^bold>R\<^sub>s((\<not>\<^sub>r (\<not>\<^sub>r pre\<^sub>R P) ;; R1 true \<and> R1 true) \<turnstile> false \<diamondop> (post\<^sub>R P \<and> $tr =\<^sub>u $tr\<acute>))"
    by (simp add: NSRD_form ISRD1_def R5_def ISRD_def RHS_tri_design_par rdes_def unrest closure)
  moreover have "... is SRD"
    by (simp add: closure unrest)
  ultimately have "ISRD(P) is SRD"
    by (simp)
  with assms show ?thesis
    by (simp add: Healthy_def)
qed

lemma ISRD_implies_NSRD [closure]:
  assumes "P is ISRD"
  shows "P is NSRD"
proof -
  have 1:"ISRD(P) = ISRD1(RD3(SRD(P)))"
    by (simp add: ISRD_def NSRD_def SRD_def, metis RD1_RD3_commute RD3_left_subsumes_RD2)
  also have "... = ISRD1(RD3(P))"
    by (simp add: assms ISRD_implies_SRD Healthy_if)
  also have "... = ISRD1 (\<^bold>R\<^sub>s ((\<not>\<^sub>r pre\<^sub>R P) wp\<^sub>r false\<^sub>h \<turnstile> (\<exists> $st\<acute> \<bullet> peri\<^sub>R P) \<diamondop> post\<^sub>R P))"
    by (simp add: RD3_def, subst SRD_right_unit_tri_lemma, simp_all add: assms ISRD_implies_SRD)
  also have "... = \<^bold>R\<^sub>s ((\<not>\<^sub>r pre\<^sub>R P) wp\<^sub>r false\<^sub>h \<turnstile> false \<diamondop> (post\<^sub>R P \<and> $tr =\<^sub>u $tr\<acute>))"
    by (simp add: RHS_tri_design_par ISRD1_def unrest choose_srd_def rpred closure ISRD_implies_SRD assms)
  also have "... = (... ;; II\<^sub>R)"
    by (rdes_simp, simp add: RHS_tri_normal_design_composition' closure assms unrest ISRD_implies_SRD R5_def wp rpred wp_rea_false_RC)
  also have "... is RD3"
    by (simp add: Healthy_def RD3_def seqr_assoc)
  finally show ?thesis
    by (simp add: SRD_RD3_implies_NSRD Healthy_if assms ISRD_implies_SRD)
qed

lemma ISRD_form:
  assumes "P is ISRD"
  shows "\<^bold>R\<^sub>s(pre\<^sub>R(P) \<turnstile> false \<diamondop> R5(post\<^sub>R(P))) = P"
proof -
  have "P = ISRD1(P)"
    by (simp add: ISRD_implies_ISRD1 assms Healthy_if)
  also have "... = ISRD1(\<^bold>R\<^sub>s(pre\<^sub>R(P) \<turnstile> peri\<^sub>R(P) \<diamondop> post\<^sub>R(P)))"
    by (simp add: SRD_reactive_tri_design ISRD_implies_SRD assms)
  also have "... = \<^bold>R\<^sub>s(pre\<^sub>R(P) \<turnstile> false \<diamondop> R5(post\<^sub>R(P)))"
    by (simp add: ISRD1_rdes_def R5_def closure assms)
  finally show ?thesis ..
qed

lemma ISRD_elim [RD_elim]:
  "\<lbrakk> P is ISRD; Q(\<^bold>R\<^sub>s (pre\<^sub>R(P) \<turnstile> false \<diamondop> R5(post\<^sub>R(P)))) \<rbrakk> \<Longrightarrow> Q(P)"
  by (simp add: ISRD_form)

lemma skip_srd_ISRD [closure]: "II\<^sub>R is ISRD"
  by (rule ISRD_intro, simp_all add: rdes closure)

lemma assigns_srd_ISRD [closure]: "\<langle>\<sigma>\<rangle>\<^sub>R is ISRD"
  by (rule ISRD_intro, simp_all add: rdes closure, rel_auto)

lemma seq_ISRD_closed:
  assumes "P is ISRD" "Q is ISRD"
  shows "P ;; Q is ISRD"
  apply (insert assms)
  apply (erule ISRD_elim)+
  apply (simp add: rdes_def closure assms unrest)
  apply (rule ISRD_rdes_intro)
    apply (simp_all add: rdes_def closure assms unrest)
  apply (rel_auto)
  done

lemma ISRD_Miracle_right_zero:
  assumes "P is ISRD" "pre\<^sub>R(P) = true\<^sub>r"
  shows "P ;; Miracle = Miracle"
  by (rdes_simp cls: assms)

text \<open> A recursion whose body does not extend the trace results in divergence \<close>

lemma ISRD_recurse_Chaos:
  assumes "P is ISRD" "post\<^sub>R P ;; true\<^sub>r = true\<^sub>r"
  shows "(\<mu>\<^sub>R X \<bullet> P ;; X) = Chaos"
proof -
  have 1: "(\<mu>\<^sub>R X \<bullet> P ;; X) = (\<mu> X \<bullet> P ;; SRD(X))"
    by (auto simp add: srdes_theory.utp_lfp_def closure assms)
  have "(\<mu> X \<bullet> P ;; SRD(X)) \<sqsubseteq> Chaos"
  proof (rule gfp_upperbound)
    have "P ;; Chaos \<sqsubseteq> Chaos"
      apply (rdes_refine_split cls: assms)
      using assms(2) apply (rel_auto, metis (no_types, lifting) dual_order.antisym order_refl)
       apply (rel_auto)+
      done
    thus "P ;; SRD Chaos \<sqsubseteq> Chaos"
      by (simp add: Healthy_if srdes_theory.bottom_closed)
  qed
  thus ?thesis
    by (metis "1" dual_order.antisym srdes_theory.LFP_closed srdes_theory.bottom_lower)
qed

lemma recursive_assign_Chaos:
  "(\<mu>\<^sub>R X \<bullet> \<langle>\<sigma>\<rangle>\<^sub>R ;; X) = Chaos"
  by (rule ISRD_recurse_Chaos, simp_all add: closure rdes, rel_auto)

lemma unproductive_form:
  assumes "P\<^sub>2 is RR" "P\<^sub>3 is RR" "P\<^sub>3 is R5" "P\<^sub>3 \<noteq> false"
  shows "\<not> (\<^bold>R\<^sub>s(true\<^sub>r \<turnstile> P\<^sub>2 \<diamondop> P\<^sub>3) is Productive)"
proof -
  have "Productive(\<^bold>R\<^sub>s(true\<^sub>r \<turnstile> P\<^sub>2 \<diamondop> P\<^sub>3)) = \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> P\<^sub>2 \<diamondop> R4(P\<^sub>3))"
    by (simp add: Productive_RHS_R4_design_form closure assms)
  also have "... = \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> P\<^sub>2 \<diamondop> false)"
    by (metis Healthy_if R4_R5 assms(3))
  also have "... \<noteq> \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> P\<^sub>2 \<diamondop> P\<^sub>3)"
    by (simp add: R5_implies_R1 assms rea_true_conj(1) rrel_theory.bottom_closed rrel_theory.top_closed srdes_tri_eq_iff)
  finally show ?thesis
    using Healthy_if by blast
qed

lemma unproductive_assigns: "\<not> (\<langle>\<sigma>\<rangle>\<^sub>R is Productive)"
  unfolding rdes_def by (rule unproductive_form, simp_all add: closure, rel_auto+)

end


(*  Title:      HOL/Auth/n_mutualExOnI.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExOnI Protocol Case Study*}

theory n_mutualExOnI imports n_mutualExOnI_lemma_invs_on_rules n_mutualExOnI_on_inis
begin
lemma main:
assumes a1: "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
and a2: "0 < N"
shows "\<forall> f. f \<in> (invariants N) --> formEval f s"
proof (rule consistentLemma)
show "consistent (invariants N) {andList (allInitSpecs N)} (rules N)"
proof (cut_tac a1, unfold consistent_def, rule conjI)
show "\<forall> f ini s. f \<in> (invariants N) --> ini \<in> {andList (allInitSpecs N)} --> formEval ini s --> formEval f s"
proof ((rule allI)+, (rule impI)+)
  fix f ini s
  assume b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  have b4: "formEval (andList (allInitSpecs N)) s"
  apply (cut_tac b2 b3, simp) done
  show "formEval f s"
  apply (rule on_inis, cut_tac b1, assumption, cut_tac b2, assumption, cut_tac b3, assumption) done
qed
next show "\<forall> f r s. f \<in> invariants N --> r \<in> rules N --> invHoldForRule s f r (invariants N)"
proof ((rule allI)+, (rule impI)+)
  fix f r s
  assume b1: "f \<in> invariants N" and b2: "r \<in> rules N"
  show "invHoldForRule s f r (invariants N)"
  apply (rule invs_on_rules, cut_tac b1, assumption, cut_tac b2, assumption) done
qed
qed
next show "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
  apply (metis a1) done
qed
end