theory func_cor_OSMboxPost
  imports rg_cond_post
begin
thm OSMboxPost_def

lemma OSMboxPost_pre_stable:" stable (OSMboxPost_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace>) (OSMboxPost_rely_lemma t) "
  by(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def stable_def gvars_conf_stable_def gvars_conf_def)

lemma OSMboxPost_post_stable:" stable (OSMboxPost_post t) (OSMboxPost_rely_lemma t) "
  by(simp add:OSMboxPost_post_def OSMboxPost_rely_lemma_def stable_def)

lemma mylist_nhd_in_tl: "dist_list l \<Longrightarrow> hd l \<notin> set (tl l) "
  by (meson dist_hd_nin_tl distinct_conv_nth)

lemma mylist_hd_in_list: "l \<noteq> [] \<Longrightarrow>hd l \<in> set l"
  by auto

text \<open>
we define inv_thd_waitq4 to represent the state where the hd of the waitq list  was removed from the waitq list
and the state of the hd(waitq) is still blocked.This lemma aims to show that inv_thd_waitq_mid4 V' can be derived from
the inv_thd_waitq V. V' = V\<lparr>wait_q = tl waitq\<rparr>.
\<close>
lemma inv_waitq_to_inv_waitq4: " \<And> V . pe \<in> OSMailBoxs V \<Longrightarrow> inv_thd_waitq V \<Longrightarrow> t = hd(wait_q (OSMailbox_info V pe)) \<Longrightarrow> (wait_q (OSMailbox_info V pe)) \<noteq> [] \<Longrightarrow>
                 inv_thd_waitq_mid4  (V\<lparr>OSMailbox_info := (OSMailbox_info V) (pe :=OSMailbox_info V pe\<lparr>wait_q := tl (wait_q ((OSMailbox_info  V) pe))\<rparr>)\<rparr>) t "
  apply(simp add:OSMboxPost_pre_def inv_thd_waitq_def inv_thd_waitq_mid4_def)
  apply auto
        apply (metis list_nhd_in_tl_set)
       apply (simp add: mylist_nhd_in_tl)
  using mylist_hd_in_list apply blast
  apply (meson list.set_sel(2))
    apply (simp add: List.nth_tl less_diff_conv)
   apply (metis list.set_sel(2))
  by (meson list.set_sel(2))              \<comment> \<open>lemma test simulate the key step which transform the pre "inv_thd_waitq" to "inv_thd_waitq4"  \<close>

lemma myconj1: "A \<Longrightarrow> B  \<Longrightarrow> B"
  unfolding and_def by (iprover intro: impI [THEN allI] mp)  \<comment> \<open>the rule to remove the useless assumption \<close>

lemma inv_waitq5_to_inv_waitq:"\<And>t tx s. inv_thd_waitq_mid5 s tx \<Longrightarrow> inv_cur s \<Longrightarrow>  inv s"
  apply(simp add:inv_thd_waitq_mid5_def inv_thd_waitq_def inv_def inv_cur_def)apply auto
  by (metis Thread_State_Type.distinct(3))

text \<open>This lemma was proved to show that V' satifies: inv_thd_waitq_midx V' = True \<close>
lemma inv_waitq_to_inv_waitqx:"                    \<comment> \<open> to show that  V' satifies: inv_thd_waitq_midx V'\<close>
pevent \<in> OSMailBoxs V \<Longrightarrow>  inv_cur V \<Longrightarrow>  cur V = Some t \<Longrightarrow> inv_thd_waitq V
 \<Longrightarrow> wait_q (OSMailbox_info V pevent) \<noteq> [] \<Longrightarrow>
