theory Post
imports "../Observation_Setup" Post_Value_Setup
begin

subsection \<open>Declassification bound\<close>

fun T :: "(state,act,out) trans \<Rightarrow> bool" where "T _ = False"

text \<open>\label{sec:post-bound}
The bound may dynamically change from closed (\<open>B\<close>) to open (\<open>BO\<close>) access to the
confidential information (or vice versa) when the openness predicate changes value.
The bound essentially relates arbitrary value sequences in the closed phase (i.e.~observers
learn nothing about the updates during that phase) and identical value sequences in the open phase
(i.e.~observers may learn everything about the updates during that phase);
when transitioning from a closed to an open access window (\<open>B_BO\<close> below),
the last update in the closed phase, i.e.~the current version of the post,
is also declassified in addition to subsequent updates.
This formalizes the ``while-or-last-before'' scheme in the informal description of the
confidentiality property.
Moreover, the empty value sequence is treated specially in order to capture harmless cases
where the observers may deduce that no secret updates have occurred,
e.g.~if the system has not been initialized yet.
See \<^cite>\<open>\<open>Section 3.4\<close> in "cosmed-jar2018"\<close> for a detailed discussion of the bound.\<close>

inductive B :: "value list \<Rightarrow> value list \<Rightarrow> bool"
and BO :: "value list \<Rightarrow> value list \<Rightarrow> bool"
where
 B_TVal[simp,intro!]:
  "(pstl = [] \<longrightarrow> pstl1 = []) \<Longrightarrow> B (map TVal pstl) (map TVal pstl1)"
