section \<open>Random Fill TLB\<close>

theory CM_RfSpec
  imports Main CM_SecurityModel
begin

subsection \<open>Data type, Basic components\<close>

(*Basic data structures*)
type_synonym vaddr = nat
type_synonym setindex = nat
type_synonym wayindex = nat

datatype tlbhit = Hit | Miss

datatype event = RF_SEARCH

(*Memory blocks*)
record memory_request =
  va :: vaddr
  protect :: bool

(*TLB structure*)
record tlb_line =
  tlb_va :: vaddr
  tlb_set :: setindex
  tlb_way :: wayindex
  valid :: bool
  lock :: bool

type_synonym tlb = "(tlb_line set) list"

type_synonym mapping = "vaddr \<rightharpoonup> setindex"

(*State Machine*)
record state =
  sram :: tlb
  maps :: mapping

subsection \<open>Random Fill TLB model specifications\<close>

definition replace_policy :: "tlb_line set \<Rightarrow> tlb_line"
  where "replace_policy cs \<equiv> SOME l. l \<in> cs"

definition probe_line :: "tlb_line set \<Rightarrow> memory_request \<Rightarrow> bool"
  where "probe_line cs mr \<equiv> \<exists>b. b \<in> cs \<and> tlb_va b = va mr \<and> valid b"

definition replace_line :: "tlb_line \<Rightarrow> memory_request \<Rightarrow> tlb_line"
  where "replace_line cl mr \<equiv> cl\<lparr>tlb_va := va mr, valid := True, lock := protect mr\<rparr>"

definition rf_search :: "state \<Rightarrow> memory_request \<Rightarrow> memory_request set \<Rightarrow> state set" where
  "rf_search s mr mrs \<equiv>
      let redir_set = the ((maps s) (va mr));
          redir_tb = (sram s) ! redir_set in
      if probe_line redir_tb mr then {s}
      else let r_line = replace_policy redir_tb;
               mm_sec = {t. t \<in> mrs \<and> protect t}; mm_nonsec = {t. t \<in> mrs \<and> \<not> protect t} in
        if protect mr then
          {t. \<exists>mm \<in> mm_sec. let mm_set = the ((maps s) (va mm)); mm_tb = (sram s) ! mm_set; r'_line = replace_policy mm_tb;
                                newset = insert (replace_line r'_line mm) (mm_tb - {r'_line}) in
              t = s\<lparr>sram := list_update (sram s) mm_set newset\<rparr>}
        else
          if lock r_line then
            {t. \<exists>mm \<in> mm_nonsec. let mm_set = the ((maps s) (va mm)); mm_tb = (sram s) ! mm_set; r'_line = replace_policy mm_tb;
                                  newset = insert (replace_line r'_line mm) (mm_tb - {r'_line}) in
                t = s\<lparr>sram := list_update (sram s) mm_set newset\<rparr>}
          else let newset = insert (replace_line r_line mr) (redir_tb - {r_line}) in
               {s\<lparr>sram := list_update (sram s) redir_set newset\<rparr>}"

subsection \<open>Instantiation\<close>

record tlb_NE =
  tlb_N :: "tlb set"
  tlb_E :: "tlb set"
  map_conf :: "mapping"
  mem_req :: "(memory_request \<times> real) set"

consts tlb_comp :: tlb_NE

definition tlb_comp_witness :: "tlb_NE"
  where "tlb_comp_witness \<equiv> \<lparr>tlb_N = {[{(\<lparr>tlb_va = 1, tlb_set = 0, tlb_way = 0, valid = True, lock = False\<rparr>)}]},
                             tlb_E = {[{(\<lparr>tlb_va = 1, tlb_set = 0, tlb_way = 0, valid = True, lock = False\<rparr>)}]},
                             map_conf = (\<lambda>t. if t = 0 then Some 0 else None),
                             mem_req = {(\<lparr>va = 0, protect = True\<rparr>, 1)}\<rparr>"

specification (tlb_comp)
  tlbN_finite: "finite (tlb_N tlb_comp)"
  tlbN_nonempty: "(tlb_N tlb_comp) \<noteq> {}"

  tlb_length: "\<forall>c \<in> (tlb_N tlb_comp). length c > 0"
  tlb_length2: "\<forall>c1 c2. c1 \<in> (tlb_N tlb_comp) \<and> c2 \<in> (tlb_N tlb_comp) \<and> c1 \<noteq> c2 \<longrightarrow> length c1 = length c2"
  tlb_finite: "\<forall>c \<in> (tlb_N tlb_comp). finite (set c)"
  tlb_set_nonempty: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>l < length c. c!l \<noteq> {})"
  tlb_set_finite: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>l < length c. finite (c!l))"
  tlb_set_num: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>l < length c. \<forall>e \<in> (c!l). tlb_set e = l)"
  tlb_way_num: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>l1 l2. l1 < length c \<and> l2 < length c \<and> l1 \<noteq> l2 \<longrightarrow> card(c!l1) = card(c!l2))"
  tlb_way_num2: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>l < length c. \<forall>e1 e2. e1 \<in> (c!l) \<and> e2 \<in> (c!l) \<and> e1 \<noteq> e2 \<longrightarrow> tlb_way e1 \<noteq> tlb_way e2)"

  tlbE_init: "(tlb_E tlb_comp) \<subseteq> (tlb_N tlb_comp)"
  tlbE_nonempty: "(tlb_E tlb_comp) \<noteq> {}"

  map_range: "\<forall>c \<in> (tlb_N tlb_comp). (\<forall>i. (map_conf tlb_comp) i \<noteq> None \<longrightarrow> the ((map_conf tlb_comp) i) < length c)"
  map_diff: "\<forall>i j. i \<noteq> j \<and> (map_conf tlb_comp) i \<noteq> None \<and> (map_conf tlb_comp) j \<noteq> None \<longrightarrow> the ((map_conf tlb_comp) i) \<noteq> the ((map_conf tlb_comp) j)"

  mem_finite: "finite (mem_req tlb_comp)"
  mem_nonempty: "card (mem_req tlb_comp) > 0"
  mem_unique: "\<forall>i j. i \<in> (mem_req tlb_comp) \<and> j \<in> (mem_req tlb_comp) \<and> i \<noteq> j \<longrightarrow> va (fst i) \<noteq> va (fst j)"
  mem_positive: "\<forall>i \<in> (mem_req tlb_comp). snd i > 0"
  mem_sum_one: "folds (\<lambda>t p. snd t + p) 0 (mem_req tlb_comp) = 1"
  mem_length: "\<forall>c \<in> (tlb_N tlb_comp). card (mem_req tlb_comp) \<le> length c"
  mem_occupy: "\<forall>i \<in> (mem_req tlb_comp). \<forall>c \<in> (tlb_E tlb_comp). \<forall>l < length c. \<forall>e \<in> (c!l). va (fst i) \<noteq> tlb_va e"
  mem_protect: "\<forall>i \<in> (mem_req tlb_comp). protect (fst i)"
  mem_mapping: "\<forall>i \<in> (mem_req tlb_comp). (map_conf tlb_comp) (va (fst i)) \<noteq> None"
  apply(intro exI[of _ tlb_comp_witness])
  unfolding tlb_comp_witness_def by auto

(*state N*)
consts state_N :: "state set"

definition state_N_witness :: "state set"
  where "state_N_witness \<equiv> {t. \<exists>c \<in> (tlb_N tlb_comp). t = \<lparr>sram = c, maps = (map_conf tlb_comp)\<rparr>}"

specification (state_N)
  state_N_init: "state_N = state_N_witness"
  by simp

lemma stateN_finite: "finite state_N"
  proof -
    {
      have "\<forall>c \<in> (tlb_N tlb_comp). finite {t. \<exists>c \<in> (tlb_N tlb_comp). t = \<lparr>sram = c, maps = (map_conf tlb_comp)\<rparr>}"
        using tlbN_finite by auto
      then show ?thesis
        using state_N_init state_N_witness_def by auto
    }
  qed

lemma stateN_nonempty: "state_N \<noteq> {}"
  using state_N_init state_N_witness_def tlbN_nonempty
  by blast

(*state E*)
consts state_E :: "state set"

definition state_E_witness :: "state set"
  where "state_E_witness \<equiv> {t. \<exists>c \<in> (tlb_E tlb_comp). t = \<lparr>sram = c, maps = (map_conf tlb_comp)\<rparr>}"

specification (state_E)
  state_E_init: "state_E = state_E_witness"
  by simp

lemma stateE_nonempty: "state_E \<noteq> {}"
  using state_E_init state_E_witness_def tlbE_nonempty
  by blast

lemma stateE_subset: "state_E \<subseteq> state_N"
  using state_N_init state_N_witness_def state_E_init state_E_witness_def
  by (smt Collect_mono_iff tlbE_init subset_eq)

lemma image_card:
  assumes a0: "finite A"
      and a1: "A \<noteq> {}"
      and a2: "\<forall>i j. i \<in> A \<and> j \<in> A \<and> i \<noteq> j \<longrightarrow> P i \<noteq> P j"
    shows "card A = card (P ` A)"
proof -
  {
    show ?thesis using a0 a1 a2
    proof(induct rule: finite_ne_induct)
      case (singleton x)
      then show ?case by auto
    next
      case (insert x F)
      have "P ` (insert x F) = {P x} \<union> (P ` F)"
        by blast
      moreover have "P x \<notin> P ` F"
        using insert.hyps(3) insert.prems by auto
      ultimately show ?case
        by (simp add: insert.hyps(1) insert.hyps(3) insert.hyps(4) insert.prems)
    qed
  }
qed

(*Observation*)
definition rf_search_observe :: "state \<Rightarrow> memory_request \<Rightarrow> memory_request set \<Rightarrow> ((setindex \<times> tlbhit) \<times> real) set" where
  "rf_search_observe s mr mrs \<equiv>
      let redir_set = the ((maps s) (va mr));
          redir_tb = (sram s) ! redir_set in
      if probe_line redir_tb mr then {((redir_set, Hit), 1)}
      else let r_line = replace_policy redir_tb;
               mm_sec = {t. t \<in> mrs \<and> protect t}; mm_nonsec = {t. t \<in> mrs \<and> \<not> protect t} in
        if protect mr then
          {t. \<exists>mm \<in> mm_sec. let mm_set = the ((maps s) (va mm)) in
              t = ((mm_set, Miss), 1/card mm_sec)}
        else
          if lock r_line then
            {t. \<exists>mm \<in> mm_nonsec. let mm_set = the ((maps s) (va mm)) in
                t = ((mm_set, Miss), 1/card mm_nonsec)}
          else
            {((redir_set, Miss), 1)}"

