(*
   Title: Psi-calculi
   Author/Maintainer: Jesper Bengtson (jebe@itu.dk), 2012
*)
theory Bisim_Pres
  imports Bisimulation Sim_Pres
begin

context env begin

lemma bisimInputPres:
  fixes \<Psi>    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a

  assumes "\<And>Tvec. length xvec = length Tvec \<Longrightarrow> \<Psi> \<rhd> P[xvec::=Tvec] \<sim> Q[xvec::=Tvec]"

  shows "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<sim> M\<lparr>\<lambda>*xvec N\<rparr>.Q"
proof -
  let ?X = "{(\<Psi>, M\<lparr>\<lambda>*xvec N\<rparr>.P, M\<lparr>\<lambda>*xvec N\<rparr>.Q) | \<Psi> M xvec N P Q. \<forall>Tvec. length xvec = length Tvec \<longrightarrow> \<Psi> \<rhd> P[xvec::=Tvec] \<sim> Q[xvec::=Tvec]}"

  from assms have "(\<Psi>, M\<lparr>\<lambda>*xvec N\<rparr>.P, M\<lparr>\<lambda>*xvec N\<rparr>.Q) \<in> ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cStatEq \<Psi> P Q)
    thus ?case by auto
  next
    case(cSim \<Psi> P Q)
    thus ?case by(blast intro: inputPres)
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by(blast dest: bisimE)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(blast dest: bisimE)
  qed
qed

lemma bisimOutputPres:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   M :: 'a
  and   N :: 'a

  assumes "\<Psi> \<rhd> P \<sim> Q"

  shows "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<sim> M\<langle>N\<rangle>.Q"
proof -
  let ?X = "{(\<Psi>, M\<langle>N\<rangle>.P, M\<langle>N\<rangle>.Q) | \<Psi> M N P Q. \<Psi> \<rhd> P \<sim> Q}"
  from `\<Psi> \<rhd> P \<sim> Q` have "(\<Psi>, M\<langle>N\<rangle>.P, M\<langle>N\<rangle>.Q) \<in> ?X" by auto
  thus ?thesis
    by(coinduct rule: bisimCoinduct, auto) (blast intro: outputPres dest: bisimE)+
qed

lemma bisimCasePres:
  fixes \<Psi>   :: 'b
  and   CsP :: "('c \<times> ('a, 'b, 'c) psi) list"
  and   CsQ :: "('c \<times> ('a, 'b, 'c) psi) list"

  assumes "\<And>\<phi> P. (\<phi>, P) mem CsP \<Longrightarrow> \<exists>Q. (\<phi>, Q) mem CsQ \<and> guarded Q \<and> \<Psi> \<rhd> P \<sim> Q"
  and     "\<And>\<phi> Q. (\<phi>, Q) mem CsQ \<Longrightarrow> \<exists>P. (\<phi>, P) mem CsP \<and> guarded P \<and> \<Psi> \<rhd> P \<sim> Q"

  shows "\<Psi> \<rhd> Cases CsP \<sim> Cases CsQ"
proof -
  let ?X = "{(\<Psi>, Cases CsP, Cases CsQ) | \<Psi> CsP CsQ. (\<forall>\<phi> P. (\<phi>, P) mem CsP \<longrightarrow> (\<exists>Q. (\<phi>, Q) mem CsQ \<and> guarded Q \<and> \<Psi> \<rhd> P \<sim> Q)) \<and>
                                                     (\<forall>\<phi> Q. (\<phi>, Q) mem CsQ \<longrightarrow> (\<exists>P. (\<phi>, P) mem CsP \<and> guarded P \<and> \<Psi> \<rhd> P \<sim> Q))}"
  from assms have "(\<Psi>, Cases CsP, Cases CsQ) \<in> ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cStatEq \<Psi> P Q)
    thus ?case by auto
  next
    case(cSim \<Psi> CasesP CasesQ)
    then obtain CsP CsQ where C1: "\<And>\<phi> Q. (\<phi>, Q) mem CsQ \<Longrightarrow> \<exists>P. (\<phi>, P) mem CsP \<and> guarded P \<and> \<Psi> \<rhd> P \<sim> Q"
                          and A: "CasesP = Cases CsP" and B: "CasesQ = Cases CsQ"
      by auto
    note C1
    moreover have "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[bisim] Q" by(rule bisimE)
    moreover have "bisim \<subseteq> ?X \<union> bisim" by blast
    ultimately have "\<Psi> \<rhd> Cases CsP \<leadsto>[(?X \<union> bisim)] Cases CsQ"
      by(rule casePres)
    thus ?case using A B by blast
  next
    case(cExt \<Psi> P Q)
    thus ?case by(blast dest: bisimE)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(blast dest: bisimE)
  qed
qed

lemma bisimResPres:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   x :: name

  assumes "\<Psi> \<rhd> P \<sim> Q"
  and     "x \<sharp> \<Psi>"

  shows "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<sim> \<lparr>\<nu>x\<rparr>Q"
