theory Wasm_Module_Checker imports Wasm_Module Wasm_Checker_Properties begin

code_pred (modes: i \<Rightarrow> i \<Rightarrow> bool as limit_type_checker_p) limit_typing .

fun module_func_type_checker :: "t_context \<Rightarrow> module_func \<Rightarrow> bool" where
"module_func_type_checker \<C> (i, t_locs, b_es) =
  ((i < length (types_t \<C>)) \<and>
     (case (types_t \<C>)!i of
       (tn _> tm) \<Rightarrow>
         b_e_type_checker (\<C>\<lparr>local := tn @ t_locs, label := ([tm] @ (label \<C>)), return := Some tm\<rparr>) b_es ([] _> tm)))"

lemma module_func_typing_equiv_module_func_type_checker:
  "module_func_typing \<C> m_f tf = (module_func_type_checker \<C> m_f \<and>
                                   ((types_t \<C>)!(fst m_f) = tf))"
  apply (cases m_f)
  apply (auto simp add: module_func_typing.simps b_e_typing_equiv_b_e_type_checker split: tf.splits)
  done

abbreviation "module_tab_type_checker \<equiv> module_tab_typing"
abbreviation "module_mem_type_checker \<equiv> module_mem_typing"

fun module_glob_type_checker :: "t_context \<Rightarrow> module_glob \<Rightarrow> bool" where
  "module_glob_type_checker \<C> \<lparr>g_type=tg, g_init=es\<rparr> =
     (const_exprs \<C> es \<and> b_e_type_checker \<C> es ([] _> [tg_t tg]))"

lemma module_glob_typing_equiv_module_glob_type_checker:
  "module_glob_typing \<C> m_g tg = (module_glob_type_checker \<C> m_g \<and>
                                   (module_glob.g_type m_g) = tg)"
  apply (cases m_g)
  apply (auto simp add: module_glob_typing.simps b_e_typing_equiv_b_e_type_checker)
  done

fun module_elem_type_checker :: "t_context \<Rightarrow> module_elem \<Rightarrow> bool" where
  "module_elem_type_checker \<C> \<lparr>e_tab=t, e_off=es, e_init=is\<rparr> =
     (const_exprs \<C> es \<and> b_e_type_checker \<C> es ([] _> [T_i32]) \<and> t < length (table \<C>) \<and> list_all (\<lambda>i. i < length (func_t \<C>)) is)"

lemma module_elem_typing_equiv_module_elem_type_checker:
  "module_elem_typing \<C> m_e = module_elem_type_checker \<C> m_e"
  apply (cases m_e)
  apply (auto simp add: module_elem_typing.simps b_e_typing_equiv_b_e_type_checker)
  done

fun module_data_type_checker :: "t_context \<Rightarrow> module_data \<Rightarrow> bool" where
  "module_data_type_checker \<C> \<lparr>d_data=d, d_off=es, d_init=bs\<rparr> =
     (const_exprs \<C> es \<and> b_e_type_checker \<C> es ([] _> [T_i32]) \<and> d < length (memory \<C>))"

lemma module_data_typing_equiv_module_data_type_checker:
  "module_data_typing \<C> m_e = module_data_type_checker \<C> m_e"
  apply (cases m_e)
  apply (auto simp add: module_data_typing.simps b_e_typing_equiv_b_e_type_checker)
  done

code_pred (modes: i \<Rightarrow> i \<Rightarrow> bool as module_start_type_checker_p) module_start_typing .

abbreviation "module_start_type_checker \<equiv> module_start_typing"

fun module_import_typer :: "tf list \<Rightarrow> imp_desc \<Rightarrow> extern_t option" where
  "module_import_typer tfs (Imp_func i) = (if i < length tfs then Some (Te_func (tfs!i)) else None)"
| "module_import_typer tfs (Imp_tab tt) = (if module_tab_typing tt then Some (Te_tab tt) else None)"
| "module_import_typer tfs (Imp_mem mt) = (if module_mem_typing mt then Some (Te_mem mt) else None)"
| "module_import_typer tfs (Imp_glob gt) =  Some (Te_glob gt)"

lemma module_import_typing_equiv_module_import_typer:
  "(module_import_typing \<C> imp e_t) = (module_import_typer (types_t \<C>) imp = Some e_t)"
  apply (cases imp)
  apply (auto simp add: module_import_typing.simps)
  done

fun module_export_typer :: "t_context \<Rightarrow> exp_desc \<Rightarrow> extern_t option" where
  "module_export_typer \<C> (Ext_func i) = (if i < length (func_t \<C>) then Some (Te_func ((func_t \<C>)!i)) else None)"
| "module_export_typer \<C> (Ext_tab i) = (if i < length (table \<C>) then Some (Te_tab ((table \<C>)!i)) else None)"
| "module_export_typer \<C> (Ext_mem i) = (if i < length (memory \<C>) then Some (Te_mem ((memory \<C>)!i)) else None)"
| "module_export_typer \<C> (Ext_glob i) = (if i < length (global \<C>) then Some (Te_glob ((global \<C>)!i)) else None)"

lemma module_export_typing_equiv_module_export_typer:
  "(module_export_typing \<C> exp e_t) = (module_export_typer \<C> exp = Some e_t)"
  apply (cases exp)
  apply (auto simp add: module_export_typing.simps)
  done

abbreviation "module_imports_typer tfs imps \<equiv> List.those (List.map (\<lambda>imp. module_import_typer tfs (I_desc imp)) imps)"
abbreviation "module_exports_typer \<C> exps \<equiv> List.those (List.map (\<lambda>exp. module_export_typer \<C> (E_desc exp)) exps)"

lemma list_all2_module_imports_typer:
  "list_all2 (\<lambda>imp. module_import_typing \<C> (I_desc imp)) imps impts = (module_imports_typer (types_t \<C>) imps = Some impts)"
proof (induction imps arbitrary:impts)
  case Nil
  thus ?case
    by auto