let V2 =
  V \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
       get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
       OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
       need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
       thd_state := (thd_state V)
         (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
          SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
       ret := (ret V)(t := OK)\<rparr>
  in
 inv_thd_waitq_midx V2 (hd(wait_q (OSMailbox_info V pevent)))
"
  apply(subgoal_tac "inv_thd_waitq_midx V  (hd(wait_q (OSMailbox_info V pevent)))")
 apply(simp add:inv_thd_waitq_midx_def)apply auto
            apply (metis list_nhd_in_tl_set)
           apply (simp add: mylist_nhd_in_tl)
           apply (metis Thread_State_Type.distinct(5) inv_cur_def  list.set_sel(2))

  apply (smt Thread_State_Type.distinct(3) list.set_sel(2) someI)
         apply (simp add: list.set_sel(2))
  using mylist_hd_in_list apply blast
       apply (metis Thread_State_Type.distinct(5) inv_cur_def)

      apply (smt Thread_State_Type.distinct(3) someI)
  apply (simp add: List.nth_tl Nitpick.size_list_simp(2))
  apply (meson list.set_sel(2))
  apply (meson list.set_sel(2))
  by (simp add: waitq_to_waitq_midx)

 (* without assumption "waitq V' \<noteq> []" , failed to prove this lemma  *)
lemma tet:" \<And>p.
         inv_cur V \<Longrightarrow>
         cur V = Some t \<Longrightarrow> wait_q (OSMailbox_info V pevent) \<noteq> [] \<Longrightarrow>
         \<forall>t. t \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> thd_state V t = BLOCKED \<longrightarrow> (\<exists>p\<in>OSMailBoxs V. t \<in> set (wait_q (OSMailbox_info V p))) \<Longrightarrow>
         \<forall>p\<in>OSMailBoxs V. \<forall>t\<in>set (wait_q (OSMailbox_info V p)). thd_state V t = BLOCKED \<Longrightarrow>
         \<forall>p\<in>OSMailBoxs V. dist_list (wait_q (OSMailbox_info V p)) \<Longrightarrow>
          pevent \<in> OSMailBoxs V \<Longrightarrow>
         \<forall>p q. p \<in> OSMailBoxs V \<and> q \<in> OSMailBoxs V \<and> p \<noteq> q \<longrightarrow> (\<forall>t. t \<in> set (wait_q (OSMailbox_info V p)) \<longrightarrow> t \<notin> set (wait_q (OSMailbox_info V q))) \<Longrightarrow>
         p \<in> OSMailBoxs V \<Longrightarrow> p \<noteq> pevent \<Longrightarrow> hd (wait_q (OSMailbox_info V pevent)) \<in> set (wait_q (OSMailbox_info V p)) \<Longrightarrow> False "
  using mylist_hd_in_list by blast

text \<open> inv_thd_waitq_mid5 can be divided into two parts: 1. inv_thd_waitq_midx 2.thd_state V t = READY,
       i.e., inv_thd_waitq_mid5 = inv_thd_waitq_midx \<and> thd_state V t\<close>
lemma waitq_midx_and_Ready_eq_waitq5:"inv_thd_waitq_midx V t \<Longrightarrow> thd_state V t = READY \<Longrightarrow>inv_thd_waitq_mid5 V t "
  using inv_thd_waitq_mid5_def inv_thd_waitq_midx_def by auto

text \<open> this lemma is to show: (V,V')\<in>OSMboxPost_guar t \<close>
lemma VV'_in_OSMboxPost_guar:" msg = Some y \<Longrightarrow>
    pevent \<in> OSMailBoxs V \<Longrightarrow>
    invariant.inv V \<Longrightarrow>
    cur V = Some t \<Longrightarrow>
    wait_q (OSMailbox_info V pevent) \<noteq> [] \<Longrightarrow>
    (V, V
     \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
        get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
        OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
        need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
        thd_state := (thd_state V)
          (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
           SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
        ret := (ret V)(t := OK)\<rparr>)
    \<in> OSMboxPost_guar t "
  apply(simp add:OSMboxPost_guar_def)
  apply auto
    apply(simp add:gvars_conf_stable_def gvars_conf_def)   (*prove:(V, V')\<in> gvars_conf_stable *)

   prefer 2
   apply(simp add:lvars_nochange_lemma_def) (*prove:\<forall>t'\<noteq>t. lvars_nochage t' V V' *)

\<comment> \<open>Next, we want to show that  V' satifies: inv V'\<close>
  apply(simp add:inv_def)
  apply(rule conjI)
apply(simp add:inv_cur_def)
   apply auto[1]
  apply(subgoal_tac "let Vx =  V
       \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
       get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
       OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
       need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
       thd_state := (thd_state V)
         (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
          SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
       ret := (ret V)(t := OK)\<rparr> in
                     inv_thd_waitq_mid5 Vx (hd(wait_q (OSMailbox_info V pevent)))")

  apply(simp add:inv_thd_waitq_mid5_def inv_thd_waitq_def)
   apply (metis (no_types, lifting) list.set_sel(2))
  apply(subgoal_tac "let Vx = V
          \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
             get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
             OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
             need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
             thd_state := (thd_state V)
               (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
                SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
             ret := (ret V)(t := OK)\<rparr>
    in inv_thd_waitq_midx Vx (hd (wait_q (OSMailbox_info V pevent)))")
  prefer 2
   apply(simp add:inv_waitq_to_inv_waitqx)apply auto
  apply(rule  waitq_midx_and_Ready_eq_waitq5)
  apply blast            (*just need to prove that:thd_state hd(wait_q) V' = READY  *)
  apply auto
  subgoal 1
proof -
  assume a1: "t = hd (wait_q (OSMailbox_info V pevent))"
  assume a2: "wait_q (OSMailbox_info V pevent) \<noteq> []"
  assume a3: "pevent \<in> OSMailBoxs V"
assume a4: "inv_thd_waitq V"
  assume a5: "cur V = Some (hd (wait_q (OSMailbox_info V pevent)))"
assume a6: "inv_cur V"
have "thd_state V t = BLOCKED"
using a4 a3 a2 a1 by (simp add: inv_thd_waitq_def)
then show False
  using a6 a5 a1 by (metis (no_types) Thread_State_Type.distinct(5) inv_cur_def)
qed

  subgoal 1
    apply(simp add:inv_thd_waitq_def)
    by (metis Thread_State_Type.distinct(5) hd_in_set inv_cur_def)

done

text \<open>this lemma is to show that: inv V \<Longrightarrow> inv V'\<close>
lemma V'_sat_INV:"msg = Some y \<Longrightarrow>
    pevent \<in> OSMailBoxs V \<Longrightarrow>
    V \<in> OSMboxPost_pre t \<Longrightarrow>
    cur V = Some t \<Longrightarrow>
    wait_q (OSMailbox_info V pevent) \<noteq> [] \<Longrightarrow>
    V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
        get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
        OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
        need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
        thd_state := (thd_state V)
          (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
           SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
        ret := (ret V)(t := OK)\<rparr>
    \<in> OSMboxPost_post t "
  apply(simp add:OSMboxPost_post_def)
  apply(case_tac"V = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
          get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
          OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
          need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
          thd_state := (thd_state V)
            (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
             SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
          ret := (ret V)(t := OK)\<rparr> ")
   apply(simp add:OSMboxPost_pre_def)
  apply(simp add:OSMboxPost_pre_def)

  apply(simp add:inv_def)
  apply(rule conjI)
apply(simp add:inv_cur_def)
   apply auto[1]
  apply(subgoal_tac "let Vx =  V
       \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
       get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
       OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
       need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
       thd_state := (thd_state V)
         (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
          SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
       ret := (ret V)(t := OK)\<rparr> in
                     inv_thd_waitq_mid5 Vx (hd(wait_q (OSMailbox_info V pevent)))")

  apply(simp add:inv_thd_waitq_mid5_def inv_thd_waitq_def)
   apply (metis (no_types, lifting) list.set_sel(2))
  apply(subgoal_tac "let Vx = V
          \<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
             get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y), statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
             OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
             need_resched := (need_resched V)(t := True), cur := Some (SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY),
             thd_state := (thd_state V)
               (hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY,
                SOME ta. ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow> ta \<noteq> t \<longrightarrow> thd_state V ta = READY := RUNNING),
             ret := (ret V)(t := OK)\<rparr>
    in inv_thd_waitq_midx Vx (hd (wait_q (OSMailbox_info V pevent)))")
  prefer 2
   apply(simp add:inv_waitq_to_inv_waitqx)apply auto
  apply(rule  waitq_midx_and_Ready_eq_waitq5)
  apply blast            (*just need to prove that:thd_state hd(wait_q) V' = READY  *)
  apply auto
  subgoal 1
proof -
  assume a1: "t = hd (wait_q (OSMailbox_info V pevent))"
  assume a2: "wait_q (OSMailbox_info V pevent) \<noteq> []"
  assume a3: "pevent \<in> OSMailBoxs V"
assume a4: "inv_thd_waitq V"
  assume a5: "cur V = Some (hd (wait_q (OSMailbox_info V pevent)))"
assume a6: "inv_cur V"
have "thd_state V t = BLOCKED"
using a4 a3 a2 a1 by (simp add: inv_thd_waitq_def)
then show False
  using a6 a5 a1 by (metis (no_types) Thread_State_Type.distinct(5) inv_cur_def)
qed

  subgoal 1
    apply(simp add:inv_thd_waitq_def)
    by (metis Thread_State_Type.distinct(5) hd_in_set inv_cur_def)

done

text \<open>
the key steps to prove this lemma:
\<bullet> Get the state V' when the event code ends
\<bullet> prove that (V,V')\<in>OSMboxPost_guar t
\<bullet> prove that inv V'
\<bullet> prove that  stable (\<lbrace>\<acute>(Pair V) \<in> OSMboxPost_guar t\<rbrace> \<inter> OSMboxPost_post t) {(x, y). x = y}

!! trick:
   to use the type V\<lparr>...\<rparr>, we should eliminate the quantifier  ‘\<And>’
\<close>
lemma OSMboxPost_satRG_h1_1:" msg = Some y \<Longrightarrow>
           pevent \<in> OSMailBoxs V \<Longrightarrow>
           V \<in> OSMboxPost_pre t \<Longrightarrow>
           cur V = Some t \<Longrightarrow>
           \<turnstile>\<^sub>I (W\<acute>th := \<acute>th(t := hd (wait_q (\<acute>OSMailbox_info pevent)));; \<acute>tmout := \<acute>tmout(\<acute>th t := OK);; \<acute>get_msg := \<acute>get_msg(\<acute>th t \<mapsto> y);;
                  \<acute>statPend := \<acute>statPend(\<acute>th t := OS_STAT_PEND_OK);;
                  \<acute>OSMailbox_info := \<acute>OSMailbox_info(pevent := \<acute>OSMailbox_info pevent\<lparr>wait_q := tl (wait_q (\<acute>OSMailbox_info pevent))\<rparr>);;
                  \<acute>thd_state := \<acute>thd_state(\<acute>th t := READY);;
                  \<acute>need_resched := \<acute>need_resched(t := True);;
                  IF \<acute>need_resched t THEN reschedule FI;;
                  \<acute>ret := \<acute>ret
                  (t := OK)) sat\<^sub>p [{V} \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>, {(x, y). x = y}, UNIV, \<lbrace>\<acute>(Pair V) \<in> OSMboxPost_guar t\<rbrace> \<inter> OSMboxPost_post t]"

  apply(case_tac "wait_q (OSMailbox_info V pevent) = []")
   apply auto
   apply(simp add:Emptyprecond)
  apply(simp add:reschedule_def)    \<comment> \<open>use this method to extract the assumption "wait_q (\<acute>OSMailbox_info pevent) \<noteq> []" \<close>

    apply(rule Seq[where mid = "let V9 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                    get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                    statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
                                    OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
                                    need_resched := (need_resched V)(t := True),
                                    thd_state := (thd_state V)(hd (wait_q (OSMailbox_info V pevent)) := READY, t := READY),
                                    cur :=
                                      Some
                                       (SOME ta.
                                           ta \<noteq> hd (wait_q (OSMailbox_info V pevent)) \<longrightarrow>
                                           ta \<noteq> t \<longrightarrow>
                                           thd_state V ta =
                                           READY)\<rparr>  in
                                {V9\<lparr>thd_state := (thd_state V9)(the (cur V9) := RUNNING)\<rparr>}"])
 apply(rule Seq[where mid = "let V6 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                    get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                    statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
                                    OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
                                    thd_state := (thd_state V)
                                      (hd (wait_q (OSMailbox_info V pevent)) :=
                                         READY)\<rparr>  in
                                    {V6\<lparr>need_resched := (need_resched V6)( t := True)\<rparr>}"])
   apply(rule Seq[where mid = "let V5 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                  get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                  statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
                                  OSMailbox_info := (OSMailbox_info V)
                                    (pevent := OSMailbox_info V pevent
                                       \<lparr>wait_q :=
                                          tl (wait_q
                                               (OSMailbox_info V
                                                 pevent))\<rparr>)\<rparr>  in
                               {V5\<lparr>thd_state := (thd_state V5)((th V5) t := READY)\<rparr>}"])
     apply(rule Seq[where mid = "let V4 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))),
                                                tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                                get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                                statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK)\<rparr> in
                                      {V4\<lparr>OSMailbox_info := (OSMailbox_info V4)(pevent := OSMailbox_info V4 pevent
                                         \<lparr>wait_q := tl (wait_q (OSMailbox_info V4 pevent))\<rparr>)\<rparr>} (* \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>*)"])
  apply(rule Seq[where mid = "let V3 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                         get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y)\<rparr> in
                                      {V3\<lparr>statPend := (statPend V3)((th V3) t := OS_STAT_PEND_OK)\<rparr>} \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>"])
    apply(rule Seq[where mid = "let V2 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK)\<rparr> in
                                      {V2\<lparr>get_msg := (get_msg V2)((th V2) t := msg)\<rparr>} \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>"])
        apply(rule Seq[where mid = "let V1 = V\<lparr>th := (th V)(t :=  hd (wait_q((OSMailbox_info V) pevent)))\<rparr> in
                                      {V1\<lparr>tmout := (tmout V1)((th V1) t := OK)\<rparr>} \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>"])
         apply(rule Seq[where mid = "{V\<lparr>th := (th V)(t :=  hd (wait_q((OSMailbox_info V) pevent)))\<rparr>} \<inter> \<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>"])

          apply(rule Basic) apply auto
           apply(simp add:stable_id2)  apply(simp add:stable_id2)
         apply(rule Basic)apply auto
          apply(simp add:stable_id2) apply(simp add:stable_id2)
        apply(rule Basic)apply auto
         apply(simp add:stable_id2) apply(simp add:stable_id2)
       apply(rule Basic)apply auto
        apply(simp add:stable_id2) apply(simp add:stable_id2)
      apply(rule Basic)apply auto
       apply(simp add:stable_id2) apply(simp add:stable_id2)
     apply(rule Basic)apply auto
      apply(simp add:stable_id2) apply(simp add:stable_id2)
    apply(rule Basic)apply auto
     apply(simp add:stable_id2) apply(simp add:stable_id2)

   apply(rule Cond)  apply(simp add:stable_id2)
 apply(rule Seq[where mid = "let V8 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                    get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                    statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
                                    OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
                                    need_resched := (need_resched V)(t := True),
                                    thd_state := (thd_state V)
                                    (hd (wait_q (OSMailbox_info V pevent)) := READY,
                                       t := READY)\<rparr>  in
                                 {V8 \<lparr>cur :=  Some (SOME t. (thd_state V8) t = READY)\<rparr>}"])
 apply(rule Seq[where mid = "let V7 = V\<lparr>th := (th V)(t := hd (wait_q (OSMailbox_info V pevent))), tmout := (tmout V)(hd (wait_q (OSMailbox_info V pevent)) := OK),
                                  get_msg := get_msg V(hd (wait_q (OSMailbox_info V pevent)) \<mapsto> y),
                                  statPend := (statPend V)(hd (wait_q (OSMailbox_info V pevent)) := OS_STAT_PEND_OK),
                                  OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>wait_q := tl (wait_q (OSMailbox_info V pevent))\<rparr>),
                                  thd_state := (thd_state V)(hd (wait_q (OSMailbox_info V pevent)) := READY), need_resched := (need_resched V)(t := True)\<rparr>  in
                                  {V7  \<lparr>thd_state := (thd_state V7)((the (cur V7)) := READY)\<rparr>}"])
       apply(rule Basic) apply auto
       apply(simp add:stable_id2) apply(simp add:stable_id2)
     apply(rule Basic) apply auto
      apply(simp add:stable_id2) apply(simp add:stable_id2)
 apply(rule Basic) apply auto
     apply(simp add:stable_id2) apply(simp add:stable_id2)
   apply(simp add:Emptyprecond)
  apply(rule Basic) apply auto
     apply(simp add:OSMboxPost_pre_def OSMboxPost_post_def)

    (*1. use lemma VV'_in_OSMboxPost_guar *)
  apply(simp add:VV'_in_OSMboxPost_guar)
    (*2. use lemma V'_sat_INV : prove that V' satifies: inv V' *)
  apply(simp add:V'_sat_INV)
   apply(simp add:stable_id2)
  apply(simp add:stable_id2)
  done

lemma  OSMboxPost_satRG_h1_2:"
    msg = Some y \<Longrightarrow>
    pevent \<in> OSMailBoxs V \<Longrightarrow>
    V \<in> OSMboxPost_pre t \<Longrightarrow>
    cur V = Some t \<Longrightarrow>
    \<turnstile>\<^sub>I (W IF \<exists>y. msgPtr (\<acute>OSMailbox_info pevent) = Some y THEN \<acute>ret := \<acute>ret(t := OS_ERR_MBOX_FULL)
           ELSE \<acute>OSMailbox_info := \<acute>OSMailbox_info(pevent := \<acute>OSMailbox_info pevent\<lparr>msgPtr := Some y\<rparr>);; \<acute>ret := \<acute>ret(t := OK)
           FI) sat\<^sub>p [{V} \<inter> -\<lbrace>wait_q (\<acute>OSMailbox_info pevent) \<noteq> []\<rbrace>, {(x, y). x = y}, UNIV, \<lbrace>\<acute>(Pair V) \<in> OSMboxPost_guar t\<rbrace> \<inter> OSMboxPost_post t]"

   apply(case_tac "wait_q (OSMailbox_info V pevent) \<noteq> []")
   apply auto
   apply(simp add:Emptyprecond)

  apply(case_tac "\<exists>y. msgPtr (OSMailbox_info V pevent) = Some y")
  subgoal 1
    apply(rule Cond)
       apply(simp add:stable_def)
      apply(rule Basic)apply auto
        apply(simp add:OSMboxPost_pre_def OSMboxPost_guar_def inv_def inv_cur_def inv_thd_waitq_def)
        apply(simp add:gvars_conf_def gvars_conf_stable_def lvars_nochange_lemma_def)
       apply(simp add:OSMboxPost_pre_def OSMboxPost_guar_def OSMboxPost_post_def inv_def inv_cur_def inv_thd_waitq_def)
       apply auto
      apply(simp add:stable_id2)
    apply(simp add:stable_id2)
    apply(simp add:Emptyprecond)
    done

  subgoal 1
    apply(rule Cond)
    apply(simp add:stable_id2)
    apply(rule Basic)apply auto
    apply(simp add:stable_id2)
    apply(simp add:stable_id2)
     apply(rule Seq[where mid = "{V\<lparr>  OSMailbox_info := (OSMailbox_info V)(pevent := OSMailbox_info V pevent\<lparr>msgPtr := Some y\<rparr>) \<rparr>}"])
     apply(rule Basic)apply auto
apply(simp add:stable_id2)
     apply(simp add:stable_id2)
    apply(rule Basic)apply auto
       apply(simp add:OSMboxPost_pre_def OSMboxPost_guar_def OSMboxPost_post_def inv_def inv_cur_def inv_thd_waitq_def)
       apply(simp add:gvars_conf_def gvars_conf_stable_def lvars_nochange_lemma_def)
       apply (metis length_pos_if_in_set less_numeral_extra(3) list.size(3))
    apply(simp add:OSMboxPost_pre_def OSMboxPost_guar_def OSMboxPost_post_def inv_def inv_cur_def inv_thd_waitq_def)
      apply fastforce
     apply(simp add:stable_id2)
    apply(simp add:stable_id2)
    done
  done

lemma OSMboxPost_satRG_h1:" \<And>y V.  msg = Some y \<Longrightarrow>
           OSMboxPost_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace> \<inter> \<lbrace>\<acute>cur = Some t\<rbrace> \<inter> {V} \<noteq> {} \<Longrightarrow>
           \<turnstile>\<^sub>I (W Await UNIV
                   (IF wait_q (\<acute>OSMailbox_info pevent) \<noteq> []
                    THEN \<acute>th := \<acute>th(t := hd (wait_q (\<acute>OSMailbox_info pevent)));; \<acute>tmout := \<acute>tmout(\<acute>th t := OK);; \<acute>get_msg := \<acute>get_msg(\<acute>th t \<mapsto> y);;
                         \<acute>statPend := \<acute>statPend(\<acute>th t := OS_STAT_PEND_OK);;
                         \<acute>OSMailbox_info := \<acute>OSMailbox_info(pevent := \<acute>OSMailbox_info pevent\<lparr>wait_q := tl (wait_q (\<acute>OSMailbox_info pevent))\<rparr>);;
                         \<acute>thd_state := \<acute>thd_state(\<acute>th t := READY);;
                         \<acute>need_resched := \<acute>need_resched(t := True);;
                         IF \<acute>need_resched t THEN reschedule FI;;
                         \<acute>ret := \<acute>ret(t := OK)
                    ELSE IF \<exists>y. msgPtr (\<acute>OSMailbox_info pevent) = Some y THEN \<acute>ret := \<acute>ret(t := OS_ERR_MBOX_FULL)
                         ELSE \<acute>OSMailbox_info := \<acute>OSMailbox_info(pevent := \<acute>OSMailbox_info pevent\<lparr>msgPtr := Some y\<rparr>);; \<acute>ret := \<acute>ret(t := OK)FI
                    FI)) sat\<^sub>p [OSMboxPost_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace> \<inter> \<lbrace>\<acute>cur = Some t\<rbrace> \<inter>
                                {V}, {(s, t). s = t}, UNIV, \<lbrace>\<acute>(Pair V) \<in> OSMboxPost_guar t\<rbrace> \<inter> OSMboxPost_post t] "
  apply auto
  apply(rule Await)
    apply(simp add: stable_id2)
  apply(simp add: stable_id2)
  apply auto
  apply(case_tac "{V} \<inter> {Va}={}")
   apply auto
   apply(simp add:Emptyprecond)
  apply(rule Cond)
     apply(simp add:stable_id2)
    apply(simp add:OSMboxPost_satRG_h1_1)
 apply(simp add:OSMboxPost_satRG_h1_2)
  apply auto
  done

lemma OSMboxPost_satRG_lemma: "\<Gamma> (OSMboxPost t pevent msg) \<turnstile> OSMboxPost_RGCond_lemma t"
  apply (simp add:Evt_sat_RG_def)
  apply (simp add:OSMboxPost_def OSMboxPost_RGCond_lemma_def)
  apply(simp add:body_def Pre\<^sub>f_def Post\<^sub>f_def guard_def
                 Rely\<^sub>f_def Guar\<^sub>f_def getrgformula_def)
  apply(unfold stm_def)
  apply auto  apply (rule BasicEvt)
     apply(simp add:body_def)
     apply(rule Cond)
        apply(simp add:guard_def stable_def) apply auto
    apply(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def
              OSMboxPost_guar_def OSMboxPost_post_def)apply auto
    apply(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def
              OSMboxPost_guar_def OSMboxPost_post_def)
        apply (simp add:gvars_conf_stable_def gvars_conf_def)apply auto
  apply(rule Await)
         apply(simp add:guard_def)
         apply(simp add: OSMboxPost_pre_stable)
        apply(simp add: OSMboxPost_post_stable)
  using Emptyprecond apply auto[1]
       apply (simp add: Emptyprecond)

  apply (rule Basic)                                                                       \<comment> \<open>msg = None,return OS_ERR_POST_NULL directly.(Basic) \<close>
     apply (simp add:guard_def OSMboxPost_guar_def gvars_conf_stable_def inv_def
           OSMboxPost_post_def gvars_conf_def  OSMboxPost_pre_def)
     apply auto
  apply (simp add:inv_cur_def)
       apply (simp add:inv_thd_waitq_def)apply auto
      apply(simp add:lvars_nochange_lemma_def)
     apply(simp add:inv_cur_def)
    apply(simp add:inv_thd_waitq_def)apply auto
   apply(simp add:stable_def)
       apply (rule stable_id2)                                                          \<comment> \<open>end \<close>

      apply(rule Await)
        apply(simp add:stable_def)
       apply(simp add: OSMboxPost_post_stable)
      apply auto apply(rule Await)
        apply(simp add:stable_def)apply(rule stable_id2)
  using Emptyprecond apply auto[1]         \<comment> \<open> OSMboxPost_satRG_h2 \<close>

     apply(simp add: OSMboxPost_guar_def)
  using OSMboxPost_post_def OSMboxPost_post_stable OSMboxPost_pre_def apply auto[1]
  apply(simp add:OSMboxPost_guar_def)             \<comment> \<open> situation 1: msg = None -------   prove end \<close>

 apply(rule BasicEvt)                            \<comment> \<open> situation 2: msg \<noteq> None \<close>
  apply(simp add:body_def)
    apply (rule Cond)
       apply(simp add:stable_def guard_def)apply auto

 apply(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def
              OSMboxPost_guar_def OSMboxPost_post_def)apply auto
    apply(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def
              OSMboxPost_guar_def OSMboxPost_post_def)
        apply (simp add:gvars_conf_stable_def gvars_conf_def)apply auto
  apply(rule Await)
         apply(simp add:stable_def)+
  apply (meson OSMboxPost_post_stable stable_def)
  using Emptyprecond apply auto[1]
     prefer 2 apply (simp add:OSMboxPost_guar_def)
    prefer 2   apply(simp add:OSMboxPost_pre_def OSMboxPost_rely_lemma_def stable_def gvars_conf_stable_def gvars_conf_def)
   prefer 2 apply(simp add:OSMboxPost_guar_def)
  apply(simp add:guard_def)
     apply (rule Await)                           \<comment> \<open> situation 2: msg \<noteq> None \<close>
  apply (simp add: OSMboxPost_pre_stable)
   apply(simp add: OSMboxPost_post_stable) apply auto
  apply(case_tac "OSMboxPost_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace> \<inter> \<lbrace>\<acute>cur = Some t\<rbrace> \<inter>
                                {V} = {}")
   apply(simp add:OSMboxPost_pre_def)
   apply(rule Await)
     apply(simp add:stable_id2)  apply(simp add:stable_id2)

   apply(simp add:Emptyprecond)                \<comment> \<open> situation 1: pevent \<notin> OSmailboxs \<close>

 apply auto                   \<comment> \<open>apply simp add:OSMboxPost_satRG_h1.  It's not able to apply OSMboxPost_satRG1 directly \<close>
  apply(rule Await)
    apply(simp add: stable_id2)
  apply(simp add: stable_id2)
  apply auto
  apply(case_tac "{V} \<inter> {Va}={}")
   apply auto
   apply(simp add:Emptyprecond)
  apply(rule Cond)
     apply(simp add:stable_id2)
    apply(simp add:OSMboxPost_satRG_h1_1)
 apply(simp add:OSMboxPost_satRG_h1_2)
  apply auto
  done

lemma lemma_trans:"rghoare_e \<Gamma> (OSMboxPost t pevent msg) (Pre\<^sub>f (OSMboxPost_RGCond_lemma t)) (Rely\<^sub>f (OSMboxPost_RGCond_lemma t)) (Guar\<^sub>f (OSMboxPost_RGCond_lemma t))
     (Post\<^sub>f (OSMboxPost_RGCond_lemma t)) =  \<Gamma> (OSMboxPost t pevent msg) \<turnstile> OSMboxPost_RGCond_lemma t"
  apply(simp add:Evt_sat_RG_def)
  done

lemma OSMboxPost_satRG: "\<Gamma> (OSMboxPost t pevent msg) \<turnstile> OSMboxPost_RGCond t"
  apply (simp add:Evt_sat_RG_def)
  apply(rule Evt_conseq[where  pre' = "Pre\<^sub>f (OSMboxPost_RGCond_lemma t)" and
                              rely' = "Rely\<^sub>f (OSMboxPost_RGCond_lemma t)" and
                              guar' = "Guar\<^sub>f (OSMboxPost_RGCond_lemma t)" and
                              post' = "Post\<^sub>f (OSMboxPost_RGCond_lemma t)" ])
      apply(simp add:Pre\<^sub>f_def OSMboxPost_RGCond_def OSMboxPost_RGCond_lemma_def getrgformula_def)
     apply(simp add:Rely\<^sub>f_def OSMboxPost_RGCond_def OSMboxPost_RGCond_lemma_def getrgformula_def)
     apply(simp add:OSMboxPost_rely_def OSMboxPost_rely_lemma_def)
     apply(simp add:lvars_nochange_lemma_rel_def lvars_nochange_rel_def) apply auto
          apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
  apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
  apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
  apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
  apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
  apply(simp add:lvars_nochange_lemma_def lvars_nochange_def)
   apply(simp add:Guar\<^sub>f_def OSMboxPost_RGCond_def OSMboxPost_RGCond_lemma_def getrgformula_def)
   apply(simp add:Post\<^sub>f_def OSMboxPost_RGCond_def OSMboxPost_RGCond_lemma_def getrgformula_def)
  apply(subst lemma_trans)

  apply(simp add: OSMboxPost_satRG_lemma)
  done

end


(*  Title:      HOL/Auth/n_german_lemma_inv__31_on_rules.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_german Protocol Case Study*}

theory n_german_lemma_inv__31_on_rules imports n_german_lemma_on_inv__31
begin
section{*All lemmas on causal relation between inv__31*}
lemma lemma_inv__31_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__31  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__0Vsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__1Vsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqEVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__31) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__31) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


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

(* Author: Andrew Boyton, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

chapter "A simplified version of the actual capDL specification."

theory Types_D
imports "HOL-Word.Word"
begin

(*
 * Objects are named by 32 bit words.
 * This name may correspond to the memory address of the object.
 *)
type_synonym cdl_object_id = "32 word"

type_synonym cdl_object_set = "cdl_object_id set"

(* The type we use to represent object sizes. *)
type_synonym cdl_size_bits = nat

(* An index into a CNode, TCB, or other kernel object that contains caps. *)
type_synonym cdl_cnode_index = nat

(* A reference to a capability slot. *)
type_synonym cdl_cap_ref = "cdl_object_id \<times> cdl_cnode_index"

(* The possible access-control rights that exist in the system. *)
datatype cdl_right = AllowRead | AllowWrite | AllowGrant

(*
 * Kernel capabilities.
 *
 * Such capabilities (or "caps") give the holder particular rights to
 * a kernel object or system hardware.
 *
 * Caps have attributes such as the object they point to, the rights
 * they give the holder, or how the holder is allowed to interact with
 * the target object.
 *
 * This is a simplified, cut-down version of this datatype for
 * demonstration purposes.
 *)
datatype cdl_cap =
    NullCap
  | EndpointCap cdl_object_id "cdl_right set"
  | CNodeCap cdl_object_id
  | TcbCap cdl_object_id

(* A mapping from capability identifiers to capabilities. *)
type_synonym cdl_cap_map = "cdl_cnode_index \<Rightarrow> cdl_cap option"

translations
  (type) "cdl_cap_map" <= (type) "nat \<Rightarrow> cdl_cap option"
  (type) "cdl_cap_ref" <= (type) "cdl_object_id \<times> nat"

(* A user cap pointer. *)
type_synonym cdl_cptr = "32 word"

(* Kernel objects *)
record cdl_tcb =
  cdl_tcb_caps :: cdl_cap_map
  cdl_tcb_fault_endpoint :: cdl_cptr

record cdl_cnode =
  cdl_cnode_caps :: cdl_cap_map
  cdl_cnode_size_bits :: cdl_size_bits

(*
 * Kernel objects.
 *
 * These are in-memory objects that may, over the course of the system
 * execution, be created or deleted by users.
 *
 * Again, a simplified version of the real datatype.
 *)
datatype cdl_object =
    Endpoint
  | Tcb cdl_tcb
  | CNode cdl_cnode

(*
 * The current state of the system.
 *
 * The state record contains the following primary pieces of information:
 *
 * objects:
 *   The objects that currently exist in the system.
 *
 * current_thread:
 *   The currently running thread. Operations will always be performed
 *   on behalf of this thread.
 *
 * ghost_state: (Used for separation logic)
 *   Which fields are owned by an object.
 *   In capDL this is all of the fields (or none of them).
 *   In any concrete state, this will be all of the fields.
 *)

(* The ghost state tracks which components (fields and slots) are owned by an object.
 * Fields + slots are encoded as None + Some nat.
 *)
type_synonym cdl_heap = "cdl_object_id \<Rightarrow> cdl_object option"
type_synonym cdl_component  = "nat option"
type_synonym cdl_components = "cdl_component set"
type_synonym cdl_ghost_state = "cdl_object_id \<Rightarrow> cdl_components"

translations
  (type) "cdl_heap" <= (type) "cdl_object_id \<Rightarrow> cdl_object option"
  (type) "cdl_ghost_state" <= (type) "cdl_object_id \<Rightarrow> nat option set"

record cdl_state =
  cdl_objects :: "cdl_heap"
  cdl_current_thread :: "cdl_object_id option"
  cdl_ghost_state :: "cdl_ghost_state"

(* Kernel objects types. *)
datatype cdl_object_type =
    EndpointType
  | TcbType
  | CNodeType

(* Return the type of an object. *)
definition
  object_type :: "cdl_object \<Rightarrow> cdl_object_type"
where
  "object_type x \<equiv>
    case x of
        Endpoint \<Rightarrow> EndpointType
      | Tcb _ \<Rightarrow> TcbType
      | CNode _ \<Rightarrow> CNodeType"

(*
 * Getters and setters for various data types.
 *)

(* Capability getters / setters *)

definition cap_objects :: "cdl_cap \<Rightarrow> cdl_object_id set"
where
    "cap_objects cap \<equiv>
       case cap of
           TcbCap x \<Rightarrow> {x}
         | CNodeCap x \<Rightarrow> {x}
         | EndpointCap x _ \<Rightarrow> {x}"

definition cap_has_object :: "cdl_cap \<Rightarrow> bool"
where
    "cap_has_object cap \<equiv>
       case cap of
           NullCap          \<Rightarrow> False
         | _                \<Rightarrow> True"

definition cap_object :: "cdl_cap \<Rightarrow> cdl_object_id"
where
    "cap_object cap \<equiv>
       if cap_has_object cap
         then THE obj_id. cap_objects cap = {obj_id}
         else undefined "

lemma cap_object_simps:
  "cap_object (TcbCap x) = x"
  "cap_object (CNodeCap x) = x"
  "cap_object (EndpointCap x j) = x"
  by (simp_all add:cap_object_def cap_objects_def cap_has_object_def)

definition
  cap_rights :: "cdl_cap \<Rightarrow> cdl_right set"
where
  "cap_rights c \<equiv> case c of
      EndpointCap _ x \<Rightarrow> x
    | _ \<Rightarrow> UNIV"

definition
  update_cap_rights :: "cdl_right set \<Rightarrow> cdl_cap \<Rightarrow> cdl_cap"
where
  "update_cap_rights r c \<equiv> case c of
      EndpointCap f1 _ \<Rightarrow> EndpointCap f1 r
    | _ \<Rightarrow> c"

(* Kernel object getters / setters *)
definition
  object_slots :: "cdl_object \<Rightarrow> cdl_cap_map"
where
  "object_slots obj \<equiv> case obj of
    CNode x \<Rightarrow> cdl_cnode_caps x
  | Tcb x \<Rightarrow> cdl_tcb_caps x
  | _ \<Rightarrow> Map.empty"

definition
  update_slots :: "cdl_cap_map \<Rightarrow> cdl_object \<Rightarrow> cdl_object"
where
  "update_slots new_val obj \<equiv> case obj of
    CNode x \<Rightarrow> CNode (x\<lparr>cdl_cnode_caps := new_val\<rparr>)
  | Tcb x \<Rightarrow> Tcb (x\<lparr>cdl_tcb_caps := new_val\<rparr>)
  | _ \<Rightarrow> obj"

(* Adds new caps to an object. It won't overwrite on a collision. *)
definition
  add_to_slots :: "cdl_cap_map \<Rightarrow> cdl_object \<Rightarrow> cdl_object"
where
  "add_to_slots new_val obj \<equiv> update_slots (new_val ++ (object_slots obj)) obj"

definition
  slots_of :: "cdl_heap \<Rightarrow> cdl_object_id \<Rightarrow> cdl_cap_map"
where
  "slots_of h \<equiv> \<lambda>obj_id.
  case h obj_id of
    None \<Rightarrow> Map.empty
  | Some obj \<Rightarrow> object_slots obj"

definition
  has_slots :: "cdl_object \<Rightarrow> bool"
where
  "has_slots obj \<equiv> case obj of
    CNode _ \<Rightarrow> True
  | Tcb _ \<Rightarrow> True
  | _ \<Rightarrow> False"

definition
  object_at :: "(cdl_object \<Rightarrow> bool) \<Rightarrow> cdl_object_id \<Rightarrow> cdl_heap \<Rightarrow> bool"
where
  "object_at P p s \<equiv> \<exists>object. s p = Some object \<and> P object"

abbreviation
  "ko_at k \<equiv> object_at ((=) k)"

end


header {*
\isachapter{A Control Flow Graph for Jinja Byte Code}

  This work was done by Denis Lohner (denis.lohner@kit.edu).

\isaheader{Formalizing the CFG}
*}

theory JVMCFG imports "../Basic/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 rep_jvmprog_jvm_prog :: "wf_jvmprog \<Rightarrow> jvm_prog"
("_\<^bsub>wf\<^esub>")
  where "P\<^bsub>wf\<^esub> \<equiv> fst(Rep_wf_jvmprog(P))"

abbreviation rep_jvmprog_phi :: "wf_jvmprog \<Rightarrow> ty\<^sub>P"
("_\<^bsub>\<Phi>\<^esub>")
  where "P\<^bsub>\<Phi>\<^esub> \<equiv> snd(Rep_wf_jvmprog(P))"

lemma wf_jvmprog_is_wf: "wf_jvm_prog\<^bsub>P\<^bsub>\<Phi>\<^esub>\<^esub> (P\<^bsub>wf\<^esub>)"
using Rep_wf_jvmprog [of P]
  by (auto simp: wf_jvmprog_def split_beta)

subsubsection {* Basic Types *}

text {*
We consider a program to be a well-formed Jinja program,
together with a given base class and a main method
*}

type_synonym jvmprog = "wf_jvmprog \<times> cname \<times> mname"
type_synonym callstack = "(cname \<times> mname \<times> pc) list"

text {*
The state is modeled as $\textrm{heap} \times \textrm{stack-variables} \times \textrm{local-variables}$

stack and local variables are modeled as pairs of natural numbers. The first number
gives the position in the call stack (i.e. the method in which the variable is used),
the second the position in the method's stack or array of local variables resp.

The stack variables are numbered from bottom up (which is the reverse order of the
array for the stack in Jinja's state representation), whereas local variables are identified
by their position in the array of local variables of Jinja's state representation.
*}

type_synonym state = "heap \<times> ((nat \<times> nat) \<Rightarrow> val) \<times> ((nat \<times> nat) \<Rightarrow> val)"

abbreviation heap_of :: "state \<Rightarrow> heap"
where
  "heap_of s \<equiv> fst(s)"

abbreviation stk_of :: "state \<Rightarrow> ((nat \<times> nat) \<Rightarrow> val)"
where
  "stk_of s \<equiv> fst(snd(s))"

abbreviation loc_of :: "state \<Rightarrow> ((nat \<times> nat) \<Rightarrow> val)"
where
  "loc_of s \<equiv> snd(snd(s))"

subsection {* Basic Definitions *}

subsubsection {* State update (instruction execution) *}

text {*
This function models instruction execution for our state representation.

Additional parameters are the call depth of the current program point,
the stack length of the current program point,
the length of the stack in the underlying call frame (needed for {\sc Return}),
and (for {\sc Invoke}) the length of the array of local variables of the invoked method.

Exception handling is not covered by this function.
*}

fun exec_instr :: "instr \<Rightarrow> wf_jvmprog \<Rightarrow> state \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> state"
where
  exec_instr_Load:
  "exec_instr (Load n) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk((calldepth,stk_length):=loc(calldepth,n)), loc))"

| exec_instr_Store:
  "exec_instr (Store n) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk, loc((calldepth,n):=stk(calldepth,stk_length - 1))))"

| exec_instr_Push:
  "exec_instr (Push v) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk((calldepth,stk_length):=v), loc))"

| exec_instr_New:
  "exec_instr (New C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    a = the(new_Addr h)
   in (h(a \<mapsto> (blank (P\<^bsub>wf\<^esub>) C)), stk((calldepth,stk_length):=Addr a), loc))"

| exec_instr_Getfield:
  "exec_instr (Getfield F C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    a = the_Addr (stk (calldepth,stk_length - 1));
    (D,fs) = the(h a)
   in (h, stk((calldepth,stk_length - 1) := the(fs(F,C))), loc))"

| exec_instr_Putfield:
  "exec_instr (Putfield F C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    v = stk (calldepth,stk_length - 1);
    a = the_Addr (stk (calldepth,stk_length - 2));
    (D,fs) = the(h a)
   in (h(a \<mapsto> (D,fs((F,C) \<mapsto> v))), stk, loc))"

| exec_instr_Checkcast:
  "exec_instr (Checkcast C) P s calldepth stk_length rs ill = s"

| exec_instr_Pop:
  "exec_instr (Pop) P s calldepth stk_length rs ill = s"

| exec_instr_IAdd:
  "exec_instr (IAdd) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    i\<^sub>1 = the_Intg (stk (calldepth, stk_length - 1));
    i\<^sub>2 = the_Intg (stk (calldepth, stk_length - 2))
   in (h, stk((calldepth, stk_length - 2) := Intg (i\<^sub>1 + i\<^sub>2)), loc))"

| exec_instr_IfFalse:
  "exec_instr (IfFalse b) P s calldepth stk_length rs ill = s"

| exec_instr_CmpEq:
  "exec_instr (CmpEq) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    v\<^sub>1 = stk (calldepth, stk_length - 1);
    v\<^sub>2 = stk (calldepth, stk_length - 2)
   in (h, stk((calldepth, stk_length - 2) := Bool (v\<^sub>1 = v\<^sub>2)), loc))"

| exec_instr_Goto:
  "exec_instr (Goto i) P s calldepth stk_length rs ill = s"

| exec_instr_Throw:
  "exec_instr (Throw) P s calldepth stk_length rs ill = s"

| exec_instr_Invoke:
  "exec_instr (Invoke M n) P s calldepth stk_length rs invoke_loc_length =
  (let (h,stk,loc) = s;
    loc' = (\<lambda>(a,b). if (a \<noteq> Suc calldepth \<or> b \<ge> invoke_loc_length) then loc(a,b) else
                      (if (b \<le> n) then stk(calldepth, stk_length - (Suc n - b)) else arbitrary))
   in (h,stk,loc'))"

| exec_instr_Return:
  "exec_instr (Return) P s calldepth stk_length ret_stk_length ill =
  (if (calldepth = 0)
    then s
    else
    (let (h,stk,loc) = s;
      v = stk(calldepth, stk_length - 1)
     in (h,stk((calldepth - 1, ret_stk_length - 1) := v),loc))
  )"

subsubsection {* length of stack and local variables *}

text {* The following terms extract the stack length at a given program point
from the well-typing of the given program *}

abbreviation stkLength :: "wf_jvmprog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> pc \<Rightarrow> nat"
  where
  "stkLength P C M pc \<equiv> length (fst(the(((P\<^bsub>\<Phi>\<^esub>) C M)!pc)))"

abbreviation locLength :: "wf_jvmprog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> pc \<Rightarrow> nat"
  where
  "locLength P C M pc \<equiv> length (snd(the(((P\<^bsub>\<Phi>\<^esub>) C M)!pc)))"

subsubsection {* Conversion functions  *}

text {*
This function takes a natural number n and a function f with domain @{text nat}
and creates the array [f 0, f 1, f 2, ..., f (n - 1)].

This is used for extracting the array of local variables
*}

(*
fun locs :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
where
  "locs 0 loc = []"
| "locs (Suc n) loc = (locs n loc)@[loc n]"
*)

abbreviation locs :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
where "locs n loc \<equiv> map loc [0..<n]"

text {*
This function takes a natural number n and a function f with domain @{text nat}
and creates the array [f (n - 1), ..., f 1, f 0].

This is used for extracting the stack as a list
*}

(*
fun stks :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
where
  "stks 0 stk = []"
| "stks (Suc n) stk = (stk n)#(stks n stk)"
*)

abbreviation stks :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
where "stks n stk \<equiv> map stk (rev [0..<n])"

text {*
This function creates a list of the arrays for local variables from the given state
corresponding to the given callstack
*}

fun locss :: "wf_jvmprog \<Rightarrow> callstack \<Rightarrow> ((nat \<times> nat) \<Rightarrow> 'a) \<Rightarrow> 'a list list"
where
  "locss P [] loc = []"
| "locss P ((C,M,pc)#cs) loc =
    (locs (locLength P C M pc) (\<lambda>a. loc (length cs, a)))#(locss P cs loc)"

text {*
This function creates a list of the (methods') stacks from the given state
corresponding to the given callstack
*}

fun stkss :: "wf_jvmprog \<Rightarrow> callstack \<Rightarrow> ((nat \<times> nat) \<Rightarrow> 'a) \<Rightarrow> 'a list list"
where
  "stkss P [] stk = []"
| "stkss P ((C,M,pc)#cs) stk =
  (stks (stkLength P C M pc) (\<lambda>a. stk (length cs, a)))#(stkss P cs stk)"

text {* Given a callstack and a state, this abbreviation converts the state
to Jinja's state representation
*}

abbreviation state_to_jvm_state :: "wf_jvmprog \<Rightarrow> callstack \<Rightarrow> state \<Rightarrow> jvm_state"
where "state_to_jvm_state P cs s \<equiv>
  (None, heap_of s, zip (stkss P cs (stk_of s)) (zip (locss P cs (loc_of s)) cs))"

text {* This function extracts the call stack from a given frame stack (as it is given
by Jinja's state representation)
*}

definition framestack_to_callstack :: "frame list \<Rightarrow> callstack"
where "framestack_to_callstack frs \<equiv> map snd (map snd frs)"

subsubsection {* State Conformance *}

text {* Now we lift byte code verifier conformance to our state representation *}

definition bv_conform :: "wf_jvmprog \<Rightarrow> callstack \<Rightarrow> state \<Rightarrow> bool"
  ("_,_ \<turnstile>\<^bsub>BV\<^esub> _ \<surd>")
where "P,cs \<turnstile>\<^bsub>BV\<^esub> s \<surd> \<equiv> correct_state (P\<^bsub>wf\<^esub>) (P\<^bsub>\<Phi>\<^esub>) (state_to_jvm_state P cs s)"

subsubsection {* Statically determine catch-block *}

text {* This function is equivalent to Jinja's @{text "find_handler"} function *}
fun find_handler_for :: "wf_jvmprog \<Rightarrow> cname \<Rightarrow> callstack \<Rightarrow> callstack"
where
  "find_handler_for P C [] = []"
| "find_handler_for P C (c#cs) = (let (C',M',pc') = c in
     (case match_ex_table (P\<^bsub>wf\<^esub>) C pc' (ex_table_of (P\<^bsub>wf\<^esub>) C' M') of
          None \<Rightarrow> find_handler_for P C cs
        | Some pc_d \<Rightarrow> (C', M', fst pc_d)#cs))"

subsection {* Simplification lemmas *}

lemma find_handler_decr [simp]: "find_handler_for P Exc cs \<noteq> c#cs"
proof
  assume "find_handler_for P Exc cs = c#cs"
  hence "length cs < length (find_handler_for P Exc cs)" by simp
  thus False by (induct cs, auto)
qed

(*
lemma locs_length [simp]: "length (locs n loc) = n"
  by (induct n) auto

lemma stks_length [simp]: "length (stks n stk) = n"
  by (induct n) auto
*)

lemma stkss_length [simp]: "length (stkss P cs stk) = length cs"
  by (induct cs) auto

lemma locss_length [simp]: "length (locss P cs loc) = length cs"
  by (induct cs) auto

(*
lemma nth_stks: "b < n \<Longrightarrow> stks n stk ! b = stk(n - Suc b)"
  by (auto simp: rev_nth)
proof (induct n arbitrary: b)
  case (0 b)
  thus ?case by simp
next
  case (Suc n b)
  thus ?case
    by (auto simp: nth_Cons' less_Suc_eq)
qed
*)

lemma nth_stkss:
  "\<lbrakk> a < length cs; b < length (stkss P cs stk ! (length cs - Suc a)) \<rbrakk>
  \<Longrightarrow> stkss P cs stk ! (length cs - Suc a) !
    (length (stkss P cs stk ! (length cs - Suc a)) - Suc b) = stk (a,b)"
proof (induct cs)
  case Nil
  thus ?case by (simp add: nth_Cons')
next
  case (Cons aa cs)
  thus ?case
    by (cases aa, auto simp add: nth_Cons' rev_nth less_Suc_eq)
qed

(*
lemma nth_locs: "b < n \<Longrightarrow> locs n loc ! b = loc b"
proof (induct n)
  case 0
  thus ?case by simp
next
  case (Suc n)
  thus ?case
    by (auto simp: nth_append less_Suc_eq)
qed
*)

lemma nth_locss:
  "\<lbrakk> a < length cs; b < length (locss P cs loc ! (length cs - Suc a)) \<rbrakk>
  \<Longrightarrow> locss P cs loc ! (length cs - Suc a) ! b = loc (a,b)"
proof (induct cs)
  case Nil
  thus ?case by (simp add: nth_Cons')
next
  case (Cons aa cs)
  thus ?case
    by (cases aa, auto simp: nth_Cons' (* nth_locs *) less_Suc_eq)
qed

lemma hd_stks [simp]: "n \<noteq> 0 \<Longrightarrow> hd (stks n stk) = stk(n - 1)"
  by (cases n, simp_all)

lemma hd_tl_stks: "n > 1 \<Longrightarrow> hd (tl (stks n stk)) = stk(n - 2)"
  by (cases n, auto)

(*
lemma stks_purge:
  "d \<ge> b \<Longrightarrow> stks b (stk(d := e)) = stks b stk"
  by (induct b, auto)

lemma stks_purge':
  "d \<ge> b \<Longrightarrow> stks b (\<lambda>x. if x = d then e else stk x) = stks b stk"
  by (fold fun_upd_def, simp only: stks_purge)
*)

lemma stkss_purge:
  "length cs \<le> a \<Longrightarrow> stkss P cs (stk((a,b) := c)) = stkss P cs stk"
  by (induct cs, auto (* simp: stks_purge *))

lemma stkss_purge':
  "length cs \<le> a \<Longrightarrow> stkss P cs (\<lambda>s. if s = (a, b) then c else stk s) = stkss P cs stk"
  by (fold fun_upd_def, simp only: stkss_purge)

(*
lemma locs_purge:
  "d \<ge> b \<Longrightarrow> locs b (loc(d := e)) = locs b loc"
  by (induct b, auto)

lemma locs_purge':
  "d \<ge> b \<Longrightarrow> locs b (\<lambda>b. if b = d then e else loc b) = locs b loc"
  by (fold fun_upd_def, simp only: locs_purge)
*)

lemma locss_purge:
  "length cs \<le> a \<Longrightarrow> locss P cs (loc((a,b) := c)) = locss P cs loc"
  by (induct cs, auto (*simp: locs_purge *))

lemma locss_purge':
  "length cs \<le> a \<Longrightarrow> locss P cs (\<lambda>s. if s = (a, b) then c else loc s) = locss P cs loc"
  by (fold fun_upd_def, simp only: locss_purge)

lemma locs_pullout [simp]:
  "locs b (loc(n := e)) = locs b loc [n := e]"
proof (induct b)
  case 0
  thus ?case by simp
next
  case (Suc b)
  thus ?case
    by (cases "n - b", auto simp: list_update_append not_less_eq less_Suc_eq)
qed

lemma locs_pullout' [simp]:
  "locs b (\<lambda>a. if a = n then e else loc (c, a)) = locs b (\<lambda>a. loc (c, a)) [n := e]"
  by (fold fun_upd_def) simp

lemma stks_pullout:
  "n < b \<Longrightarrow> stks b (stk(n := e)) = stks b stk [b - Suc n := e]"
proof (induct b)
  case 0
  thus ?case by simp
next
  case (Suc b)
  thus ?case
  proof (cases "b = n")
    case True
    with Suc show ?thesis
      by auto
(*      by (auto simp: stks_purge') *)
  next
    case False
    with Suc show ?thesis
      by (cases "b - n") (auto intro!: nth_equalityI simp: nth_list_update)
 qed
qed

lemma nth_tl : "xs \<noteq> [] \<Longrightarrow> tl xs ! n = xs ! (Suc n)"
  by (cases xs, simp_all)

lemma f2c_Nil [simp]: "framestack_to_callstack [] = []"
  by (simp add: framestack_to_callstack_def)

lemma f2c_Cons [simp]:
  "framestack_to_callstack ((stk,loc,C,M,pc)#frs) = (C,M,pc)#(framestack_to_callstack frs)"
  by (simp add: framestack_to_callstack_def)

lemma f2c_length [simp]:
  "length (framestack_to_callstack frs) = length frs"
  by (simp add: framestack_to_callstack_def)

lemma f2c_s2jvm_id [simp]:
  "framestack_to_callstack
    (snd(snd(state_to_jvm_state P cs s))) =
  cs"
  by (cases s, simp add: framestack_to_callstack_def)

lemma f2c_s2jvm_id' [simp]:
  "framestack_to_callstack
  (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = cs"
  by (simp add: framestack_to_callstack_def)

lemma f2c_append [simp]:
  "framestack_to_callstack (frs @ frs') =
  (framestack_to_callstack frs) @ (framestack_to_callstack frs')"
  by (simp add: framestack_to_callstack_def)

section {* CFG construction *}

subsection {* Datatypes *}

text {* Nodes are labeled with a callstack and an optional tuple (consisting of
a callstack and a flag).

The first callstack determines the current program point (i.e. the next statement
to execute). If the second parameter is not None, we are at an intermediate state,
where the target of the instruction is determined (the second callstack)
and the flag is set to whether an exception is thrown or not.
*}
datatype j_node =
   Entry  ("'('_Entry'_')")
 | Node "callstack" "(callstack \<times> bool) option" ("'('_ _,_ '_')")

text {* The empty callstack indicates the exit node *}

abbreviation j_node_Exit :: "j_node" ("'('_Exit'_')")
where "j_node_Exit \<equiv> (_ [],None _)"

text {* An edge is a triple, consisting of two nodes and the edge kind *}

type_synonym j_edge = "(j_node \<times> state edge_kind \<times> j_node)"

subsection {* CFG *}

text {*
The CFG is constructed by a case analysis on the instructions and
their different behavior in different states. E.g. the exceptional behavior of
{\sc New}, if there is no more space in the heap, vs. the normal behavior.

Note: The set of edges defined by this predicate is a first approximation to the
real set of edges in the CFG. We later (theory JVMInterpretation) add some well-formedness
requirements to the nodes.
*}

inductive JVM_CFG :: "jvmprog \<Rightarrow> j_node \<Rightarrow> state edge_kind \<Rightarrow> j_node \<Rightarrow> bool"
  ("_ \<turnstile> _ -_\<rightarrow> _")
where
  JCFG_EntryExit:
  "prog \<turnstile> (_Entry_) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (_Exit_)"

| JCFG_EntryStart:
  "prog = (P, C0, Main) \<Longrightarrow> prog \<turnstile> (_Entry_) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (_ [(C0, Main, 0)],None _)"

| JCFG_ReturnExit:
  "\<lbrakk> prog = (P,C0,Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Return \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ [(C, M, pc)],None _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Straight_NoExc:
  "\<lbrakk> prog = (P, C0, Main);
    instrs_of (P\<^bsub>wf\<^esub>) C M ! pc \<in> {Load idx, Store idx, Push val, Pop, IAdd, CmpEq};
    ek = \<Up>(\<lambda>s. exec_instr ((instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc) P s
                          (length cs) (stkLength P C M pc) arbitrary arbitrary) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_New_Normal_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (New Cl);
    ek = (\<lambda>(h,stk,loc). new_Addr h \<noteq> None)\<^sub>\<surd>\<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs,False)\<rfloor> _)"

| JCFG_New_Normal_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (New Cl);
    ek = \<Up>(\<lambda>s. exec_instr (New Cl) P s (length cs) (stkLength P C M pc) arbitrary arbitrary) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs, False)\<rfloor> _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_New_Exc_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc). new_Addr h = None)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs',True)\<rfloor> _)"

| JCFG_New_Exc_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = \<Up>(\<lambda>(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt OutOfMemory)),
      loc)
     ) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_New_Exc_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = [] \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([], True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Getfield_Normal_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Getfield Fd Cl);
    ek = (\<lambda>(h,stk,loc).  stk(length cs, stkLength P C M pc - 1) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs, False)\<rfloor> _)"

| JCFG_Getfield_Normal_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Getfield Fd Cl);
    ek = \<Up>(\<lambda>s. exec_instr (Getfield Fd Cl) P s (length cs) (stkLength P C M pc)
                          arbitrary arbitrary) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs, False)\<rfloor> _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Getfield_Exc_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Null)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs', True)\<rfloor> _)"

| JCFG_Getfield_Exc_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek =  \<Up>(\<lambda>(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     ) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_Getfield_Exc_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([], True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Putfield_Normal_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Putfield Fd Cl);
    ek = (\<lambda>(h,stk,loc).  stk(length cs, stkLength P C M pc - 2) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs, False)\<rfloor> _)"

| JCFG_Putfield_Normal_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Putfield Fd Cl);
    ek = \<Up>(\<lambda>s. exec_instr (Putfield Fd Cl) P s (length cs) (stkLength P C M pc)
                          arbitrary arbitrary) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C, M, Suc pc)#cs, False)\<rfloor> _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Putfield_Exc_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc). stk(length cs, stkLength P C M pc - 2) = Null)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs', True)\<rfloor> _)"

| JCFG_Putfield_Exc_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = \<Up>(\<lambda>(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     ) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_Putfield_Exc_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([], True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Checkcast_Normal_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Checkcast Cl);
    ek = (\<lambda>(h,stk,loc). cast_ok (P\<^bsub>wf\<^esub>) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Checkcast_Exc_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc). \<not> cast_ok (P\<^bsub>wf\<^esub>) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs', True)\<rfloor> _)"

| JCFG_Checkcast_Exc_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = \<Up>(\<lambda>(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt ClassCast)),
      loc)
     ) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_Checkcast_Exc_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = [] \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([], True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Invoke_Normal_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Invoke M2 n);
    cd = length cs;
    stk_length = stkLength P C M pc;
    ek = (\<lambda>(h,stk,loc).
     stk(cd, stk_length - Suc n) \<noteq> Null \<and>
     fst(method (P\<^bsub>wf\<^esub>) (cname_of h (the_Addr(stk(cd, stk_length - Suc n)))) M2) = D
    )\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow>
      prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>((D, M2, 0)#(C, M, pc)#cs, False)\<rfloor> _)"

| JCFG_Invoke_Normal_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Invoke M2 n);
    stk_length = stkLength P C M pc;
    loc_length = locLength P D M2 0;
    ek = \<Up>(\<lambda>s. exec_instr (Invoke M2 n) P s (length cs) stk_length arbitrary loc_length)
   \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((D, M2, 0)#(C, M, pc)#cs, False)\<rfloor> _) -ek\<rightarrow>
               (_ (D, M2, 0)#(C, M, pc)#cs,None _)"

| JCFG_Invoke_Exc_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Invoke m2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc). stk(length cs, stkLength P C M pc - Suc n) = Null)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs', True)\<rfloor> _)"

| JCFG_Invoke_Exc_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Invoke M2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = \<Up>(\<lambda>(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     )
   \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_Invoke_Exc_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (Invoke M2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([], True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

| JCFG_Return_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Return;
    stk_length = stkLength P C M pc;
    r_stk_length = stkLength P C' M' (Suc pc');
    ek = \<Up>(\<lambda>s. exec_instr Return P s (Suc (length cs)) stk_length r_stk_length arbitrary) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#(C', M', pc')#cs,None _) -ek\<rightarrow> (_ (C', M', Suc pc')#cs,None _)"

| JCFG_Goto_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Goto idx \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -\<Up>id\<rightarrow> (_ (C, M, nat (int pc + idx))#cs,None _)"

| JCFG_IfFalse_False:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (IfFalse b);
    b \<noteq> 1;
    ek = (\<lambda>(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Bool False)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, nat (int pc + b))#cs,None _)"

| JCFG_IfFalse_Next:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = (IfFalse b);
    ek = (\<lambda>(h,stk,loc). stk(length cs, stkLength P C M pc - 1) \<noteq> Bool False \<or> b = 1)\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Throw_Pred:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Throw;
    cd = length cs;
    stk_length = stkLength P C M pc;
    \<exists>Exc. find_handler_for P Exc ((C, M, pc)#cs) = cs';
    ek = (\<lambda>(h,stk,loc).
      (stk(length cs, stkLength P C M pc - 1) = Null \<and>
        find_handler_for P NullPointer ((C, M, pc)#cs) = cs') \<or>
      (stk(length cs, stkLength P C M pc - 1) \<noteq> Null \<and>
        find_handler_for P (cname_of h (the_Addr(stk(cd, stk_length - 1)))) ((C, M, pc)#cs) = cs')
    )\<^sub>\<surd> \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,None _) -ek\<rightarrow> (_ (C, M, pc)#cs,\<lfloor>(cs', True)\<rfloor> _)"

| JCFG_Throw_Update:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Throw;
    ek = \<Up>(\<lambda>(h,stk,loc).
      (h,
       stk((length cs',(stkLength P C' M' pc') - 1) :=
         if (stk(length cs, stkLength P C M pc - 1) = Null) then
           Addr (addr_of_sys_xcpt NullPointer)
         else (stk(length cs, stkLength P C M pc - 1))),
       loc)
    ) \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>((C', M', pc')#cs', True)\<rfloor> _) -ek\<rightarrow> (_ (C', M', pc')#cs',None _)"

| JCFG_Throw_Exit:
  "\<lbrakk> prog = (P, C0, Main);
    (instrs_of (P\<^bsub>wf\<^esub>) C M) ! pc = Throw \<rbrakk>
    \<Longrightarrow> prog \<turnstile> (_ (C, M, pc)#cs,\<lfloor>([],True)\<rfloor> _) -\<Up>id\<rightarrow> (_Exit_)"

subsection {* CFG properties *}

lemma JVMCFG_Entry_no_targetnode [dest]:
  assumes edge:"prog \<turnstile> n -et\<rightarrow> (_Entry_)"
  shows "False"
proof -
  { fix n' have "\<lbrakk>prog \<turnstile> n -et\<rightarrow> n'; n' = (_Entry_)\<rbrakk> \<Longrightarrow> False"
      by (auto elim!: JVM_CFG.cases)
  }
  with edge show ?thesis by fastforce
qed

lemma JVMCFG_EntryD:
  "\<lbrakk>(P,C,M) \<turnstile> n -et\<rightarrow> n'; n = (_Entry_)\<rbrakk>
  \<Longrightarrow> (n' = (_Exit_) \<and> et = (\<lambda>s. False)\<^sub>\<surd>) \<or> (n' = (_ [(C,M,0)],None _) \<and> et = (\<lambda>s. True)\<^sub>\<surd>)"
by (erule JVM_CFG.cases) simp_all

declare split_def [simp add]
declare find_handler_for.simps [simp del]

(* The following lemma explores many cases, it takes a little to prove *)
lemma JVMCFG_edge_det:
  "\<lbrakk>prog \<turnstile> n -et\<rightarrow> n'; prog \<turnstile> n -et'\<rightarrow> n'\<rbrakk> \<Longrightarrow> et = et'"
  by (erule JVM_CFG.cases, (erule JVM_CFG.cases, fastforce+)+)

declare split_def [simp del]
declare find_handler_for.simps [simp add]

end


theory Example_Semantics
imports Call_Return_Unfolding "Primitive_Matchers/Common_Primitive_Matcher"
begin

section\<open>Examples Big Step Semantics\<close>
text\<open>We use a primitive matcher which always applies. We don't care about matching in this example.\<close>
  fun applies_Yes :: "('a, 'p) matcher" where
  "applies_Yes m p = True"

  definition "m=Match (Src (IpAddr (0::ipv4addr)))"
  lemma[simp]: "Semantics.matches applies_Yes m p" by (simp add: m_def)

  lemma "[''FORWARD'' \<mapsto> [(Rule m Log), (Rule m Accept), (Rule m Drop)]],applies_Yes,p\<turnstile>
      \<langle>[Rule MatchAny (Call ''FORWARD'')], Undecided\<rangle> \<Rightarrow> (Decision FinalAllow)"
  apply(rule call_result)
    apply(auto)
  apply(rule seq_cons)
   apply(auto intro:Semantics.log)
  apply(rule seq_cons)
   apply(auto intro: Semantics.accept)
  apply(rule Semantics.decision)
  done

  lemma "[''FORWARD'' \<mapsto> [(Rule m Log), (Rule m (Call ''foo'')), (Rule m Accept)],
          ''foo'' \<mapsto> [(Rule m Log), (Rule m Return)]],applies_Yes,p\<turnstile>
      \<langle>[Rule MatchAny (Call ''FORWARD'')], Undecided\<rangle> \<Rightarrow> (Decision FinalAllow)"
  apply(rule call_result)
    apply(auto)
  apply(rule seq_cons)
   apply(auto intro: Semantics.log)
  apply(rule seq_cons)
   apply(rule Semantics.call_return[where rs\<^sub>1="[Rule m Log]" and rs\<^sub>2="[]"])
      apply(simp)+
   apply(auto intro: Semantics.log)
  apply(auto intro: Semantics.accept)
  done

  lemma "[''FORWARD'' \<mapsto> [Rule m (Call ''foo''), Rule m Drop], ''foo'' \<mapsto> []],applies_Yes,p\<turnstile>
            \<langle>[Rule MatchAny (Call ''FORWARD'')], Undecided\<rangle> \<Rightarrow> (Decision FinalDeny)"
  apply(rule call_result)
    apply(auto)
  apply(rule Semantics.seq_cons)
   apply(rule Semantics.call_result)
     apply(auto)
   apply(rule Semantics.skip)
  apply(auto intro: deny)
  done

  lemma "((\<lambda>rs. process_call [''FORWARD'' \<mapsto> [Rule m (Call ''foo''), Rule m Drop], ''foo'' \<mapsto> []] rs)^^2)
                    [Rule MatchAny (Call ''FORWARD'')]
         = [Rule (MatchAnd MatchAny m) Drop]" by eval

  hide_const m

  definition "pkt=\<lparr>p_iiface=''+'', p_oiface=''+'', p_src=0, p_dst=0,
                   p_proto=TCP, p_sport=0, p_dport=0, p_tcp_flags = {TCP_SYN},
                   p_payload='''',p_tag_ctstate= CT_New\<rparr>"

  text\<open>We tune the primitive matcher to support everything we need in the example. Note that the undefined cases cannot be handled with these exact semantics!\<close>
  fun applies_exampleMatchExact :: "(32 common_primitive, 32 tagged_packet) matcher" where
  "applies_exampleMatchExact (Src (IpAddr addr)) p \<longleftrightarrow> p_src p = addr" |
  "applies_exampleMatchExact (Dst (IpAddr addr)) p \<longleftrightarrow> p_dst p = addr" |
  "applies_exampleMatchExact (Prot ProtoAny) p \<longleftrightarrow> True" |
  "applies_exampleMatchExact (Prot (Proto pr)) p \<longleftrightarrow> p_proto p = pr"
  (* not exhaustive, only an example!!*)

  lemma "[''FORWARD'' \<mapsto> [ Rule (MatchAnd (Match (Src (IpAddr 0))) (Match (Dst (IpAddr 0)))) Reject,
                          Rule (Match (Dst (IpAddr 0))) Log,
                          Rule (Match (Prot (Proto TCP))) Accept,
                          Rule (Match (Prot (Proto TCP))) Drop]
         ],applies_exampleMatchExact, pkt\<lparr>p_src:=(ipv4addr_of_dotdecimal (1,2,3,4)), p_dst:=(ipv4addr_of_dotdecimal (0,0,0,0))\<rparr>\<turnstile>
            \<langle>[Rule MatchAny (Call ''FORWARD'')], Undecided\<rangle> \<Rightarrow> (Decision FinalAllow)"
  apply(rule call_result)
    apply(auto)
  apply(rule Semantics.seq_cons)
   apply(auto intro: Semantics.nomatch simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
  apply(rule Semantics.seq_cons)
   apply(auto intro: Semantics.log simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
  apply(rule Semantics.seq_cons)
   apply(auto simp add: pkt_def intro: Semantics.accept)
  apply(auto intro: Semantics.decision)
  done

end