|B_BO[intro]:
  "BO vl vl1 \<Longrightarrow> (pstl = [] \<longleftrightarrow> pstl1 = []) \<Longrightarrow> (pstl \<noteq> [] \<Longrightarrow> last pstl = last pstl1) \<Longrightarrow>
   B (map TVal pstl  @ OVal True # vl)
     (map TVal pstl1 @ OVal True # vl1)"
(*  *)
|BO_TVal[simp,intro!]:
  "BO (map TVal pstl) (map TVal pstl)"
|BO_B[intro]:
  "B vl vl1 \<Longrightarrow>
   BO (map TVal pstl @ OVal False # vl) (map TVal pstl @ OVal False # vl1)"

lemma B_not_Nil: "B vl vl1 \<Longrightarrow> vl = [] \<Longrightarrow> vl1 = []"
by(auto elim: B.cases)

lemma B_OVal_True:
assumes "B (OVal True # vl') vl1"
shows "\<exists> vl1'. BO vl' vl1' \<and> vl1 = OVal True # vl1'"
using assms apply(auto elim!: B.cases)
by (metis append_self_conv2 hd_append list.map_disc_iff list.map_sel(1) list.sel(1)
       list.sel(3) value.distinct(1))+

no_notation relcomp (infixr "O" 75)

interpretation BD_Security_IO where
istate = istate and step = step and
\<phi> = \<phi> and f = f and \<gamma> = \<gamma> and g = g and T = T and B = B
done

subsection \<open>Unwinding proof\<close>

(* Key lemma: *)
lemma eqButPID_step_\<gamma>_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and op: "\<not> open s"
and sT: "reachNT s" and s1: "reach s1"
and \<gamma>: "\<gamma> (Trans s a ou s')"
shows "ou = ou1"
proof-
  note [simp] = all_defs
                open_defs
  note s = reachNT_reach[OF sT]
  note willUse =
  step step1 \<gamma>
  not_open_eqButPID[OF op ss1]
  reach_visPost[OF s]
  eqButPID_stateSelectors[OF ss1]
  eqButPID_actions[OF ss1]
  eqButPID_not_PID[OF ss1]
  {fix uid p pid assume "a = Ract (rPost uid p pid)"
   hence ?thesis using willUse
   by (cases "pid = PID") fastforce+
  } note intCase1 = this
  show ?thesis
  proof (cases a)
    case (Sact x1)
    then show ?thesis using intCase1 willUse by (cases x1) auto
  next
    case (Cact x2)
    then show ?thesis using intCase1 willUse by (cases x2) auto
  next
    case (Dact x3)
    then show ?thesis using intCase1 willUse by (cases x3) auto
  next
    case (Uact x4)
    then show ?thesis using intCase1 willUse by (cases x4) auto
  next
    case (Ract x5)
    then show ?thesis using intCase1 willUse by (cases x5) auto
  next
    case (Lact x6)
    then show ?thesis using intCase1 willUse by (cases x6) auto
  qed
qed

(* Key lemma: *)
lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and a: "a = Uact (uPost uid p PID pst)" "ou = outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
using ss1 step step1
using eqButPID_stateSelectors[OF ss1] eqButPID_setPost[OF ss1]
unfolding a by (auto simp: u_defs)

definition \<Delta>0 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>0 s vl s1 vl1 \<equiv>
 \<not> PID \<in>\<in> postIDs s \<and>
 s = s1 \<and> B vl vl1"

definition \<Delta>1 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>1 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 (\<exists> pstl pstl1. (pstl = [] \<longrightarrow> pstl1 = []) \<and> vl = map TVal pstl \<and> vl1 = map TVal pstl1) \<and>
 eqButPID s s1 \<and> \<not> open s"

definition \<Delta>2 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>2 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 (\<exists> pstl. vl = map TVal pstl \<and> vl1 = map TVal pstl) \<and>
 s = s1 \<and> open s"

definition \<Delta>31 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>31 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 (\<exists> pstl pstl1 vll vll1.
    BO vll vll1 \<and> pstl \<noteq> [] \<and> pstl1 \<noteq> [] \<and> last pstl = last pstl1 \<and>
    vl = map TVal pstl @ OVal True # vll \<and> vl1 = map TVal pstl1 @ OVal True # vll1) \<and>
 eqButPID s s1 \<and> \<not> open s"

definition \<Delta>32 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>32 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 (\<exists> vll vll1.
    BO vll vll1 \<and>
    vl = OVal True # vll \<and> vl1 = OVal True # vll1) \<and>
 s = s1 \<and> \<not> open s"

definition \<Delta>4 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>4 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 (\<exists> pstl vll vll1.
    B vll vll1 \<and>
    vl = map TVal pstl @ OVal False # vll \<and> vl1 = map TVal pstl @ OVal False # vll1) \<and>
 s = s1 \<and> open s"

lemma istate_\<Delta>0:
assumes B: "B vl vl1"
shows "\<Delta>0 istate vl istate vl1"
using assms unfolding \<Delta>0_def istate_def by auto

lemma unwind_cont_\<Delta>0: "unwind_cont \<Delta>0 {\<Delta>0,\<Delta>1,\<Delta>2,\<Delta>31,\<Delta>32,\<Delta>4}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>0 s vl s1 vl1 \<or>
                           \<Delta>1 s vl s1 vl1 \<or> \<Delta>2 s vl s1 vl1 \<or>
                           \<Delta>31 s vl s1 vl1 \<or> \<Delta>32 s vl s1 vl1 \<or> \<Delta>4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1" and PID: "\<not> PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>0_def by auto
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" using B_not_Nil B by auto
  have op: "\<not> open s" using PID unfolding open_defs by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have ?match proof(cases "\<exists> uid p text. a = Cact (cPost uid p PID text) \<and> ou = outOK")
          case True
          then obtain uid p "text" where a: "a = Cact (cPost uid p PID text)" and ou: "ou = outOK" by auto
          have PID': "PID \<in>\<in> postIDs s'"
          using step PID unfolding a ou by (auto simp: c_defs)
          show ?thesis proof(cases "uid \<in> UIDs \<or> (\<exists> uid' \<in> UIDs. uid' \<in>\<in> userIDs s \<and> (uid' \<in>\<in> friendIDs s uid))")
            case True note uid = True
            have op': "open s'" using uid using step PID' unfolding a ou by (auto simp: c_defs open_defs)
            have \<phi>: "\<phi> ?trn" using op op' unfolding \<phi>_def2[OF step] by simp
            then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
            using c unfolding consume_def \<phi>_def2 by(cases vl) auto
            have v: "v = OVal True" using f op op' unfolding a by simp
            then obtain vl1' where BO': "BO vl' vl1'" and vl1: "vl1 = OVal True # vl1'"
            using B_OVal_True B unfolding vl v by auto
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1'" using \<phi> f unfolding vl1 v consume_def ss1 by simp
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?\<Delta> s' vl' s' vl1'" using BO' proof(cases rule: BO.cases)
                case (BO_TVal pstl)
                hence "\<Delta>2 s' vl' s' vl1'" using PID' op' unfolding \<Delta>2_def by auto
                thus ?thesis by simp
              next
                case (BO_B vll vll1 pstl)
                hence "\<Delta>4 s' vl' s' vl1'" using PID' op' unfolding \<Delta>4_def by auto
                thus ?thesis by simp
              qed
            qed
          next
            case False note uid = False
            have op': "\<not> open s'" using step op uid unfolding open_defs a
              by (auto simp add: c_defs reach_not_postIDs_vis_FriendV rs)
            have \<phi>: "\<not> \<phi> ?trn" using op op' a unfolding \<phi>_def2[OF step] by auto
            hence vl': "vl' = vl" using c unfolding consume_def by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1" using \<phi> unfolding consume_def ss1 by auto
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?\<Delta> s' vl' s' vl1" using B proof(cases rule: B.cases)
                case (B_TVal pstl)
                hence "\<Delta>1 s' vl' s' vl1" using PID' op' unfolding \<Delta>1_def vl' by auto
                thus ?thesis by simp
              next
                case (B_BO vll vll1 pstl pstl1)
                show ?thesis
                proof(cases "pstl \<noteq> [] \<and> pstl1 \<noteq> []")
                  case True
                  hence "\<Delta>31 s' vl' s' vl1" using B_BO PID' op' unfolding \<Delta>31_def vl' by auto
                  thus ?thesis by simp
                next
                  case False
                  hence "\<Delta>32 s' vl' s' vl1" using B_BO PID' op' unfolding \<Delta>32_def vl' by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          qed
        next
          case False note a = False
          have op': "\<not> open s'"
            using a step PID op unfolding open_defs
            by (cases a) (auto elim: step_elims simp: all_defs)
          have \<phi>: "\<not> \<phi> ?trn" using PID step op op' unfolding \<phi>_def2[OF step] by (auto simp: u_defs)
          hence vl': "vl' = vl" using c unfolding consume_def by simp
          have PID': "\<not> PID \<in>\<in> postIDs s'"
            using step PID a
            by (cases a) (auto elim: step_elims simp: all_defs)
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using \<phi> unfolding consume_def ss1 by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "\<Delta>0 s' vl' s' vl1" using a B PID' unfolding \<Delta>0_def vl' by simp
            thus "?\<Delta> s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>1: "unwind_cont \<Delta>1 {\<Delta>1}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>1 s vl s1 vl1"
  then obtain pstl pstl1 where
  t: "pstl = [] \<longrightarrow> pstl1 = []"
  and vl: "vl = map TVal pstl" and vl1: "vl1 = map TVal pstl1"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "\<not> open s" and PID: "PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>1_def by auto
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" using t unfolding vl vl1 by auto
  have PID1: "PID \<in>\<in> postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID \<in> set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "\<not> open s1" using op ss1 eqButPID_open by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof(cases pstl1)
    case (Cons text1 pstll1) note pstl1 = Cons
    define uid where uid: "uid \<equiv> owner s PID"  define p where p: "p \<equiv> pass s uid"
    define a1 where a1: "a1 \<equiv> Uact (uPost uid p PID text1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
    have op1': "\<not> open s1'" using step1 op1 unfolding a1 ou1 open_defs by (auto simp: u_defs)
    have uid: "uid \<notin> UIDs" unfolding uid using op PID own unfolding open_defs by auto
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show \<phi>: "\<phi> ?trn1" unfolding \<phi>_def2[OF step1] a1 ou1 by simp
      show "consume ?trn1 vl1 (map TVal pstll1)"
      using \<phi> unfolding vl1 consume_def pstl1 a1 by auto
    next
      show "\<not> \<gamma> ?trn1" using uid unfolding a1 by auto
    next
      have "eqButPID s1 s1'" using Uact_uPost_step_eqButPID[OF _ step1] a1 by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      show "?\<Delta> s vl s1' (map TVal pstll1)" using PID op t ss1' unfolding \<Delta>1_def vl pstl1 by auto
    qed
    thus ?thesis by simp
  next
    case Nil note pstl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof(cases "\<exists> uid p textt. a = Uact (uPost uid p PID textt) \<and> ou = outOK")
        case True then obtain uid p textt where
        a: "a = Uact (uPost uid p PID textt)" and ou: "ou = outOK" by auto
        hence \<phi>: "\<phi> ?trn" unfolding \<phi>_def2[OF step] by auto
        then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text"
        and vl': "vl' = map TVal pstl'"
        using c unfolding consume_def \<phi>_def2 vl by (cases pstl) auto
        have textt: "textt = text" using f unfolding a by auto
        have uid: "uid \<notin> UIDs" using step op PID unfolding a ou open_defs by (auto simp: u_defs)
        have "eqButPID s s'" using Uact_uPost_step_eqButPID[OF a step] by auto
        hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
        have op': "\<not> open s'" using step PID' op unfolding a ou open_defs by (auto simp: u_defs)
        have ?ignore proof
          show "\<not> \<gamma> ?trn" unfolding a using uid by auto
        next
          show "?\<Delta> s' vl' s1 vl1" using PID' s's1 op' unfolding \<Delta>1_def vl' vl1 pstl1 by auto
        qed
        thus ?thesis by simp
      next
        case False note a = False
        {assume \<phi>: "\<phi> ?trn"
         then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text"
         and vl': "vl' = map TVal pstl'" using c unfolding consume_def vl by (cases pstl) auto
         have False using f a \<phi> by (cases ?trn rule: \<phi>.cases) auto
        }
        hence \<phi>: "\<not> \<phi> ?trn" by auto
        have op': "\<not> open s'" using a op \<phi> unfolding \<phi>_def2[OF step] by auto
        have vl': "vl' = vl" using c \<phi> unfolding consume_def by auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        have op1': "\<not> open s1'" using op' eqButPID_open[OF s's1'] by simp
        have "\<And> uid p text. e_updatePost s1 uid p PID text \<longleftrightarrow> e_updatePost s uid p PID text"
        using eqButPID_stateSelectors[OF ss1] unfolding u_defs by auto
        hence ou1: "\<And> uid p text. a = Uact (uPost uid p PID text) \<Longrightarrow> ou1 = ou"
        using step step1 by auto
        hence \<phi>1: "\<not> \<phi> ?trn1" using a op1 op1' unfolding \<phi>_def2[OF step1] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn"
          hence "ou1 = ou" using eqButPID_step_\<gamma>_out[OF ss1 step step1 op rsT rs1] by simp
          thus "g ?trn = g ?trn1" by simp
        next
          show "?\<Delta> s' vl' s1' vl1" using s's1' op' PID' unfolding \<Delta>1_def vl' vl vl1 pstl1 by auto
        qed
      thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>2: "unwind_cont \<Delta>2 {\<Delta>2}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>2 s vl s1 vl1"
  then obtain pstl where
  vl: "vl = map TVal pstl" and vl1: "vl1 = map TVal pstl"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>2_def by fastforce
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" unfolding vl vl1 by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
      {assume op': "\<not> open s'"
       hence \<phi>: "\<phi> ?trn" using op unfolding \<phi>_def2[OF step] by simp
       then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text" and vl': "vl' = map TVal pstl'"
       using c unfolding consume_def \<phi>_def2 vl by(cases pstl) auto
       obtain uid p where a: "a = Uact (uPost uid p PID text)" and ou: "ou = outOK"
         using f \<phi> by (cases ?trn rule: \<phi>.cases) auto
       have False using step op op' PID PID' unfolding a ou open_defs by (auto simp: u_defs)
      }
      hence op': "open s'" by auto
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have ?match proof(cases "\<phi> ?trn")
          case True note \<phi> = True
          then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text" and vl': "vl' = map TVal pstl'"
          using c unfolding consume_def \<phi>_def2 vl by(cases pstl) auto
          obtain uid p textt where a: "a = Uact (uPost uid p PID textt)" and ou: "ou = outOK"
          using \<phi> op op' unfolding \<phi>_def2[OF step] by auto
          have textt: "textt = text" using f unfolding a by simp
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl'" using \<phi> unfolding ss1 consume_def vl1 vl vl' pstl f by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            show "?\<Delta> s' vl' s' vl'" using PID' op' unfolding \<Delta>2_def vl1 vl' vl by auto
          qed
        next
          case False note \<phi> = False
          hence vl': "vl' = vl" using c unfolding consume_def by auto
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl" using \<phi> unfolding ss1 consume_def vl1 vl vl' by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            show "?\<Delta> s' vl' s' vl" using PID' op' unfolding \<Delta>2_def vl1 vl' vl by auto
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>31: "unwind_cont \<Delta>31 {\<Delta>31,\<Delta>32}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>31 s vl s1 vl1 \<or> \<Delta>32 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>31 s vl s1 vl1"
  then obtain pstl pstl1 vll vll1 where BO: "BO vll vll1" and
  t: "pstl \<noteq> []" "pstl1 \<noteq> []" "last pstl = last pstl1"
  and vl: "vl = map TVal pstl @ OVal True # vll"
  and vl1: "vl1 = map TVal pstl1 @ OVal True # vll1"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "\<not> open s" and PID: "PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>31_def by auto
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" using t unfolding vl vl1 by auto
  have PID1: "PID \<in>\<in> postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID \<in> set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "\<not> open s1" using op ss1 eqButPID_open by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof(cases "length pstl1 \<ge> 2" )
    case True then obtain text1 pstll1 where pstl1: "pstl1 = text1 # pstll1"
    and pstll1: "pstll1 \<noteq> []" by (cases pstl1) fastforce+
    define uid where uid: "uid \<equiv> owner s PID"  define p where p: "p \<equiv> pass s uid"
    define a1 where a1: "a1 \<equiv> Uact (uPost uid p PID text1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
    have op1': "\<not> open s1'" using step1 op1 unfolding a1 ou1 open_defs by (auto simp: u_defs)
    have uid: "uid \<notin> UIDs" unfolding uid using op PID own unfolding open_defs by auto
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show \<phi>: "\<phi> ?trn1" unfolding \<phi>_def2[OF step1] a1 ou1 by simp
      show "consume ?trn1 vl1 (map TVal pstll1 @ OVal True # vll1)"
      using \<phi> unfolding vl1 consume_def pstl1 a1 by auto
    next
      show "\<not> \<gamma> ?trn1" using uid unfolding a1 by auto
    next
      have "eqButPID s1 s1'" using Uact_uPost_step_eqButPID[OF _ step1] a1 by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      have "\<Delta>31 s vl s1' (map TVal pstll1 @ OVal True # vll1)"
      using BO PID op t ss1' pstll1 unfolding \<Delta>31_def vl pstl1 by auto
      thus "?\<Delta> s vl s1' (map TVal pstll1 @ OVal True # vll1)" by simp
    qed
    thus ?thesis by simp
  next
    case False then obtain text1 where pstl1: "pstl1 = [text1]" using t
    by (cases pstl1) (auto simp: Suc_leI)
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof(cases "\<exists> uid p textt. a = Uact (uPost uid p PID textt) \<and> ou = outOK")
        case True then obtain uid p textt where
        a: "a = Uact (uPost uid p PID textt)" and ou: "ou = outOK" by auto
        hence \<phi>: "\<phi> ?trn" unfolding \<phi>_def2[OF step] by auto
        then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text"
        and vl': "vl' = map TVal pstl' @ OVal True # vll"
        using c t unfolding consume_def \<phi>_def2 vl by (cases pstl) auto
        have textt: "textt = text" using f unfolding a by auto
        have uid: "uid \<notin> UIDs" using step op PID unfolding a ou open_defs by (auto simp: u_defs)
        have "eqButPID s s'" using Uact_uPost_step_eqButPID[OF a step] by auto
        hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
        have s's1': "s' = s1'" using step step1 ss1 eqButPID_step_eq unfolding a ou by blast
        have "e_updatePost s' uid p PID textt" using step unfolding a ou by(auto simp: u_defs)
        hence \<phi>1: "\<phi> ?trn1" using step1 unfolding a \<phi>_def2[OF step1] s's1' by auto
        hence f1: "f ?trn1 = TVal text" unfolding a textt by simp
        show ?thesis proof(cases "pstl' = []")
          case True note pstl' = True
          hence pstl: "pstl = [text]" unfolding pstl by auto
          hence text1: "text1 = text" using pstl pstl1 t by auto
          have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
          have op': "\<not> open s'" using step PID' op unfolding a ou open_defs by (auto simp: u_defs)
          have ou1: "ou1 = outOK" using \<phi>1 op1 op' unfolding \<phi>_def2[OF step1] s's1' by auto
          have ?match proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 (OVal True # vll1)"
            using \<phi>1 f1 unfolding consume_def vl1 pstl1 pstl text1 by simp
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn"
            show "g ?trn = g ?trn1" using ou ou1 by simp
          next
            have "\<Delta>32 s' vl' s1' (OVal True # vll1)"
            using s's1' BO PID' op' unfolding \<Delta>32_def vl' pstl' by auto
            thus "?\<Delta> s' vl' s1' (OVal True # vll1)" by simp
          qed
          thus ?thesis by simp
        next
          case False note pstl'NE = False
          have lpstl': "last pstl' = text1" using t pstl'NE unfolding pstl pstl1 by simp
          have ?ignore proof
            show "\<not> \<gamma> ?trn" unfolding a using uid by auto
          next
            have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
            have op': "\<not> open s'" using step PID' op unfolding a ou open_defs by (auto simp: u_defs)
            have ou1: "ou1 = outOK" using \<phi>1 op1 op' unfolding \<phi>_def2[OF step1] s's1' by auto
            have "\<Delta>31 s' vl' s1 vl1"
            using PID' s's1 op' BO pstl'NE lpstl' unfolding \<Delta>31_def vl' vl1 pstl1 by force
            thus "?\<Delta> s' vl' s1 vl1" by simp
          qed
          thus ?thesis by simp
        qed
      next
        case False note a = False
        {assume \<phi>: "\<phi> ?trn"
         then obtain "text" pstl' where pstl: "pstl = text # pstl'" and f: "f ?trn = TVal text"
         and vl': "vl' = map TVal pstl' @ OVal True # vll"
         using c t unfolding consume_def vl by (cases pstl) auto
         have False using f a \<phi> by (cases ?trn rule: \<phi>.cases) auto
        }
        hence \<phi>: "\<not> \<phi> ?trn" by auto
        have op': "\<not> open s'" using a op \<phi> unfolding \<phi>_def2[OF step] by auto
        have vl': "vl' = vl" using c \<phi> unfolding consume_def by auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        have op1': "\<not> open s1'" using op' eqButPID_open[OF s's1'] by simp
        have "\<And> uid p text. e_updatePost s1 uid p PID text \<longleftrightarrow> e_updatePost s uid p PID text"
        using eqButPID_stateSelectors[OF ss1] unfolding u_defs by auto
        hence ou1: "\<And> uid p text. a = Uact (uPost uid p PID text) \<Longrightarrow> ou1 = ou"
        using step step1 by auto
        hence \<phi>1: "\<not> \<phi> ?trn1" using a op1 op1' unfolding \<phi>_def2[OF step1] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn"
          hence "ou1 = ou" using eqButPID_step_\<gamma>_out[OF ss1 step step1 op rsT rs1] by simp
          thus "g ?trn = g ?trn1" by simp
        next
          have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
          have "\<Delta>31 s' vl' s1' vl1" using s's1' op' PID' BO t
          unfolding \<Delta>31_def vl' vl vl1 pstl1 by fastforce
          thus "?\<Delta> s' vl' s1' vl1" by simp
        qed
      thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>32: "unwind_cont \<Delta>32 {\<Delta>2,\<Delta>32,\<Delta>4}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>2 s vl s1 vl1 \<or> \<Delta>32 s vl s1 vl1 \<or> \<Delta>4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>32 s vl s1 vl1"
  then obtain vll vll1 where BO: "BO vll vll1"
  and vl: "vl = OVal True # vll"
  and vl1: "vl1 = OVal True # vll1"
  and rs: "reach s" and ss1: "s1 = s" and op: "\<not> open s" and PID: "PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>32_def by fastforce
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" unfolding vl vl1 by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
      let ?trn1 = "Trans s1 a ou s'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof
        show ?match proof(cases "\<phi> ?trn")
          case True note \<phi> = True
          hence f: "f ?trn = OVal True" and vl': "vl' = vll" using c unfolding consume_def vl by auto
          have op': "open s'" using op \<phi> f unfolding \<phi>_def2[OF step] by auto
          show ?thesis proof
            show "validTrans ?trn1" using step unfolding ss1 by simp
          next
            show "consume ?trn1 vl1 vll1" using \<phi> f unfolding consume_def vl1 ss1 by simp
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn"
            thus "g ?trn = g ?trn1" by simp
          next
            show "?\<Delta> s' vl' s' vll1" using BO proof(cases rule: BO.cases)
              case (BO_TVal pstll)
              hence "\<Delta>2 s' vl' s' vll1" using PID' op' unfolding \<Delta>2_def vl' by auto
              thus ?thesis by simp
            next
              case (BO_B vlll pstll)
              hence "\<Delta>4 s' vl' s' vll1" using PID' op' unfolding \<Delta>4_def vl' by auto
              thus ?thesis by simp
            qed
          qed
        next
          case False note \<phi> = False
          hence vl': "vl' = vl" using c unfolding consume_def vl by auto
          have op': "\<not> open s'" using op \<phi> unfolding \<phi>_def2[OF step] by auto
          show ?thesis proof
            show "validTrans ?trn1" using step unfolding ss1 by simp
          next
            show "consume ?trn1 vl1 vl1" using \<phi> unfolding consume_def vl1 ss1 by simp
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn"
            thus "g ?trn = g ?trn1" by simp
          next
            have "\<Delta>32 s' vl' s' vl1" using BO PID' op' unfolding \<Delta>32_def vl' vl vl1 by simp
            thus "?\<Delta> s' vl' s' vl1" by simp
          qed
        qed
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>4: "unwind_cont \<Delta>4 {\<Delta>1,\<Delta>31,\<Delta>32,\<Delta>4}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>1 s vl s1 vl1 \<or> \<Delta>31 s vl s1 vl1 \<or> \<Delta>32 s vl s1 vl1 \<or> \<Delta>4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>4 s vl s1 vl1"
  then obtain pstl vll vll1 where B: "B vll vll1"
  and vl: "vl = map TVal pstl @ OVal False # vll" and vl1: "vl1 = map TVal pstl @ OVal False # vll1"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID \<in>\<in> postIDs s"
  using reachNT_reach unfolding \<Delta>4_def by fastforce
  have vlvl1: "vl = [] \<Longrightarrow> vl1 = []" unfolding vl vl1 by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have ?match proof(cases pstl)
          case (Cons "text" pstl') note pstl = Cons
          {assume op': "\<not> open s'"
           hence \<phi>: "\<phi> ?trn" using op unfolding \<phi>_def2[OF step] by simp
           hence f: "f ?trn = TVal text"
           and vl': "vl' = map TVal pstl' @ OVal False # vll"
           using c unfolding consume_def vl pstl by auto
           obtain uid p where a: "a = Uact (uPost uid p PID text)" and ou: "ou = outOK"
             using f \<phi> by (cases ?trn rule: \<phi>.cases) auto
           have False using step op op' PID PID' unfolding a ou open_defs by (auto simp: u_defs)
          }
          hence op': "open s'" by auto
          show ?thesis proof(cases "\<phi> ?trn")
            case True note \<phi> = True
            hence f: "f ?trn = TVal text" and vl': "vl' = map TVal pstl' @ OVal False # vll"
            using c unfolding consume_def  vl pstl by auto
            obtain uid p textt where a: "a = Uact (uPost uid p PID textt)" and ou: "ou = outOK"
            using \<phi> op op' unfolding \<phi>_def2[OF step] by auto
            have textt: "textt = text" using f unfolding a by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 (map TVal pstl' @ OVal False # vll1)"
              using \<phi> unfolding ss1 consume_def vl1 vl vl' pstl f by auto
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have "\<Delta>4 s' vl' s' (map TVal pstl' @ OVal False # vll1)"
              using B PID' op' unfolding \<Delta>4_def vl1 vl' vl by auto
              thus "?\<Delta> s' vl' s' (map TVal pstl' @ OVal False # vll1)" by simp
            qed
          next
            case False note \<phi> = False
            hence vl': "vl' = vl" using c unfolding consume_def by auto
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1" using \<phi> unfolding ss1 consume_def vl1 vl vl' by auto
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have "\<Delta>4 s' vl' s' vl1"
              using B PID' op' unfolding \<Delta>4_def vl1 vl' vl by auto
              thus "?\<Delta> s' vl' s' vl1" by simp
            qed
          qed
        next
          case Nil note pstl = Nil
          show ?thesis proof(cases "\<phi> ?trn")
            case True note \<phi> = True
            hence f: "f ?trn = OVal False" and vl': "vl' = vll"
            using c unfolding consume_def vl pstl by auto
            hence op': "\<not> open s'" using op step \<phi> unfolding \<phi>_def2[OF step] by auto
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vll1"
              using \<phi> unfolding ss1 consume_def vl1 vl vl' pstl f by auto
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?\<Delta> s' vl' s' vll1" using B proof(cases rule: B.cases)
                case (B_TVal pstlll pstlll1)
                hence "\<Delta>1 s' vl' s' vll1"
                using B PID' op' unfolding \<Delta>1_def vl1 vl' vl by auto
                thus ?thesis by simp
              next
                case (B_BO vlll vlll1 pstlll pstlll1)
                show ?thesis proof(cases "pstlll \<noteq> [] \<and> pstlll1 \<noteq> []")
                  case True
                  hence "\<Delta>31 s' vl' s' vll1"
                  using B_BO B PID' op' unfolding \<Delta>31_def vl1 vl' vl by auto
                  thus ?thesis by simp
                next
                  case False
                  hence "\<Delta>32 s' vl' s' vll1"
                  using B_BO B PID' op' unfolding \<Delta>32_def vl1 vl' vl by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          next
            case False note \<phi> = False
            hence vl': "vl' = vl" using c unfolding consume_def by auto
            have op': "open s'" using \<phi> op unfolding \<phi>_def2[OF step] by auto
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1" using \<phi> unfolding ss1 consume_def vl1 vl vl' by auto
            next
              show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
            next
              assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have "\<Delta>4 s' vl' s' vl1"
              using B PID' op' unfolding \<Delta>4_def vl1 vl' vl by auto
              thus "?\<Delta> s' vl' s' vl1" by simp
            qed
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

definition Gr where
"Gr =
 {
 (\<Delta>0, {\<Delta>0,\<Delta>1,\<Delta>2,\<Delta>31,\<Delta>32,\<Delta>4}),
 (\<Delta>1, {\<Delta>1}),
 (\<Delta>2, {\<Delta>2}),
 (\<Delta>31, {\<Delta>31,\<Delta>32}),
 (\<Delta>32, {\<Delta>2,\<Delta>32,\<Delta>4}),
 (\<Delta>4, {\<Delta>1,\<Delta>31,\<Delta>32,\<Delta>4})
 }"

theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr \<Delta>0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_\<Delta>0 unwind_cont_\<Delta>0 unwind_cont_\<Delta>1
unwind_cont_\<Delta>31 unwind_cont_\<Delta>32 unwind_cont_\<Delta>2 unwind_cont_\<Delta>4
unfolding Gr_def by auto

end


theory OptionI
  imports Isabelle_LLVM.LLVM_DS_Dflt
begin

datatype 'a option_i =
  OPTION_I (val: 'a) (flag: "8 word")
hide_const (open) val flag

instantiation option_i :: (llvm_rep) llvm_rep
begin

definition to_val_option_i :: "'a option_i \<Rightarrow> llvm_val" where
  "to_val_option_i opti \<equiv> (
    case opti of (OPTION_I x flag)  \<Rightarrow> LL_STRUCT [to_val x, to_val flag]
  )"

definition from_val_option_i :: "llvm_val \<Rightarrow> 'a option_i" where
  "from_val_option_i val \<equiv> (
    case val of
     LL_STRUCT [x_val, flag_val] \<Rightarrow> OPTION_I (from_val x_val) (from_val flag_val)|
      _ \<Rightarrow> undefined
  )"

definition "struct_of_option_i (_ :: 'a option_i itself) \<equiv>
  VS_STRUCT [struct_of TYPE('a), struct_of TYPE(8 word)]"

definition "init_option_i \<equiv> OPTION_I init init"

instance
proof(standard, goal_cases)
  case 1
  then show ?case
    unfolding from_val_option_i_def to_val_option_i_def id_def
    apply standard
    by (auto split:  option_i.split)
next
  case (2 v)
  then show ?case
    unfolding from_val_option_i_def to_val_option_i_def struct_of_option_i_def
    by (auto split: llvm_val.split)
next
  case (3 x)
  then show ?case
    unfolding to_val_option_i_def struct_of_option_i_def
    by (auto split: option_i.split)
next
  case 4
  then show ?case
    unfolding to_val_option_i_def init_option_i_def struct_of_option_i_def
    by (auto simp add: init_zero to_val_word_def)
qed
end

subsubsection \<open>Setup for LLVM code export\<close>
text \<open>Declare structure to code generator.\<close>
lemma to_val_option_i[ll_struct_of]:
  "struct_of TYPE('a::llvm_rep option_i) =  VS_STRUCT [struct_of TYPE('a), struct_of TYPE(8 word)]"
  unfolding struct_of_option_i_def by simp

subsubsection \<open>Code Generator Preprocessor Setup\<close>
text \<open>The next two are auxiliary lemmas\<close>
lemma option_i_insert_value:
  "ll_insert_value (OPTION_I x flag) xn 0 = Mreturn (OPTION_I xn flag)"
  "ll_insert_value (OPTION_I x flag) flagn (Suc 0) = Mreturn (OPTION_I x flagn)"
  by (simp add:
      ll_insert_value_def
      llvm_insert_value_def
      to_val_option_i_def
      checked_from_val_def
      struct_of_option_i_def
      from_val_option_i_def)+

lemma option_i_extract_value:
  "ll_extract_value (OPTION_I x flag) 0 = Mreturn x"
  "ll_extract_value (OPTION_I x flag) (Suc 0) = Mreturn flag"
  by (simp add:
      ll_extract_value_def
      llvm_extract_value_def
      checked_from_val_def
      to_val_option_i_def)+

text \<open>Lemmas to translate node construction and destruction\<close>
lemma inline_return_option_i[llvm_pre_simp]: "Mreturn (OPTION_I x flag) =
   doM {
    res \<leftarrow> ll_insert_value init x 0;
    res \<leftarrow> ll_insert_value res flag 1;
    Mreturn res
  }"
  by (auto simp: init_option_i_def option_i_insert_value)

lemma inline_option_i_case[llvm_pre_simp]: "
  (case opti of (OPTION_I x flag) \<Rightarrow> f x flag) =
   doM {
    x \<leftarrow> ll_extract_value opti 0;
    flag \<leftarrow> ll_extract_value opti 1;
    f x flag
  }"
  apply (cases opti)
  by (auto simp: option_i_extract_value)

lemma inline_return_option_i_case[llvm_pre_simp]:
 "Mreturn (case opti of (OPTION_I x flag) \<Rightarrow> f x flag) =
  doM {
    x \<leftarrow> ll_extract_value opti 0;
    flag \<leftarrow> ll_extract_value opti 1;
    Mreturn (f x flag)
  }"
  apply (cases opti)
  by (auto simp: option_i_extract_value)

lemmas [llvm_inline] = option_i.val_def option_i.flag_def

locale option_impl =
  fixes elem_assn :: "('a, 'ai) dr_assn"
begin

fun option_assn' :: "'a option \<Rightarrow> 'ai option_i \<Rightarrow> ll_assn" where
  "option_assn' None (OPTION_I xi flag) = \<up>(flag = 0)"
| "option_assn' (Some x) (OPTION_I xi flag) = (\<up>(flag = 1) ** \<upharpoonleft>elem_assn x xi)"

definition "option_assn \<equiv> mk_assn option_assn'"

lemma option_assn_None [simp]: "\<upharpoonleft>option_assn None (OPTION_I xi flag) = \<up>(flag = 0)"
  unfolding option_assn_def by auto

lemma option_assn_Some [simp]:
  "\<upharpoonleft>option_assn (Some x) (OPTION_I xi flag) =(\<up>(flag = 1) ** \<upharpoonleft>elem_assn x xi)"
  unfolding option_assn_def by auto

lemma option_assn_0 [simp]: "\<upharpoonleft>option_assn opt (OPTION_I xi 0) = \<up>(opt = None)"
  unfolding option_assn_def
  by (cases opt; simp)

end

end


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