next
  case (Cons imp imps)
  thus ?case
  proof (cases impts)
    case Nil
    thus ?thesis
      by (simp split: option.splits)
  next
    case (Cons impt impts')
    thus ?thesis
      using module_import_typing_equiv_module_import_typer[of \<C> "(I_desc imp)" impt]
            Cons.IH
      by (auto split: option.splits)
  qed
qed

lemma list_all2_module_exports_typer:
  "list_all2 (\<lambda>exp. module_export_typing \<C> (E_desc exp)) exps expts = (module_exports_typer \<C> exps = Some expts)"
proof (induction exps arbitrary:expts)
  case Nil
  thus ?case
    by auto
next
  case (Cons exp exps)
  thus ?case
  proof (cases expts)
    case Nil
    thus ?thesis
      by (simp split: option.splits)
  next
    case (Cons expt expts')
    thus ?thesis
      using module_export_typing_equiv_module_export_typer[of \<C> "(E_desc exp)" expt]
            Cons.IH
      by (auto split: option.splits)
  qed
qed

definition gather_m_f_type :: "tf list \<Rightarrow> module_func \<Rightarrow> tf option" where
  "gather_m_f_type tfs m_f \<equiv> if (fst m_f < length tfs) then Some (tfs!(fst m_f)) else None"

abbreviation gather_m_f_types :: "tf list \<Rightarrow> module_func list \<Rightarrow> (tf list) option" where
  "gather_m_f_types tfs m_fs \<equiv> List.those (List.map (gather_m_f_type tfs) m_fs)"

lemma module_func_typing_imp_gather_m_f_type:
  assumes "module_func_typing \<C> fs ft"
  shows "gather_m_f_type (types_t \<C>) fs = Some ft"
  using assms
  unfolding module_func_typing.simps gather_m_f_type_def
  by (auto split: if_splits)

lemma module_func_typing_imp_gather_m_f_types:
  assumes "list_all2 (module_func_typing \<C>) fs fts"
  shows "gather_m_f_types (types_t \<C>) fs = Some fts"
  using assms
proof (induction fs arbitrary: fts)
  case Nil
  thus ?case
    by auto
next
  case (Cons a fs)
  thus ?case
    using module_func_typing_imp_gather_m_f_type
    unfolding list_all2_Cons1
    by fastforce
qed

lemma gather_m_f_types_length:
  assumes "gather_m_f_types (types_t \<C>) fs = Some fts"
  shows "length fs = length fts"
  using assms
proof (induction fs arbitrary: fts)
case Nil
  thus ?case
    by simp
next
  case (Cons a fs)
  thus ?case
    by (auto split: option.splits)
qed

lemma gather_m_f_type_imp_module_func_typing:
  assumes "gather_m_f_type (types_t \<C>) f = Some ft"
          "module_func_type_checker \<C> f"
  shows "module_func_typing \<C> f ft"
  using assms
  unfolding gather_m_f_type_def
  by (simp add: module_func_typing_equiv_module_func_type_checker split: if_splits)

lemma gather_m_f_types_imp_module_func_typing:
  assumes "gather_m_f_types (types_t \<C>) fs = Some fts"
          "list_all (module_func_type_checker \<C>) fs"
  shows "list_all2 (module_func_typing \<C>) fs fts"
  using assms
proof (induction fs arbitrary: fts)
  case Nil
  thus ?case
    by simp
next
  case (Cons f fs')
  note outer_Cons = Cons
  show ?case
  proof (cases fts)
    case Nil
    thus ?thesis
      using Cons(2)
      by (simp split: option.splits)
  next
    case (Cons ft fts')
    thus ?thesis
      using outer_Cons gather_m_f_type_imp_module_func_typing
      by (auto split: option.splits)
  qed
qed

abbreviation gather_m_g_types :: "module_glob list \<Rightarrow> tg list" where
  "gather_m_g_types \<equiv> map module_glob.g_type"

fun module_type_checker :: "m \<Rightarrow> (extern_t list \<times> extern_t list) option" where
  "module_type_checker \<lparr>m_types = tfs,
                        m_funcs = fs,
                        m_tabs = ts,
                        m_mems = ms,
                        m_globs = gs,
                        m_elem = els,
                        m_data = ds,
                        m_start = i_opt,
                        m_imports = imps,
                        m_exports = exps\<rparr> =
  (case (gather_m_f_types tfs fs, module_imports_typer tfs imps) of
     (Some fts, Some impts) \<Rightarrow>
       let ifts = ext_t_funcs impts in
       let its = ext_t_tabs impts in
       let ims = ext_t_mems impts in
       let igs = ext_t_globs impts in
       let gts = gather_m_g_types gs in
       let \<C> = \<lparr>types_t=tfs, func_t=ifts@fts, global=igs@gts, table=its@ts, memory=ims@ms, local=[], label=[], return=None\<rparr> in
       let \<C>' = \<lparr>types_t=[], func_t=[], global=igs, table=[], memory=[], local=[], label=[], return=None\<rparr> in
       if (list_all (\<lambda>tf. case tf of (tn _> tm) \<Rightarrow> length tm \<le> 1) tfs \<and> \<comment> \<open>\<open>MVP restriction\<close>\<close>
           list_all (module_func_type_checker \<C>) fs \<and>
           list_all (module_tab_type_checker) ts \<and>
           list_all (module_mem_type_checker) ms \<and>
           list_all (module_glob_type_checker \<C>') gs \<and>
           list_all (module_elem_type_checker \<C>) els \<and>
           list_all (module_data_type_checker \<C>) ds \<and>
           pred_option (module_start_type_checker \<C>) i_opt \<and>
           module_exports_distinct exps \<and>
         length (its@ts) \<le> 1 \<and> \<comment> \<open>\<open>MVP restriction\<close>\<close>
         length (ims@ms) \<le> 1   \<comment> \<open>\<open>MVP restriction\<close>\<close>) then
         case (module_exports_typer \<C> exps) of
           Some expts \<Rightarrow> Some (impts, expts)
         | _ \<Rightarrow> None
       else None
     | _ \<Rightarrow> None
  )"

lemma module_typing_imp_module_type_checker:
  assumes "module_typing m impts expts"
  shows "module_type_checker m = Some (impts, expts)"
proof -
  obtain tfs fs ts ms gs els ds i_opt imps exps where m_def:
    "m =\<lparr>m_types = tfs,
         m_funcs = fs,
         m_tabs = ts,
         m_mems = ms,
         m_globs = gs,
         m_elem = els,
         m_data = ds,
         m_start = i_opt,
         m_imports = imps,
         m_exports = exps\<rparr>"
    using module_type_checker.cases
    by blast
  obtain \<C> \<C>' fts gts ifts its ims igs where module_typing_is:
    "list_all (\<lambda>tf. case tf of (tn _> tm) \<Rightarrow> length tm \<le> 1) tfs"
    "list_all2 (module_func_typing \<C>) fs fts"
    "list_all (module_tab_typing) ts"
    "list_all (module_mem_typing) ms"
    "list_all2 (module_glob_typing \<C>') gs gts"
    "list_all (module_elem_typing \<C>) els"
    "list_all (module_data_typing \<C>) ds"
    "pred_option (module_start_typing \<C>) i_opt"
    "list_all2 (\<lambda>imp. module_import_typing \<C> (I_desc imp)) imps impts"
    "list_all2 (\<lambda>exp. module_export_typing \<C> (E_desc exp)) exps expts"
    "ifts = ext_t_funcs impts"
    "its = ext_t_tabs impts"
    "ims = ext_t_mems impts"
    "igs = ext_t_globs impts"
    "module_exports_distinct exps"
    "length (its@ts) \<le> 1"
    "length (ims@ms) \<le> 1"
    "\<C> = \<lparr>types_t=tfs, func_t=ifts@fts, global=igs@gts, table=its@ts, memory=ims@ms, local=[], label=[], return=None\<rparr>"
    "\<C>' = \<lparr>types_t=[], func_t=[], global=igs, table=[], memory=[], local=[], label=[], return=None\<rparr>"
    using assms
    unfolding m_def
    apply (simp only: module_typing.simps)
    apply blast
    done

  have "gather_m_f_types tfs fs = Some fts"
    using module_typing_is(2,18) module_func_typing_imp_gather_m_f_types
    by fastforce
  moreover
  have "gather_m_g_types gs = gts"
    using module_typing_is(5)
    unfolding list_all2_conv_all_nth module_glob_typing.simps
    by (metis length_map module_glob.select_convs(1) nth_equalityI nth_map)
  moreover
  have "module_imports_typer tfs imps = Some impts"
    using module_typing_is(9)
    by (simp add: list_all2_module_imports_typer module_typing_is(18))
  moreover
  have "module_exports_typer \<C> exps = Some expts"
    using module_typing_is(10)
    by (simp add: list_all2_module_exports_typer)
  moreover
  have "list_all (module_func_type_checker \<C>) fs"
       "list_all (module_tab_type_checker) ts"
       "list_all (module_mem_type_checker) ms"
       "list_all (module_glob_type_checker \<C>') gs"
       "list_all (module_elem_type_checker \<C>) els"
       "list_all (module_data_type_checker \<C>) ds"
       "pred_option (module_start_type_checker \<C>) i_opt"
       "module_exports_distinct exps"
    using module_typing_is(2-8,15)
          module_func_typing_equiv_module_func_type_checker
          module_glob_typing_equiv_module_glob_type_checker
          module_elem_typing_equiv_module_elem_type_checker
          module_data_typing_equiv_module_data_type_checker
    by (simp_all add: list_all2_conv_all_nth list_all_length)
  ultimately
  show ?thesis
    using module_typing_is
    unfolding m_def
    by simp
qed

lemma module_type_checker_imp_module_typing:
  assumes "module_type_checker m = Some (impts, expts)"
  shows "module_typing m impts expts"
proof -
  obtain tfs fs ts ms gs els ds i_opt imps exps where m_def:
    "m =\<lparr>m_types = tfs,
         m_funcs = fs,
         m_tabs = ts,
         m_mems = ms,
         m_globs = gs,
         m_elem = els,
         m_data = ds,
         m_start = i_opt,
         m_imports = imps,
         m_exports = exps\<rparr>"
    using module_type_checker.cases
    by blast
  obtain fts ifts its ims igs gts \<C> \<C>' where module_type_checker_is:
    "gather_m_f_types tfs fs = Some fts"
    "module_imports_typer tfs imps = Some impts"
    "ifts = ext_t_funcs impts"
    "its = ext_t_tabs impts"
    "ims = ext_t_mems impts"
    "igs = ext_t_globs impts"
    "gts = gather_m_g_types gs"
    "\<C> = \<lparr>types_t=tfs, func_t=ifts@fts, global=igs@gts, table=its@ts, memory=ims@ms, local=[], label=[], return=None\<rparr>"
    "\<C>' = \<lparr>types_t=[], func_t=[], global=igs, table=[], memory=[], local=[], label=[], return=None\<rparr>"
    "list_all (\<lambda>tf. case tf of (tn _> tm) \<Rightarrow> length tm \<le> 1) tfs"
    "list_all (module_func_type_checker \<C>) fs"
    "list_all (module_tab_type_checker) ts"
    "list_all (module_mem_type_checker) ms"
    "list_all (module_glob_type_checker \<C>') gs"
    "list_all (module_elem_type_checker \<C>) els"
    "list_all (module_data_type_checker \<C>) ds"
    "pred_option (module_start_type_checker \<C>) i_opt"
    "module_exports_distinct exps"
    "length (its@ts) \<le> 1"
    "length (ims@ms) \<le> 1"
    "module_exports_typer \<C> exps = Some expts"
    using assms m_def
    by (simp add: Let_def split: option.splits if_splits)
  have "list_all2 (module_func_typing \<C>) fs fts"
    using gather_m_f_types_imp_module_func_typing
          module_type_checker_is(1,8,11)
    by fastforce
  moreover
  have "list_all (module_tab_typing) ts"
       "list_all (module_mem_typing) ms"
       "list_all2 (module_glob_typing \<C>') gs gts"
       "list_all (module_elem_typing \<C>) els"
       "list_all (module_data_typing \<C>) ds"
       "pred_option (module_start_typing \<C>) i_opt"
    using module_type_checker_is
          module_glob_typing_equiv_module_glob_type_checker
          module_elem_typing_equiv_module_elem_type_checker
          module_data_typing_equiv_module_data_type_checker
    by (simp_all add: list_all2_conv_all_nth list_all_length)
  moreover
  have "list_all2 (\<lambda>imp. module_import_typing \<C> (I_desc imp)) imps impts"
    using list_all2_module_imports_typer[symmetric]
          module_type_checker_is(2,8)
    by fastforce
  moreover
  have "list_all2 (\<lambda>exp. module_export_typing \<C> (E_desc exp)) exps expts"
    using list_all2_module_exports_typer[symmetric]
          module_type_checker_is(21,8)
    by fastforce
  ultimately
  show ?thesis
    using m_def module_type_checker_is
    by (fastforce simp add: module_typing.simps)
qed

theorem module_typing_equiv_module_type_checker:
  "module_typing m impts expts = (module_type_checker m = Some (impts, expts))"
  using module_typing_imp_module_type_checker
        module_type_checker_imp_module_typing
  by blast

(*
lemma[code]: "pred_option P None = True"
  by auto
lemmas[code] = option.pred_inject(2)

export_code module_type_checker in OCaml
module_name Example file_prefix "example.ml"
*)
end


theory flash71Rev imports flashPub
begin
section{*Main defintions*}
lemma NI_FAckVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (NI_FAck ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_InvVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Inv  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1VsInv71:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1_HomeVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_InvAck_1_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_2VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_InvAck_2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_GetXVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak1VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak2VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak3VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX1VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX2VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX3VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX4VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX5VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX6VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX7VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX8VsInv71:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX8_homeVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX9VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX10VsInv71:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX10_homeVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX11VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_GetVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak1VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak2VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak3VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put1VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put2VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Put2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put3VsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Local_Get_Put3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_PutVsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (NI_Local_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_PutXAcksDoneVsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (NI_Local_PutXAcksDone ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_NakVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Nak  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Nak_ClearVsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (NI_Nak_Clear ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Nak_HomeVsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (NI_Nak_Home ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Remote_GetX_NakVsInv71:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1  a2  a3 , simp)

        apply(rule_tac x=" (neg ( andForm ( andForm ( eqn ( IVar ( Para ''UniMsg_Cmd'' iRule1) )  ( Const UNI_GetX ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_Put ))  )    ( eqn ( IVar ( Para ''UniMsg_proc'' iRule1) )   (Const iRule2))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Remote_GetX_Nak_HomeVsInv71:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Remote_GetX_PutXVsInv71:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_PutX_HomeVsInv71:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Remote_Get_Nak1VsInv71:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Remote_Get_Nak2VsInv71:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1  a2  a3 , simp)

        apply(rule_tac x=" (neg ( andForm ( andForm ( eqn ( IVar ( Para ''UniMsg_Cmd'' iRule1) )  ( Const UNI_Get ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_Put ))  )    ( eqn ( IVar ( Para ''UniMsg_proc'' iRule1) )   (Const iRule2))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Remote_Get_Put1VsInv71:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_Get_Put1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''NakcMsg_Cmd'') )  ( Const NAKC_Nakc ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_Get ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Remote_Get_Put2VsInv71:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_Put  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutXVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceHomeVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (NI_ReplaceHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceHomeShrVldVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (NI_ReplaceHomeShrVld ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceShrVldVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (NI_ReplaceShrVld  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ShWbVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (NI_ShWb N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_WbVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (NI_Wb ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_GetX1VsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_GetX1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_GetX2VsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_GetX2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_PutX1VsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_PutX1 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_PutX2VsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_PutX2 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_PutX3VsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_PutX3 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_PutX4VsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_GetX_PutX4 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_Get_GetVsInv71:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv71 ) (PI_Local_Get_Get ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_Get_PutVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_Get_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_PutXVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_PutX ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_ReplaceVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (PI_Local_Replace ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Remote_GetVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (PI_Remote_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_GetXVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (PI_Remote_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_PutXVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (PI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_ReplaceVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (PI_Remote_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreVsInv71:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv71 ) (Store  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreHomeVsInv71:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv71 ) (StoreHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

(*
  Example C structure instantiation and related lemmas
*)

theory CompoundCTypesEx
imports CompoundCTypes
begin

record x_struct_ex =
  x_example :: "32 word"
  y_example :: "8 word"

definition x_struct_ex_tag :: "'a x_struct_ex_scheme typ_info" where
  "x_struct_ex_tag \<equiv> (
    final_pad \<circ>
    (ti_typ_pad_combine TYPE(8 word) y_example (y_example_update \<circ> (\<lambda>x _. x)) ''y_example'') \<circ>
    (ti_typ_pad_combine TYPE(32 word) x_example (x_example_update \<circ> (\<lambda>x _. x))  ''x_example''))
    (empty_typ_info ''x_struct_ex'')"

instantiation x_struct_ex_ext :: (type) c_type
begin
instance ..
end

defs (overloaded)
x_struct_ex_typ_tag: "typ_info_t (t::'a x_struct_ex_ext itself) \<equiv>
    (x_struct_ex_tag::'a x_struct_ex_scheme typ_info)"

lemma aggregate_x_struct_ex_tag [simp]:
  "aggregate x_struct_ex_tag"
  by (simp add: x_struct_ex_tag_def final_pad_def Let_def)

lemma
  "upd_local (x_example_update \<circ> (\<lambda>x _. x))"
apply(auto simp: upd_local_def )
apply(tactic {* Record.split_tac 1 *} )
apply simp
done

instantiation x_struct_ex_ext :: (unit_class) mem_type
begin
instance
apply intro_classes

apply(auto simp: x_struct_ex_typ_tag x_struct_ex_tag_def)

(* wf_desc *)
apply(fastforce intro: wf_desc_final_pad wf_desc_ti_typ_pad_combine)

(* wf_size_desc *)
apply(fastforce intro: wf_size_desc_ti_typ_pad_combine wf_size_desc_final_pad)

(* wf_lf *)
apply(fastforce intro: wf_lf_final_pad wf_lf_ti_typ_pad_combine
                      wf_desc_final_pad wf_desc_ti_typ_pad_combine
                      g_ind_ti_typ_pad_combine f_ind_ti_typ_pad_combine
                      fa_ind_ti_typ_pad_combine)

(* fu_eq_mask *)
apply(rule fu_eq_mask)
 apply(simp add: size_of_def  x_struct_ex_typ_tag x_struct_ex_tag_def)
apply(rule fu_eq_mask_final_pad)
apply(rule fu_eq_mask_ti_typ_pad_combine)+
apply(rule fu_eq_mask_empty_typ_info)
apply(simp add: there_is_only_one)
apply(fastforce simp: fg_cons_def intro: fc_ti_typ_pad_combine)+

(* align_of dvd size_of *)
apply(simp add: align_of_def size_of_def x_struct_ex_typ_tag
                x_struct_ex_tag_def)

(* align_field *)
apply(simp add: align_field_final_pad align_field_ti_typ_pad_combine)

(* max_size *)
apply(simp add: size_of_def x_struct_ex_typ_tag x_struct_ex_tag_def
                size_td_lt_final_pad size_td_lt_ti_typ_pad_combine
                size_td_lt_ti_typ_combine size_td_lt_ti_pad_combine padup_def
                addr_card align_of_final_pad align_of_def)
done
end

declare x_struct_ex_typ_tag [simp add]
declare x_struct_ex_tag_def [simp add]

lemma x_struct_ex_fnl [simp]:
  "field_names_list (x_struct_ex_tag::'a x_struct_ex_scheme typ_info) =
      [''x_example'',''y_example''] @
          padding_fields (x_struct_ex_tag::'a x_struct_ex_scheme typ_info)"
apply(clarsimp simp: field_names_list_def)
done

record y_struct_ex =
  x2_example :: "32 word ptr"
(*
  x3_example :: "32 word ptr"
  x4_example :: "32 word ptr"
  x5_example :: "32 word ptr"
  x6_example :: "32 word ptr"
  x7_example :: "32 word ptr"

  x12_example :: "32 word ptr"
  x13_example :: "32 word ptr"
  x14_example :: "32 word ptr"
  x15_example :: "32 word ptr"
  x16_example :: "32 word ptr"
  x17_example :: "32 word ptr"*)
  y2_example :: "x_struct_ex"

definition y_struct_ex_tag :: "'a y_struct_ex_scheme typ_info" where
  "y_struct_ex_tag \<equiv> (
    final_pad \<circ>
    (ti_typ_pad_combine TYPE(x_struct_ex) y2_example (y2_example_update \<circ> (\<lambda>x _. x)) ''y2_example'') \<circ>
    (ti_typ_pad_combine TYPE(32 word ptr) x2_example (x2_example_update \<circ> (\<lambda>x _. x))  ''x2_example'')
    )
    (empty_typ_info ''y_struct_ex'')"

instantiation y_struct_ex_ext :: (type) c_type
begin
instance ..
end

defs (overloaded)
y_struct_ex_typ_tag: "typ_info_t (t::'a y_struct_ex_ext itself) \<equiv>
    (y_struct_ex_tag::'a y_struct_ex_scheme typ_info)"

instantiation y_struct_ex_ext :: (unit_class) mem_type
begin

instance
apply intro_classes

apply(auto simp: y_struct_ex_typ_tag y_struct_ex_tag_def align_of_def size_of_def)

(* wf_desc *)
apply(fastforce intro: wf_desc_final_pad wf_desc_ti_typ_pad_combine)

(* wf_size_desc *)
apply(fastforce intro: wf_size_desc_ti_typ_pad_combine wf_size_desc_final_pad)

(* wf_lf *)
apply(force intro: wf_lf_final_pad wf_lf_ti_typ_pad_combine
                      wf_desc_final_pad wf_desc_ti_typ_pad_combine
                      g_ind_ti_typ_pad_combine f_ind_ti_typ_pad_combine
                      fa_ind_ti_typ_pad_combine)

(* fu_eq_mask *)
apply(rule fu_eq_mask)
 apply(simp add: size_of_def  y_struct_ex_typ_tag y_struct_ex_tag_def)
apply(rule fu_eq_mask_final_pad)
apply(rule fu_eq_mask_ti_typ_pad_combine)+
apply(rule fu_eq_mask_empty_typ_info)
apply(simp add: there_is_only_one)
apply(fastforce simp: fg_cons_def intro: fc_ti_typ_pad_combine)+

(* align_field *)
apply(simp add: align_field_final_pad align_field_ti_typ_pad_combine)

(* max_size *)
apply(simp add: size_td_simps_1)
apply(simp add: size_td_simps_2 addr_card )
done

end

declare y_struct_ex_typ_tag [simp add]
declare y_struct_ex_tag_def [simp add]

lemma y_struct_ex_fnl [simp]:
  "field_names_list (y_struct_ex_tag::'a y_struct_ex_scheme typ_info) =
      [''x2_example'',''y2_example''] @
          padding_fields (y_struct_ex_tag::'a y_struct_ex_scheme typ_info)"
apply(clarsimp simp: field_names_list_def)
done

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory Helpers_SD
imports
  "Lookups_D"
  "../../lib/SimpStrategy"
  "../../lib/LemmaBucket"
  "../../lib/sep_algebra/Map_Extra"
begin

(* Functions we need from capDL, but can't have yet (until we change capDL).
 * Maybe they aren't actually needed for the proof.
 * (If capDL doesn't have them, then we might not need them to prove conformance.)
 *)

consts tcb_priority :: "cdl_tcb \<Rightarrow> word8 \<times> word8"
consts tcb_ip :: "cdl_tcb \<Rightarrow> word32"
consts tcb_sp :: "cdl_tcb \<Rightarrow> word32"
consts opt_vmattribs :: "cdl_object \<Rightarrow> cdl_raw_vmattrs option"

(* We don't need to know anything about this except that it isn't 0. *)
definition tcb_ipc_buffer_address :: "cdl_tcb \<Rightarrow> word32"
where "tcb_ipc_buffer_address tcb = 1"

lemma tcb_ipc_buffer_address_non_zero:
  "tcb_ipc_buffer_address tcb \<noteq> 0"
  by (clarsimp simp: tcb_ipc_buffer_address_def)

(* Helper funtions. These possibly should be moved somewhere else. *)

(***************************************************
 * Generic Isabelle lemmas. Could be moved to lib. *
 ***************************************************)
lemma map_upd_nonempty' [simp]: "empty \<noteq> t(k\<mapsto>x)"
  by (rule not_sym, simp)

lemma insert_unit_set [simp]:
  "insert () A = UNIV"
  by auto

lemma restrict_map_not_empty [simp]:
  "f p = Some v \<Longrightarrow> f |` {p} \<noteq> empty"
  "f p = Some v \<Longrightarrow> empty \<noteq> f |` {p}"
  by (clarsimp simp: restrict_map_def fun_eq_iff split: if_split_asm)+

(* This lets us compose a total and a partial function in the obvious manner. *)
definition
  map_comp' :: "('b \<Rightarrow> 'c) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> 'a \<rightharpoonup> 'c"  (infixl "o'_M" 55) where
  "f o_M g = (\<lambda>k. case g k of None \<Rightarrow> None | Some v \<Rightarrow> Some (f v))"

notation (xsymbols)
  map_comp'  (infixl "\<circ>\<^sub>M" 55)

lemma map_comp'_apply [simp]: "(f \<circ>\<^sub>M g) x = case_option None (\<lambda>x. Some (f x)) (g x)"
  by (clarsimp simp: map_comp'_def)

lemma map_comp'_empty [simp]:
  "m \<circ>\<^sub>M empty = empty"
  by auto

lemma dom_map_comp' [simp]:
  "dom (f \<circ>\<^sub>M m) = dom m"
  by (clarsimp simp: dom_def split: option.splits)

lemma restrict_map_comp' [simp]:
  "f \<circ>\<^sub>M g |` S = (f \<circ>\<^sub>M g) |` S"
  by (rule ext, clarsimp simp: map_comp'_def restrict_map_def)

(**************************
 * Rules about intervals. *
 **************************)

lemma nat_list_not_UNIV [simp]:
  "set (xs::nat list) \<noteq> UNIV"
  by (metis finite'_code(1) Cardinality.finite'_def infinite_UNIV_nat)

(***********************************
 * End of generic Isabelle lemmas. *
 ***********************************)

(*************************************
 * Rules that should go in MapExtra. *
 *************************************)

lemma map_add_self:
  "m ++ m = m"
  by (auto simp add:map_add_def split:option.splits)

(* This lemma is strictly weaker than restrict_map_disj. *)
lemma restrict_map_disj':
  "S \<inter> T = {} \<Longrightarrow> h |` S \<bottom> h' |` T"
  by (auto simp: map_disj_def restrict_map_def dom_def)

lemma map_add_restrict_comm:
  "S \<inter> T = {} \<Longrightarrow> h |` S ++ h' |` T = h' |` T ++ h |` S"
  apply (drule restrict_map_disj')
  apply (erule map_add_com)
  done

lemma restrict_map_not_self_UNIV [simp]:
  "h |` (UNIV - dom h) = empty"
  by (rule ext, clarsimp simp: restrict_map_def)

lemma map_add_emptyE [elim!]:
  "\<lbrakk>a ++ b = empty; \<lbrakk>a = empty; b = empty\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
  by (metis map_add_None)

lemma restrict_map_sub_singleton [simp]:
  "s \<noteq> t \<Longrightarrow> h `- {t} |` {s} = h |` {s}"
  by (rule ext)(clarsimp simp: restrict_map_def sub_restrict_map_def)

lemma restrict_map_sub_add': "h `- S ++ h |` S = h"
  by (fastforce simp: sub_restrict_map_def map_add_def
               split: option.splits)

lemma map_add_restrict_singleton:
  "s \<noteq> t \<Longrightarrow> (m |` {s} ++ m' |` {t}) |` {s} = m |` {s}"
  apply (rule ext)
  apply (clarsimp simp: map_add_def restrict_map_def split: option.splits)
  done

lemma map_add_restrict_singleton':
  "s \<noteq> t \<Longrightarrow> (m |` {s} ++ m' |` {t}) |` {t} = m' |` {t}"
  apply (rule ext)
  apply (clarsimp simp: map_add_def restrict_map_def split: option.splits)
  done

(********************************************
 * End of rules that should go in MapExtra. *
 ********************************************)

(**********************************************************
 * CapDL specific lemmas, that could be moved into capDL. *
 * These have nothing to do with the separation logic.    *
 **********************************************************)

definition
  all_caps :: "cdl_state \<Rightarrow> cdl_cap set"
where
"all_caps spec = {cap. \<exists>obj_id slot. opt_cap (obj_id,slot) spec = Some cap \<and> cap \<noteq> NullCap}"

lemma all_capsE [elim!]:
  "\<lbrakk>opt_cap (obj_id, slot) spec = Some cap; cap \<noteq> NullCap\<rbrakk> \<Longrightarrow> cap \<in> all_caps spec"
  "\<lbrakk>opt_cap cap_ref spec = Some cap; cap \<noteq> NullCap\<rbrakk> \<Longrightarrow> cap \<in> all_caps spec"
  apply (clarsimp simp: all_caps_def|fast)+
  by (metis surj_pair)

lemma default_tcb_slots:
 "[0 ..< tcb_pending_op_slot] = [0,1,2,3,4]"
 "[0 ..< 5] = [0,1,2,3,4]"
 "[0 .e. tcb_pending_op_slot] = [0,1,2,3,4,5]"
 "[0 .e. (5::nat)] = [0,1,2,3,4,5]"
 "[0..< 6] = [0,1,2,3,4,5]"
 "[0..< 7] = [0,1,2,3,4,5,6]"
  by (clarsimp simp: tcb_pending_op_slot_def upt_rec)+

definition "update_tcb_fault_endpoint fault_ep = cdl_tcb_fault_endpoint_update (\<lambda>_. fault_ep)"

lemma update_tcb_fault_endpoint_id [simp]:
  "cdl_tcb_fault_endpoint tcb = fault_ep
  \<Longrightarrow> update_tcb_fault_endpoint fault_ep tcb = tcb"
  by (clarsimp simp: update_tcb_fault_endpoint_def)

definition tcb_has_fault :: "cdl_object \<Rightarrow> bool"
where
  "tcb_has_fault obj \<equiv> case obj of Tcb tcb \<Rightarrow> cdl_tcb_has_fault tcb | _ \<Rightarrow> False"

definition tcb_domain :: "cdl_object \<Rightarrow> word8"
where
  "tcb_domain obj \<equiv> case obj of Tcb tcb \<Rightarrow> cdl_tcb_domain tcb | _ \<Rightarrow> 0"

definition update_cap_object :: "cdl_object_id \<Rightarrow> cdl_cap \<Rightarrow> cdl_cap"
where
  "update_cap_object obj_id cap \<equiv> case cap of
    IOPageTableCap _ \<Rightarrow> IOPageTableCap obj_id
  | IOSpaceCap _ \<Rightarrow> IOSpaceCap obj_id
  | IOPortsCap _ f2 \<Rightarrow> IOPortsCap obj_id f2
  | AsidPoolCap _ f2 \<Rightarrow> AsidPoolCap obj_id f2
  | PageDirectoryCap _ f2 f3 \<Rightarrow> PageDirectoryCap obj_id f2 f3
  | PageTableCap _ f2 f3 \<Rightarrow> PageTableCap obj_id f2 f3
  | FrameCap dev _ f2 f3 f4 f5 \<Rightarrow> FrameCap dev obj_id f2 f3 f4 f5
  | TcbCap _ \<Rightarrow> TcbCap obj_id
  | CNodeCap _ f2 f3 f4 \<Rightarrow> CNodeCap obj_id f2 f3 f4
  | MasterReplyCap _ \<Rightarrow> MasterReplyCap obj_id
  | ReplyCap _ \<Rightarrow> ReplyCap obj_id
  | NotificationCap _ f2 f3 \<Rightarrow> NotificationCap obj_id f2 f3
  | EndpointCap _ f2 f3 \<Rightarrow> EndpointCap obj_id f2 f3
  | ZombieCap _ \<Rightarrow> ZombieCap obj_id
  | PendingSyncSendCap _ f2 f3 f4 f5 \<Rightarrow> PendingSyncSendCap obj_id f2 f3 f4 f5
  | PendingSyncRecvCap _ f2 \<Rightarrow> PendingSyncRecvCap obj_id f2
  | PendingNtfnRecvCap _ \<Rightarrow> PendingNtfnRecvCap obj_id
  | BoundNotificationCap _ \<Rightarrow> BoundNotificationCap obj_id
  | _ \<Rightarrow> cap"

definition update_cap_objects :: "cdl_object_id set \<Rightarrow> cdl_cap \<Rightarrow> cdl_cap"
where
    "update_cap_objects obj_ids cap \<equiv> case cap of
    UntypedCap d _ a \<Rightarrow> UntypedCap d obj_ids a
  | _ \<Rightarrow> cap"

lemma slots_of_cdl_objects:
  "slots_of obj_id s slot = Some cap \<Longrightarrow> \<exists>obj. cdl_objects s obj_id = Some obj"
  by (clarsimp simp: slots_of_def opt_object_def split: option.splits)

lemma opt_cap_cdl_objects:
  "opt_cap (obj_id, slot) s = Some cap \<Longrightarrow> \<exists>obj. cdl_objects s obj_id = Some obj"
  by (clarsimp simp: opt_cap_def slots_of_cdl_objects)

lemma object_slots_slots_of:
  "\<lbrakk>slots_of obj_id spec slot = Some cap; cdl_objects spec obj_id = Some obj\<rbrakk>
  \<Longrightarrow> object_slots obj slot = Some cap"
  by (clarsimp simp: slots_of_def opt_object_def)

lemma object_slots_opt_cap:
  "\<lbrakk>opt_cap cap_ref spec = Some cap; cdl_objects spec obj_id = Some obj; cap_ref = (obj_id, slot)\<rbrakk>
  \<Longrightarrow> object_slots obj slot = Some cap"
  by (clarsimp simp: opt_cap_def object_slots_slots_of split: prod.split_asm)+

lemma object_slots_opt_capI:
  "\<lbrakk>opt_cap (obj_id, slot) spec = Some cap; cdl_objects spec obj_id = Some obj\<rbrakk>
  \<Longrightarrow> object_slots obj slot = Some cap"
  by (clarsimp simp: opt_cap_def object_slots_slots_of split: prod.split_asm)

lemma object_slots_opt_capD:
  "\<lbrakk>opt_cap cap_ref spec = Some cap; cdl_objects spec (fst cap_ref) = Some obj\<rbrakk>
  \<Longrightarrow> object_slots obj (snd cap_ref) = Some cap"
  by (clarsimp simp: opt_cap_def object_slots_slots_of split: prod.split_asm)

lemma object_slots_has_slots:
  "object_slots obj \<noteq> empty \<Longrightarrow> has_slots obj"
  by (clarsimp simp: has_slots_def object_slots_def split: cdl_object.splits)

lemma opt_object_dom_cdl_objects [elim!]:
  "opt_object obj_id spec = Some obj \<Longrightarrow> obj_id \<in> dom (cdl_objects spec)"
  "opt_object obj_id spec = Some obj \<Longrightarrow> \<exists>slot. cdl_objects spec obj_id = Some slot"
  by (clarsimp simp: opt_object_def)+

lemma slots_of_dom_cdl_objects [elim!]:
  "slots_of obj_id spec slot = Some cap \<Longrightarrow> obj_id \<in> dom (cdl_objects spec)"
  "slots_of obj_id spec slot = Some cap \<Longrightarrow> \<exists>slot. cdl_objects spec obj_id = Some slot"
 by (clarsimp simp: slots_of_def split:option.splits)+

lemma opt_cap_dom_cdl_objects [elim]:
  "opt_cap (obj_id, slot) spec = Some cap \<Longrightarrow> obj_id \<in> dom (cdl_objects spec)"
  "opt_cap cap_ref spec = Some cap \<Longrightarrow> fst cap_ref \<in> dom (cdl_objects spec)"
  by (clarsimp simp: opt_cap_def split: prod.split_asm)+

lemma opt_cap_dom_slots_of [elim]:
  "opt_cap (obj_id, slot) spec = Some cap \<Longrightarrow> slot \<in> dom (slots_of obj_id spec)"
  "opt_cap cap_ref spec = Some cap \<Longrightarrow> snd cap_ref \<in> dom (slots_of (fst cap_ref) spec)"
  by (clarsimp simp: opt_cap_def split: prod.split_asm)+

(*
 * Untyped cap rules.
 *)

definition
  well_formed_untyped_cap :: "cdl_cap \<Rightarrow> bool"
where
  "well_formed_untyped_cap cap \<equiv> case cap of
    UntypedCap _ cover_ids available_ids \<Rightarrow> available_ids \<subseteq> cover_ids
  | _ \<Rightarrow> True"

lemma cap_free_ids_simps:
  "cap_free_ids (UntypedCap d cover_ids available_ids) = available_ids"
  by (clarsimp simp: cap_free_ids_def)

lemma cap_objects_remove_free_ids [simp]:
  "cap_objects (remove_free_ids cap obj_ids) = cap_objects cap"
  by (clarsimp simp: cap_objects_def remove_free_ids_def
              split: cdl_cap.splits)

lemma cap_free_ids_remove_free_ids:
  "cap_free_ids (remove_free_ids cap obj_ids) = cap_free_ids cap - obj_ids"
  by (clarsimp simp: remove_free_ids_def cap_free_ids_def
              split: cdl_cap.splits)

lemma cap_type_remove_free_ids [simp]:
  "cap_type (remove_free_ids cap obj_ids) = cap_type cap"
  by (clarsimp simp: cap_type_def remove_free_ids_def
              split: cdl_cap.splits)

definition
  is_device_cap :: "cdl_cap \<Rightarrow> bool"
where  "is_device_cap cap \<equiv> case cap of
   (UntypedCap dev cover_ids available_ids) \<Rightarrow> dev
   | (FrameCap dev _ _ _ _ _) \<Rightarrow> dev
   | _ \<Rightarrow> False"

lemmas is_device_cap_simps[simp] = is_device_cap_def[split_simps cdl_cap.split]

lemma remove_free_ids_simps:
  "\<lbrakk>is_untyped_cap cap; available_ids \<subseteq> cap_free_ids cap\<rbrakk>
  \<Longrightarrow> remove_free_ids cap (cap_free_ids cap - available_ids)
    = UntypedCap (is_device_cap cap) (cap_objects cap) available_ids"
  by (auto simp: remove_free_ids_def cap_free_ids_def cap_type_def
          split: cdl_cap.splits)

definition
  is_full_untyped_cap :: "cdl_cap \<Rightarrow> bool"
where
  "is_full_untyped_cap cap \<equiv> case cap of
     UntypedCap dev cover_ids available_ids \<Rightarrow> cover_ids = available_ids
   | _ \<Rightarrow> False"

lemma is_full_untyped_cap_is_untyped_cap:
  "is_full_untyped_cap cap \<Longrightarrow> is_untyped_cap cap"
  by (clarsimp simp: is_full_untyped_cap_def split: cdl_cap.splits)

lemma is_full_untyped_cap_simps:
  "is_full_untyped_cap cap \<Longrightarrow> cap_objects cap = cap_free_ids cap"
  by (auto simp: is_full_untyped_cap_def cap_free_ids_def
          split: cdl_cap.splits)

lemma is_full_untyped_cap_eq:
  "is_untyped_cap cap
  \<Longrightarrow> is_full_untyped_cap cap = (cap_objects cap = cap_free_ids cap)"
  by (auto simp: is_full_untyped_cap_def cap_free_ids_def
                 cap_objects_def cap_type_def
          split: cdl_cap.splits)

lemma well_formed_untyped_cap_remove_free_ids:
  "well_formed_untyped_cap cap
  \<Longrightarrow> well_formed_untyped_cap (remove_free_ids cap obj_ids)"
  by (auto simp: well_formed_untyped_cap_def remove_free_ids_def
          split: cdl_cap.splits)

lemma well_formed_untyped_cap_simps:
  "is_untyped_cap cap
  \<Longrightarrow> well_formed_untyped_cap cap = (cap_free_ids cap \<subseteq> cap_objects cap)"
  by (clarsimp simp: well_formed_untyped_cap_def cap_free_ids_def
                     cap_objects_def cap_type_def
              split: cdl_cap.splits)

definition
  some_nat :: "nat option \<Rightarrow> nat"
where
  "some_nat n \<equiv> case n of Some n \<Rightarrow> n | None \<Rightarrow> 0"

lemma some_nat_Some [simp]:
  "some_nat (Some n) = n"
  by (simp add: some_nat_def)

lemma some_nat_None [simp]:
  "some_nat None = 0"
  by (simp add: some_nat_def)

definition
  is_untyped :: "cdl_object \<Rightarrow> bool" where
 "is_untyped v \<equiv> case v of Untyped \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_ep :: "cdl_object \<Rightarrow> bool" where
 "is_ep v \<equiv> case v of Endpoint \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_ntfn :: "cdl_object \<Rightarrow> bool" where
 "is_ntfn v \<equiv> case v of Notification \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_tcb :: "cdl_object \<Rightarrow> bool" where
 "is_tcb v \<equiv> case v of Tcb _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_cnode :: "cdl_object \<Rightarrow> bool" where
 "is_cnode v \<equiv> case v of CNode _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_irq_node :: "cdl_object \<Rightarrow> bool" where
 "is_irq_node v \<equiv> case v of IRQNode _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_asidpool :: "cdl_object \<Rightarrow> bool" where
 "is_asidpool v \<equiv> case v of AsidPool _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_pt :: "cdl_object \<Rightarrow> bool" where
 "is_pt v \<equiv> case v of PageTable _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_pd :: "cdl_object \<Rightarrow> bool" where
 "is_pd v \<equiv> case v of PageDirectory _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  is_frame :: "cdl_object \<Rightarrow> bool" where
 "is_frame v \<equiv> case v of Frame _ \<Rightarrow> True | _ \<Rightarrow> False"

definition
  object_domain :: "cdl_object \<Rightarrow> word8"
where
  "object_domain obj \<equiv> case obj of
      Tcb tcb \<Rightarrow> cdl_tcb_domain tcb
    | _ \<Rightarrow> 0"

lemma is_object_simps [simp]:
  "is_untyped Untyped"
  "is_ep Endpoint"
  "is_ntfn Notification"
  "is_tcb (Tcb tcb)"
  "is_cnode (CNode c)"
  "is_asidpool (AsidPool a)"
  "is_pd (PageDirectory pd)"
  "is_pt (PageTable pt)"
  "is_frame (Frame f)"
  by (clarsimp simp: is_untyped_def is_ep_def is_ntfn_def is_tcb_def is_cnode_def
                     is_asidpool_def is_pt_def is_pd_def is_frame_def)+

(* These sizes are needed for ARM *)
definition pt_size :: nat
where
  "pt_size = 8"

definition pd_size :: nat
where
  "pd_size = 12"

definition small_frame_size :: nat
where
  "small_frame_size = 12"

definition
  object_size_bits :: "cdl_object \<Rightarrow> cdl_size_bits"
where
  "object_size_bits obj \<equiv> case obj of
      CNode cnode \<Rightarrow> cdl_cnode_size_bits cnode
    | AsidPool ap \<Rightarrow> asid_low_bits
    | Frame frame \<Rightarrow> cdl_frame_size_bits frame
    | PageTable cdl_page_table \<Rightarrow> pt_size
    | PageDirectory cdl_page_directory \<Rightarrow> pd_size
    | _ \<Rightarrow> 0"

lemma object_size_bits_default_tcb [simp]:
  "object_size_bits (Tcb (default_tcb domain)) = 0"
  by (clarsimp simp: object_size_bits_def default_tcb_def)

lemma object_size_bits_empty_cnode [simp]:
  "object_size_bits (CNode (empty_cnode sz)) = sz"
  by (clarsimp simp: object_size_bits_def empty_cnode_def)

definition
  object_at_pointer_size_bits :: "cdl_state \<Rightarrow> cdl_object_id \<Rightarrow> cdl_size_bits"
where
  "object_at_pointer_size_bits spec obj_id \<equiv>
   some_nat (option_map object_size_bits (cdl_objects spec obj_id))"

lemma object_at_pointer_size_bits_simp [simp]:
  "cdl_objects spec obj_id = Some object
  \<Longrightarrow> object_at_pointer_size_bits spec obj_id = object_size_bits object"
  by (simp add: object_at_pointer_size_bits_def)

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

abbreviation
  "untyped_at \<equiv> object_at is_untyped"
abbreviation
  "ep_at \<equiv> object_at is_ep"
abbreviation
  "ntfn_at \<equiv> object_at is_ntfn"
abbreviation
  "tcb_at \<equiv> object_at is_tcb"
abbreviation
  "cnode_at \<equiv> object_at is_cnode"
abbreviation
  "irq_node_at \<equiv> object_at is_irq_node"
abbreviation
  "asidpool_at \<equiv> object_at is_asidpool"
abbreviation
  "pt_at \<equiv> object_at is_pt"
abbreviation
  "pd_at \<equiv> object_at is_pd"
abbreviation
  "frame_at \<equiv> object_at is_frame"

(* Threads that are waiting to run. *)
definition
  is_waiting_thread :: "cdl_object \<Rightarrow> bool"
where
  "is_waiting_thread obj \<equiv> is_tcb obj \<and> object_slots obj tcb_pending_op_slot = Some RestartCap"

abbreviation
  "is_waiting_thread_at \<equiv> object_at is_waiting_thread"

definition
  irq_nodes :: "cdl_state \<Rightarrow> cdl_object_id set"
where
  "irq_nodes \<equiv> \<lambda>s. {obj_id. irq_node_at obj_id s}"

definition
  bound_irqs :: "cdl_state \<Rightarrow> cdl_irq set"
where
  "bound_irqs \<equiv> \<lambda>s. {irq. \<exists>cap. slots_of (cdl_irq_node s irq) s 0 = Some cap \<and> cap \<noteq> NullCap}"

definition
  bound_irq_list :: "cdl_state \<Rightarrow> cdl_irq list"
where
  "bound_irq_list \<equiv> \<lambda>s. sorted_list_of_set (bound_irqs s)"

definition
  used_irqs :: "cdl_state \<Rightarrow> cdl_irq set"
where
  "used_irqs \<equiv> \<lambda>s. {irq. \<exists>cap. cap \<in> all_caps s \<and> is_irqhandler_cap cap \<and> cap_irq cap = irq}"

definition
  used_irq_list :: "cdl_state \<Rightarrow> cdl_irq list"
where
  "used_irq_list \<equiv> \<lambda>s. sorted_list_of_set (used_irqs s)"

definition
  used_irq_nodes :: "cdl_state \<Rightarrow> cdl_object_id set"
where
  "used_irq_nodes \<equiv> \<lambda>s. cdl_irq_node s ` used_irqs s"

(* Distinctions between "real objects" and IRQ objects. *)
definition
  "real_object_at \<equiv> \<lambda> obj_id s. obj_id \<in> dom (cdl_objects s) \<and> obj_id \<notin> irq_nodes s"

(* Agregate object types. *)
abbreviation
  "table_at \<equiv> \<lambda>obj_id s. pt_at obj_id s \<or> pd_at obj_id s"
abbreviation
  "capless_at \<equiv> \<lambda>obj_id s. untyped_at obj_id s \<or> ep_at obj_id s \<or> ntfn_at obj_id s \<or> frame_at obj_id s"
abbreviation
  "cnode_or_tcb_at \<equiv> \<lambda>obj_id spec. cnode_at obj_id spec \<or> tcb_at obj_id spec"
abbreviation
  "memory_object_at \<equiv> \<lambda>obj_id spec. pt_at obj_id spec \<or> pd_at obj_id spec \<or> frame_at obj_id spec"

lemma capless_at_def2:
  "capless_at p s = object_at (\<lambda>obj. \<not> (has_slots obj)) p s"
  apply (clarsimp simp: has_slots_def object_at_def)
  apply (fastforce simp: is_untyped_def is_ep_def is_ntfn_def is_frame_def
                 split: cdl_object.splits)
  done

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

lemma ko_at_tcb_at:
  "ko_at (Tcb t) p s \<Longrightarrow> tcb_at p s"
  by (simp add: object_at_def is_tcb_def)

abbreviation
  "type_at T \<equiv> object_at (\<lambda>ob. object_type ob = T)"

lemma length_sorted_list_of_set [simp]:
  "finite A \<Longrightarrow> length (sorted_list_of_set A) = card A"
  by (metis sorted_list_of_set distinct_card)

lemma length_used_irq_list [simp]:
  "length (used_irq_list spec) = card (used_irqs spec)"
  by (clarsimp simp: used_irq_list_def)

lemma distinct_used_irq_list [simp]:
  "distinct (used_irq_list spec)"
  by (simp add: used_irq_list_def)

lemma set_used_irq_list [simp]:
  "set (used_irq_list spec) = used_irqs spec"
  by (simp add: used_irq_list_def)

lemma object_type_is_object:
  "is_untyped obj  = (object_type obj = UntypedType)"
  "is_ep obj       = (object_type obj = EndpointType)"
  "is_ntfn obj      = (object_type obj = NotificationType)"
  "is_tcb obj      = (object_type obj = TcbType)"
  "is_cnode obj    = (object_type obj = CNodeType)"
  "is_irq_node obj = (object_type obj = IRQNodeType)"
  "is_asidpool obj = (object_type obj = AsidPoolType)"
  "is_pt obj       = (object_type obj = PageTableType)"
  "is_pd obj       = (object_type obj = PageDirectoryType)"
  "is_frame obj    = (\<exists>n. object_type obj = FrameType n)"
  by (simp_all add: object_type_def is_untyped_def is_ep_def is_ntfn_def is_tcb_def
                    is_cnode_def is_irq_node_def is_asidpool_def is_pt_def is_pd_def is_frame_def
             split: cdl_object.splits)

lemma object_at_object_type:
  "\<lbrakk>cdl_objects spec obj_id = Some obj; untyped_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = UntypedType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; ep_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = EndpointType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; ntfn_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = NotificationType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; tcb_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = TcbType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; cnode_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = CNodeType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; irq_node_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = IRQNodeType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; asidpool_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = AsidPoolType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; pt_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = PageTableType"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; pd_at obj_id spec\<rbrakk> \<Longrightarrow> object_type obj = PageDirectoryType"
  by (simp_all add: object_at_def object_type_is_object)

lemma object_type_object_at:
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = UntypedType\<rbrakk> \<Longrightarrow> untyped_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = EndpointType\<rbrakk> \<Longrightarrow> ep_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = NotificationType\<rbrakk> \<Longrightarrow> ntfn_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = TcbType\<rbrakk> \<Longrightarrow> tcb_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = CNodeType\<rbrakk> \<Longrightarrow> cnode_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = IRQNodeType\<rbrakk> \<Longrightarrow> irq_node_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = AsidPoolType\<rbrakk> \<Longrightarrow> asidpool_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = PageTableType\<rbrakk> \<Longrightarrow> pt_at obj_id spec"
  "\<lbrakk>cdl_objects spec obj_id = Some obj; object_type obj = PageDirectoryType\<rbrakk> \<Longrightarrow> pd_at obj_id spec"
  by (simp_all add: object_at_def object_type_is_object)

lemma set_object_type [simp]:
  "{obj_id \<in> dom (cdl_objects spec). object_at P obj_id spec} = {obj_id. object_at P obj_id spec}"
  "{obj_id \<in> dom (cdl_objects spec). table_at obj_id spec} = {obj_id. table_at obj_id spec}"
  "{obj_id \<in> dom (cdl_objects spec). capless_at obj_id spec} = {obj_id. capless_at obj_id spec}"
  "{obj_id \<in> dom (cdl_objects spec). cnode_or_tcb_at obj_id spec} = {obj_id. cnode_or_tcb_at obj_id spec}"
  "{obj_id \<in> dom (cdl_objects spec). cnode_at obj_id spec} = {obj_id. cnode_at obj_id spec}"
  "{obj_id \<in> dom (cdl_objects spec). real_object_at obj_id spec} = {obj_id. real_object_at obj_id spec}"
  by (auto simp: object_at_def real_object_at_def)

definition
  real_objects :: "cdl_state \<Rightarrow> cdl_object_id set"
where
  "real_objects \<equiv> \<lambda>s. {obj_id. real_object_at obj_id s}"

lemma cnode_or_tcb_at_simps:
  "(cnode_or_tcb_at obj_id spec \<and> cnode_at obj_id spec) = cnode_at obj_id spec"
  "(cnode_or_tcb_at obj_id spec \<and> \<not> cnode_at obj_id spec) = tcb_at obj_id spec"
  by (auto simp: object_at_def object_type_is_object)

(******************************
 * Cap types and default caps *
 ******************************)
definition cap_at :: "(cdl_cap \<Rightarrow> bool) \<Rightarrow> cdl_cap_ref \<Rightarrow> cdl_state \<Rightarrow> bool"
where
  "cap_at P ref s \<equiv> \<exists>cap. opt_cap ref s = Some cap \<and> P cap"

definition is_fake_pt_cap :: "cdl_cap \<Rightarrow> bool"
where "is_fake_pt_cap cap \<equiv> case cap of
    PageTableCap _ Fake _ \<Rightarrow> True
  | _ \<Rightarrow> False"

lemma is_fake_pt_cap_is_pt_cap [elim!]:
  "is_fake_pt_cap cap \<Longrightarrow> is_pt_cap cap"
  by (clarsimp simp: is_fake_pt_cap_def split: cdl_cap.splits)

abbreviation "pd_cap_at \<equiv> cap_at is_pd_cap"
abbreviation "pt_cap_at \<equiv> cap_at is_pt_cap"
abbreviation "fake_pt_cap_at \<equiv> cap_at is_fake_pt_cap"
abbreviation "irqhandler_cap_at \<equiv> cap_at is_irqhandler_cap"

lemma is_cnode_cap_simps:
  "is_cnode_cap (UntypedCap dev ids ids') = False"
  "is_cnode_cap (IOPageTableCap x) = False"
  "is_cnode_cap (IOSpaceCap x) = False"
  "is_cnode_cap (IOPortsCap x a) = False"
  "is_cnode_cap (AsidPoolCap x b) = False"
  "is_cnode_cap (PageDirectoryCap x c d) = False"
  "is_cnode_cap (PageTableCap x e f) = False"
  "is_cnode_cap (FrameCap dev x g h i j) = False"
  "is_cnode_cap (TcbCap x) = False"
  "is_cnode_cap (MasterReplyCap x) = False"
  "is_cnode_cap (ReplyCap x) = False"
  "is_cnode_cap (NotificationCap x m n) = False"
  "is_cnode_cap (EndpointCap x p q) = False"
  "is_cnode_cap (ZombieCap x) = False"
  "is_cnode_cap (PendingSyncSendCap x s t u v) = False"
  "is_cnode_cap (PendingSyncRecvCap x t) = False"
  "is_cnode_cap (PendingNtfnRecvCap x) = False"

  "is_cnode_cap (CNodeCap x k l sz) = True"
  by (unfold cap_type_def, simp_all split: cdl_object_type.splits)

(* This is to be rarely used. original_cap_at is what you probably want. *)
definition cap_at_has_no_parents_in_cdt :: "cdl_cap_ref \<Rightarrow> cdl_state \<Rightarrow> bool"
where
  "cap_at_has_no_parents_in_cdt cap_ref \<equiv> \<lambda>spec. opt_parent cap_ref spec = None"

(* This predicate decides which capabilities should be moved, or copied.
 * The actual definition of this function is rarely used by the initialiser,
 * only to know that IRQ Handler caps are move, and so the definition can be
 * updated if newer caps are added that need to be moved.
 *)
definition
  original_cap_at :: "cdl_cap_ref \<Rightarrow> cdl_state \<Rightarrow> bool"
where
  "original_cap_at cap_ref \<equiv> \<lambda>spec. cap_at_has_no_parents_in_cdt cap_ref spec \<or>
                                     irqhandler_cap_at cap_ref spec"

definition is_default_cap :: "cdl_cap \<Rightarrow> bool"
where
  "is_default_cap cap \<equiv>
  (\<exists>type dev. cap_type cap = Some type \<and>
   cap = default_cap type (cap_objects cap) (cnode_cap_size cap) dev) \<or>
   is_irqhandler_cap cap"

lemma default_cap_eq:
  "\<lbrakk>is_default_cap cap; is_default_cap cap';
    cap_type cap = cap_type cap'; cap_objects cap = cap_objects cap';
    cnode_cap_size cap = cnode_cap_size cap';
    cap_irq cap = cap_irq cap'; is_device_cap cap = is_device_cap cap'\<rbrakk>
  \<Longrightarrow> cap = cap'"
  by (auto simp: is_default_cap_def cap_type_def cap_irq_def default_cap_def
          split: cdl_cap.splits )

lemma cnode_cap_size_non_cnode [simp]:
  "\<not> is_cnode_cap cap \<Longrightarrow> cnode_cap_size cap = 0"
  by (clarsimp simp: cap_type_def cnode_cap_size_def split: cdl_cap.splits)

lemma irqhandler_cap_irq_non_irqhandler [simp]:
  "\<not> is_irqhandler_cap cap \<Longrightarrow> cap_irq cap = undefined"
  by (clarsimp simp: cap_irq_def split: cdl_cap.splits)

lemma default_cap_eq_non_cnode:
  "\<lbrakk>is_default_cap cap; is_default_cap cap';
   \<not> is_cnode_cap cap; \<not> is_irqhandler_cap cap;
    cap_type cap = cap_type cap'; cap_objects cap = cap_objects cap';
    is_device_cap cap = is_device_cap cap'\<rbrakk>
  \<Longrightarrow> cap = cap'"
  apply (rule default_cap_eq)
   apply simp+
  done

lemma cap_type_default_cap [simp]:
  "cap_type (default_cap type {obj_id} sz dev) = Some type"
  by (clarsimp simp: default_cap_def cap_type_def split: cdl_object_type.splits)

lemma is_tcb_update_slots [simp]:
  "is_tcb (update_slots slots obj) = is_tcb obj"
  by (clarsimp simp: is_tcb_def update_slots_def split: cdl_object.splits)

lemma tcb_has_slots [elim!]:
  "is_tcb obj \<Longrightarrow> has_slots obj"
  by (clarsimp simp: is_tcb_def has_slots_def split: cdl_object.splits)

lemma cnode_has_slots [elim!]:
  "is_cnode obj \<Longrightarrow> has_slots obj"
  by (clarsimp simp: is_cnode_def has_slots_def split: cdl_object.splits)

lemma pt_has_slots [elim!]:
  "is_pt obj \<Longrightarrow> has_slots obj"
  by (clarsimp simp: is_pt_def has_slots_def split: cdl_object.splits)

lemma pd_has_slots [elim!]:
  "is_pd obj \<Longrightarrow> has_slots obj"
  by (clarsimp simp: is_pd_def has_slots_def split: cdl_object.splits)

lemma asidpool_has_slots [elim!]:
  "is_asidpool obj \<Longrightarrow> has_slots obj"
  by (clarsimp simp: is_asidpool_def has_slots_def split: cdl_object.splits)

lemma object_type_has_slots [elim!]:
  "object_type obj = TcbType \<Longrightarrow> has_slots obj"
  "object_type obj = CNodeType \<Longrightarrow> has_slots obj"
  "object_type obj = IRQNodeType \<Longrightarrow> has_slots obj"
  "object_type obj = PageTableType \<Longrightarrow> has_slots obj"
  "object_type obj = PageDirectoryType \<Longrightarrow> has_slots obj"
  "object_type obj = AsidPoolType \<Longrightarrow> has_slots obj"
  by (clarsimp simp: object_type_def has_slots_def split: cdl_object.splits)+

lemma cap_type_update_cap_objects [simp]:
  "cap_type (update_cap_objects x cap) = cap_type cap"
  apply (clarsimp simp: cap_type_def update_cap_objects_def)
  apply (cases cap, simp_all)
  done

lemma cap_type_update_cap_object [simp]:
  "cap_type (update_cap_object x cap) = cap_type cap"
  by (clarsimp simp: update_cap_object_def cap_type_def
              split: cdl_cap.splits)

lemma cap_has_object_update_cap_objects [simp]:
  "cap_has_object (update_cap_objects x cap) = cap_has_object cap"
  apply (clarsimp simp: update_cap_object_def
                        cap_has_object_def update_cap_objects_def)
  apply (cases cap, simp_all)
  done

lemma cap_has_object_update_cap_object [simp]:
  "cap_has_object (update_cap_object x cap) = cap_has_object cap"
  by (clarsimp simp: update_cap_object_def cap_has_object_def
              split: cdl_cap.splits)

lemma cap_object_default_cap' [simp]:
  "\<lbrakk>\<not>is_untyped obj; \<not>is_irq_node obj\<rbrakk>
  \<Longrightarrow> cap_object (default_cap (object_type obj) {obj_id} sz dev) = obj_id"
  by (clarsimp simp: default_cap_def  object_type_def is_untyped_def is_irq_node_def cap_object_simps
              split: cdl_object_type.splits cdl_object.splits)

lemma cap_object_default_cap [simp]:
  "\<lbrakk>type \<noteq> UntypedType; type \<noteq> IRQNodeType\<rbrakk>
  \<Longrightarrow> cap_object (default_cap type {obj_id} sz dev) = obj_id"
  by (clarsimp simp: default_cap_def  object_type_def is_untyped_def cap_object_simps
              split: cdl_object_type.splits cdl_object.splits)

lemma cap_object_default_cap_frame:
  "is_frame_cap cap \<Longrightarrow> cap_object (default_cap (the (cap_type cap)) {obj_id} sz dev) = obj_id"
  by clarsimp

lemma default_cap_not_null [elim!]:
  "default_cap type obj_ids sz dev = NullCap \<Longrightarrow> False"
  "NullCap = default_cap type obj_ids sz dev\<Longrightarrow> False"
  by (simp add: default_cap_def split: cdl_object_type.splits)+

lemma cap_objects_update_cap_object [simp]:
  "\<lbrakk>cap_has_object cap; \<not>is_untyped_cap cap\<rbrakk>
  \<Longrightarrow> cap_objects (update_cap_object obj_id cap) = {obj_id}"
  by (clarsimp simp: cap_has_object_def update_cap_object_def
              split: cdl_cap.splits)

lemma  cap_has_object_default_cap [simp]:
  "type \<noteq> IRQNodeType \<Longrightarrow> cap_has_object (default_cap type ids sz dev)"
  by (clarsimp simp: default_cap_def cap_has_object_def split: cdl_object_type.splits)

lemma cap_rights_default_cap_cnode [simp]:
  "cap_rights (default_cap CNodeType ids sz dev) = UNIV"
  by (clarsimp simp: cap_rights_def default_cap_def)

lemma cap_rights_cnode_cap [simp]:
  "is_cnode_cap cap \<Longrightarrow> cap_rights cap = UNIV"
  by (clarsimp simp: cap_type_def cap_rights_def
              split: cdl_cap.splits)

lemma cap_has_object_simps [simp]:
  "cap_has_object (IOPageTableCap x)"
  "cap_has_object (IOSpaceCap x)"
  "cap_has_object (IOPortsCap x a)"
  "cap_has_object (AsidPoolCap x b)"
  "cap_has_object (PageDirectoryCap x c d)"
  "cap_has_object (PageTableCap x e f)"
  "cap_has_object (FrameCap dev x g h i j)"
  "cap_has_object (TcbCap x)"
  "cap_has_object (CNodeCap x k l sz)"
  "cap_has_object (MasterReplyCap x)"
  "cap_has_object (ReplyCap x)"
  "cap_has_object (NotificationCap x m n)"
  "cap_has_object (EndpointCap x p q)"
  "cap_has_object (ZombieCap x)"
  "cap_has_object (PendingSyncSendCap x s t u v)"
  "cap_has_object (PendingSyncRecvCap x t)"
  "cap_has_object (PendingNtfnRecvCap x)"
  "cap_has_object (UntypedCap dev ids ids') = True"
  by (simp_all add:cap_has_object_def)

lemma is_cap_NullCap [simp]:
  "\<not> is_untyped_cap NullCap"
  "\<not> is_ep_cap NullCap"
  "\<not> is_ntfn_cap NullCap"
  "\<not> is_cnode_cap NullCap"
  "\<not> is_tcb_cap NullCap"
  "\<not> is_asidpool_cap NullCap"
  "\<not> is_pt_cap NullCap"
  "\<not> is_pd_cap NullCap"
  "\<not> is_frame_cap NullCap"
  "\<not> is_fake_pt_cap NullCap"
  "\<not> is_irqhandler_cap NullCap"
  by (clarsimp simp: cap_type_def is_fake_pt_cap_def)+

(* The slots of an object, returns an empty list for non-existing objects
   or objects that do not have caps *)
definition
  slots_of_list :: "cdl_state \<Rightarrow> cdl_object_id \<Rightarrow> cdl_cnode_index list"
where
  "slots_of_list spec obj_id \<equiv> sorted_list_of_set $ dom $ slots_of obj_id spec"

(* Encode the guard and guard size for passing to the kernel. *)
definition guard_as_rawdata :: "cdl_cap \<Rightarrow> cdl_raw_capdata"
where
  "guard_as_rawdata cap \<equiv>
  let
    reserved_bits = 3;
    guard_size_bits = 5
  in
    (cap_guard cap << (reserved_bits + guard_size_bits))
    + (of_nat (cap_guard_size cap) << reserved_bits)"

definition cap_data :: "cdl_cap \<Rightarrow> cdl_raw_capdata"
where
  "cap_data cap \<equiv>
  if (is_ep_cap cap) then
    cap_badge cap
  else if (is_ntfn_cap cap) then
    cap_badge cap
  else
    guard_as_rawdata cap"

(*
 * Deterministic version of update_cap_data used by the capDL kernel.
 * This is used in the specification of the CSpace kernel calls.
 *)
definition guard_update :: "cdl_cap \<Rightarrow> word32 \<Rightarrow> cdl_cap"
where "guard_update cap data  \<equiv>
  case cap of cdl_cap.CNodeCap oid _ _ sz \<Rightarrow>
    (let reserved_bits = 3; guard_bits = 18; guard_size_bits = 5; new_guard_size = unat ((data >> reserved_bits) && mask guard_size_bits);
        new_guard =
          (data >> reserved_bits + guard_size_bits) && mask (min (unat ((data >> reserved_bits) && mask guard_size_bits)) guard_bits)
    in CNodeCap oid new_guard new_guard_size sz)
  | _ \<Rightarrow> cap"

definition
  update_cap_data_det :: "cdl_raw_capdata \<Rightarrow> cdl_cap \<Rightarrow> cdl_cap"
where
  "update_cap_data_det raw_data cap \<equiv>
   case cap of
        EndpointCap _ b _      \<Rightarrow> badge_update raw_data cap
      | NotificationCap _ b _ \<Rightarrow> badge_update raw_data cap
      | CNodeCap object g gs _  \<Rightarrow> guard_update cap raw_data
      | _ \<Rightarrow> cap"

definition "valid_src_cap cap data \<equiv>
   is_cnode_cap cap \<longrightarrow> (
         unat ((data >> 3) && mask 5) + cnode_cap_size cap \<le> word_bits)"

(* MOVE TO KHeap.thy in capDL and fix get_thread *)
(* Get a thread from the given pointer. *)
definition
  opt_thread :: "cdl_object_id \<Rightarrow> cdl_state \<Rightarrow> cdl_tcb option"
where
  "opt_thread p s \<equiv>
      case opt_object p s of
          Some (Tcb tcb) \<Rightarrow> (Some tcb)
        | _ \<Rightarrow> None"

definition derived_cap :: "cdl_cap \<Rightarrow> cdl_cap"
where "derived_cap cap \<equiv> case cap of
          ReplyCap _ \<Rightarrow> NullCap
        | MasterReplyCap _ \<Rightarrow> NullCap
        | IrqControlCap \<Rightarrow> NullCap
        | FrameCap d p r sz b x \<Rightarrow> FrameCap d p r sz b None
        | ZombieCap _ \<Rightarrow> NullCap
        | _ \<Rightarrow> cap "

lemma derive_cap_wp:
  "\<lbrace> P (derived_cap cap) \<rbrace> derive_cap slot cap \<lbrace>P\<rbrace>, -"
  apply (clarsimp simp: derive_cap_def derived_cap_def)
  apply (clarsimp simp: validE_R_def derive_cap_def split:cdl_cap.splits)
  apply (safe, (wp alternative_wp alternativeE_wp hoare_whenE_wp |
                clarsimp simp: ensure_no_children_def)+ )
  done

definition safe_for_derive :: "cdl_cap \<Rightarrow> bool"
where "safe_for_derive cap \<equiv> case cap of
    NullCap \<Rightarrow> False
  | UntypedCap _ _ _ \<Rightarrow> False
  | PageTableCap _ _ _ \<Rightarrow> False
  | PageDirectoryCap _ _ _ \<Rightarrow> False
  | ReplyCap _ \<Rightarrow> False
  | MasterReplyCap _ \<Rightarrow> False
  | IrqControlCap \<Rightarrow> False
  | ZombieCap _ \<Rightarrow> False
  | _ \<Rightarrow> True"

lemma is_exclusive_cap_update_cap_rights [simp]:
  "safe_for_derive (update_cap_rights rights cap) = safe_for_derive cap"
  by (clarsimp simp: update_cap_rights_def safe_for_derive_def
              split: cdl_cap.splits)

lemma derive_cap_non_exclusive:
  "\<lbrace> P (derived_cap cap) and K (safe_for_derive cap) \<rbrace> derive_cap slot cap \<lbrace>P\<rbrace>, \<lbrace>Q\<rbrace>"
  apply (clarsimp simp: derive_cap_def derived_cap_def)
  apply (clarsimp simp: validE_R_def derive_cap_def
    safe_for_derive_def
    split:cdl_cap.splits)
  apply (intro conjI allI impI, wp+)
  done

lemma derived_cap_safe_for_derive[simp]:
  "safe_for_derive (derived_cap cap) = safe_for_derive cap"
  apply (case_tac cap)
  apply (simp_all add:derived_cap_def safe_for_derive_def)
  done

lemma safe_for_derive_not_non:
  "safe_for_derive cap \<Longrightarrow> cap \<noteq> NullCap"
  by (simp add:safe_for_derive_def split:cdl_cap.splits)

(* Given an object, this returns what the default state is for the object.
 * This should be the same as what is created by a retype operation.
 *)
definition
  object_default_state :: "cdl_object \<Rightarrow> cdl_object"
where
  "object_default_state object \<equiv>
  the $ default_object (object_type object)
                       (object_size_bits object)
                       (object_domain object)"

lemma object_default_state_def2:
  "object_default_state obj = (
    case obj of
        Untyped \<Rightarrow> Untyped
      | Endpoint \<Rightarrow> Endpoint
      | Notification \<Rightarrow> Notification
      | Tcb tcb \<Rightarrow> Tcb (default_tcb (cdl_tcb_domain tcb))
      | CNode cnode \<Rightarrow> CNode (empty_cnode (cdl_cnode_size_bits cnode))
      | IRQNode cnode \<Rightarrow> IRQNode empty_irq_node
      | AsidPool ap \<Rightarrow> AsidPool \<lparr>cdl_asid_pool_caps = empty_cap_map asid_low_bits\<rparr>
      | PageTable pt \<Rightarrow> PageTable \<lparr> cdl_page_table_caps = empty_cap_map 8 \<rparr>
      | PageDirectory pd \<Rightarrow> PageDirectory \<lparr> cdl_page_directory_caps = empty_cap_map 12 \<rparr>
      | Frame frame \<Rightarrow> Frame \<lparr> cdl_frame_size_bits = (cdl_frame_size_bits frame) \<rparr>)"
  by (clarsimp simp: object_default_state_def object_type_def default_object_def
                     object_size_bits_def object_domain_def
              split: cdl_object.splits)

(******************************************************
 * More rules, that should be put in the right place. *
 ******************************************************)

lemma object_type_update_slots [simp]:
  "object_type (update_slots slots x) = object_type x"
  by (clarsimp simp: object_type_def update_slots_def split: cdl_object.splits)

lemma object_slots_empty [simp]:
  "\<not> has_slots obj \<Longrightarrow> object_slots obj = empty"
  by (clarsimp simp: object_slots_def has_slots_def split: cdl_object.splits)

lemma object_slots_update_slots [simp]:
  "has_slots obj \<Longrightarrow> object_slots (update_slots slots obj) = slots"
  by (clarsimp simp: object_slots_def update_slots_def has_slots_def
              split: cdl_object.splits)

lemma object_slots_update_slots_empty [simp]:
  "\<not>has_slots obj \<Longrightarrow> object_slots (update_slots slots obj) = empty"
  by (clarsimp simp: object_slots_def update_slots_def has_slots_def
                 split: cdl_object.splits)

lemma update_slots_no_slots [simp]:
  "\<not>has_slots obj \<Longrightarrow> update_slots slots obj = obj"
  by (clarsimp simp: update_slots_def has_slots_def split: cdl_object.splits)

lemma update_slots_update_slots [simp]:
  "update_slots slots (update_slots slots' obj) = update_slots slots obj"
  by (clarsimp simp: update_slots_def split: cdl_object.splits)

lemma update_slots_same_object:
  "a = b \<Longrightarrow> update_slots a obj = update_slots b obj"
  by (erule arg_cong)

lemma update_slots_eq_slots:
  "\<lbrakk>has_slots obj; update_slots slots obj = update_slots slots' obj'\<rbrakk> \<Longrightarrow> slots = slots'"
  by (clarsimp simp: update_slots_def has_slots_def cdl_tcb.splits cdl_cnode.splits
                     cdl_asid_pool.splits cdl_irq_node.splits
                     cdl_page_table.splits cdl_page_directory.splits
              split: cdl_object.splits)

lemma has_slots_object_type_has_slots:
  "\<lbrakk>has_slots x; object_type x = object_type y\<rbrakk> \<Longrightarrow> has_slots y"
  by (clarsimp simp: object_type_def has_slots_def split: cdl_object.splits)

lemma object_type_has_slots_eq:
  "object_type y = object_type x \<Longrightarrow> has_slots x = has_slots y"
  by (clarsimp simp: object_type_def has_slots_def split: cdl_object.splits)

lemma object_type_object_default_state [simp]:
  "object_type (object_default_state obj) = object_type obj"
  by (clarsimp simp: object_default_state_def2 object_type_def split: cdl_object.splits)

lemma is_cnode_object_default_state [simp]:
  "is_cnode (object_default_state obj) = is_cnode obj"
  by (clarsimp simp: object_default_state_def2 is_cnode_def split: cdl_object.splits)

lemma update_slots_same [simp]:
  "object_slots obj = cap_map \<Longrightarrow> update_slots cap_map obj = obj"
  by (clarsimp simp: update_slots_def object_slots_def split: cdl_object.splits)

lemma dom_sub_restrict [simp]:
  "dom (m `- A) = dom m \<inter> -A"
  by (auto simp: sub_restrict_map_def dom_def split: if_split_asm)

lemma inter_empty_not_both:
"\<lbrakk>x \<in> A; A \<inter> B = {}\<rbrakk> \<Longrightarrow> x \<notin> B"
  by fastforce

end


(*  Title:      HOL/Auth/n_german_lemma_inv__43_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__43_on_rules imports n_german_lemma_on_inv__43
begin
section{*All lemmas on causal relation between inv__43*}
lemma lemma_inv__43_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__43  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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) 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__43) done
    }

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

end


(*  Title:      JinjaThreads/Execute/State_Refinement.thy
    Author:     Andreas Lochbihler
*)

header {* \chapter{Schedulers}
          \isaheader{Refinement for multithreaded states} *}

theory State_Refinement
imports
  "../Framework/FWSemantics"
  "../Common/StartConfig"
begin

type_synonym
  ('l,'t,'m,'m_t,'m_w,'s_i) state_refine = "('l,'t) locks \<times> ('m_t \<times> 'm) \<times> 'm_w \<times> 's_i"

locale state_refine_base =
  fixes final :: "'x \<Rightarrow> bool"
  and r :: "'t \<Rightarrow> ('x \<times> 'm) \<Rightarrow> (('l,'t,'x,'m,'w,'o) thread_action \<times> 'x \<times> 'm) Predicate.pred"
  and convert_RA :: "'l released_locks \<Rightarrow> 'o list"
  and thr_\<alpha> :: "'m_t \<Rightarrow> ('l,'t,'x) thread_info"
  and thr_invar :: "'m_t \<Rightarrow> bool"
  and ws_\<alpha> :: "'m_w \<Rightarrow> ('w,'t) wait_sets"
  and ws_invar :: "'m_w \<Rightarrow> bool"
  and is_\<alpha> :: "'s_i \<Rightarrow> 't interrupts"
  and is_invar :: "'s_i \<Rightarrow> bool"
begin

fun state_\<alpha> :: "('l,'t,'m,'m_t,'m_w, 's_i) state_refine \<Rightarrow> ('l,'t,'x,'m,'w) state"
where "state_\<alpha> (ls, (ts, m), ws, is) = (ls, (thr_\<alpha> ts, m), ws_\<alpha> ws, is_\<alpha> is)"

lemma state_\<alpha>_conv [simp]:
  "locks (state_\<alpha> s) = locks s"
  "thr (state_\<alpha> s) = thr_\<alpha> (thr s)"
  "shr (state_\<alpha> s) = shr s"
  "wset (state_\<alpha> s) = ws_\<alpha> (wset s)"
  "interrupts (state_\<alpha> s) = is_\<alpha> (interrupts s)"
by(case_tac [!] s) auto

inductive state_invar :: "('l,'t,'m,'m_t,'m_w,'s_i) state_refine \<Rightarrow> bool"
where "\<lbrakk> thr_invar ts; ws_invar ws; is_invar is \<rbrakk> \<Longrightarrow> state_invar (ls, (ts, m), ws, is)"

inductive_simps state_invar_simps [simp]:
  "state_invar (ls, (ts, m), ws, is)"

lemma state_invarD [simp]:
  assumes "state_invar s"
  shows "thr_invar (thr s)" "ws_invar (wset s)" "is_invar (interrupts s)"
using assms by(case_tac [!] s) auto

end

sublocale state_refine_base < \<alpha>!: final_thread final .
sublocale state_refine_base < \<alpha>!:
  multithreaded_base
    final
    "\<lambda>t xm ta x'm'. Predicate.eval (r t xm) (ta, x'm')"
.

definition (in heap_base) start_state_refine ::
  "'m_t \<Rightarrow> ('thread_id \<Rightarrow> ('x \<times> 'addr released_locks) \<Rightarrow> 'm_t \<Rightarrow> 'm_t) \<Rightarrow> 'm_w \<Rightarrow> 's_i
  \<Rightarrow> (cname \<Rightarrow> mname \<Rightarrow> ty list \<Rightarrow> ty \<Rightarrow> 'md \<Rightarrow> 'addr val list \<Rightarrow> 'x) \<Rightarrow> 'md prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> 'addr val list
  \<Rightarrow> ('addr, 'thread_id, 'heap, 'm_t, 'm_w, 's_i) state_refine"
where
  "\<And>is_empty.
  start_state_refine thr_empty thr_update ws_empty is_empty f P C M vs =
  (let (D, Ts, T, m) = method P C M
   in (K$ None, (thr_update start_tid (f D M Ts T (the m) vs, no_wait_locks) thr_empty, start_heap), ws_empty, is_empty))"

definition Jinja_output ::
  "'s \<Rightarrow> 'thread_id \<Rightarrow> ('addr, 'thread_id, 'x, 'heap, 'addr, ('addr, 'thread_id) obs_event) thread_action
  \<Rightarrow> ('thread_id \<times> ('addr, 'thread_id) obs_event list) option"
where "Jinja_output \<sigma> t ta = (if \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> = [] then None else Some (t, \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"

lemmas [code] =
  heap_base.start_state_refine_def

end