proof -
  let ?X = "{(\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) | \<Psi> x P Q. \<Psi> \<rhd> P \<sim> Q \<and> x \<sharp> \<Psi>}"

  from assms have "(\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) \<in> ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cStatEq \<Psi> xP xQ)
    from `(\<Psi>, xP, xQ) \<in> ?X` obtain x P Q where "\<Psi> \<rhd> P \<sim> Q" and "x \<sharp> \<Psi>" and "xP = \<lparr>\<nu>x\<rparr>P" and "xQ = \<lparr>\<nu>x\<rparr>Q"
      by auto
    moreover from `\<Psi> \<rhd> P \<sim> Q` have PeqQ: "insertAssertion(extractFrame P) \<Psi> \<simeq>\<^sub>F insertAssertion(extractFrame Q) \<Psi>"
      by(rule bisimE)
    ultimately show ?case by(auto intro: frameResPres)
  next
    case(cSim \<Psi> xP xQ)
    from `(\<Psi>, xP, xQ) \<in> ?X` obtain x P Q where "\<Psi> \<rhd> P \<sim> Q" and "x \<sharp> \<Psi>" and "xP = \<lparr>\<nu>x\<rparr>P" and "xQ = \<lparr>\<nu>x\<rparr>Q"
      by auto
    from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<rhd> P \<leadsto>[bisim] Q" by(rule bisimE)
    moreover have "eqvt ?X"
      by(force simp add: eqvt_def bisimClosed pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
    hence "eqvt(?X \<union> bisim)" by auto
    moreover note `x \<sharp> \<Psi>`
    moreover have "bisim \<subseteq> ?X \<union> bisim" by auto
    moreover have "\<And>\<Psi> P Q x. \<lbrakk>(\<Psi>, P, Q) \<in> bisim; x \<sharp> \<Psi>\<rbrakk> \<Longrightarrow> (\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) \<in> ?X \<union> bisim"
      by auto
    ultimately have "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<leadsto>[(?X \<union> bisim)] \<lparr>\<nu>x\<rparr>Q"
      by(rule resPres)
    with `xP = \<lparr>\<nu>x\<rparr>P` `xQ = \<lparr>\<nu>x\<rparr>Q` show ?case
      by simp
  next
    case(cExt \<Psi> xP xQ \<Psi>')
    from `(\<Psi>, xP, xQ) \<in> ?X` obtain x P Q where "\<Psi> \<rhd> P \<sim> Q" and "x \<sharp> \<Psi>" and "xP = \<lparr>\<nu>x\<rparr>P" and "xQ = \<lparr>\<nu>x\<rparr>Q"
      by auto
    obtain y::name where "y \<sharp> P" and "y \<sharp> Q" and "y \<sharp> \<Psi>" and "y \<sharp> \<Psi>'"
     by(generate_fresh "name", auto simp add: fresh_prod)
   from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<otimes> ([(x, y)] \<bullet> \<Psi>') \<rhd> P \<sim> Q"
     by(rule bisimE)
   hence "([(x, y)] \<bullet> (\<Psi> \<otimes> ([(x, y)] \<bullet> \<Psi>'))) \<rhd> ([(x, y)] \<bullet> P) \<sim> ([(x, y)] \<bullet> Q)"
     by(rule bisimClosed)
   with `x \<sharp> \<Psi>` `y \<sharp> \<Psi>` have "\<Psi> \<otimes> \<Psi>' \<rhd> ([(x, y)] \<bullet> P) \<sim> ([(x, y)] \<bullet> Q)"
     by(simp add: eqvts)
   with `y \<sharp> \<Psi>` `y \<sharp> \<Psi>'` have "(\<Psi> \<otimes> \<Psi>', \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> P), \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> Q)) \<in> ?X"
     by auto
   moreover from `y \<sharp> P` `y \<sharp> Q` have "\<lparr>\<nu>x\<rparr>P = \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> P)" and "\<lparr>\<nu>x\<rparr>Q = \<lparr>\<nu>y\<rparr>([(x, y)] \<bullet> Q)"
     by(simp add: alphaRes)+
   ultimately show ?case using `xP = \<lparr>\<nu>x\<rparr>P` `xQ = \<lparr>\<nu>x\<rparr>Q` by simp
 next
    case(cSym \<Psi> P Q)
    thus ?case
      by(blast dest: bisimE)
  qed
qed

lemma bisimResChainPres:
  fixes \<Psi>   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   xvec :: "name list"

  assumes "\<Psi> \<rhd> P \<sim> Q"
  and     "xvec \<sharp>* \<Psi>"

  shows "\<Psi> \<rhd> \<lparr>\<nu>*xvec\<rparr>P \<sim> \<lparr>\<nu>*xvec\<rparr>Q"
using assms
by(induct xvec) (auto intro: bisimResPres)

lemma bisimParPresAux:
  fixes \<Psi>  :: 'b
  and   \<Psi>\<^sub>R :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   Q  :: "('a, 'b, 'c) psi"
  and   R  :: "('a, 'b, 'c) psi"
  and   A\<^sub>R :: "name list"

  assumes "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"
  and     FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>"
  and     "A\<^sub>R \<sharp>* \<Psi>"
  and     "A\<^sub>R \<sharp>* P"
  and     "A\<^sub>R \<sharp>* Q"

  shows "\<Psi> \<rhd> P \<parallel> R \<sim> Q \<parallel> R"
proof -
  let ?X = "{(\<Psi>, \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R), \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)) | xvec \<Psi> P Q R. xvec \<sharp>* \<Psi> \<and> (\<forall>A\<^sub>R \<Psi>\<^sub>R. (extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle> \<and> A\<^sub>R \<sharp>* \<Psi> \<and> A\<^sub>R \<sharp>* P \<and> A\<^sub>R \<sharp>* Q) \<longrightarrow>
                                                                                \<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q)}"
  {
    fix xvec :: "name list"
    and \<Psi>    :: 'b
    and P    :: "('a, 'b, 'c) psi"
    and Q    :: "('a, 'b, 'c) psi"
    and R    :: "('a, 'b, 'c) psi"

    assume "xvec \<sharp>* \<Psi>"
    and    "\<And>A\<^sub>R \<Psi>\<^sub>R. \<lbrakk>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>; A\<^sub>R \<sharp>* \<Psi>; A\<^sub>R \<sharp>* P; A\<^sub>R \<sharp>* Q\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"

    hence "(\<Psi>, \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R), \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)) \<in> ?X"
      apply auto
      by blast
  }

  note XI = this
  {
    fix xvec :: "name list"
    and \<Psi>    :: 'b
    and P    :: "('a, 'b, 'c) psi"
    and Q    :: "('a, 'b, 'c) psi"
    and R    :: "('a, 'b, 'c) psi"
    and C    :: "'d::fs_name"

    assume "xvec \<sharp>* \<Psi>"
    and    A: "\<And>A\<^sub>R \<Psi>\<^sub>R. \<lbrakk>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>; A\<^sub>R \<sharp>* \<Psi>; A\<^sub>R \<sharp>* P; A\<^sub>R \<sharp>* Q; A\<^sub>R \<sharp>* C\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"

    from `xvec \<sharp>* \<Psi>` have "(\<Psi>, \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R), \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)) \<in> ?X"
    proof(rule XI)
      fix A\<^sub>R \<Psi>\<^sub>R
      assume FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>"
      obtain p::"name prm" where "(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>R) \<sharp>* P" and "(p \<bullet> A\<^sub>R) \<sharp>* Q" and "(p \<bullet> A\<^sub>R) \<sharp>* R" and "(p \<bullet> A\<^sub>R) \<sharp>* C"
                             and "(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>R" and S: "(set p) \<subseteq> (set A\<^sub>R) \<times> (set(p \<bullet> A\<^sub>R))" and "distinctPerm p"
        by(rule_tac c="(\<Psi>, P, Q, R, \<Psi>\<^sub>R, C)" in name_list_avoiding) auto
      from FrR `(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>\<^sub>R` S have "extractFrame R = \<langle>(p \<bullet> A\<^sub>R), p \<bullet> \<Psi>\<^sub>R\<rangle>" by(simp add: frameChainAlpha')

      moreover assume "A\<^sub>R \<sharp>* \<Psi>"
      hence "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> \<Psi>)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `A\<^sub>R \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>` S have "(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>" by simp
      moreover assume "A\<^sub>R \<sharp>* P"
      hence "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `A\<^sub>R \<sharp>* P` `(p \<bullet> A\<^sub>R) \<sharp>* P` S have "(p \<bullet> A\<^sub>R) \<sharp>* P" by simp
      moreover assume "A\<^sub>R \<sharp>* Q"
      hence "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `A\<^sub>R \<sharp>* Q` `(p \<bullet> A\<^sub>R) \<sharp>* Q` S have "(p \<bullet> A\<^sub>R) \<sharp>* Q" by simp
      ultimately have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<rhd> P \<sim> Q" using `(p \<bullet> A\<^sub>R) \<sharp>* C` A by blast
      hence "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<rhd> (p \<bullet> P) \<sim> (p \<bullet> Q)" by(rule bisimClosed)
      with `A\<^sub>R \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>` `A\<^sub>R \<sharp>* P` `(p \<bullet> A\<^sub>R) \<sharp>* P` `A\<^sub>R \<sharp>* Q` `(p \<bullet> A\<^sub>R) \<sharp>* Q` S `distinctPerm p`
      show "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q" by(simp add: eqvts)
    qed
  }
  note XI' = this

  have "eqvt ?X"
    apply(auto simp add: eqvt_def)
    apply(rule_tac x="p \<bullet> xvec" in exI)
    apply(rule_tac x="p \<bullet> P" in exI)
    apply(rule_tac x="p \<bullet> Q" in exI)
    apply(rule_tac x="p \<bullet> R" in exI)
    apply(simp add: eqvts)
    apply(simp add: fresh_star_bij)
    apply(clarify)
    apply(erule_tac x="(rev p) \<bullet> A\<^sub>R" in allE)
    apply(erule_tac x="(rev p) \<bullet> \<Psi>\<^sub>R" in allE)
    apply(drule mp)
    apply(rule conjI)
    apply(rule_tac pi=p in pt_bij4[OF pt_name_inst, OF at_name_inst])
    apply(simp add: eqvts)
    defer
    apply(drule_tac p=p in bisimClosed)
    apply(simp add: eqvts)
    apply(subst pt_fresh_star_bij[OF pt_name_inst,OF at_name_inst, of p, THEN sym])
    apply simp
    apply(subst pt_fresh_star_bij[OF pt_name_inst,OF at_name_inst, of p, THEN sym])
    apply simp
    apply(subst pt_fresh_star_bij[OF pt_name_inst,OF at_name_inst, of p, THEN sym])
    by simp

  moreover have Res: "\<And>\<Psi> P Q x. \<lbrakk>(\<Psi>, P, Q) \<in> ?X \<union> bisim; x \<sharp> \<Psi>\<rbrakk> \<Longrightarrow> (\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) \<in> ?X \<union> bisim"
  proof -
    fix \<Psi> P Q x
    assume "(\<Psi>, P, Q) \<in> ?X \<union> bisim" and "(x::name) \<sharp> \<Psi>"
    show "(\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) \<in> ?X \<union> bisim"
    proof(case_tac "(\<Psi>, P, Q) \<in> ?X")
      assume "(\<Psi>, P, Q) \<in> ?X"
      with `x \<sharp> \<Psi>` have "(\<Psi>, \<lparr>\<nu>x\<rparr>P, \<lparr>\<nu>x\<rparr>Q) \<in> ?X"
        apply auto
        by(rule_tac x="x#xvec" in exI) auto
      thus ?thesis by simp
    next
      assume "\<not>(\<Psi>, P, Q) \<in> ?X"
      with `(\<Psi>, P, Q) \<in> ?X \<union> bisim` have "\<Psi> \<rhd> P \<sim> Q"
        by blast
      hence "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<sim> \<lparr>\<nu>x\<rparr>Q" using `x \<sharp> \<Psi>`
        by(rule bisimResPres)
      thus ?thesis
        by simp
    qed
  qed

  have "(\<Psi>, P \<parallel> R, Q \<parallel> R) \<in> ?X"
  proof -
    {
      fix A\<^sub>R' :: "name list"
      and \<Psi>\<^sub>R' :: 'b

      assume FrR': "extractFrame R = \<langle>A\<^sub>R', \<Psi>\<^sub>R'\<rangle>"
      and    "A\<^sub>R' \<sharp>* \<Psi>"
      and    "A\<^sub>R' \<sharp>* P"
      and    "A\<^sub>R' \<sharp>* Q"

      obtain p where "(p \<bullet> A\<^sub>R') \<sharp>* A\<^sub>R" and "(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>\<^sub>R'" and "(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>" and "(p \<bullet> A\<^sub>R') \<sharp>* P" and "(p \<bullet> A\<^sub>R') \<sharp>* Q"
                 and Sp: "(set p) \<subseteq> (set A\<^sub>R') \<times> (set(p \<bullet> A\<^sub>R'))" and "distinctPerm p"
        by(rule_tac c="(A\<^sub>R, \<Psi>, \<Psi>\<^sub>R', P, Q)" in name_list_avoiding) auto

      from FrR' `(p \<bullet> A\<^sub>R') \<sharp>*  \<Psi>\<^sub>R'` Sp have "extractFrame R = \<langle>(p \<bullet> A\<^sub>R'), p \<bullet> \<Psi>\<^sub>R'\<rangle>"
        by(simp add: frameChainAlpha eqvts)
      with FrR `(p \<bullet> A\<^sub>R') \<sharp>* A\<^sub>R` obtain q::"name prm"
        where Sq: "set q \<subseteq> set(p \<bullet> A\<^sub>R') \<times> set A\<^sub>R" and "distinctPerm q" and "\<Psi>\<^sub>R = q \<bullet> p \<bullet> \<Psi>\<^sub>R'"
        by(force elim: frameChainEq)

      from `\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q` `\<Psi>\<^sub>R = q \<bullet> p \<bullet> \<Psi>\<^sub>R'` have "\<Psi> \<otimes> (q \<bullet> p \<bullet> \<Psi>\<^sub>R') \<rhd> P \<sim> Q" by simp
      hence "(q \<bullet> (\<Psi> \<otimes> (q \<bullet> p \<bullet> \<Psi>\<^sub>R'))) \<rhd> (q \<bullet> P) \<sim> (q \<bullet> Q)" by(rule bisimClosed)
      with Sq `A\<^sub>R \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>` `A\<^sub>R \<sharp>* P` `(p \<bullet> A\<^sub>R') \<sharp>* P` `A\<^sub>R \<sharp>* Q` `(p \<bullet> A\<^sub>R') \<sharp>* Q` `distinctPerm q`
      have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R') \<rhd> P \<sim> Q" by(simp add: eqvts)
      hence "(p \<bullet> (\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R'))) \<rhd> (p \<bullet> P) \<sim> (p \<bullet> Q)" by(rule bisimClosed)
      with Sp `A\<^sub>R' \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>` `A\<^sub>R' \<sharp>* P` `(p \<bullet> A\<^sub>R') \<sharp>* P` `A\<^sub>R' \<sharp>* Q` `(p \<bullet> A\<^sub>R') \<sharp>* Q` `distinctPerm p`
      have "\<Psi> \<otimes> \<Psi>\<^sub>R' \<rhd> P \<sim> Q" by(simp add: eqvts)
    }
    thus ?thesis
      apply auto
      apply(rule_tac x="[]" in exI)
      by auto blast
  qed
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cStatEq \<Psi> PR QR)
    from `(\<Psi>, PR, QR) \<in> ?X`
    obtain xvec P Q R A\<^sub>R \<Psi>\<^sub>R where PFrR: "PR = \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R)" and QFrR: "QR = \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)"
                              and "xvec \<sharp>* \<Psi>" and FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>" and PSimQ: "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"
                              and "A\<^sub>R \<sharp>* xvec" and "A\<^sub>R \<sharp>* \<Psi>" and "A\<^sub>R \<sharp>* P" and "A\<^sub>R \<sharp>* Q" and "A\<^sub>R \<sharp>* R"
      apply auto
      apply(subgoal_tac "\<exists>A\<^sub>R \<Psi>\<^sub>R. extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle> \<and> A\<^sub>R \<sharp>* (xvec, \<Psi>, P, Q, R)")
      apply auto
      apply(rule_tac F="extractFrame R" and C="(xvec, \<Psi>, P, Q, R)" in freshFrame)
      by auto

    obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* A\<^sub>R" and "A\<^sub>P \<sharp>* \<Psi>\<^sub>R"
      by(rule_tac C="(\<Psi>, A\<^sub>R, \<Psi>\<^sub>R)" in freshFrame) auto
    obtain A\<^sub>Q \<Psi>\<^sub>Q where FrQ: "extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" and "A\<^sub>Q \<sharp>* \<Psi>" and "A\<^sub>Q \<sharp>* A\<^sub>R" and "A\<^sub>Q \<sharp>* \<Psi>\<^sub>R"
      by(rule_tac C="(\<Psi>, A\<^sub>R, \<Psi>\<^sub>R)" in freshFrame) auto
    from `A\<^sub>R \<sharp>* P` `A\<^sub>R \<sharp>* Q` `A\<^sub>P \<sharp>* A\<^sub>R` `A\<^sub>Q \<sharp>* A\<^sub>R` FrP FrQ have "A\<^sub>R \<sharp>* \<Psi>\<^sub>P" and  "A\<^sub>R \<sharp>* \<Psi>\<^sub>Q"
      by(force dest: extractFrameFreshChain)+

    have "\<langle>(A\<^sub>P@A\<^sub>R), \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>(A\<^sub>Q@A\<^sub>R), \<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R\<rangle>"
    proof -
      have "\<langle>A\<^sub>P, \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>P\<rangle>"
        by(metis frameResChainPres frameNilStatEq Associativity Commutativity AssertionStatEqTrans Composition)
      moreover from PSimQ have "insertAssertion(extractFrame P) (\<Psi> \<otimes> \<Psi>\<^sub>R) \<simeq>\<^sub>F insertAssertion(extractFrame Q) (\<Psi> \<otimes> \<Psi>\<^sub>R)"
        by(rule bisimE)
      with FrP FrQ freshCompChain `A\<^sub>P \<sharp>* \<Psi>` `A\<^sub>P \<sharp>* \<Psi>\<^sub>R` `A\<^sub>Q \<sharp>* \<Psi>` `A\<^sub>Q \<sharp>* \<Psi>\<^sub>R` have "\<langle>A\<^sub>P, (\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, (\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>Q\<rangle>"
        by auto
      moreover have "\<langle>A\<^sub>Q, (\<Psi> \<otimes> \<Psi>\<^sub>R) \<otimes> \<Psi>\<^sub>Q\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R\<rangle>"
        by(metis frameResChainPres frameNilStatEq Associativity Commutativity AssertionStatEqTrans Composition)
      ultimately have "\<langle>A\<^sub>P, \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R\<rangle>"
        by(blast intro: FrameStatEqTrans)
      hence "\<langle>(A\<^sub>R@A\<^sub>P), \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>R\<rangle> \<simeq>\<^sub>F \<langle>(A\<^sub>R@A\<^sub>Q), \<Psi> \<otimes> \<Psi>\<^sub>Q \<otimes> \<Psi>\<^sub>R\<rangle>"
        by(drule_tac frameResChainPres) (simp add: frameChainAppend)
      thus ?thesis
        apply(simp add: frameChainAppend)
        by(metis frameResChainComm FrameStatEqTrans)
    qed
    moreover from `A\<^sub>P \<sharp>* \<Psi>` `A\<^sub>R \<sharp>* \<Psi>` have "(A\<^sub>P@A\<^sub>R) \<sharp>* \<Psi>" by simp
    moreover from `A\<^sub>Q \<sharp>* \<Psi>` `A\<^sub>R \<sharp>* \<Psi>` have "(A\<^sub>Q@A\<^sub>R) \<sharp>* \<Psi>" by simp
    ultimately have PFrRQR: "insertAssertion(extractFrame(P \<parallel> R)) \<Psi> \<simeq>\<^sub>F insertAssertion(extractFrame(Q \<parallel> R)) \<Psi>"
      using FrP FrQ FrR `A\<^sub>P \<sharp>* A\<^sub>R` `A\<^sub>P \<sharp>* \<Psi>\<^sub>R` `A\<^sub>Q \<sharp>* A\<^sub>R` `A\<^sub>Q \<sharp>* \<Psi>\<^sub>R` `A\<^sub>R \<sharp>* \<Psi>\<^sub>P` `A\<^sub>R \<sharp>* \<Psi>\<^sub>Q`
      by simp

    from `xvec \<sharp>* \<Psi>` have "insertAssertion (extractFrame(\<lparr>\<nu>*xvec\<rparr>P \<parallel> R)) \<Psi> \<simeq>\<^sub>F \<lparr>\<nu>*xvec\<rparr>(insertAssertion (extractFrame(P \<parallel> R)) \<Psi>)"
      by(rule insertAssertionExtractFrameFresh)
    moreover from PFrRQR have "\<lparr>\<nu>*xvec\<rparr>(insertAssertion (extractFrame(P \<parallel> R)) \<Psi>) \<simeq>\<^sub>F \<lparr>\<nu>*xvec\<rparr>(insertAssertion (extractFrame(Q \<parallel> R)) \<Psi>)"
      by(induct xvec) (auto intro: frameResPres)
    moreover from `xvec \<sharp>* \<Psi>` have "\<lparr>\<nu>*xvec\<rparr>(insertAssertion (extractFrame(Q \<parallel> R)) \<Psi>) \<simeq>\<^sub>F insertAssertion (extractFrame(\<lparr>\<nu>*xvec\<rparr>Q \<parallel> R)) \<Psi>"
      by(rule FrameStatEqSym[OF insertAssertionExtractFrameFresh])
    ultimately show ?case using PFrR QFrR
      by(blast intro: FrameStatEqTrans)
  next
    case(cSim \<Psi> PR QR)
    {
      fix \<Psi> P Q R xvec
      assume "\<And>A\<^sub>R \<Psi>\<^sub>R. \<lbrakk>extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>; A\<^sub>R \<sharp>* \<Psi>; A\<^sub>R \<sharp>* P; A\<^sub>R \<sharp>* Q\<rbrakk> \<Longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"
      moreover have "eqvt bisim" by simp
      moreover from `eqvt ?X` have "eqvt(?X \<union> bisim)" by auto
      moreover from bisimE(1) have "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> insertAssertion (extractFrame Q) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame P) \<Psi>" by(simp add: FrameStatEq_def)
      moreover note bisimE(2) bisimE(3)
      moreover
      {
        fix \<Psi> P Q A\<^sub>R \<Psi>\<^sub>R R
        assume PSimQ: "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"
           and FrR: "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>"
           and "A\<^sub>R \<sharp>* \<Psi>"
           and "A\<^sub>R \<sharp>* P"
           and "A\<^sub>R \<sharp>* Q"
        hence "(\<Psi>, P \<parallel> R, Q \<parallel> R) \<in> ?X"
        proof -
          have "P \<parallel> R = \<lparr>\<nu>*[]\<rparr>(P \<parallel> R)" by simp
          moreover have "Q \<parallel> R = \<lparr>\<nu>*[]\<rparr>(Q \<parallel> R)" by simp
          moreover have "([]::name list) \<sharp>* \<Psi>" by simp
          moreover
          {
            fix A\<^sub>R' \<Psi>\<^sub>R'

            assume FrR': "extractFrame R = \<langle>A\<^sub>R', \<Psi>\<^sub>R'\<rangle>"
               and "A\<^sub>R' \<sharp>* \<Psi>"
               and "A\<^sub>R' \<sharp>* P"
               and "A\<^sub>R' \<sharp>* Q"
            obtain p where "(p \<bullet> A\<^sub>R') \<sharp>* A\<^sub>R"
                       and "(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>\<^sub>R'"
                       and "(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>"
                       and "(p \<bullet> A\<^sub>R') \<sharp>* P"
                       and "(p \<bullet> A\<^sub>R') \<sharp>* Q"
                       and S: "(set p) \<subseteq> (set A\<^sub>R') \<times> (set(p \<bullet> A\<^sub>R'))" and "distinctPerm p"
              by(rule_tac c="(A\<^sub>R, \<Psi>, \<Psi>\<^sub>R', P, Q)" in name_list_avoiding) auto

            from `(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>\<^sub>R'` S have "\<langle>A\<^sub>R', \<Psi>\<^sub>R'\<rangle> = \<langle>p \<bullet> A\<^sub>R', p \<bullet> \<Psi>\<^sub>R'\<rangle>"
              by(simp add: frameChainAlpha)

            with FrR' have FrR'': "extractFrame R = \<langle>p \<bullet> A\<^sub>R', p \<bullet> \<Psi>\<^sub>R'\<rangle>" by simp
            with FrR `(p \<bullet> A\<^sub>R') \<sharp>* A\<^sub>R`
            obtain q where "p \<bullet> \<Psi>\<^sub>R' = (q::name prm) \<bullet> \<Psi>\<^sub>R" and S': "set q \<subseteq> (set A\<^sub>R) \<times> set(p \<bullet> A\<^sub>R')" and "distinctPerm q"
              apply auto
              apply(drule_tac sym) apply simp
              by(drule_tac frameChainEq) auto
            from PSimQ have "(q \<bullet> (\<Psi> \<otimes> \<Psi>\<^sub>R)) \<rhd> (q \<bullet> P) \<sim> (q \<bullet> Q)"
              by(rule bisimClosed)
            with `A\<^sub>R \<sharp>* \<Psi>` `A\<^sub>R \<sharp>* P` `A\<^sub>R \<sharp>* Q` `(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R') \<sharp>* P` `(p \<bullet> A\<^sub>R') \<sharp>* Q` S'
            have "\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>R) \<rhd> P \<sim> Q" by(simp add: eqvts)
            hence "(p \<bullet> (\<Psi> \<otimes> (q \<bullet> \<Psi>\<^sub>R))) \<rhd> (p \<bullet> P) \<sim> (p \<bullet> Q)" by(rule bisimClosed)
            with `A\<^sub>R' \<sharp>* \<Psi>` `A\<^sub>R' \<sharp>* P` `A\<^sub>R' \<sharp>* Q` `(p \<bullet> A\<^sub>R') \<sharp>* \<Psi>` `(p \<bullet> A\<^sub>R') \<sharp>* P` `(p \<bullet> A\<^sub>R') \<sharp>* Q` S `distinctPerm p` `(p \<bullet> \<Psi>\<^sub>R') = q \<bullet> \<Psi>\<^sub>R`
            have "\<Psi> \<otimes> \<Psi>\<^sub>R' \<rhd> P \<sim> Q"
              by(drule_tac sym) (simp add: eqvts)
          }
          ultimately show ?thesis
            by blast
        qed
        hence "(\<Psi>, P \<parallel> R, Q \<parallel> R) \<in> ?X \<union> bisim"
          by simp
      }
      moreover have "\<And>\<Psi> P Q xvec. \<lbrakk>(\<Psi>, P, Q) \<in> ?X \<union> bisim; (xvec::name list) \<sharp>* \<Psi>\<rbrakk> \<Longrightarrow> (\<Psi>, \<lparr>\<nu>*xvec\<rparr>P, \<lparr>\<nu>*xvec\<rparr>Q) \<in> ?X \<union> bisim"
      proof -
        fix \<Psi> P Q xvec
        assume "(\<Psi>, P, Q) \<in> ?X \<union> bisim"
        assume "(xvec::name list) \<sharp>* \<Psi>"
        thus "(\<Psi>, \<lparr>\<nu>*xvec\<rparr>P, \<lparr>\<nu>*xvec\<rparr>Q) \<in> ?X \<union> bisim"
        proof(induct xvec)
          case Nil
          thus ?case using `(\<Psi>, P, Q) \<in> ?X \<union> bisim` by simp
        next
          case(Cons x xvec)
          thus ?case by(simp only: resChain.simps) (rule_tac Res, auto)
        qed
      qed
      ultimately have "\<Psi> \<rhd> P \<parallel> R \<leadsto>[(?X \<union> bisim)] Q \<parallel> R" using statEqBisim
        by(rule parPres)
      moreover assume "(xvec::name list) \<sharp>* \<Psi>"
      moreover from `eqvt ?X` have "eqvt(?X \<union> bisim)" by auto
      ultimately have "\<Psi> \<rhd> \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R) \<leadsto>[(?X \<union> bisim)] \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)" using Res
        by(rule_tac resChainPres)
    }
    with `(\<Psi>, PR, QR) \<in> ?X` show ?case by blast
  next
    case(cExt \<Psi> PR QR \<Psi>')

    from `(\<Psi>, PR, QR) \<in> ?X`
    obtain xvec P Q R A\<^sub>R \<Psi>\<^sub>R where PFrR: "PR = \<lparr>\<nu>*xvec\<rparr>(P \<parallel> R)" and QFrR: "QR = \<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R)"
                               and "xvec \<sharp>* \<Psi>" and A: "\<forall>A\<^sub>R \<Psi>\<^sub>R. (extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle> \<and> A\<^sub>R \<sharp>* \<Psi> \<and> A\<^sub>R \<sharp>* P \<and> A\<^sub>R \<sharp>* Q) \<longrightarrow> \<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q"
      by auto

    obtain p where "(p \<bullet> xvec) \<sharp>* \<Psi>"
               and "(p \<bullet> xvec) \<sharp>* P"
               and "(p \<bullet> xvec) \<sharp>* Q"
               and "(p \<bullet> xvec) \<sharp>* R"
               and "(p \<bullet> xvec) \<sharp>* \<Psi>'"
               and S: "(set p) \<subseteq> (set xvec) \<times> (set(p \<bullet> xvec))" and "distinctPerm p"
      by(rule_tac c="(\<Psi>, P, Q, R, \<Psi>')" in name_list_avoiding) auto

    from `(p \<bullet> xvec) \<sharp>* P` `(p \<bullet> xvec) \<sharp>* R` S have "\<lparr>\<nu>*xvec\<rparr>(P \<parallel> R) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(p \<bullet> (P \<parallel> R))"
      by(subst resChainAlpha) auto
    hence PRAlpha: "\<lparr>\<nu>*xvec\<rparr>(P \<parallel> R) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>((p \<bullet> P) \<parallel> (p \<bullet> R))"
      by(simp add: eqvts)

    from `(p \<bullet> xvec) \<sharp>* Q` `(p \<bullet> xvec) \<sharp>* R` S have "\<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>(p \<bullet> (Q \<parallel> R))"
      by(subst resChainAlpha) auto
    hence QRAlpha: "\<lparr>\<nu>*xvec\<rparr>(Q \<parallel> R) = \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>((p \<bullet> Q) \<parallel> (p \<bullet> R))"
      by(simp add: eqvts)

    from `(p \<bullet> xvec) \<sharp>* \<Psi>` `(p \<bullet> xvec) \<sharp>* \<Psi>'` have "(\<Psi> \<otimes> \<Psi>', \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>((p \<bullet> P) \<parallel> (p \<bullet> R)), \<lparr>\<nu>*(p \<bullet> xvec)\<rparr>((p \<bullet> Q) \<parallel> (p \<bullet> R))) \<in> ?X"
    proof(rule_tac C2="(\<Psi>, (p \<bullet> P), (p \<bullet> Q), R, \<Psi>', xvec, p \<bullet> xvec)" in XI', auto)
      fix A\<^sub>R \<Psi>\<^sub>R
      assume FrR: "extractFrame (p \<bullet> R) = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>" and "A\<^sub>R \<sharp>* \<Psi>" and "A\<^sub>R \<sharp>* \<Psi>'" and "A\<^sub>R \<sharp>* (p \<bullet> P)" and "A\<^sub>R \<sharp>* (p \<bullet> Q)"
      from FrR have "(p \<bullet> (extractFrame (p \<bullet> R))) = (p \<bullet> \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>)" by simp
      with `distinctPerm p` have "extractFrame R = \<langle>p \<bullet> A\<^sub>R, p \<bullet> \<Psi>\<^sub>R\<rangle>" by(simp add: eqvts)
      moreover from `A\<^sub>R \<sharp>* \<Psi>` have "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> \<Psi>)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `xvec \<sharp>* \<Psi>` `(p \<bullet> xvec) \<sharp>* \<Psi>` S have "(p \<bullet> A\<^sub>R) \<sharp>* \<Psi>" by simp
      moreover from `A\<^sub>R \<sharp>* (p \<bullet> P)` have "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> p \<bullet> P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `distinctPerm p` have "(p \<bullet> A\<^sub>R) \<sharp>* P" by simp
      moreover from `A\<^sub>R \<sharp>* (p \<bullet> Q)` have "(p \<bullet> A\<^sub>R) \<sharp>* (p \<bullet> p \<bullet> Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with `distinctPerm p` have "(p \<bullet> A\<^sub>R) \<sharp>* Q" by simp
      ultimately have "\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<rhd> P \<sim> Q" using A by blast
      hence "(\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R)) \<otimes> (p \<bullet> \<Psi>') \<rhd> P \<sim> Q" by(rule bisimE)
      moreover have "(\<Psi> \<otimes> (p \<bullet> \<Psi>\<^sub>R)) \<otimes> (p \<bullet> \<Psi>') \<simeq> (\<Psi> \<otimes> (p \<bullet> \<Psi>')) \<otimes> (p \<bullet> \<Psi>\<^sub>R)"
        by(metis Associativity Commutativity Composition AssertionStatEqTrans AssertionStatEqSym)
      ultimately have "(\<Psi> \<otimes> (p \<bullet> \<Psi>')) \<otimes> (p \<bullet> \<Psi>\<^sub>R) \<rhd> P \<sim> Q"
        by(rule statEqBisim)
      hence "(p \<bullet> ((\<Psi> \<otimes> (p \<bullet> \<Psi>')) \<otimes> (p \<bullet> \<Psi>\<^sub>R))) \<rhd> (p \<bullet> P) \<sim> (p \<bullet> Q)"
        by(rule bisimClosed)
      with `distinctPerm p` `xvec \<sharp>* \<Psi>` `(p \<bullet> xvec) \<sharp>* \<Psi>` S show "(\<Psi> \<otimes> \<Psi>') \<otimes> \<Psi>\<^sub>R \<rhd> (p \<bullet> P) \<sim> (p \<bullet> Q)"
        by(simp add: eqvts)
    qed
    with PFrR QFrR PRAlpha QRAlpha show ?case by simp
  next
    case(cSym \<Psi> PR QR)
    thus ?case by(blast dest: bisimE)
  qed
qed

lemma bisimParPres:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> P \<sim> Q"

  shows "\<Psi> \<rhd> P \<parallel> R \<sim> Q \<parallel> R"
proof -
  obtain A\<^sub>R \<Psi>\<^sub>R where "extractFrame R = \<langle>A\<^sub>R, \<Psi>\<^sub>R\<rangle>" and "A\<^sub>R \<sharp>* \<Psi>" and "A\<^sub>R \<sharp>* P" and "A\<^sub>R \<sharp>* Q"
    by(rule_tac C="(\<Psi>, P, Q)" in freshFrame) auto
  moreover from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<otimes> \<Psi>\<^sub>R \<rhd> P \<sim> Q" by(rule bisimE)
  ultimately show ?thesis by(rule_tac bisimParPresAux)
qed

end

end


(*<*)

(* Author: Kyndylan Nienhuis *)

theory TraceProperties

imports
  "CHERI-abstraction.CheriAbstraction"
  "CompartmentAuthority"
begin

(*>*)
section \<open>Trace based security properties\<close>

subsection \<open>Traces\<close>

type_synonym Trace = "AbstractStep list"

primrec TracePreservesDomain :: "Trace \<Rightarrow> bool" where
  "TracePreservesDomain [] = True" |
  "TracePreservesDomain (h # t) = (PreservesDomain h \<and> TracePreservesDomain t)"

lemma TracePreservesDomainE:
  assumes "TracePreservesDomain trace"
      and "step \<in> set trace"
  shows "PreservesDomain step"
using assms
by (induct trace) auto

primrec IsTrace :: "Semantics \<Rightarrow> state \<Rightarrow> Trace \<Rightarrow> state \<Rightarrow> bool" where
  "IsTrace sem s [] s' = (s = s')"
| "IsTrace sem s (h # t) s' = (\<exists>x. IsTrace sem s t x \<and> (h, s') \<in> sem x)"

definition Traces :: "Semantics \<Rightarrow> state \<Rightarrow> (Trace \<times> state) set" where
  "Traces sem s = {(trace, s')| trace s'. IsTrace sem s trace s'}"

lemma Traces_member_simp [simp]:
shows "(trace, s') \<in> Traces sem s = IsTrace sem s trace s'"
unfolding Traces_def
by simp

subsection \<open>Transitively valid state\<close>

lemma TraceInvarianceStateIsValid:
  assumes abstraction: "CanBeSimulated sem"
      and valid: "getStateIsValid s"
      and trace: "(trace, s') \<in> Traces sem s"
  shows "getStateIsValid s'"
using trace
proof (induct trace arbitrary: s')
  case Nil
  thus ?case
    using valid by simp
next
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  show ?case
    using Cons(1)[OF r\<^sub>1]
    using CanBeSimulatedE_ValidState[OF abstraction r\<^sub>2]
    by auto
qed

subsection \<open>Transitively available capabilities\<close>

inductive_set
  AvailableCaps :: "state \<Rightarrow> Capability set" for s where

Reg:
  "\<lbrakk>RegisterIsAlwaysAccessible r;
    getTag (getCapReg r s)\<rbrakk> \<Longrightarrow>
    getCapReg r s \<in> AvailableCaps s"

| Memory:
  "\<lbrakk>cap \<in> AvailableCaps s;
    \<not> getSealed cap;
    Permit_Load_Capability (getPerms cap);
    addr \<in> getTranslateCapAddresses (RegionOfCap cap) LOAD s;
    getTag (getMemCap addr s)\<rbrakk> \<Longrightarrow>
    getMemCap addr s \<in> AvailableCaps s"

| Restrict:
  "\<lbrakk>cap \<in> AvailableCaps s;
    cap' \<le> cap;
    getTag cap'\<rbrakk> \<Longrightarrow>
    cap' \<in> AvailableCaps s"

| Seal:
  "\<lbrakk>cap \<in> AvailableCaps s;
    \<not> getSealed cap;
    sealer \<in> AvailableCaps s;
    \<not> getSealed sealer;
    Permit_Seal (getPerms sealer);
    ucast t \<in> RegionOfCap sealer\<rbrakk> \<Longrightarrow>
    setType (setSealed (cap, True), t) \<in> AvailableCaps s"

| Unseal:
  "\<lbrakk>cap \<in> AvailableCaps s;
    getSealed cap;
    unsealer \<in> AvailableCaps s;
    \<not> getSealed unsealer;
    Permit_Unseal (getPerms unsealer);
    ucast (getType cap) \<in> RegionOfCap unsealer\<rbrakk> \<Longrightarrow>
    setType (setSealed (cap, False), 0) \<in> AvailableCaps s"

lemma AvailableCaps_getTag [elim!]:
  assumes "cap \<in> AvailableCaps s"
  shows "getTag cap"
using assms
by (rule AvailableCaps.induct) auto

lemma AvailableCaps_PCC [intro!]:
  assumes "getTag (getPCC s)"
  shows "getPCC s \<in> AvailableCaps s"
using Reg[where r=RegPCC] assms
by auto

lemma AvailableCaps_BranchToPCC [intro!]:
  assumes "getTag (getBranchToPccCap s)"
  shows "getBranchToPccCap s \<in> AvailableCaps s"
using Reg[where r=RegBranchToPCC] assms
by auto

lemma AvailableCaps_BranchDelayPCC [intro!]:
  assumes tag: "getTag (getBranchDelayPccCap s)"
  shows "getBranchDelayPccCap s \<in> AvailableCaps s"
using Reg[where r=RegBranchDelayPCC]
using assms
by auto

lemma AvailableCaps_Capr [intro!]:
  assumes "getTag (getCAPR cd s)"
  shows "getCAPR cd s \<in> AvailableCaps s"
using Reg[where r="RegGeneral cd"]
using assms
by auto

lemma AvailableCaps_DDC [intro!]:
  assumes "getTag (getDDC s)"
  shows "getDDC s \<in> AvailableCaps s"
using Reg[where r="RegSpecial 0"]
using assms
by auto

lemma AvailableCaps_TLSC [intro!]:
  assumes "getTag (getTLSC s)"
  shows "getTLSC s \<in> AvailableCaps s"
using Reg[where r="RegSpecial 1"]
using assms
by auto

lemma AvailableCaps_SCapr [elim]:
  assumes abstraction: "CanBeSimulated sem"
      and suc: "(PreserveDomain actions, s') \<in> sem s"
      and action: "action \<in> actions"
      and reg: "cd \<in> SpecialRegisterParameters action"
      and no_sys: "\<not> Access_System_Registers (getPerms (getPCC s))"
      and valid: "getStateIsValid s"
      and tag: "getTag (getSCAPR cd s)"
  shows "getSCAPR cd s \<in> AvailableCaps s"
proof -
  have "RegisterIsAlwaysAccessible (RegSpecial cd)"
    unfolding RegisterIsAlwaysAccessible_def
    using CanBeSimulatedE_SystemRegister[OF abstraction suc _ _ _ _ valid]
    using reg action no_sys
    by auto
  from Reg[OF this]
  show ?thesis
    using tag by auto
qed

lemma AvailableCaps_CapReg [elim]:
  assumes abstraction: "CanBeSimulated sem"
      and suc: "(PreserveDomain actions, s') \<in> sem s"
      and action: "action \<in> actions"
      and reg: "case r of RegSpecial cd \<Rightarrow> cd \<in> SpecialRegisterParameters action | _ \<Rightarrow> True"
      and no_sys: "\<not> Access_System_Registers (getPerms (getPCC s))"
      and valid: "getStateIsValid s"
      and tag: "getTag (getCapReg r s)"
  shows "getCapReg r s \<in> AvailableCaps s"
using assms AvailableCaps_SCapr
by (cases r) auto

subsection \<open>Transitively usable capabilities\<close>

definition TransUsableCaps where
  "TransUsableCaps s \<equiv> {cap. cap \<in> AvailableCaps s \<and> \<not> getSealed cap}"

lemma TransUsableCapsI [intro]:
  assumes "cap \<in> AvailableCaps s"
      and "\<not> getSealed cap"
  shows "cap \<in> TransUsableCaps s"
using assms
unfolding TransUsableCaps_def
by simp

lemma TransUsableCapsE [elim!]:
  assumes "cap \<in> TransUsableCaps s"
  shows "getTag cap"
    and "\<not> getSealed cap"
    and "cap \<in> AvailableCaps s"
using assms
unfolding TransUsableCaps_def
by auto

lemma TransUsableCapsPcc [intro!]:
  assumes "getTag (getPCC s)"
      and "\<not> getSealed (getPCC s)"
  shows "getPCC s \<in> TransUsableCaps s"
using assms
by auto

subsection \<open>Transitively available permissions\<close>

definition AvailableAuthority :: "state \<Rightarrow> CompartmentAuthority" where
  "AvailableAuthority s \<equiv> GetAuthorityOfCaps (TransUsableCaps s)"

lemma GetAuthority_AvailableAuthority_le [elim!]:
  assumes "cap \<in> TransUsableCaps s"
  shows "GetAuthority cap \<le> AvailableAuthority s"
unfolding AvailableAuthority_def GetAuthorityOfCaps_def
using assms
by (intro Sup_upper) auto

lemma getPCC_AvailableAuthority_le [intro]:
  assumes "getTag (getPCC s)"
      and "\<not> getSealed (getPCC s)"
  shows "GetAuthority (getPCC s) \<le> AvailableAuthority s"
proof -
  have "getPCC s \<in> TransUsableCaps s"
    using assms
    by auto
  thus ?thesis by auto
qed

lemma AvailableCaps_AvailableAuthority_le [elim!]:
  assumes "AvailableCaps s \<subseteq> AvailableCaps s'"
  shows "AvailableAuthority s \<le> AvailableAuthority s'"
unfolding AvailableAuthority_def
using assms
by (intro GetAuthorityOfCaps_subset) auto

lemma SystemRegisterAccess_PCC:
  assumes abstraction: "CanBeSimulated sem"
      and suc: "(label, s') \<in> sem s"
      and no_ex: "label \<noteq> SwitchDomain RaiseException"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "\<not> Access_System_Registers (getPerms (getPCC s))"
proof -
  have valid_pcc: "getTag (getPCC s)"  "\<not> getSealed (getPCC s)"
    using CanBeSimulatedE_Execute[OF abstraction suc no_ex valid]
    by auto
  hence "GetAuthority (getPCC s) \<le> AvailableAuthority s"
    by auto
  from SystemRegisterAccess_le[OF this]
  show "\<not> Access_System_Registers (getPerms (getPCC s))"
    using no_sys valid_pcc
    by (auto simp: GetAuthority_accessors)
qed

lemma AvailableAuthority_AddressTranslation:
  assumes abstraction: "CanBeSimulated sem"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
      and suc: "(step, s') \<in> sem s"
      and no_ex: "step \<noteq> SwitchDomain RaiseException"
  shows "getTranslateAddr a s' = getTranslateAddr a s"
proof -
  have valid_pcc: "getTag (getPCC s)"  "\<not> getSealed (getPCC s)"
    using CanBeSimulatedE_Execute[OF abstraction suc no_ex valid]
    by auto
  hence "GetAuthority (getPCC s) \<le> AvailableAuthority s"
    by auto
  from SystemRegisterAccess_le[OF this]
  have "\<not> Access_System_Registers (getPerms (getPCC s))"
    using no_sys valid_pcc
    by (auto simp: GetAuthority_accessors)
  thus ?thesis
    using CanBeSimulatedE_AddressTranslation[OF abstraction suc no_ex _ valid]
    by auto
qed

subsection \<open>Readable capabilities\<close>

lemma ReadableCapsAreAvailable [elim!]:
  assumes readable: "cap \<in> ReadableCaps (AvailableAuthority s) s"
  shows "cap \<in> AvailableCaps s"
proof -
  obtain loc where [simp]: "cap = getCap loc s"
               and loc: "loc \<in> ReadableLocations (AvailableAuthority s) s"
    using readable by auto
  have tag: "getTag cap"
    using readable by auto
  show ?thesis
    proof (cases loc)
      case (LocReg r)
      hence "RegisterIsAlwaysAccessible r"
        using loc by auto
      from Reg[OF this]
      show ?thesis
        using tag LocReg
        by auto
    next
      case (LocMem a)
      thus ?thesis
        using Memory[where addr=a and s=s]
        using LocMem tag loc
        unfolding AvailableAuthority_def TransUsableCaps_def
        by (auto simp: getTranslateCapAddresses_distrib_Union GetAuthority_accessors
                 split: if_splits)
    qed
qed

definition InvokableCapsNotUnsealable :: "CompartmentAuthority \<Rightarrow> state \<Rightarrow> bool" where
  "InvokableCapsNotUnsealable perm s \<equiv>
   \<forall>cap\<in>ReadableCaps perm s.
   Permit_CCall (getPerms cap) \<longrightarrow>
   getSealed cap \<and>
   getType cap \<notin> UnsealableTypes perm"

lemma InvokableCapsNotUnsealableE [elim]:
  assumes "InvokableCapsNotUnsealable perm s"
      and "cap \<in> ReadableCaps perm s"
      and "Permit_CCall (getPerms cap)"
  shows "getSealed cap"
    and "getType cap \<notin> UnsealableTypes perm"
using assms
unfolding InvokableCapsNotUnsealable_def
by auto

lemma InvokableCapsNotUnsealable_le:
  assumes "p \<le> q"
      and "InvokableCapsNotUnsealable q s"
  shows "InvokableCapsNotUnsealable p s"
using assms(2)
using ReadableCaps_le[OF assms(1)]
using UnsealableTypes_le[OF assms(1)]
unfolding InvokableCapsNotUnsealable_def
by auto

lemma AvailableInvokableCapsAreReadable:
  assumes available: "cap \<in> AvailableCaps s"
      and ccall: "Permit_CCall (getPerms cap)"
      and base: "InvokableCapsNotUnsealable (AvailableAuthority s) s"
  shows "cap \<in> ReadableCaps (AvailableAuthority s) s"
proof -
  have "cap \<in> ReadableCaps (AvailableAuthority s) s \<and>
        getSealed cap \<and>
        getType cap \<notin> UnsealableTypes (AvailableAuthority s)"
    using available ccall
    proof induct
      case (Reg r)
      hence "getCapReg r s \<in> ReadableCaps (AvailableAuthority s) s"
        using Reg
        by (auto intro: ReadableCapsI[where loc="LocReg r"])
      thus ?case
        using Reg
        using InvokableCapsNotUnsealableE[OF base, where cap="getCapReg r s"]
        by auto
    next
      case (Memory cap addr)
      hence "cap \<in> TransUsableCaps s"
        by auto
      note gperm = GetAuthority_AvailableAuthority_le[OF this]
      have "addr \<in> getTranslateCapAddresses (CapLoadableAddresses (GetAuthority cap)) LOAD s"
        using Memory AvailableCaps_getTag
        by (auto simp: GetAuthority_accessors)
      hence "addr \<in> getTranslateCapAddresses (CapLoadableAddresses (AvailableAuthority s)) LOAD s"
        using getTranslateCapAddresses_le[OF CapLoadableAddresses_le[OF gperm]]
        by auto
      hence "getMemCap addr s \<in> ReadableCaps (AvailableAuthority s) s"
        using Memory
        by (auto intro: ReadableCapsI[where loc="LocMem addr"])
      thus ?case
        using Memory
        using InvokableCapsNotUnsealableE[OF base, where cap="getMemCap addr s"]
        by auto
    next
      case (Restrict cap cap')
      hence "getPerms cap' \<le> getPerms cap"
        using less_eq_CapabilityE_getPerms
        by auto
      hence "Permit_CCall (getPerms cap)"
        unfolding less_eq_Perms_ext_alt
        using Restrict
        by auto
      hence "getSealed cap"
        using Restrict by auto
      hence "getSealed cap'"
        using less_eq_CapabilityE_getSealed
        using Restrict by auto
      hence "cap' = cap"
        using less_eq_CapabilityE_IsSealed
        using Restrict by auto
      thus ?case
        using Restrict
        by auto
    next
      case (Seal cap sealer t)
      thus ?case by auto
    next
      case (Unseal cap unsealer)
      hence "unsealer \<in> TransUsableCaps s"
        by auto
      note gperm = GetAuthority_AvailableAuthority_le[OF this]
      have "getType cap \<in> UnsealableTypes (GetAuthority unsealer)"
        using Unseal
        by (auto simp: GetAuthority_accessors)
      hence False
        using UnsealableTypes_le[OF gperm]
        using Unseal
        by auto
      thus ?case by simp
    qed
  thus ?thesis
    by auto
qed

subsection \<open>Closed permissions\<close>

definition PermIsClosed where
  "PermIsClosed perm s \<equiv>
   \<forall>cap\<in>ReadableCaps perm s.
   (\<not> getSealed cap \<or> getType cap \<in> UnsealableTypes perm) \<longrightarrow>
   GetAuthority cap \<le> perm"

lemma PermIsClosedE [elim]:
  assumes "PermIsClosed perm s"
      and "cap \<in> ReadableCaps perm s"
      and "getSealed cap \<Longrightarrow> getType cap \<in> UnsealableTypes perm"
  shows "GetAuthority cap \<le> perm"
using assms
unfolding PermIsClosed_def
by auto

lemma TransUsableCapsInClosedPerm:
  assumes closed: "PermIsClosed perm s"
      and usable: "cap \<in> TransUsableCaps s"
  shows "GetAuthority cap \<le> perm"
proof -
  have available: "cap \<in> AvailableCaps s" and
       type: "getSealed cap \<longrightarrow> getType cap \<in> UnsealableTypes perm"
    using usable
    unfolding TransUsableCaps_def
    by auto
  thus ?thesis
    proof induct
      case (Reg r)
      hence "LocReg r \<in> ReadableLocations perm s"
        by auto
      thus ?case
        using Reg
        using PermIsClosedE[OF closed, OF ReadableCapsI[where loc="LocReg r"]]
        by auto
    next
      case (Memory cap addr)
      hence "GetAuthority cap \<le> perm"
        by auto
      from CapLoadableAddresses_le[OF this]
      have "CapLoadableAddresses (GetAuthority cap) \<subseteq> CapLoadableAddresses perm"
        by auto
      from getTranslateCapAddresses_le[OF this]
      have "addr \<in> getTranslateCapAddresses (CapLoadableAddresses perm) LOAD s"
        using Memory AvailableCaps_getTag
        by (auto simp: GetAuthority_accessors)
      hence "LocMem addr \<in> ReadableLocations perm s"
        by auto
      thus ?case
        using Memory
        using PermIsClosedE[OF closed, OF ReadableCapsI[where loc="LocMem addr"]]
        by auto
    next
      case (Restrict cap cap')
      hence "GetAuthority cap' \<le> GetAuthority cap"
        by auto
      thus ?case
        using less_eq_CapabilityE_getSealed[OF `cap' \<le> cap`]
        using less_eq_CapabilityE_getType[OF `cap' \<le> cap`]
        using Restrict
        by auto
    next
      case (Seal cap sealer t)
      thus ?case by simp
    next
      case (Unseal cap unsealer)
      hence "GetAuthority unsealer \<le> perm"
        by auto
      from UnsealableTypes_le[OF this]
      have "getType cap \<in> UnsealableTypes perm"
        using Unseal
        by (auto simp: GetAuthority_accessors)
      thus ?case
        using Unseal by auto
    qed
qed

lemma AvailableAuthorityInClosedPerm:
  assumes "PermIsClosed perm s"
  shows "AvailableAuthority s \<le> perm"
using TransUsableCapsInClosedPerm[OF assms]
unfolding AvailableAuthority_def GetAuthorityOfCaps_def TransUsableCaps_def
unfolding Sup_le_iff
by auto

subsection \<open>Monotonicity of available capabilities\<close>

lemma NewCapsAreAvailable:
  assumes abstraction: "CanBeSimulated sem"
      and suc: "(PreserveDomain actions, s') \<in> sem s"
      and no_sys: "\<not> Access_System_Registers (getPerms (getPCC s))"
      and valid: "getStateIsValid s"
      and tag: "getTag (getCap loc s')"
  shows "getCap loc s' \<in> AvailableCaps s \<or>
         getCap loc s' = getCap loc s"
proof -
  obtain parentLoc where "parentLoc \<in> ProvenanceParents actions loc"
    using ProvenanceParentExists by auto
  thus ?thesis
    proof (cases rule: ProvenanceCases)
      case Unchanged
      hence "getCap loc s' = getCap loc s"
        using CanBeSimulatedE_CapabilityInvariant[OF abstraction suc _ _ valid]
        by simp
      thus ?thesis by auto
    next
      case (StoreData auth a l)
      hence "getMemCap (GetCapAddress a) s' = getMemCap (GetCapAddress a) s"
        using CanBeSimulatedE_StoreData[OF abstraction suc _ StoreData(1) valid]
        using tag
        by auto
      thus ?thesis
        using StoreData
        by auto
    next
      case (RestrictedReg r r')
      have le: "getCapReg r' s' \<le> getCapReg r s"
        using RestrictedReg
        using CanBeSimulatedE_RestrictRegCap[OF abstraction suc _ RestrictedReg(1) valid]
        by auto
      have tag_original: "getTag (getCapReg r s)"
        using le tag RestrictedReg by auto
      have "getCapReg r s \<in> AvailableCaps s"
        using AvailableCaps_CapReg[OF abstraction suc RestrictedReg(1) _ no_sys valid tag_original]
        by (cases r) auto
      from AvailableCaps.Restrict[OF this le]
      show ?thesis
        using RestrictedReg tag
        by auto
    next
      case (Loaded auth a cd)
      have "LoadCapProp s (PreserveDomain actions) s'"
        using CanBeSimulatedE[OF abstraction suc]
        by auto
      from LoadCapPropE_mem[OF this _ Loaded(1) valid, where a'="ExtendCapAddress a"]
      obtain vAddr where "vAddr \<in> RegionOfCap (getCapReg auth s)"
                         "getTranslateAddr (vAddr, LOAD) s = Some (ExtendCapAddress a)"
        by auto
      hence le: "getCAPR cd s' \<le> getMemCap a s"
      and tag_auth: "getTag (getCapReg auth s)"
      and segment: "a \<in> getTranslateCapAddresses (RegionOfCap (getCapReg auth s)) LOAD s"
      and unsealed: "\<not> getSealed (getCapReg auth s)"
      and perm: "Permit_Load_Capability (getPerms (getCapReg auth s))"
        using CanBeSimulatedE_LoadCap[OF abstraction suc _ Loaded(1) valid]
        by auto
      have auth: "getCapReg auth s \<in> AvailableCaps s"
        using AvailableCaps_CapReg[OF abstraction suc Loaded(1) _ no_sys valid tag_auth]
        by (cases auth) auto
      hence "getTag (getMemCap a s)"
        using le tag Loaded by auto
      hence "getMemCap a s \<in> AvailableCaps s"
        using Memory[OF auth unsealed perm segment]
        by auto
      from AvailableCaps.Restrict[OF this le]
      show ?thesis
        using Loaded tag
        by auto
    next
      case (Stored auth cd a)
      have le: "getMemCap a s' \<le> getCAPR cd s"
        using CanBeSimulatedE_StoreCap[OF abstraction suc _ Stored(1) valid]
        by auto
      hence "getTag (getCAPR cd s)"
        using tag Stored by auto
      note AvailableCaps_Capr[OF this]
      from AvailableCaps.Restrict[OF this le]
      show ?thesis
        using Stored tag
        by auto
    next
      case (Sealed auth cd cd')
      define t :: ObjectType where
        "t \<equiv> ucast (getBase (getCapReg auth s)) + ucast (getOffset (getCapReg auth s))"
      have tag_cd: "getTag (getCAPR cd s)"
      and tag_auth: "getTag (getCapReg auth s)"
        using CanBeSimulatedE_SealCap[OF abstraction suc _ Sealed(1) valid]
        using tag Sealed
        by auto
      have "getCapReg auth s \<in> AvailableCaps s"
        using AvailableCaps_CapReg[OF abstraction suc Sealed(1) _ no_sys valid tag_auth]
        by (cases auth) auto
      hence "setType (setSealed (getCAPR cd s, True), t) \<in> AvailableCaps s"
        using CanBeSimulatedE_SealCap[OF abstraction suc _ Sealed(1) valid]
        using tag_cd
        unfolding t_def
        by (intro AvailableCaps.Seal[where sealer="getCapReg auth s"]) auto
      thus ?thesis
        using CanBeSimulatedE_SealCap[OF abstraction suc _ Sealed(1) valid]
        using Sealed
        unfolding t_def
        by auto
    next
      case (Unsealed auth cd cd')
      have tag_cd: "getTag (getCAPR cd s)"
      and tag_auth: "getTag (getCapReg auth s)"
        using TagOfGreaterCap[OF _ tag, where cap'="setType (setSealed (getCAPR cd s, False), 0)"]
        using CanBeSimulatedE_UnsealCap[OF abstraction suc _ Unsealed(1) valid]
        using Unsealed
        by auto
      have "getCapReg auth s \<in> AvailableCaps s"
        using AvailableCaps_CapReg[OF abstraction suc Unsealed(1) _ no_sys valid tag_auth]
        by (cases auth) auto
      hence "setType (setSealed (getCAPR cd s, False), 0) \<in> AvailableCaps s"
        using CanBeSimulatedE_UnsealCap[OF abstraction suc _ Unsealed(1) valid]
        using tag_cd
        by (intro AvailableCaps.Unseal[where unsealer="getCapReg auth s"]) auto
      from AvailableCaps.Restrict[OF this _ tag]
      show ?thesis
        using CanBeSimulatedE_UnsealCap[OF abstraction suc _ Unsealed(1) valid]
        using Unsealed
        by auto
    qed
qed

lemma MonotonicityAvailableCaps_Step:
  assumes abstraction: "CanBeSimulated sem"
      and suc: "(PreserveDomain actions, s') \<in> sem s"
      and no_sys: "\<not> Access_System_Registers (getPerms (getPCC s))"
      and valid: "getStateIsValid s"
  shows "AvailableCaps s' \<subseteq> AvailableCaps s"
proof
  fix cap
  assume "cap \<in> AvailableCaps s'"
  thus "cap \<in> AvailableCaps s"
    proof (induct rule: AvailableCaps.inducts)
      case (Reg r)
      thus ?case
        using NewCapsAreAvailable[OF abstraction suc no_sys valid, where loc="LocReg r"]
        using Reg AvailableCaps.Reg
        by auto
    next
      case (Memory cap' a)
      have "getTranslateAddr (v, LOAD) s' = getTranslateAddr (v, LOAD) s" for v
        using CanBeSimulatedE_AddressTranslation[OF abstraction suc _ no_sys valid]
        by auto
      hence "getTranslateCapAddresses addrs LOAD s' = getTranslateCapAddresses addrs LOAD s" for addrs
        unfolding getTranslateCapAddresses_def
        unfolding getTranslateAddresses_def
        by simp
      thus ?case
        using NewCapsAreAvailable[OF abstraction suc no_sys valid, where loc="LocMem a"]
        using Memory AvailableCaps.Memory
        by auto
    next
      case Restrict
      thus ?case
        using AvailableCaps.Restrict
        by auto
    next
      case Seal
      thus ?case
        using AvailableCaps.Seal
        by auto
    next
      case Unseal
      thus ?case
        using AvailableCaps.Unseal
        by auto
    qed
qed

theorem MonotonicityAvailableCaps:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "AvailableCaps s' \<subseteq> AvailableCaps s"
using trace intra
proof (induct trace arbitrary: s')
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  have ih: "AvailableCaps r \<subseteq> AvailableCaps s"
    using Cons(1)[OF r\<^sub>1]
    using Cons(3)
    by simp
  have intra: "PreservesDomain step"
    using Cons(3) by auto
  hence no_ex: "step \<noteq> SwitchDomain RaiseException"
    by auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have no_sys2: "\<not> SystemRegisterAccess (AvailableAuthority r)"
    using AvailableCaps_AvailableAuthority_le[OF ih]
    using SystemRegisterAccess_le no_sys
    by auto
  have "\<not> Access_System_Registers (getPerms (getPCC r))"
    using SystemRegisterAccess_PCC[OF abstraction r\<^sub>2 no_ex no_sys2 valid2]
    by auto
  hence "AvailableCaps s' \<subseteq> AvailableCaps r"
    using MonotonicityAvailableCaps_Step[OF abstraction _ _ valid2, where s'=s']
    using r\<^sub>2 intra
    by (cases step) auto
  thus ?case
    using ih by simp
qed simp

corollary MonotonicityTransUsableCaps:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "TransUsableCaps s' \<subseteq> TransUsableCaps s"
using MonotonicityAvailableCaps[OF abstraction trace intra no_sys valid]
by auto

corollary MonotonicityAvailableAuthority:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "AvailableAuthority s' \<le> AvailableAuthority s"
using MonotonicityTransUsableCaps[OF abstraction trace intra no_sys valid]
unfolding AvailableAuthority_def
by auto

subsection \<open>Invariance of address translation\<close>

lemma TraceInvarianceAddressTranslation:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "getTranslateAddr addr s' = getTranslateAddr addr s"
using trace intra
proof (induct trace arbitrary: s')
  case Nil
  thus ?case by simp
next
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  have intra2: "TracePreservesDomain trace"
    using Cons by auto
  hence ih: "getTranslateAddr addr r = getTranslateAddr addr s"
    using Cons(1)[OF r\<^sub>1]
    by auto
  have no_ex: "step \<noteq> SwitchDomain RaiseException"
    using Cons by auto
  note MonotonicityAvailableAuthority[OF abstraction r\<^sub>1 intra2 no_sys valid]
  from SystemRegisterAccess_le[OF this]
  have no_sys2: "\<not> SystemRegisterAccess (AvailableAuthority r)"
    using no_sys
    by auto
  thus ?case
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    using AvailableAuthority_AddressTranslation[OF abstraction _ _ r\<^sub>2 no_ex]
    using ih
    by auto
qed

subsection \<open>Invariance of system registers\<close>

lemma SpecialCapRegisterInvariant_aux:
  assumes abstraction: "CanBeSimulated sem"
      and no_access: "\<not> Access_System_Registers (getPerms (getPCC s))"
      and system: "cd \<noteq> 0" "cd \<noteq> 1"
      and valid: "getStateIsValid s"
      and suc: "(step, s') \<in> sem s"
      and no_ex: "step \<noteq> SwitchDomain RaiseException"
  shows "getSCAPR cd s' = getSCAPR cd s"
proof (cases "PreservesDomain step")
  case False
  then obtain crossing where "step = SwitchDomain crossing"
    by (cases step) auto
  then obtain cd cd' where "step = SwitchDomain (InvokeCapability cd cd')"
    using no_ex
    by (cases crossing) auto
  hence "(SwitchDomain (InvokeCapability cd cd'), s') \<in> sem s"
    using suc by auto
  from CanBeSimulatedE_InvokeCap[OF abstraction this _ valid]
  show ?thesis
    by auto
next
  case True
  then obtain actions where "step = PreserveDomain actions"
    by (cases step) auto
  hence intra_suc: "(PreserveDomain actions, s') \<in> sem s"
    using suc
    by auto
  have "cd \<notin> \<Union> (SpecialRegisterParameters ` actions)"
    using CanBeSimulatedE_SystemRegister[OF abstraction intra_suc _ _ system  valid]
    using no_access
    by auto
  hence "\<And>prov. prov \<in> actions \<Longrightarrow> LocReg (RegSpecial cd) \<notin> ActionTargets prov"
    unfolding SpecialRegisterParameters_def
    by auto
  from CanBeSimulatedE_CapabilityInvariant
       [OF abstraction intra_suc _ this valid]
  show ?thesis by auto
qed

lemma SpecialCapRegisterInvariant_intra:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_access: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and system: "cd \<noteq> 0" "cd \<noteq> 1"
      and valid: "getStateIsValid s"
  shows "getSCAPR cd s' = getSCAPR cd s"
using trace intra
proof (induct trace arbitrary: s')
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  have ih: "getSCAPR cd r = getSCAPR cd s"
    using Cons(1)[OF r\<^sub>1] Cons(3)
    by auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have no_ex2: "step \<noteq> SwitchDomain RaiseException"
    using Cons(3)
    by auto
  have "AvailableAuthority r \<le> AvailableAuthority s"
    using MonotonicityAvailableAuthority[OF abstraction r\<^sub>1 _ no_access valid]
    using Cons(3)
    by auto
  from SystemRegisterAccess_le[OF this]
  have no_access2: "\<not> SystemRegisterAccess (AvailableAuthority r)"
    using no_access by auto
  note pcc = CanBeSimulatedE_Execute[OF abstraction r\<^sub>2 no_ex2 valid2]
  hence "getPCC r \<in> TransUsableCaps r"
    by auto
  hence "GetAuthority (getPCC r) \<le> AvailableAuthority r"
    by auto
  from SystemRegisterAccess_le[OF this]
  have "\<not> SystemRegisterAccess (GetAuthority (getPCC r))"
    using no_access2 by auto
  hence "\<not> Access_System_Registers (getPerms (getPCC r))"
    using pcc
    by (auto simp: GetAuthority_accessors)
  hence "getSCAPR cd s' = getSCAPR cd r"
    using SpecialCapRegisterInvariant_aux[OF abstraction _ system valid2 r\<^sub>2 no_ex2]
    by auto
  thus ?case
    using ih by auto
qed simp

theorem SpecialCapRegisterInvariant:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(step # trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and inter: "\<not> PreservesDomain step"
      and no_access: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and system: "cd \<noteq> 0" "cd \<noteq> 1"
      and non_eppc: "cd \<noteq> 31"
      and valid: "getStateIsValid s"
  shows "getSCAPR cd s' = getSCAPR cd s"
proof -
  obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
             and r\<^sub>2: "(step, s') \<in> sem r"
    using trace by auto
  obtain crossing where step: "step = SwitchDomain crossing"
    using inter by (cases step) auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have "getSCAPR cd s' = getSCAPR cd r"
    proof (cases crossing)
      case RaiseException
      hence "(SwitchDomain RaiseException, s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_Exception[OF abstraction this _ valid2]
      have "getSCAPR cd s' = SignalExceptionSCAPR cd r"
        by auto
      thus ?thesis
        unfolding SignalExceptionSCAPR_def
        using non_eppc
        by auto
    next
      case (InvokeCapability cd cd')
      hence "(SwitchDomain (InvokeCapability cd cd'), s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_InvokeCap[OF abstraction this _ valid2]
      show ?thesis by auto
    qed
  have "getSCAPR cd r = getSCAPR cd s"
    using SpecialCapRegisterInvariant_intra[OF abstraction r\<^sub>1 intra no_access system valid]
    by simp
  thus ?thesis
    using `getSCAPR cd s' = getSCAPR cd r`
    by auto
qed

subsection \<open>Invariance of capabilities in memory\<close>

lemma MemCapInvariant_intra:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_access: "a \<notin> StorablePhysCapAddresses (AvailableAuthority s) s"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "getMemCap a s' = getMemCap a s"
using trace intra
proof (induct trace arbitrary: s')
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  have intra2: "TracePreservesDomain trace"
    using Cons by auto
  have ih: "getMemCap a r = getMemCap a s"
    using Cons(1)[OF r\<^sub>1] intra2
    by auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have no_ex2: "step \<noteq> SwitchDomain RaiseException"
    using Cons(3)
    by auto
  have perms: "AvailableAuthority r \<le> AvailableAuthority s"
    using MonotonicityAvailableAuthority[OF abstraction r\<^sub>1 intra2 no_sys valid]
    by auto
  from SystemRegisterAccess_le[OF this]
  have no_sys2: "\<not> SystemRegisterAccess (AvailableAuthority r)"
    using no_sys by auto
  have no_sys_pcc: "\<not> Access_System_Registers (getPerms (getPCC r))"
    using SystemRegisterAccess_PCC[OF abstraction r\<^sub>2 no_ex2 no_sys2 valid2]
    by auto
  have addrTrans: "getTranslateAddr a r = getTranslateAddr a s" for a
    using TraceInvarianceAddressTranslation[OF abstraction r\<^sub>1 intra2 no_sys valid]
    by auto
  from StorablePhysCapAddresses_le[OF perms]
  have no_access2: "a \<notin> StorablePhysCapAddresses (AvailableAuthority r) r"
    using getTranslateCapAddresses_eqI_getTranslateAddr[OF addrTrans]
    using no_access
    unfolding StorablePhysCapAddresses_def
    by auto
  hence "getMemCap a s' = getMemCap a r"
    proof -
      obtain actions where "step = PreserveDomain actions"
        using Cons(3)
        by (cases step) auto
      hence intra_suc: "(PreserveDomain actions, s') \<in> sem r"
        using r\<^sub>2
        by auto
      have "\<not> (\<exists>action. action \<in> actions \<and>
                        LocMem a \<in> ActionTargets action)"
        proof (clarify)
          fix action
          assume action: "action \<in> actions"
             and target: "LocMem a \<in> ActionTargets action"
          thus False
            proof (cases action)
              case (StoreDataAction auth a' l)
              hence "StoreDataAction auth a' l \<in> actions"
                using action
                by auto
              note restrict =
                   CanBeSimulatedE_StoreData[OF abstraction intra_suc _ this valid2]
              have a: "a = GetCapAddress a'"
                using target StoreDataAction
                by auto
              have "getCapReg auth r \<in> AvailableCaps r"
                using AvailableCaps_CapReg
                      [OF abstraction intra_suc action _ no_sys_pcc valid2, where r=auth]
                using restrict StoreDataAction
                by (cases auth) auto
              hence "getCapReg auth r \<in> TransUsableCaps r"
                using restrict
                by auto
              hence gperm: "GetAuthority (getCapReg auth r) \<le> AvailableAuthority r"
                by auto
              have "StoreDataProp r (PreserveDomain actions) s'"
                using CanBeSimulatedE[OF abstraction intra_suc]
                by auto
              from StoreDataPropE_mem
                   [OF this _ _ valid2,
                    where a=a' and a'=a' and auth=auth and l=l and actions=actions]
              obtain vAddr where "vAddr \<in> RegionOfCap (getCapReg auth r)"
                                 "getTranslateAddr (vAddr, STORE) r = Some a'"
                using action StoreDataAction target restrict
                by auto
              hence "a \<in> getTranslateCapAddresses (StorableAddresses (GetAuthority (getCapReg auth r))) STORE r"
                using a restrict
                by (auto simp: GetAuthority_accessors
                         intro: getTranslateCapAddressesI)
              hence "a \<in> getTranslateCapAddresses (StorableAddresses (AvailableAuthority r)) STORE r"
                using getTranslateCapAddresses_le[OF StorableAddresses_le[OF gperm]]
                by auto
              thus False
                using no_access2
                unfolding StorablePhysCapAddresses_def Let_def
                unfolding getTranslateCapAddresses_distrib_union
                by simp
            next
              case (StoreCapAction auth cd a')
              hence "StoreCapAction auth cd a \<in> actions"
                using action target
                by auto
              note store = CanBeSimulatedE_StoreCap[OF abstraction intra_suc _ this valid2]
              have "getCapReg auth r \<in> AvailableCaps r"
                using AvailableCaps_CapReg
                      [OF abstraction intra_suc action _ no_sys_pcc valid2, where r=auth]
                using store StoreCapAction
                by (cases auth) auto
              hence "getCapReg auth r \<in> TransUsableCaps r"
                using store
                by auto
              hence gperm: "GetAuthority (getCapReg auth r) \<le> AvailableAuthority r"
                by auto
              have "StoreCapProp r (PreserveDomain actions) s'"
                using CanBeSimulatedE[OF abstraction intra_suc]
                by auto
              from StoreCapPropE_mem
                   [OF this _ _ valid2,
                    where a=a and a'="ExtendCapAddress a" and actions=actions]
              obtain vAddr where "vAddr \<in> RegionOfCap (getCapReg auth r)"
                                 "getTranslateAddr (vAddr, STORE) r = Some (ExtendCapAddress a)"
                using action StoreCapAction target
                by auto
              from getTranslateCapAddressesI_word_cat[OF this(2) this(1)]
              have "a \<in> getTranslateCapAddresses (StorableAddresses (GetAuthority (getCapReg auth r))) STORE r"
                using store
                unfolding word_size
                by (auto simp: GetAuthority_accessors
                         intro: getTranslateCapAddressesI)
              hence "a \<in> getTranslateCapAddresses (StorableAddresses (AvailableAuthority r)) STORE r"
                using getTranslateCapAddresses_le[OF StorableAddresses_le[OF gperm]]
                by auto
              thus False
                using no_access2
                unfolding StorablePhysCapAddresses_def Let_def
                unfolding getTranslateCapAddresses_distrib_union
                by simp
            qed simp_all
        qed
      hence "\<And>prov. prov \<in> actions \<Longrightarrow> LocMem a \<notin> ActionTargets prov"
        by auto
      from CanBeSimulatedE_CapabilityInvariant[OF abstraction intra_suc _ this valid2]
      show ?thesis by auto
    qed
  thus ?case using ih by auto
qed simp

theorem MemCapInvariant:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(step # trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and inter: "\<not> PreservesDomain step"
      and no_access: "a \<notin> StorablePhysCapAddresses (AvailableAuthority s) s"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "getMemCap a s' = getMemCap a s"
proof -
  obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
             and r\<^sub>2: "(step, s') \<in> sem r"
    using trace by auto
  obtain crossing where step: "step = SwitchDomain crossing"
    using inter by (cases step) auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have "getMemCap a s' = getMemCap a r"
    proof (cases crossing)
      case RaiseException
      hence "(SwitchDomain RaiseException, s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_Exception[OF abstraction this _ valid2]
      show ?thesis
        unfolding getMemCap_def
        by auto
    next
      case (InvokeCapability cd cd')
      hence "(SwitchDomain (InvokeCapability cd cd'), s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_InvokeCap[OF abstraction this _ valid2]
      show ?thesis
        unfolding getMemCap_def
        by auto
    qed
  have "getMemCap a r = getMemCap a s"
    using MemCapInvariant_intra[OF abstraction r\<^sub>1 intra no_access no_sys valid]
    by simp
  thus ?thesis
    using `getMemCap a s' = getMemCap a r`
    by auto
qed

subsection \<open>Invariance of data\<close>

lemma MemoryInvariant_intra:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and no_access: "a \<notin> StorablePhysAddresses (AvailableAuthority s) s"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "getMemByte a s' = getMemByte a s"
using trace intra
proof (induct trace arbitrary: s')
  case (Cons step trace)
  then obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
                  and r\<^sub>2: "(step, s') \<in> sem r"
    by auto
  have intra2: "TracePreservesDomain trace"
    using Cons by auto
  have ih: "getMemByte a r = getMemByte a s"
    using Cons(1)[OF r\<^sub>1] Cons(3)
    by auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have no_ex2: "step \<noteq> SwitchDomain RaiseException"
    using Cons(3)
    by auto
  have perms: "AvailableAuthority r \<le> AvailableAuthority s"
    using MonotonicityAvailableAuthority[OF abstraction r\<^sub>1 intra2 no_sys valid]
    by auto
  from SystemRegisterAccess_le[OF this]
  have no_sys2: "\<not> SystemRegisterAccess (AvailableAuthority r)"
    using no_sys by auto
  have no_sys_pcc: "\<not> Access_System_Registers (getPerms (getPCC r))"
    using SystemRegisterAccess_PCC[OF abstraction r\<^sub>2 no_ex2 no_sys2 valid2]
    by auto
  have addrTrans: "getTranslateAddr a r = getTranslateAddr a s" for a
    using TraceInvarianceAddressTranslation[OF abstraction r\<^sub>1 intra2 no_sys valid]
    by auto
  from StorablePhysAddresses_le[OF perms]
  have no_access2: "a \<notin> StorablePhysAddresses (AvailableAuthority r) r"
    using getTranslateAddresses_eqI_getTranslateAddr[OF addrTrans]
    using no_access
    unfolding StorablePhysAddresses_def
    by auto
  hence "getMemByte a s' = getMemByte a r"
    proof -
      obtain actions where "step = PreserveDomain actions"
        using Cons(3)
        by (cases step) auto
      hence intra_suc: "(PreserveDomain actions, s') \<in> sem r"
        using r\<^sub>2
        by auto
      have no_store_data:
        "\<not> (\<exists>auth a' l. StoreDataAction auth a' l \<in> actions \<and> a \<in> Region a' l)"
        proof (clarify)
          fix auth a' l
          assume prov: "StoreDataAction auth a' l \<in> actions"
             and addr: "a \<in> Region a' l "
          hence "l \<noteq> 0"
            by auto
          note store = CanBeSimulatedE_StoreData[OF abstraction intra_suc _ prov valid2]
          have *: "a \<in> getTranslateAddresses (StorableAddresses (GetAuthority (getCapReg auth r))) STORE r"
            using store addr
            by (auto simp: GetAuthority_accessors intro: getTranslateAddressesI)
          have "getCapReg auth r \<in> AvailableCaps r"
            using AvailableCaps_CapReg
                  [OF abstraction intra_suc prov _ no_sys_pcc valid2, where r=auth]
            using store `l \<noteq> 0`
            by (cases auth) auto
          hence "getCapReg auth r \<in> TransUsableCaps r"
            using store
            by auto
          hence "GetAuthority (getCapReg auth r) \<le> AvailableAuthority r"
            by auto
          note StorableAddresses_le[OF this]
          from getTranslateAddresses_le[OF this]
          show False
            using no_access2 *
            unfolding StorablePhysAddresses_def
            by auto
        qed
      have no_store_cap:
        "\<not> (\<exists>auth cd a'. StoreCapAction auth cd a' \<in> actions \<and>
                         a \<in> Region (ExtendCapAddress a') 32)"
        proof (clarify)
          fix auth cd a'
          assume prov: "StoreCapAction auth cd a' \<in> actions"
             and addr: "a \<in> Region (ExtendCapAddress a') 32"
          note store = CanBeSimulatedE_StoreCap[OF abstraction intra_suc _ prov valid2]
          have *: "a \<in> getTranslateAddresses (StorableAddresses (GetAuthority (getCapReg auth r))) STORE r"
            using store addr
            by (auto simp: GetAuthority_accessors intro: getTranslateAddressesI)
          have "getCapReg auth r \<in> AvailableCaps r"
            using AvailableCaps_CapReg
                  [OF abstraction intra_suc prov _ no_sys_pcc valid2, where r=auth]
            using store
            by (cases auth) auto
          hence "getCapReg auth r \<in> TransUsableCaps r"
            using store
            by auto
          hence "GetAuthority (getCapReg auth r) \<le> AvailableAuthority r"
            by auto
          note StorableAddresses_le[OF this]
          from getTranslateAddresses_le[OF this]
          show False
            using no_access2 *
            unfolding StorablePhysAddresses_def
            by auto
        qed
      have "\<And>prov. prov \<in> actions \<Longrightarrow> a \<notin> WrittenAddresses prov"
        unfolding WrittenAddresses_def
        using no_store_data no_store_cap
        by (auto split: DomainAction.splits)
      from CanBeSimulatedE_MemoryInvariant[OF abstraction intra_suc _ this valid2]
      show ?thesis
        by auto
    qed
  thus ?case
    using ih by auto
qed simp

theorem MemoryInvariant:
  assumes abstraction: "CanBeSimulated sem"
      and trace: "(step # trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and inter: "\<not> PreservesDomain step"
      and no_access: "a \<notin> StorablePhysAddresses (AvailableAuthority s) s"
      and no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
      and valid: "getStateIsValid s"
  shows "getMemByte a s' = getMemByte a s"
proof -
  obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
             and r\<^sub>2: "(step, s') \<in> sem r"
    using trace by auto
  obtain crossing where step: "step = SwitchDomain crossing"
    using inter by (cases step) auto
  have valid2: "getStateIsValid r"
    using TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
    by auto
  have "getMemByte a s' = getMemByte a r"
    proof (cases crossing)
      case RaiseException
      hence "(SwitchDomain RaiseException, s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_Exception[OF abstraction this _ valid2]
      show ?thesis
        unfolding getMemByte_def
        by auto
    next
      case (InvokeCapability cd cd')
      hence "(SwitchDomain (InvokeCapability cd cd'), s') \<in> sem r"
        using r\<^sub>2 step by auto
      from CanBeSimulatedE_InvokeCap[OF abstraction this _ valid2]
      show ?thesis
        unfolding getMemByte_def
        by auto
    qed
  have "getMemByte a r = getMemByte a s"
    using MemoryInvariant_intra[OF abstraction r\<^sub>1 intra no_access no_sys valid]
    by metis
  thus ?thesis
    using `getMemByte a s' = getMemByte a r`
    by auto
qed

(*<*)
end
(*>*)