lemma mem_tlb_miss:
  "\<forall>i \<in> mem_req tlb_comp. \<forall>s0 \<in> state_E. rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
    {t. \<exists>r \<in> mem_req tlb_comp. let r_set = the ((maps s0) (va (fst r))) in
        t = ((r_set, Miss), 1/card (mem_req tlb_comp))}"
  proof -
    {
      fix i assume t0: "i \<in> mem_req tlb_comp"
      have "\<forall>s0 \<in> state_E. rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
            {t. \<exists>r \<in> mem_req tlb_comp. let r_set = the ((maps s0) (va (fst r))) in
                t = ((r_set, Miss), 1/card (mem_req tlb_comp))}"
      proof -
        {
          fix s0 assume t1: "s0 \<in> state_E"
          have "rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
                {t. \<exists>r \<in> mem_req tlb_comp. let r_set = the ((maps s0) (va (fst r))) in
                    t = ((r_set, Miss), 1/card (mem_req tlb_comp))}"
          proof -
            {
              let ?redir_set = "the ((maps s0) (va (fst i)))"
              have exi_redir: "?redir_set < length (sram s0)"
                using state_E_init unfolding state_E_witness_def using mem_mapping
                by (smt tlbE_init map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) subsetD t0 t1)
              let ?redir_tb = "(sram s0) ! ?redir_set"
              have t2: "sram s0 \<in> tlb_E tlb_comp"
                using state_E_init unfolding state_E_witness_def
                proof -
                  assume "state_E = {t. \<exists>c\<in>tlb_E tlb_comp. t = \<lparr>sram = c, maps = map_conf tlb_comp\<rparr>}"
                  then have "state_E = {s. \<exists>Ts. Ts \<in> tlb_E tlb_comp \<and> s = \<lparr>sram = Ts, maps = map_conf tlb_comp\<rparr>}"
                    by meson
                  then have "\<exists>Ts. Ts \<in> tlb_E tlb_comp \<and> s0 = \<lparr>sram = Ts, maps = map_conf tlb_comp\<rparr>"
                    using t1 by blast
                  then show ?thesis
                    by force
                qed
              then have setowned: "\<forall>i \<in> (mem_req tlb_comp). \<forall>l < length (sram s0). \<forall>e \<in> ((sram s0)!l). va (fst i) \<noteq> tlb_va e"
                using mem_occupy by auto
              then have "\<nexists>b. b \<in> ?redir_tb \<and> tlb_va b = va (fst i) \<and> valid b"
                using exi_redir t0 by force
              then have c1: "\<not> probe_line ?redir_tb (fst i)"
                unfolding probe_line_def by blast
              let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
              have c2: "protect (fst i)"
                by (simp add: mem_protect t0)
              have out1: "rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
                         {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                             t = ((mm_set, Miss), 1/card ?mm_sec)}"
                unfolding rf_search_observe_def Let_def
                using c1 c2 by simp
              have "?mm_sec = fst ` (mem_req tlb_comp)"
                using mem_protect by blast
              then have out2: "rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
                              {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                  t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                using out1 by auto
              have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                using image_card mem_finite mem_nonempty mem_unique
                proof -
                  have "mem_req tlb_comp \<noteq> {}"
                    using t0 by force
                  then show ?thesis
                    by (metis (no_types) image_card mem_finite mem_unique)
                qed
              then have out3: "rf_search_observe s0 (fst i) (fst ` (mem_req tlb_comp)) =
                              {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                  t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                using out2 by auto
              then show ?thesis by blast
            }
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

(*pmf instantiate*)
definition execution :: "memory_request \<Rightarrow> state \<Rightarrow> event \<Rightarrow> ((setindex \<times> tlbhit) \<times> real) set"
  where "execution mr s e \<equiv> rf_search_observe s mr (fst ` (mem_req tlb_comp))"

lemma search_finite:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. finite (execution (fst mr) s e)"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. finite (execution (fst mr) s e)"
      proof -
        {
          fix i assume t0: "i \<in> mem_req tlb_comp"
          have "\<forall>s0 \<in> state_N. finite (execution (fst i) s0 e)"
          proof -
            {
              fix s0 assume t1: "s0 \<in> state_N"
              have "finite (execution (fst i) s0 e)"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_N_init unfolding state_N_witness_def using mem_mapping
                    by (smt map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  show ?thesis
                  proof(cases "probe_line ?redir_tb (fst i)")
                    case True
                    then have "execution (fst i) s0 e = {((?redir_set, Hit), 1)}"
                      unfolding execution_def rf_search_observe_def Let_def by auto
                    then show ?thesis by simp
                  next
                    case False
                    let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                    have c2: "protect (fst i)"
                      by (simp add: mem_protect t0)
                    have out1: "execution (fst i) s0 e =
                               {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                                   t = ((mm_set, Miss), 1/card ?mm_sec)}"
                      unfolding execution_def rf_search_observe_def Let_def
                      using False c2 by simp
                    have "?mm_sec = fst ` (mem_req tlb_comp)"
                      using mem_protect by blast
                    then have out2: "execution (fst i) s0 e =
                                    {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                        t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                      using out1 by auto
                    have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                      using image_card mem_finite mem_nonempty mem_unique
                      proof -
                        have "mem_req tlb_comp \<noteq> {}"
                          using t0 by force
                        then show ?thesis
                          by (metis (no_types) image_card mem_finite mem_unique)
                      qed
                    then have out3: "execution (fst i) s0 e =
                                      {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                          t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using out2 by auto
                    have "finite {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                     t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using mem_finite by auto
                    then show ?thesis using out3 by auto
                  qed
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

lemma search_nonempty:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. execution (fst mr) s e \<noteq> {}"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. execution (fst mr) s e \<noteq> {}"
      proof -
        {
          fix i assume t0: "i \<in> mem_req tlb_comp"
          have "\<forall>s0 \<in> state_N. execution (fst i) s0 e \<noteq> {}"
          proof -
            {
              fix s0 assume t1: "s0 \<in> state_N"
              have "execution (fst i) s0 e \<noteq> {}"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_N_init unfolding state_N_witness_def using mem_mapping
                    by (smt map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  show ?thesis
                  proof(cases "probe_line ?redir_tb (fst i)")
                    case True
                    then have "execution (fst i) s0 e = {((?redir_set, Hit), 1)}"
                      unfolding execution_def rf_search_observe_def Let_def by auto
                    then show ?thesis by simp
                  next
                    case False
                    let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                    have c2: "protect (fst i)"
                      by (simp add: mem_protect t0)
                    have out1: "execution (fst i) s0 e =
                               {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                                   t = ((mm_set, Miss), 1/card ?mm_sec)}"
                      unfolding execution_def rf_search_observe_def Let_def
                      using False c2 by simp
                    have "?mm_sec = fst ` (mem_req tlb_comp)"
                      using mem_protect by blast
                    then have out2: "execution (fst i) s0 e =
                                    {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                        t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                      using out1 by auto
                    have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                      using image_card mem_finite mem_nonempty mem_unique
                      proof -
                        have "mem_req tlb_comp \<noteq> {}"
                          using t0 by force
                        then show ?thesis
                          by (metis (no_types) image_card mem_finite mem_unique)
                      qed
                    then have out3: "execution (fst i) s0 e =
                                      {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                          t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using out2 by auto
                    have "mem_req tlb_comp \<noteq> {}"
                      using t0 by blast
                    then have "{t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                   t = ((mm_set, Miss), 1/card (mem_req tlb_comp))} \<noteq> {}"
                      by auto
                    then show ?thesis using out3 by auto
                  qed
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

lemma search_unique:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. \<forall>m n. m \<in> (execution (fst mr) s e) \<and> n \<in> (execution (fst mr) s e) \<and> m \<noteq> n \<longrightarrow> fst m \<noteq> fst n"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. \<forall>m n. m \<in> (execution (fst mr) s e) \<and> n \<in> (execution (fst mr) s e) \<and> m \<noteq> n \<longrightarrow> fst m \<noteq> fst n"
      proof -
        {
          fix i assume t0: "i \<in> mem_req tlb_comp"
          have "\<forall>s0 \<in> state_N. \<forall>m n. m \<in> (execution (fst i) s0 e) \<and> n \<in> (execution (fst i) s0 e) \<and> m \<noteq> n \<longrightarrow> fst m \<noteq> fst n"
          proof -
            {
              fix s0 assume t1: "s0 \<in> state_N"
              have "\<forall>m n. m \<in> (execution (fst i) s0 e) \<and> n \<in> (execution (fst i) s0 e) \<and> m \<noteq> n \<longrightarrow> fst m \<noteq> fst n"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_N_init unfolding state_N_witness_def using mem_mapping
                    by (smt map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  show ?thesis
                  proof(cases "probe_line ?redir_tb (fst i)")
                    case True
                    then have "execution (fst i) s0 e = {((?redir_set, Hit), 1)}"
                      unfolding execution_def rf_search_observe_def Let_def by auto
                    then show ?thesis by simp
                  next
                    case False
                    let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                    have c2: "protect (fst i)"
                      by (simp add: mem_protect t0)
                    have out1: "execution (fst i) s0 e =
                               {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                                   t = ((mm_set, Miss), 1/card ?mm_sec)}"
                      unfolding execution_def rf_search_observe_def Let_def
                      using False c2 by simp
                    have "?mm_sec = fst ` (mem_req tlb_comp)"
                      using mem_protect by blast
                    then have out2: "execution (fst i) s0 e =
                                    {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                        t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                      using out1 by auto
                    have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                      using image_card mem_finite mem_nonempty mem_unique
                      proof -
                        have "mem_req tlb_comp \<noteq> {}"
                          using t0 by force
                        then show ?thesis
                          by (metis (no_types) image_card mem_finite mem_unique)
                      qed
                    then have out3: "execution (fst i) s0 e =
                                      {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                          t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using out2 by auto
                    then show ?thesis by auto
                  qed
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

lemma search_positive:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. \<forall>d \<in> (execution (fst mr) s e). snd d \<ge> 0"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. \<forall>d \<in> (execution (fst mr) s e). snd d \<ge> 0"
      proof -
        {
          fix i assume t0: "i \<in> mem_req tlb_comp"
          have "\<forall>s0 \<in> state_N. \<forall>d \<in> (execution (fst i) s0 e). snd d \<ge> 0"
          proof -
            {
              fix s0 assume t1: "s0 \<in> state_N"
              have "\<forall>d \<in> (execution (fst i) s0 e). snd d \<ge> 0"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_N_init unfolding state_N_witness_def using mem_mapping
                    by (smt map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  show ?thesis
                  proof(cases "probe_line ?redir_tb (fst i)")
                    case True
                    then have "execution (fst i) s0 e = {((?redir_set, Hit), 1)}"
                      unfolding execution_def rf_search_observe_def Let_def by auto
                    then show ?thesis by simp
                  next
                    case False
                    let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                    have c2: "protect (fst i)"
                      by (simp add: mem_protect t0)
                    have out1: "execution (fst i) s0 e =
                               {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                                   t = ((mm_set, Miss), 1/card ?mm_sec)}"
                      unfolding execution_def rf_search_observe_def Let_def
                      using False c2 by simp
                    have "?mm_sec = fst ` (mem_req tlb_comp)"
                      using mem_protect by blast
                    then have out2: "execution (fst i) s0 e =
                                    {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                        t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                      using out1 by auto
                    have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                      using image_card mem_finite mem_nonempty mem_unique
                      proof -
                        have "mem_req tlb_comp \<noteq> {}"
                          using t0 by force
                        then show ?thesis
                          by (metis (no_types) image_card mem_finite mem_unique)
                      qed
                    then have out3: "execution (fst i) s0 e =
                                      {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                          t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using out2 by auto
                    then show ?thesis by auto
                  qed
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

lemma set_size:
  assumes a_finite: "finite (w::((nat \<times> tlbhit) \<times> real) set)"
      and a_nonempty: "w \<noteq> {}"
      and a0: "\<forall>d \<in> w. P d = (i::real)"
    shows "folds (\<lambda>s p. P s + p) 0 w = i * card w"
  proof -
    show ?thesis using a_finite a_nonempty a0
    proof(induct arbitrary: i rule: finite_ne_induct)
      case (singleton x)
      then have "P x = i"
        by auto
      moreover have "folds (\<lambda>s p. P s + p) 0 {x} = P x"
        by force
      ultimately show ?case by auto
    next
      case (insert x F)
      have p0: "folds (\<lambda>s p. P s + p) 0 (insert x F) = P x + folds (\<lambda>s p. P s + p) 0 F"
        using plus_comp_fun_commute_P.fold_insert
        by (simp add: insert.hyps(1) insert.hyps(3))
      have p1: "folds (\<lambda>s p. P s + p) 0 F = i * card F"
        using insert.hyps(4) insert.prems by blast
      have p2: "P x + folds (\<lambda>s p. P s + p) 0 F = i * Suc (card F)"
        by (simp add: insert.prems p1 ring_class.ring_distribs(1))
      then show ?case using p0
        by (simp add: insert.hyps(1) insert.hyps(3))
    qed
  qed

lemma set_size2:
  assumes a0: "finite A"
      and a1: "A \<noteq> {}"
      and a2: "\<forall>a1 a2. a1 \<in> A \<and> a2 \<in> A \<and> a1 \<noteq> a2 \<longrightarrow> f a1 \<noteq> f a2"
    shows "card {t. \<exists>a \<in> A. t = f a} = card A"
  proof -
    show ?thesis using a0 a1 a2
    proof(induct rule: finite_ne_induct)
      case (singleton x)
      then show ?case by auto
    next
      case (insert x F)
      have insert_length: "card (insert x F) = card F + 1"
        by (simp add: insert.hyps(1) insert.hyps(3))
      have "{t. \<exists>a \<in> (insert x F). t = f a} = {t. \<exists>a \<in> {x}. t = f a} \<union> {t. \<exists>a \<in> F. t = f a}"
        by auto
      moreover have "f x \<notin> {t. \<exists>a \<in> F. t = f a}"
        using insert.hyps(3) insert.prems by blast
      ultimately have "card {t. \<exists>a \<in> (insert x F). t = f a} = card {t. \<exists>a \<in> F. t = f a} + 1"
        using insert.hyps(1) by auto
      then show ?case
        using insert_length by (simp add: insert.hyps(4) insert.prems)
    qed
  qed

lemma search_sum_one:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. folds (\<lambda>t p. snd t + p) 0 (execution (fst mr) s e) = 1"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_N. folds (\<lambda>t p. snd t + p) 0 (execution (fst mr) s e) = 1"
      proof -
        {
          fix i assume t0: "i \<in> mem_req tlb_comp"
          have "\<forall>s0 \<in> state_N. folds (\<lambda>t p. snd t + p) 0 (execution (fst i) s0 e) = 1"
          proof -
            {
              fix s0 assume t1: "s0 \<in> state_N"
              have "folds (\<lambda>t p. snd t + p) 0 (execution (fst i) s0 e) = 1"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_N_init unfolding state_N_witness_def using mem_mapping
                    by (smt map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  show ?thesis
                  proof(cases "probe_line ?redir_tb (fst i)")
                    case True
                    then have "execution (fst i) s0 e = {((?redir_set, Hit), 1)}"
                      unfolding execution_def rf_search_observe_def Let_def by auto
                    then show ?thesis by simp
                  next
                    case False
                    let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                    have c2: "protect (fst i)"
                      by (simp add: mem_protect t0)
                    have out1: "execution (fst i) s0 e =
                               {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)) in
                                   t = ((mm_set, Miss), 1/card ?mm_sec)}"
                      unfolding execution_def rf_search_observe_def Let_def
                      using False c2 by simp
                    have "?mm_sec = fst ` (mem_req tlb_comp)"
                      using mem_protect by blast
                    then have out2: "execution (fst i) s0 e =
                                    {t. \<exists>mm \<in> fst ` (mem_req tlb_comp). let mm_set = the ((maps s0) (va mm)) in
                                        t = ((mm_set, Miss), 1/card (fst ` (mem_req tlb_comp)))}"
                      using out1 by auto
                    have "card (fst ` (mem_req tlb_comp)) = card (mem_req tlb_comp)"
                      using image_card mem_finite mem_nonempty mem_unique
                      proof -
                        have "mem_req tlb_comp \<noteq> {}"
                          using t0 by force
                        then show ?thesis
                          by (metis (no_types) image_card mem_finite mem_unique)
                      qed
                    then have out3: "execution (fst i) s0 e =
                                      {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                          t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using out2 by auto
                    have "folds (\<lambda>t p. snd t + p) 0 {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                                        t = ((mm_set, Miss), 1/card (mem_req tlb_comp))} =
                         1/card (mem_req tlb_comp) * card {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                                              t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}"
                      using set_size[where ?w = "{t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                                     t = ((mm_set, Miss), 1/card (mem_req tlb_comp))}" and
                                           ?P = "snd" and
                                           ?i = "1/card (mem_req tlb_comp)"]
                            mem_finite mem_nonempty t0 by auto
                    moreover have "card {t. \<exists>mm \<in> mem_req tlb_comp. let mm_set = the ((maps s0) (va (fst mm))) in
                                            t = ((mm_set, Miss), 1/card (mem_req tlb_comp))} =
                                   card (mem_req tlb_comp)"
                    proof -
                      {
                        have "\<forall>i1 i2. i1 \<in> mem_req tlb_comp \<and> i2 \<in> mem_req tlb_comp \<and> i1 \<noteq> i2 \<longrightarrow>
                                      ((the ((maps s0) (va (fst i1))), Miss), 1/card (mem_req tlb_comp)) \<noteq> ((the ((maps s0) (va (fst i2))), Miss), 1/card (mem_req tlb_comp))"
                          using mem_mapping mem_unique
                          by (smt Pair_inject map_diff mem_Collect_eq state.select_convs(2) state_N_init state_N_witness_def t1)
                        then  show ?thesis unfolding Let_def
                          using set_size2[where ?A = "mem_req tlb_comp" and
                                                ?f = "\<lambda>e. ((the ((maps s0) (va (fst e))), Miss), 1/card (mem_req tlb_comp))"]
                                mem_finite mem_nonempty by fastforce
                      }
                    qed
                    ultimately show ?thesis
                      by (simp add: mem_nonempty out3)
                  qed
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

interpretation CM state_N state_E "mem_req tlb_comp" execution
  apply standard
  using mem_finite mem_nonempty mem_unique mem_positive mem_sum_one
        search_finite search_nonempty search_unique search_positive search_sum_one
        stateN_finite stateN_nonempty stateE_nonempty stateE_subset
  by auto

subsection \<open>Proofs of Correctness\<close>

lemma one_changed_remain_same:
  "\<forall>i \<in> mem_req tlb_comp. \<forall>s0 \<in> state_E. \<forall>s' \<in> rf_search s0 (fst i) (fst ` (mem_req tlb_comp)).
    \<exists>!l. (\<forall>l' \<noteq> l. (sram s0)!l' = (sram s')!l') \<and> (card (((sram s') ! l) \<inter> ((sram s0) ! l)) = card ((sram s0) ! l) - 1)"
  proof -
    {
      fix i assume t0: "i \<in> mem_req tlb_comp"
      have "\<forall>s0 \<in> state_E. \<forall>s' \<in> rf_search s0 (fst i) (fst ` (mem_req tlb_comp)).
              \<exists>!l. (\<forall>l' \<noteq> l. (sram s0)!l' = (sram s')!l') \<and> (card (((sram s') ! l) \<inter> ((sram s0) ! l)) = card ((sram s0) ! l) - 1)"
      proof -
        {
          fix s0 assume t1: "s0 \<in> state_E"
          have "\<forall>s' \<in> rf_search s0 (fst i) (fst ` (mem_req tlb_comp)).
                  \<exists>!l. (\<forall>l' \<noteq> l. (sram s0)!l' = (sram s')!l') \<and> (card (((sram s') ! l) \<inter> ((sram s0) ! l)) = card ((sram s0) ! l) - 1)"
          proof -
            {
              fix s' assume t2: "s' \<in> rf_search s0 (fst i) (fst ` (mem_req tlb_comp))"
              have "\<exists>!l. (\<forall>l' \<noteq> l. (sram s0)!l' = (sram s')!l') \<and> (card (((sram s') ! l) \<inter> ((sram s0) ! l)) = card ((sram s0) ! l) - 1)"
              proof -
                {
                  let ?redir_set = "the ((maps s0) (va (fst i)))"
                  have exi_redir: "?redir_set < length (sram s0)"
                    using state_E_init unfolding state_E_witness_def using mem_mapping
                    by (smt tlbE_init map_range mem_Collect_eq state.select_convs(1) state.select_convs(2) subsetD t0 t1)
                  let ?redir_tb = "(sram s0) ! ?redir_set"
                  have t3: "sram s0 \<in> tlb_E tlb_comp"
                    using state_E_init unfolding state_E_witness_def
                    proof -
                      assume "state_E = {t. \<exists>c\<in>tlb_E tlb_comp. t = \<lparr>sram = c, maps = map_conf tlb_comp\<rparr>}"
                      then have "state_E = {s. \<exists>Ts. Ts \<in> tlb_E tlb_comp \<and> s = \<lparr>sram = Ts, maps = map_conf tlb_comp\<rparr>}"
                        by meson
                      then have "\<exists>Ts. Ts \<in> tlb_E tlb_comp \<and> s0 = \<lparr>sram = Ts, maps = map_conf tlb_comp\<rparr>"
                        using t1 by blast
                      then show ?thesis
                        by force
                    qed
                  then have setowned: "\<forall>i \<in> (mem_req tlb_comp). \<forall>l < length (sram s0). \<forall>e \<in> ((sram s0)!l). va (fst i) \<noteq> tlb_va e"
                    using mem_occupy by auto
                  then have "\<nexists>b. b \<in> ?redir_tb \<and> tlb_va b = va (fst i) \<and> valid b"
                    using exi_redir t0 by force
                  then have c1: "\<not> probe_line ?redir_tb (fst i)"
                    unfolding probe_line_def by blast
                  let ?mm_sec = "{t. t \<in> (fst ` (mem_req tlb_comp)) \<and> protect t}"
                  have c2: "protect (fst i)"
                    by (simp add: mem_protect t0)
                  have out: "rf_search s0 (fst i) (fst ` (mem_req tlb_comp)) =
                            {t. \<exists>mm \<in> ?mm_sec. let mm_set = the ((maps s0) (va mm)); mm_tb = (sram s0) ! mm_set; r'_line = replace_policy mm_tb;
                                                            newset = insert (replace_line r'_line mm) (mm_tb - {r'_line}) in
                                                t = s0\<lparr>sram := list_update (sram s0) mm_set newset\<rparr>}"
                    unfolding rf_search_def Let_def
                    using c1 c2 by simp
                  then have "\<exists>mm \<in> ?mm_sec.
                              s' = (let mm_set = the ((maps s0) (va mm)); mm_tb = (sram s0) ! mm_set; r'_line = replace_policy mm_tb;
                                                 newset = insert (replace_line r'_line mm) (mm_tb - {r'_line}) in
                                    s0\<lparr>sram := list_update (sram s0) mm_set newset\<rparr>)"
                    using t2 by (smt mem_Collect_eq)
                  then obtain mm where t4: "mm \<in> ?mm_sec \<and>
                                            s' = (let mm_set = the ((maps s0) (va mm)); mm_tb = (sram s0) ! mm_set; r'_line = replace_policy mm_tb;
                                                               newset = insert (replace_line r'_line mm) (mm_tb - {r'_line}) in
                                                  s0\<lparr>sram := list_update (sram s0) mm_set newset\<rparr>)"
                    by auto
                  let ?mm_set = "the ((maps s0) (va mm))"
                  have mm_length: "?mm_set < length (sram s0)"
                    using t4
                    proof -
                      have "state_E_witness = {s. \<exists>Ts. Ts \<in> tlb_E tlb_comp \<and> s = \<lparr>sram = Ts, maps = map_conf tlb_comp\<rparr>}"
                        by (simp add: Bex_def_raw state_E_witness_def)
                      then obtain TTs :: "state \<Rightarrow> tlb_line set list" where
                        f1: "TTs s0 \<in> tlb_E tlb_comp \<and> s0 = \<lparr>sram = TTs s0, maps = map_conf tlb_comp\<rparr>"
                        using state_E_init t1 by moura
                      then have f2: "\<lparr>sram = TTs s0, maps = map_conf tlb_comp\<rparr> = \<lparr>sram = sram s0, maps = maps s0, \<dots> = state.more s0\<rparr>"
                        by simp
                      have "map_conf tlb_comp (va mm) \<noteq> None"
                        using mem_mapping t4 by fastforce
                      then show ?thesis
                        using f2 f1 by (metis map_range state.ext_inject subsetD tlbE_init)
                    qed
                  let ?mm_tb = "(sram s0) ! ?mm_set"
                  let ?r'_line = "replace_policy ?mm_tb"
                  have r'_belong: "?r'_line \<in> ?mm_tb"
                    using t4
                    proof -
                      have "sram s0 \<in> tlb_N tlb_comp"
                        by (meson subsetD t3 tlbE_init)
                      then show ?thesis
                        by (simp add: mm_length replace_policy_def some_in_eq tlb_set_nonempty)
                    qed
                  then have tag_diff: "tlb_va ?r'_line \<noteq> va mm"
                    using setowned mm_length t4 by fastforce
                  let ?r'_line' = "replace_line ?r'_line mm"
                  have tag_same: "tlb_va ?r'_line' = va mm"
                    unfolding replace_line_def by simp
                  have t5: "?r'_line' \<notin> ?mm_tb"
                    proof -
                      have "mm \<in> fst ` mem_req tlb_comp"
                        using t4 by fastforce
                      then show ?thesis
                        by (metis (no_types) imageE mm_length setowned tag_same)
                    qed
                  let ?newset = "insert ?r'_line' (?mm_tb - {?r'_line})"
                  have "?newset \<inter> ?mm_tb = ?mm_tb - {?r'_line}"
                    using t5 by auto
                  then have re: "card (?newset \<inter> ?mm_tb) = card ?mm_tb - 1"
                    by (simp add: card_Diff_subset_Int r'_belong)
                  have out1: "s' = s0\<lparr>sram := list_update (sram s0) ?mm_set ?newset\<rparr>"
                    by (metis (full_types) t4)
                  then have "sram s' = list_update (sram s0) ?mm_set ?newset"
                    by auto
                  then have "\<exists>!l. l = ?mm_set \<and> (\<forall>l' \<noteq> l. (sram s0)!l' = (sram s')!l') \<and>
                                  (card (((sram s') ! l) \<inter> ((sram s0) ! l)) = card ((sram s0) ! l) - 1)"
                    using re mm_length nth_list_update_eq by auto
                  then show ?thesis
                    by (metis \<open>sram s' = (sram s0) [the (maps s0 (va mm)) := insert (replace_line (replace_policy (sram s0 ! the (maps s0 (va mm)))) mm) (sram s0 ! the (maps s0 (va mm)) - {replace_policy (sram s0 ! the (maps s0 (va mm)))})]\<close> insertI1 mm_length nth_list_update_eq t5)
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

subsection \<open>Proofs of Security Model\<close>

lemma search_not_zero:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e. snd d \<noteq> 0"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e. snd d \<noteq> 0"
      proof -
        {
          fix mr
          assume t0: "mr \<in> mem_req tlb_comp"
          have "\<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e. snd d \<noteq> 0"
          proof -
            {
              fix s
              assume t1: "s \<in> state_E"
              have "\<forall>d \<in> execution (fst mr) s e. snd d \<noteq> 0"
              proof -
                {
                  have "execution (fst mr) s e = {t. \<exists>r\<in>mem_req tlb_comp. let r_set = the (maps s (va (fst r))) in t = ((r_set, Miss), 1 / real (card (mem_req tlb_comp)))}"
                    unfolding execution_def using mem_tlb_miss t0 t1 by auto
                  then show ?thesis
                    using mem_nonempty by auto
                }
              qed
            }
            then show ?thesis by blast
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

lemma search_uniform:
  "\<forall>e. \<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e.
    snd d = folds (\<lambda>t p. snd t + p) 0 {u. u \<in> makeDist s e \<and> snd (fst u) = fst d}"
  proof -
    {
      fix e
      have "\<forall>mr \<in> mem_req tlb_comp. \<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e.
             snd d = folds (\<lambda>t p. snd t + p) 0 {u. u \<in> makeDist s e \<and> snd (fst u) = fst d}"
      proof -
        {
          fix mr assume t0: "mr \<in> mem_req tlb_comp"
          have "\<forall>s \<in> state_E. \<forall>d \<in> execution (fst mr) s e.
                 snd d = folds (\<lambda>t p. snd t + p) 0 {u. u \<in> makeDist s e \<and> snd (fst u) = fst d}"
          proof -
            {
              fix s assume t1: "s \<in> state_E"
              have "\<forall>d \<in> execution (fst mr) s e.
                     snd d = folds (\<lambda>t p. snd t + p) 0 {u. u \<in> makeDist s e \<and> snd (fst u) = fst d}"
              proof -
                {
                  fix d assume "d \<in> execution (fst mr) s e"
                  have emr: "execution (fst mr) s e = {t. \<exists>r \<in> mem_req tlb_comp. let r_set = the ((maps s) (va (fst r))) in
                                                          t = ((r_set, Miss), 1/card (mem_req tlb_comp))}"
                    unfolding execution_def using mem_tlb_miss
                    using t0 t1 by blast
                  have pmf_m: "\<forall>m \<in> mem_req tlb_comp. \<exists>!t \<in> execution (fst m) s e. t = (fst d, snd d)"
                    using \<open>d \<in> execution (fst mr) s e\<close> execution_def mem_tlb_miss t0 t1 by auto
                  then have makedist_m: "\<forall>m \<in> mem_req tlb_comp. ((fst m, fst d), snd m * snd d) \<in> makeDist s e"
                    unfolding makeDist_def using emr by fastforce
                  then have set_equal: "{u. u \<in> makeDist s e \<and> snd (fst u) = fst d} =
                                        {t. \<exists>m \<in> mem_req tlb_comp. t = ((fst m, fst d), snd m * snd d)}"
                    by (smt Collect_cong Pair_inject execution_def makeDist_def mem_Collect_eq mem_tlb_miss pmf_m surjective_pairing t1)
                  have sum1: "folds (\<lambda>t p. snd t + p) 0 {t. \<exists>m \<in> mem_req tlb_comp. t = ((fst m, fst d), snd m * snd d)} =
                              folds (\<lambda>t p. snd t * snd d + p) 0 (mem_req tlb_comp)"
                    using folds_plus_times_input2[where ?w = "mem_req tlb_comp" and ?d = "d"]
                          mem_finite mem_nonempty mem_unique inputdist_nonempty by auto
                  have sum2: "folds (\<lambda>t p. snd t * snd d + p) 0 (mem_req tlb_comp) = snd d * (folds (\<lambda>t p. snd t + p) 0 (mem_req tlb_comp))"
                    using folds_plus_times_input[where ?w = "mem_req tlb_comp" and ?i = "snd d"]
                          mem_finite mem_nonempty mem_unique inputdist_nonempty by auto
                  have "snd d = folds (\<lambda>t p. snd t + p) 0 {u. u \<in> makeDist s e \<and> snd (fst u) = fst d}"
                    using set_equal sum1 sum2 mem_sum_one by simp
                }
                then show ?thesis by auto
              qed
            }
            then show ?thesis by auto
          qed
        }
        then show ?thesis by blast
      qed
    }
    then show ?thesis by blast
  qed

end


(*  Title:      JinjaThreads/Common/BinOp.thy
    Author:     Andreas Lochbihler
*)

header{* \isaheader{ Binary Operators } *}

theory BinOp
imports
  WellForm
begin

datatype bop =  -- "names of binary operations"
    Eq
  | NotEq
  | LessThan
  | LessOrEqual
  | GreaterThan
  | GreaterOrEqual
  | Add
  | Subtract
  | Mult
  | Div
  | Mod
  | BinAnd
  | BinOr
  | BinXor
  | ShiftLeft
  | ShiftRightZeros
  | ShiftRightSigned

section{* The semantics of binary operators *}

type_synonym 'addr binop_ret = "'addr val + 'addr" -- "a value or the address of an exception"

fun binop_LessThan :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_LessThan (Intg i1) (Intg i2) = Some (Inl (Bool (i1 <s i2)))"
| "binop_LessThan v1 v2 = None"

fun binop_LessOrEqual :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_LessOrEqual (Intg i1) (Intg i2) = Some (Inl (Bool (i1 <=s i2)))"
| "binop_LessOrEqual v1 v2 = None"

fun binop_GreaterThan :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_GreaterThan (Intg i1) (Intg i2) = Some (Inl (Bool (i2 <s i1)))"
| "binop_GreaterThan v1 v2 = None"

fun binop_GreaterOrEqual :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_GreaterOrEqual (Intg i1) (Intg i2) = Some (Inl (Bool (i2 <=s i1)))"
| "binop_GreaterOrEqual v1 v2 = None"

fun binop_Add :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_Add (Intg i1) (Intg i2) = Some (Inl (Intg (i1 + i2)))"
| "binop_Add v1 v2 = None"

fun binop_Subtract :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_Subtract (Intg i1) (Intg i2) = Some (Inl (Intg (i1 - i2)))"
| "binop_Subtract v1 v2 = None"

fun binop_Mult :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_Mult (Intg i1) (Intg i2) = Some (Inl (Intg (i1 * i2)))"
| "binop_Mult v1 v2 = None"

fun binop_BinAnd :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_BinAnd (Intg i1) (Intg i2) = Some (Inl (Intg (i1 AND i2)))"
| "binop_BinAnd (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<and> b2)))"
| "binop_BinAnd v1 v2 = None"

fun binop_BinOr :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_BinOr (Intg i1) (Intg i2) = Some (Inl (Intg (i1 OR i2)))"
| "binop_BinOr (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<or> b2)))"
| "binop_BinOr v1 v2 = None"

fun binop_BinXor :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_BinXor (Intg i1) (Intg i2) = Some (Inl (Intg (i1 XOR i2)))"
| "binop_BinXor (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<noteq> b2)))"
| "binop_BinXor v1 v2 = None"

fun binop_ShiftLeft :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_ShiftLeft (Intg i1) (Intg i2) = Some (Inl (Intg (i1 << unat (i2 AND 0x1f))))"
| "binop_ShiftLeft v1 v2 = None"

fun binop_ShiftRightZeros :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_ShiftRightZeros (Intg i1) (Intg i2) = Some (Inl (Intg (i1 >> unat (i2 AND 0x1f))))"
| "binop_ShiftRightZeros v1 v2 = None"

fun binop_ShiftRightSigned :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_ShiftRightSigned (Intg i1) (Intg i2) = Some (Inl (Intg (i1 >>> unat (i2 AND 0x1f))))"
| "binop_ShiftRightSigned v1 v2 = None"

text {*
  Division on @{typ "'a word"} is unsigned, but JLS specifies signed division.
*}
definition word_sdiv :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "sdiv" 70)
where [code]:
  "x sdiv y =
   (let x' = sint x; y' = sint y;
        negative = (x' < 0) \<noteq> (y' < 0);
        result = abs x' div abs y'
    in word_of_int (if negative then -result else result))"

definition word_smod :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "smod" 70)
where [code]:
  "x smod y =
   (let x' = sint x; y' = sint y;
        negative = (x' < 0);
        result = abs x' mod abs y'
    in word_of_int (if negative then -result else result))"

declare word_sdiv_def [simp] word_smod_def [simp]

lemma sdiv_smod_id: "(a sdiv b) * b + (a smod b) = a"
proof -
  have F5: "\<forall>u\<Colon>'a word. - (- u) = u" by (metis word_sint.Rep_inverse' minus_minus wi_hom_neg)
  have F7: "\<forall>v u\<Colon>'a word. u + v = v + u" by(metis add.left_commute add_0_right)
  have F8: "\<forall>(w\<Colon>'a word) (v\<Colon>int) u\<Colon>int. word_of_int u + word_of_int v * w = word_of_int (u + v * sint w)"
    by (metis word_sint.Rep_inverse wi_hom_syms(1) wi_hom_syms(3))
  have "\<exists>u. u = - sint b \<and> word_of_int (sint a mod u + - (- u * (sint a div u))) = a"
    using F5 by (metis minus_minus word_sint.Rep_inverse' mult_minus_left add.commute zmod_zdiv_equality)
  hence "word_of_int (sint a mod - sint b + - (sint b * (sint a div - sint b))) = a" by (metis equation_minus_iff)
  hence "word_of_int (sint a mod - sint b) + word_of_int (- (sint a div - sint b)) * b = a"
    using F8 by(metis mult.commute mult_minus_left)
  hence eq: "word_of_int (- (sint a div - sint b)) * b + word_of_int (sint a mod - sint b) = a" using F7 by metis

  show ?thesis
  proof(cases "sint a < 0")
    case True note a = this
    show ?thesis
    proof(cases "sint b < 0")
      case True
      with a show ?thesis
        by simp (metis F7 F8 eq minus_equation_iff minus_mult_minus semiring_div_class.mod_div_equality')
    next
      case False
      from eq have "word_of_int (- (- sint a div sint b)) * b + word_of_int (- (- sint a mod sint b)) = a"
        by (metis div_minus_right mod_minus_right)
      with a False show ?thesis by simp
    qed
  next
    case False note a = this
    show ?thesis
    proof(cases "sint b < 0")
      case True
      with a eq show ?thesis by simp
    next
      case False with a show ?thesis
        by simp (metis wi_hom_add wi_hom_mult add.commute mult.commute word_sint.Rep_inverse add.commute zmod_zdiv_equality)
    qed
  qed
qed

notepad begin
have  "  5  sdiv ( 3 :: word32) =  1"
  and "  5  smod ( 3 :: word32) =  2"
  and "  5  sdiv (-3 :: word32) = -1"
  and "  5  smod (-3 :: word32) =  2"
  and "(-5) sdiv ( 3 :: word32) = -1"
  and "(-5) smod ( 3 :: word32) = -2"
  and "(-5) sdiv (-3 :: word32) =  1"
  and "(-5) smod (-3 :: word32) = -2"
  and "-2147483648 sdiv 1 = (-2147483648 :: word32)"
  by eval+
end

context heap_base begin

fun binop_Mod :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_Mod (Intg i1) (Intg i2) =
   Some (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg (i1 smod i2)))"
| "binop_Mod v1 v2 = None"

fun binop_Div :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop_Div (Intg i1) (Intg i2) =
   Some (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg (i1 sdiv i2)))"
| "binop_Div v1 v2 = None"

primrec binop :: "bop \<Rightarrow> 'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
where
  "binop Eq v1 v2 =  Some (Inl (Bool (v1 = v2)))"
| "binop NotEq v1 v2 = Some (Inl (Bool (v1 \<noteq> v2)))"
| "binop LessThan = binop_LessThan"
| "binop LessOrEqual = binop_LessOrEqual"
| "binop GreaterThan = binop_GreaterThan"
| "binop GreaterOrEqual = binop_GreaterOrEqual"
| "binop Add = binop_Add"
| "binop Subtract = binop_Subtract"
| "binop Mult = binop_Mult"
| "binop Mod = binop_Mod"
| "binop Div = binop_Div"
| "binop BinAnd = binop_BinAnd"
| "binop BinOr = binop_BinOr"
| "binop BinXor = binop_BinXor"
| "binop ShiftLeft = binop_ShiftLeft"
| "binop ShiftRightZeros = binop_ShiftRightZeros"
| "binop ShiftRightSigned = binop_ShiftRightSigned"

end

lemma [simp]:
  "(binop_LessOrEqual v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i1 <=s i2)))"
by(cases "(v1, v2)" rule: binop_LessOrEqual.cases) auto

lemma [simp]:
  "(binop_GreaterThan v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i2 <s i1)))"
by(cases "(v1, v2)" rule: binop_GreaterThan.cases) auto

lemma [simp]:
  "(binop_GreaterOrEqual v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i2 <=s i1)))"
by(cases "(v1, v2)" rule: binop_GreaterOrEqual.cases) auto

lemma [simp]:
  "(binop_Add v\<^sub>1 v\<^sub>2  = Some va) \<longleftrightarrow>
   (\<exists>i\<^sub>1 i\<^sub>2. v\<^sub>1 = Intg i\<^sub>1 \<and> v\<^sub>2 = Intg i\<^sub>2 \<and> va = Inl (Intg (i\<^sub>1+i\<^sub>2)))"
by(cases "(v\<^sub>1, v\<^sub>2)" rule: binop_Add.cases) auto

lemma [simp]:
  "(binop_Subtract v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 - i2)))"
by(cases "(v1, v2)" rule: binop_Subtract.cases) auto

lemma [simp]:
  "(binop_Mult v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 * i2)))"
by(cases "(v1, v2)" rule: binop_Mult.cases) auto

lemma [simp]:
  "(binop_BinAnd v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<and> b2))) \<or>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 AND i2)))"
by(cases "(v1, v2)" rule: binop_BinAnd.cases) auto

lemma [simp]:
  "(binop_BinOr v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<or> b2))) \<or>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 OR i2)))"
by(cases "(v1, v2)" rule: binop_BinOr.cases) auto

lemma [simp]:
  "(binop_BinXor v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<noteq> b2))) \<or>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 XOR i2)))"
by(cases "(v1, v2)" rule: binop_BinXor.cases) auto

lemma [simp]:
  "(binop_ShiftLeft v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 << unat (i2 AND 0x1f))))"
by(cases "(v1, v2)" rule: binop_ShiftLeft.cases) auto

lemma [simp]:
  "(binop_ShiftRightZeros v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 >> unat (i2 AND 0x1f))))"
by(cases "(v1, v2)" rule: binop_ShiftRightZeros.cases) auto

lemma [simp]:
  "(binop_ShiftRightSigned v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 >>> unat (i2 AND 0x1f))))"
by(cases "(v1, v2)" rule: binop_ShiftRightSigned.cases) auto

context heap_base begin

lemma [simp]:
  "(binop_Mod v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and>
      va = (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg(i1 smod i2))))"
by(cases "(v1, v2)" rule: binop_Mod.cases) auto

lemma [simp]:
  "(binop_Div v1 v2 = Some va) \<longleftrightarrow>
   (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and>
      va = (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg(i1 sdiv i2))))"
by(cases "(v1, v2)" rule: binop_Div.cases) auto

end

section {* Typing for binary operators *}

inductive WT_binop :: "'m prog \<Rightarrow> ty \<Rightarrow> bop \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _\<guillemotleft>_\<guillemotright>_ :: _" [51,0,0,0,51] 50)
where
  WT_binop_Eq:
  "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: Boolean"

| WT_binop_NotEq:
  "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: Boolean"

| WT_binop_LessThan:
  "P \<turnstile> Integer\<guillemotleft>LessThan\<guillemotright>Integer :: Boolean"

| WT_binop_LessOrEqual:
  "P \<turnstile> Integer\<guillemotleft>LessOrEqual\<guillemotright>Integer :: Boolean"

| WT_binop_GreaterThan:
  "P \<turnstile> Integer\<guillemotleft>GreaterThan\<guillemotright>Integer :: Boolean"

| WT_binop_GreaterOrEqual:
  "P \<turnstile> Integer\<guillemotleft>GreaterOrEqual\<guillemotright>Integer :: Boolean"

| WT_binop_Add:
  "P \<turnstile> Integer\<guillemotleft>Add\<guillemotright>Integer :: Integer"

| WT_binop_Subtract:
  "P \<turnstile> Integer\<guillemotleft>Subtract\<guillemotright>Integer :: Integer"

| WT_binop_Mult:
  "P \<turnstile> Integer\<guillemotleft>Mult\<guillemotright>Integer :: Integer"

| WT_binop_Div:
  "P \<turnstile> Integer\<guillemotleft>Div\<guillemotright>Integer :: Integer"

| WT_binop_Mod:
  "P \<turnstile> Integer\<guillemotleft>Mod\<guillemotright>Integer :: Integer"

| WT_binop_BinAnd_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinAnd\<guillemotright>Boolean :: Boolean"

| WT_binop_BinAnd_Int:
  "P \<turnstile> Integer\<guillemotleft>BinAnd\<guillemotright>Integer :: Integer"

| WT_binop_BinOr_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinOr\<guillemotright>Boolean :: Boolean"

| WT_binop_BinOr_Int:
  "P \<turnstile> Integer\<guillemotleft>BinOr\<guillemotright>Integer :: Integer"

| WT_binop_BinXor_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinXor\<guillemotright>Boolean :: Boolean"

| WT_binop_BinXor_Int:
  "P \<turnstile> Integer\<guillemotleft>BinXor\<guillemotright>Integer :: Integer"

| WT_binop_ShiftLeft:
  "P \<turnstile> Integer\<guillemotleft>ShiftLeft\<guillemotright>Integer :: Integer"

| WT_binop_ShiftRightZeros:
  "P \<turnstile> Integer\<guillemotleft>ShiftRightZeros\<guillemotright>Integer :: Integer"

| WT_binop_ShiftRightSigned:
  "P \<turnstile> Integer\<guillemotleft>ShiftRightSigned\<guillemotright>Integer :: Integer"

lemma WT_binopI [intro]:
  "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: Boolean"
  "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: Boolean"
  "bop = Add \<or> bop = Subtract \<or> bop = Mult \<or> bop = Mod \<or> bop = Div \<or> bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<or>
   bop = ShiftLeft \<or> bop = ShiftRightZeros \<or> bop = ShiftRightSigned
   \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer :: Integer"
  "bop = LessThan \<or> bop = LessOrEqual \<or> bop = GreaterThan \<or> bop = GreaterOrEqual \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer :: Boolean"
  "bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<Longrightarrow> P \<turnstile> Boolean\<guillemotleft>bop\<guillemotright>Boolean :: Boolean"
by(auto intro: WT_binop.intros)

inductive_cases [elim]:
  "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 :: T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 :: T"

lemma WT_binop_fun: "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T' \<rbrakk> \<Longrightarrow> T = T'"
by(cases bop)(auto)

lemma WT_binop_is_type:
  "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T"
by(cases bop) auto

inductive WTrt_binop :: "'m prog \<Rightarrow> ty \<Rightarrow> bop \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _\<guillemotleft>_\<guillemotright>_ : _" [51,0,0,0,51] 50)
where
  WTrt_binop_Eq:
  "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : Boolean"

| WTrt_binop_NotEq:
  "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : Boolean"

| WTrt_binop_LessThan:
  "P \<turnstile> Integer\<guillemotleft>LessThan\<guillemotright>Integer : Boolean"

| WTrt_binop_LessOrEqual:
  "P \<turnstile> Integer\<guillemotleft>LessOrEqual\<guillemotright>Integer : Boolean"

| WTrt_binop_GreaterThan:
  "P \<turnstile> Integer\<guillemotleft>GreaterThan\<guillemotright>Integer : Boolean"

| WTrt_binop_GreaterOrEqual:
  "P \<turnstile> Integer\<guillemotleft>GreaterOrEqual\<guillemotright>Integer : Boolean"

| WTrt_binop_Add:
  "P \<turnstile> Integer\<guillemotleft>Add\<guillemotright>Integer : Integer"

| WTrt_binop_Subtract:
  "P \<turnstile> Integer\<guillemotleft>Subtract\<guillemotright>Integer : Integer"

| WTrt_binop_Mult:
  "P \<turnstile> Integer\<guillemotleft>Mult\<guillemotright>Integer : Integer"

| WTrt_binop_Div:
  "P \<turnstile> Integer\<guillemotleft>Div\<guillemotright>Integer : Integer"

| WTrt_binop_Mod:
  "P \<turnstile> Integer\<guillemotleft>Mod\<guillemotright>Integer : Integer"

| WTrt_binop_BinAnd_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinAnd\<guillemotright>Boolean : Boolean"

| WTrt_binop_BinAnd_Int:
  "P \<turnstile> Integer\<guillemotleft>BinAnd\<guillemotright>Integer : Integer"

| WTrt_binop_BinOr_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinOr\<guillemotright>Boolean : Boolean"

| WTrt_binop_BinOr_Int:
  "P \<turnstile> Integer\<guillemotleft>BinOr\<guillemotright>Integer : Integer"

| WTrt_binop_BinXor_Bool:
  "P \<turnstile> Boolean\<guillemotleft>BinXor\<guillemotright>Boolean : Boolean"

| WTrt_binop_BinXor_Int:
  "P \<turnstile> Integer\<guillemotleft>BinXor\<guillemotright>Integer : Integer"

| WTrt_binop_ShiftLeft:
  "P \<turnstile> Integer\<guillemotleft>ShiftLeft\<guillemotright>Integer : Integer"

| WTrt_binop_ShiftRightZeros:
  "P \<turnstile> Integer\<guillemotleft>ShiftRightZeros\<guillemotright>Integer : Integer"

| WTrt_binop_ShiftRightSigned:
  "P \<turnstile> Integer\<guillemotleft>ShiftRightSigned\<guillemotright>Integer : Integer"

inductive_cases WTrt_binop_cases [elim]:
  "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 : T"

inductive_simps WTrt_binop_simps [simp]:
  "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 : T"
  "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 : T"

fun binop_relevant_class :: "bop \<Rightarrow> 'm prog \<Rightarrow> cname \<Rightarrow> bool"
where
  "binop_relevant_class Div = (\<lambda>P C. P \<turnstile> ArithmeticException \<preceq>\<^sup>* C )"
| "binop_relevant_class Mod = (\<lambda>P C. P \<turnstile> ArithmeticException \<preceq>\<^sup>* C )"
| "binop_relevant_class _ = (\<lambda>P C. False)"

lemma WT_binop_WTrt_binop:
  "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T \<Longrightarrow> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
by(auto elim: WT_binop.cases)

context heap begin

lemma binop_progress:
  "\<lbrakk> typeof\<^bsub>h\<^esub> v1 = \<lfloor>T1\<rfloor>; typeof\<^bsub>h\<^esub> v2 = \<lfloor>T2\<rfloor>; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T \<rbrakk>
  \<Longrightarrow> \<exists>va. binop bop v1 v2 = \<lfloor>va\<rfloor>"
by(cases bop)(auto del: disjCI split del: split_if)

lemma binop_type:
  assumes wf: "wf_prog wf_md P"
  and pre: "preallocated h"
  and type: "typeof\<^bsub>h\<^esub> v1 = \<lfloor>T1\<rfloor>" "typeof\<^bsub>h\<^esub> v2 = \<lfloor>T2\<rfloor>" "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
  shows "binop bop v1 v2 = \<lfloor>Inl v\<rfloor> \<Longrightarrow> P,h \<turnstile> v :\<le> T"
  and "binop bop v1 v2 = \<lfloor>Inr a\<rfloor> \<Longrightarrow> P,h \<turnstile> Addr a :\<le> Class Throwable"
using type
apply(case_tac [!] bop)
apply(auto split: split_if_asm simp add: conf_def wf_preallocatedD[OF wf pre])
done

lemma binop_relevant_class:
  assumes wf: "wf_prog wf_md P"
  and pre: "preallocated h"
  and bop: "binop bop v1 v2 = \<lfloor>Inr a\<rfloor>"
  and sup: "P \<turnstile> cname_of h a \<preceq>\<^sup>* C"
  shows "binop_relevant_class bop P C"
using assms
by(cases bop)(auto split: split_if_asm)

end

lemma WTrt_binop_fun: "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T' \<rbrakk> \<Longrightarrow> T = T'"
by(cases bop)(auto)

lemma WTrt_binop_THE [simp]: "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T \<Longrightarrow> The (WTrt_binop P T1 bop T2) = T"
by(auto dest: WTrt_binop_fun)

lemma WTrt_binop_widen_mono:
  "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; P \<turnstile> T1' \<le> T1; P \<turnstile> T2' \<le> T2 \<rbrakk> \<Longrightarrow> \<exists>T'. P \<turnstile> T1'\<guillemotleft>bop\<guillemotright>T2' : T' \<and> P \<turnstile> T' \<le> T"
by(cases bop)(auto elim!: WTrt_binop_cases)

lemma WTrt_binop_is_type:
  "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T"
by(cases bop) auto

subsection {* Code generator setup *}

lemmas [code] =
  heap_base.binop_Div.simps
  heap_base.binop_Mod.simps
  heap_base.binop.simps

code_pred
  (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
  WT_binop
.

code_pred
  (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
  WTrt_binop
.

lemma eval_WTrt_binop_i_i_i_i_o:
  "Predicate.eval (WTrt_binop_i_i_i_i_o P T1 bop T2) T \<longleftrightarrow> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
by(auto elim: WTrt_binop_i_i_i_i_oE intro: WTrt_binop_i_i_i_i_oI)

lemma the_WTrt_binop_code:
  "(THE T. P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T) = Predicate.the (WTrt_binop_i_i_i_i_o P T1 bop T2)"
by(simp add: Predicate.the_def eval_WTrt_binop_i_i_i_i_o)

end


section \<open>CSP processes\<close>

theory CSP_Processes
imports Reactive_Processes
begin

text \<open>A CSP process is a UTP reactive process that satisfies two additional
healthiness conditions called $CSP1$ and $CSP2$. A reactive process that satisfies
$CSP1$ and $CSP2$ is said to be CSP healthy.\<close>

subsection \<open>Definitions\<close>

text \<open>We introduce here the definitions of the CSP healthiness conditions.\<close>

definition CSP1::"(('\<theta>,'\<sigma>) alphabet_rp) Healthiness_condition"
where "CSP1 (P)  \<equiv>  P \<or> (\<lambda>(A, A'). \<not>ok A \<and> tr A \<le> tr A')"

definition J_csp
where "J_csp  \<equiv>  \<lambda>(A, A'). (ok A \<longrightarrow> ok A') \<and> tr A = tr A' \<and> wait A = wait A'
                                                     \<and> ref A = ref A' \<and> more A = more A'"

definition CSP2::"(('\<theta>,'\<sigma>) alphabet_rp) Healthiness_condition"
where "CSP2 (P)  \<equiv>  P ;; J_csp"

definition is_CSP_process::"('\<theta>,'\<sigma>) relation_rp \<Rightarrow> bool" where
"is_CSP_process P \<equiv> P is CSP1 healthy \<and> P is CSP2 healthy \<and> P is R healthy"

lemmas csp_defs = CSP1_def J_csp_def CSP2_def is_CSP_process_def

lemma is_CSP_processE1 [elim?]:
  assumes "is_CSP_process P"
  obtains "P is CSP1 healthy" "P is CSP2 healthy" "P is R healthy"
  using assms unfolding is_CSP_process_def by simp

lemma is_CSP_processE2 [elim?]:
  assumes "is_CSP_process P"
  obtains "CSP1 P = P" "CSP2 P = P" "R P = P"
  using assms unfolding is_CSP_process_def by (simp add: Healthy_def')

subsection \<open>Proofs\<close>

text \<open>Theorems and lemmas relative to CSP processes are introduced here.\<close>

lemma CSP1_CSP2_commute: "CSP1 o CSP2 = CSP2 o CSP1"
by (auto simp: csp_defs fun_eq_iff)

lemma CSP2_is_H2: "H2 = CSP2"
apply (clarsimp simp add: csp_defs design_defs rp_defs fun_eq_iff)
apply (rule iffI)
apply (erule_tac [!] comp_elim)
apply (rule_tac [!] b=ba in comp_intro)
apply (auto elim!: alpha_d_more_eqE intro!: alpha_d_more_eqI)
done

lemma H2_CSP1_commute: "H2 o CSP1 = CSP1 o H2"
apply (subst CSP2_is_H2[simplified Healthy_def])+
apply (rule CSP1_CSP2_commute[symmetric])
done

lemma H2_CSP1_commute2: "H2 (CSP1 P) = CSP1 (H2 P)"
by (simp add: H2_CSP1_commute[simplified Fun.comp_def fun_eq_iff, rule_format] fun_eq_iff)

lemma CSP2_R_commute:
  "CSP2 (R P) = R (CSP2 P)"
apply (subst CSP2_is_H2[symmetric])+
apply (rule R_H2_commute2[symmetric])
done

lemma CSP1_idem: "CSP1 = CSP1 o CSP1"
by (auto simp: csp_defs fun_eq_iff)

lemma CSP2_idem: "CSP2 = CSP2 o CSP2"
by (auto simp: csp_defs fun_eq_iff)

lemma CSP_is_CSP1:
  assumes A: "is_CSP_process P"
  shows "P is CSP1 healthy"
using A by (auto simp: is_CSP_process_def design_defs)

lemma CSP_is_CSP2:
  assumes A: "is_CSP_process P"
  shows "P is CSP2 healthy"
using A by (simp add: design_defs prefix_def is_CSP_process_def)

lemma CSP_is_R:
  assumes A: "is_CSP_process P"
  shows "P is R healthy"
using A by (simp add: design_defs prefix_def is_CSP_process_def)

lemma CSP2_ok_a:
"(CSP2 P)(a, b\<lparr>ok:=True\<rparr>) \<Longrightarrow> (P(a, b\<lparr>ok:=True\<rparr>) \<or> P(a, b\<lparr>ok:=False\<rparr>))"
apply (clarsimp simp: csp_defs design_defs rp_defs split: cond_splits elim: prefixE)
apply (case_tac "ok ba")
apply (rule_tac t="b\<lparr>ok := True\<rparr>" and s="ba" in ssubst, simp_all)
apply (drule_tac b="b\<lparr>ok := False\<rparr>" and a="ba" in back_subst)
apply (auto intro: alpha_rp.equality)
done

lemma CSP2_ok_b:
"(P(a, b\<lparr>ok:=True\<rparr>) \<or> P(a, b\<lparr>ok:=False\<rparr>)) \<Longrightarrow> (CSP2 P)(a, b\<lparr>ok:=True\<rparr>)"
by (auto simp: csp_defs design_defs rp_defs)

lemma CSP2_ok:
"(CSP2 P)(a, b\<lparr>ok:=True\<rparr>) = (P(a, b\<lparr>ok:=True\<rparr>) \<or> P(a, b\<lparr>ok:=False\<rparr>))"
apply (rule iffI)
apply (simp add: CSP2_ok_a)
by (simp add: CSP2_ok_b)

lemma CSP2_notok_a: "(CSP2 P)(a, b\<lparr>ok:=False\<rparr>) \<Longrightarrow> P(a, b\<lparr>ok:=False\<rparr>)"
apply (clarsimp simp: csp_defs design_defs rp_defs)
apply (case_tac "ok ba")
apply (rule_tac t="b\<lparr>ok := True\<rparr>" and s="ba" in ssubst, simp_all)
apply (drule_tac b="b\<lparr>ok := False\<rparr>" and a="ba" in back_subst)
apply (auto intro: alpha_rp.equality)
done

lemma CSP2_notok_b: "P(a, b\<lparr>ok:=False\<rparr>) \<Longrightarrow> (CSP2 P)(a, b\<lparr>ok:=False\<rparr>)"
by (auto simp: csp_defs design_defs rp_defs)

lemma CSP2_notok: "(CSP2 P)(a, b\<lparr>ok:=False\<rparr>) = P(a, b\<lparr>ok:=False\<rparr>)"
apply (rule iffI)
apply (simp add: CSP2_notok_a)
by (simp add: CSP2_notok_b)

lemma CSP2_t_f:
  assumes A:"(CSP2 (R (r \<turnstile> p)))(a, b)"
  and B: "((CSP2 (R (r \<turnstile> p)))(a, b\<lparr>ok:=False\<rparr>)) \<or>
          ((CSP2 (R (r \<turnstile> p)))(a, b\<lparr>ok:=True\<rparr>)) \<Longrightarrow> Q"
  shows "Q"
apply (rule B)
apply (rule disjI2)
apply (insert A)
apply (auto simp add: csp_defs design_defs rp_defs)
done

lemma disj_CSP1:
  assumes "P is CSP1 healthy"
    and "Q is CSP1 healthy"
  shows "(P \<or> Q) is CSP1 healthy"
using assms by (auto simp: csp_defs design_defs rp_defs fun_eq_iff)

lemma disj_CSP2:
  "P is CSP2 healthy ==> Q is CSP2 healthy ==> (P \<or> Q) is CSP2 healthy"
  by (simp add: CSP2_is_H2[symmetric] Healthy_def' design_defs comp_ndet_l_distr)

lemma disj_CSP:
  assumes A: "is_CSP_process P"
  assumes B: "is_CSP_process Q"
  shows "is_CSP_process (P \<or> Q)"
apply (simp add: is_CSP_process_def Healthy_def)
apply (subst disj_CSP2[simplified Healthy_def, symmetric])
apply (rule A[THEN CSP_is_CSP2, simplified Healthy_def])
apply (rule B[THEN CSP_is_CSP2, simplified Healthy_def], simp)
apply (subst disj_CSP1[simplified Healthy_def, symmetric])
apply (rule A[THEN CSP_is_CSP1, simplified Healthy_def])
apply (rule B[THEN CSP_is_CSP1, simplified Healthy_def], simp)
apply (subst R_disj[simplified Healthy_def])
apply (rule A[THEN CSP_is_R, simplified Healthy_def])
apply (rule B[THEN CSP_is_R, simplified Healthy_def], simp)
done

lemma seq_CSP1:
  assumes A: "P is CSP1 healthy"
  assumes B: "Q is CSP1 healthy"
  shows "(P ;; Q) is CSP1 healthy"
using A B by (auto simp: csp_defs design_defs rp_defs fun_eq_iff)

lemma seq_CSP2:
  assumes A: "Q is CSP2 healthy"
  shows "(P ;; Q) is CSP2 healthy"
using A
by (auto simp: CSP2_is_H2[symmetric] H2_J[symmetric])

lemma seq_R:
  assumes "P is R healthy"
  and "Q is R healthy"
  shows "(P ;; Q) is R healthy"
proof -
  have "R P = P" and "R Q = Q"
    using assms by (simp_all only: Healthy_def)
  moreover
  have "(R P ;; R Q) is R healthy"
    apply (auto simp add: design_defs rp_defs prefix_def fun_eq_iff split: cond_splits)
           apply (rule_tac b=a in comp_intro, auto split: cond_splits)
       apply (rule_tac x="zs" in exI, auto split: cond_splits)
      apply (rule_tac b="ba\<lparr>tr := tr a @ tr ba\<rparr>" in comp_intro, auto split: cond_splits)+
    done
  ultimately show ?thesis by simp
qed

lemma seq_CSP:
  assumes A: "P is CSP1 healthy"
  and B: "P is R healthy"
  and C: "is_CSP_process Q"
  shows "is_CSP_process (P ;; Q)"
apply (auto simp add: is_CSP_process_def)
apply (subst seq_CSP1[simplified Healthy_def])
apply (rule A[simplified Healthy_def])
apply (rule CSP_is_CSP1[OF C, simplified Healthy_def])
apply (simp add: Healthy_def, subst CSP1_idem, auto)
apply (subst seq_CSP2[simplified Healthy_def])
apply (rule CSP_is_CSP2[OF C, simplified Healthy_def])
apply (simp add: Healthy_def, subst CSP2_idem, auto)
apply (subst seq_R[simplified Healthy_def])
apply (rule B[simplified Healthy_def])
apply (rule CSP_is_R[OF C, simplified Healthy_def])
apply (simp add: Healthy_def, subst R_idem2, auto)
done

lemma rd_ind_wait: "(R(\<not>(P \<^sup>f\<^sub>f) \<turnstile> (P \<^sup>t\<^sub>f)))
                        = (R((\<not>(\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
                                  \<turnstile> (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>))))"
apply (auto simp: design_defs rp_defs fun_eq_iff split: cond_splits)
apply (subgoal_tac "a\<lparr>tr := [], wait := False\<rparr> = a\<lparr>tr := []\<rparr>", auto)
apply (subgoal_tac "a\<lparr>tr := [], wait := False\<rparr> = a\<lparr>tr := []\<rparr>", auto)
apply (subgoal_tac "a\<lparr>tr := [], wait := False\<rparr> = a\<lparr>tr := []\<rparr>", auto)
apply (subgoal_tac "a\<lparr>tr := [], wait := False\<rparr> = a\<lparr>tr := []\<rparr>", auto)
apply (subgoal_tac "a\<lparr>tr := [], wait := False\<rparr> = a\<lparr>tr := []\<rparr>", auto)
apply (rule_tac t="a\<lparr>tr := [], wait := False\<rparr>" and s="a\<lparr>tr := []\<rparr>" in subst, simp_all)
done

lemma rd_H1: "(R((\<not>(\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
                              \<turnstile> (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>)))) =
                      (R ((\<not> H1 (\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
                              \<turnstile> H1 (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>))))"
by (auto simp: design_defs rp_defs fun_eq_iff split: cond_splits)

lemma rd_H1_H2: "(R((\<not> H1 (\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
                                  \<turnstile> H1 (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>)))) =
                        (R((\<not>(H1 o H2) (\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
                                  \<turnstile> (H1 o H2) (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>))))"
apply (auto simp: design_defs rp_defs prefix_def fun_eq_iff split: cond_splits elim: alpha_d_more_eqE)
apply (subgoal_tac "b\<lparr>tr := zs, ok := False\<rparr> = ba\<lparr>ok := False\<rparr>", auto intro: alpha_d.equality)
apply (subgoal_tac "b\<lparr>tr := zs, ok := False\<rparr> = ba\<lparr>ok := False\<rparr>", auto intro: alpha_d.equality)
apply (subgoal_tac "b\<lparr>tr := zs, ok := False\<rparr> = ba\<lparr>ok := False\<rparr>", auto intro: alpha_d.equality)
apply (subgoal_tac "b\<lparr>tr := zs, ok := True\<rparr> = ba\<lparr>ok := True\<rparr>", auto intro: alpha_d.equality)
apply (subgoal_tac "b\<lparr>tr := zs, ok := True\<rparr> = ba\<lparr>ok := True\<rparr>", auto intro: alpha_d.equality)
done

lemma rd_H1_H2_R_H1_H2:
   "(R ((\<not> (H1 o H2) (\<lambda> (A, A'). P (A, A'\<lparr>ok := False\<rparr>)))
            \<turnstile> (H1 o H2) (\<lambda> (A, A'). P (A, A'\<lparr>ok := True\<rparr>)))) =
    (R o H1 o H2) P"
apply (auto simp: design_defs rp_defs fun_eq_iff split: cond_splits)
apply (erule notE) back back
apply (rule_tac b="ba" in comp_intro, auto)
apply (rule_tac t="ba\<lparr>ok := False\<rparr>" and s=ba in subst, auto intro: alpha_d.equality)
apply (erule notE) back back
apply (rule_tac b="ba" in comp_intro, auto)
apply (rule_tac t="ba\<lparr>ok := False\<rparr>" and s=ba in subst, auto intro: alpha_d.equality)
apply (case_tac "ok ba")
apply (rule_tac b="ba" in comp_intro, auto)
apply (rule_tac t="ba\<lparr>ok := True\<rparr>" and s=ba in subst, auto)
apply (erule notE) back
apply (rule_tac b="ba" in comp_intro, auto)
apply (rule_tac t="ba\<lparr>ok := False\<rparr>" and s=ba in subst, auto intro: alpha_d.equality)
done

lemma CSP1_is_R1_H1:
  assumes "P is R1 healthy"
  shows "CSP1 P = R1 (H1 P)"
using assms
by (auto simp: csp_defs design_defs rp_defs fun_eq_iff split: cond_splits)

lemma CSP1_is_R1_H1_2: "CSP1 (R1 P) = R1 (H1 P)"
by (auto simp: csp_defs design_defs rp_defs fun_eq_iff split: cond_splits)

lemma CSP1_R1_commute: "CSP1 o R1 = R1 o CSP1"
by (auto simp: csp_defs design_defs rp_defs fun_eq_iff split: cond_splits)

lemma CSP1_R1_commute2: "CSP1 (R1 P) = R1 (CSP1 P)"
by (auto simp: csp_defs design_defs rp_defs fun_eq_iff split: cond_splits)

lemma CSP1_join:
  assumes A: "x is CSP1 healthy"
  and B: "y is CSP1 healthy"
  shows "(x \<sqinter> y) is CSP1 healthy"
  using A B
  by (simp add: Healthy_def CSP1_def fun_eq_iff utp_defs)

lemma CSP2_join:
  assumes A: "x is CSP2 healthy"
  and B: "y is CSP2 healthy"
  shows "(x \<sqinter> y) is CSP2 healthy"
  using A B
  apply (simp add: design_defs csp_defs fun_eq_iff)
  apply (rule allI)
  apply (rule allI)
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="b" in allE)+
  by (auto)

lemma CSP1_meet:
  assumes A: "x is CSP1 healthy"
  and B: "y is CSP1 healthy"
  shows "(x \<squnion> y) is CSP1 healthy"
  using A B
  apply (simp add: Healthy_def CSP1_def fun_eq_iff utp_defs)
  apply (rule allI)
  apply (rule allI)
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="b" in allE)+
  by (auto)

lemma CSP2_meet:
  assumes A: "x is CSP2 healthy"
  and B: "y is CSP2 healthy"
  shows "(x \<squnion> y) is CSP2 healthy"
  using A B
  apply (simp add: Healthy_def CSP2_def fun_eq_iff)
  apply (rule allI)+
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="a" in allE)
  apply (erule_tac x="b" in allE)+
  apply (auto)
  apply (rule_tac b="ca" in comp_intro)
  apply (auto simp: J_csp_def)
done

lemma CSP_join:
  assumes A: "is_CSP_process x"
  and B: "is_CSP_process y"
  shows "is_CSP_process (x \<sqinter> y)"
  using A B
by (simp add: is_CSP_process_def CSP1_join CSP2_join R_join)

lemma CSP_meet:
  assumes A: "is_CSP_process x"
  and B: "is_CSP_process y"
  shows "is_CSP_process (x \<squnion> y)"
  using A B
by (simp add: is_CSP_process_def CSP1_meet CSP2_meet R_meet)

subsection \<open>CSP processes and reactive designs\<close>

text \<open>In this section, we prove the relation between CSP processes and reactive designs.\<close>

lemma rd_is_CSP1: "(R (r \<turnstile> p)) is CSP1 healthy"
by (auto simp: csp_defs design_defs rp_defs fun_eq_iff split: cond_splits elim: prefixE)

lemma rd_is_CSP2:
  assumes A: "\<forall> a b. r (a, b\<lparr>ok := True\<rparr>) \<longrightarrow> r (a, b\<lparr>ok := False\<rparr>)"
  shows "(R (r \<turnstile> p)) is CSP2 healthy"
apply (subst CSP2_is_H2[symmetric])
apply (simp add: Healthy_def)
apply (subst R_H2_commute2[symmetric])
apply (subst design_H2[simplified Healthy_def], auto simp: A)
done

lemma rd_is_CSP:
  assumes A: "\<forall> a b. r (a, b\<lparr>ok := True\<rparr>) \<longrightarrow> r (a, b\<lparr>ok := False\<rparr>)"
  shows "is_CSP_process (R (r \<turnstile> p))"
apply (simp add: is_CSP_process_def Healthy_def fun_eq_iff)
apply (subst R_idem2)
apply (subst rd_is_CSP2[simplified Healthy_def, symmetric], rule A)
apply (subst rd_is_CSP1[simplified Healthy_def, symmetric], simp)
done

lemma CSP_is_rd:
  assumes A: "is_CSP_process P"
  shows "P = (R (\<not>(P \<^sup>f\<^sub>f) \<turnstile> (P \<^sup>t\<^sub>f)))"
  apply (subst rd_ind_wait)
  apply (subst rd_H1)
  apply (subst rd_H1_H2)
  apply (subst rd_H1_H2_R_H1_H2)
  apply (subst R_abs_R1[symmetric])
  apply (subst CSP1_is_R1_H1_b)
  apply (subst CSP2_is_H2)
  apply (simp)
  apply (subst CSP_is_CSP2[OF A, simplified Healthy_def, symmetric])
  apply (subst CSP_is_CSP1[OF A, simplified Healthy_def, symmetric])
  apply (subst CSP_is_R[OF A, simplified Healthy_def, symmetric], simp)
done

end