(*  Title:      HOL/Auth/n_german_lemma_inv__1_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end


(*
   Title: Psi-calculi
   Author/Maintainer: Jesper Bengtson (jebe@itu.dk), 2012
*)
theory Tau
  imports Weak_Congruence Bisim_Struct_Cong
begin

locale tau = env +
  fixes nameTerm :: "name \<Rightarrow> 'a"

  assumes ntEqvt[eqvt]: "(p::name prm) \<bullet> (nameTerm x) = nameTerm(p \<bullet> x)"
  and     ntSupp: "supp(nameTerm x) = {x}"
  and     ntEq: "\<Psi> \<turnstile> (nameTerm x) \<leftrightarrow> M = (M = nameTerm x)"
  and     subst4: "\<lbrakk>length xvec = length Tvec; distinct xvec; xvec \<sharp>* (M::'a)\<rbrakk> \<Longrightarrow> M[xvec::=Tvec] = M"
begin

lemma ntChanEq[simp]:
  fixes \<Psi> :: 'b
  and   x :: name

  shows "\<Psi> \<turnstile> (nameTerm x) \<leftrightarrow> (nameTerm x)"
using ntEq
by auto

lemma nameTermFresh[simp]:
  fixes x :: name
  and   y :: name

  shows "x \<sharp> (nameTerm y) = (x \<noteq> y)"
using ntSupp
by(auto simp add: fresh_def)

lemma nameTermFreshChain[simp]:
  fixes xvec :: "name list"
  and   x    :: name

  shows "xvec \<sharp>* (nameTerm x) = x \<sharp> xvec"
by(induct xvec) auto

definition tauPrefix :: "('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi" ("\<tau>._" [85] 85)
  where "tauPrefix P \<equiv> THE P'. \<exists>x::name. x \<sharp> P \<and> P' = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"

lemma tauActionUnfold:
  fixes P :: "('a, 'b, 'c) psi"
  and   C :: "'d::fs_name"

  obtains x::name where "x \<sharp> P" and "x \<sharp> C" and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
proof -
  obtain x::name where "x \<sharp> P" and "x \<sharp> C" by(generate_fresh "name") auto
  hence "\<exists>x::name. x \<sharp> P \<and> x \<sharp> C \<and> \<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    apply(simp add: tauPrefix_def)
    apply(subst the_equality)
    apply(rule_tac x=x in exI)
    apply simp
    apply(clarify)
    apply(simp add: psi.inject alpha)
    by(auto simp add: calc_atm eqvts abs_fresh)
  moreover assume "\<And>x. \<lbrakk>x \<sharp> P; x \<sharp> C;
          \<tau>.(P) =
          \<lparr>\<nu>x\<rparr>((nameTerm x\<lparr>\<lambda>*[] nameTerm x\<rparr>.\<zero>) \<parallel> nameTerm x\<langle>nameTerm x\<rangle>.P)\<rbrakk>
         \<Longrightarrow> thesis"
  ultimately show ?thesis by blast
qed

lemma tauActionI:
  fixes P :: "('a, 'b, 'c) psi"

  shows "\<exists>P'. \<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P' \<and> \<Psi> \<rhd> P \<sim> P'"
proof -
  obtain x:: name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule tauActionUnfold)

  then have "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> \<lparr>\<nu>x\<rparr>(\<zero> \<parallel> P)"
    apply simp
    apply(rule Scope)
    apply auto
    apply(subgoal_tac "\<Psi> \<rhd> ((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P) \<longmapsto>\<tau> \<prec> \<lparr>\<nu>*[]\<rparr>(\<zero> \<parallel> P)")
    apply simp
    apply(rule_tac M="(nameTerm x)" and N="(nameTerm x)" and K="(nameTerm x)" in Comm1)
    apply(auto intro: ntChanEq Output Input)
    apply(subgoal_tac "\<Psi> \<otimes> \<one> \<rhd> (nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero> \<longmapsto>(nameTerm x)\<lparr>((nameTerm x)[([])::=[]])\<rparr> \<prec> (\<zero>[[]::=[]])")
    apply(simp add: subst4)
    by(rule_tac Input) auto
  moreover from \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> P\<close> have "\<Psi> \<rhd> P \<sim> \<lparr>\<nu>x\<rparr>(\<zero> \<parallel> P)"
    by(metis bisimTransitive bisimParNil bisimScopeExtSym bisimResNil bisimParPresSym bisimParComm bisimE(4))
  ultimately show ?thesis by blast
qed

lemma outputEmpy[dest]:
  assumes "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> P'"

  shows "xvec = []"
using assms
apply -
by(ind_cases "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N'\<rangle> \<prec> P'") (auto simp add: psi.inject residualInject)

lemma tauActionE:
  fixes P :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'"

  shows "\<Psi> \<rhd> P \<sim> P'" and "supp P' = ((supp P)::name set)"
proof -
  obtain x:: name where "x \<sharp> (\<Psi>, P')" and "x \<sharp> P" and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule tauActionUnfold)
  with assms have "\<Psi> \<rhd> P \<sim> P' \<and> supp P' = ((supp P)::name set)"
    apply simp
    apply(erule_tac resTauCases)
    apply simp+
    apply(erule_tac C="x" in parCases)
    apply simp+
    apply(drule_tac nilTrans(3)[where xvec="[]", simplified])
    apply simp
    apply force
    apply simp
    apply(subgoal_tac "\<Psi> \<otimes> \<one> \<rhd> (nameTerm x)\<lparr>\<lambda>*[] (nameTerm x)\<rparr>.\<zero> \<longmapsto>M\<lparr>N\<rparr> \<prec> P'a")
    apply(erule_tac inputCases)
    apply simp
    apply(subgoal_tac "xvec = []")
    apply(erule_tac outputCases)
    apply simp
    apply(clarsimp)
    apply(rule conjI)
    apply(metis bisimTransitive bisimParNil bisimScopeExtSym bisimResNil bisimParPresSym bisimParComm bisimE(4))
    apply(auto simp add: psi.supp abs_supp suppBottom)
    by(simp add: fresh_def)
  thus "\<Psi> \<rhd> P \<sim> P'" and "supp P' = ((supp P)::name set)"
    by auto
qed

lemma tauActionEqvt[eqvt]:
  fixes P :: "('a, 'b, 'c) psi"
  and   p :: "name prm"

  shows "(p \<bullet> \<tau>.(P)) = \<tau>.(p \<bullet> P)"
proof -
  obtain x::name where "x \<sharp> P" and "x \<sharp> p" and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule tauActionUnfold)
  moreover obtain y::name where "y \<sharp> p \<bullet> P" and "y \<sharp> (p, x)" and "\<tau>.(p \<bullet> P) = \<lparr>\<nu>y\<rparr>(((nameTerm y)\<lparr>\<lambda>*([]) (nameTerm y)\<rparr>.\<zero>) \<parallel> ((nameTerm y)\<langle>(nameTerm y)\<rangle>.(p \<bullet> P)))"
    by(rule tauActionUnfold)
  ultimately show ?thesis
    by(simp add: eqvts calc_atm at_prm_fresh[OF at_name_inst] psi.inject alpha pt_fresh_perm_app[OF pt_name_inst, OF at_name_inst])
qed

lemma resCases'[consumes 7, case_names cOpen cRes]:
  fixes \<Psi>    :: 'b
  and   x    :: name
  and   P    :: "('a, 'b, 'c) psi"
  and   \<alpha>    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   C    :: "'d::fs_name"

  assumes Trans: "\<Psi> \<rhd> \<lparr>\<nu>x\<rparr>P \<longmapsto>x\<alpha> \<prec> xP'"
  and     "x \<sharp> \<Psi>"
  and     "x \<sharp> x\<alpha>"
  and     "x \<sharp> xP'"
  and     "bn x\<alpha> \<sharp>* \<Psi>"
  and     "bn x\<alpha> \<sharp>* P"
  and     "bn x\<alpha> \<sharp>* subject x\<alpha>"
  and     rOpen: "\<And>M xvec yvec y N P'. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>M\<lparr>\<nu>*(xvec@yvec)\<rparr>\<langle>([(x, y)] \<bullet> N)\<rangle> \<prec> ([(x, y)] \<bullet> P'); y \<in> supp N;
                                         x \<sharp> N; x \<sharp> P'; x \<noteq> y; y \<sharp> xvec; y \<sharp> yvec; y \<sharp> M; distinct xvec; distinct yvec;
                                         xvec \<sharp>* \<Psi>; y \<sharp> \<Psi>; yvec \<sharp>* \<Psi>; xvec \<sharp>* P; y \<sharp> P; yvec \<sharp>* P; xvec \<sharp>* M; y \<sharp> M;
                                         yvec \<sharp>* M; xvec \<sharp>* yvec; x\<alpha> = M\<lparr>\<nu>*(xvec@y#yvec)\<rparr>\<langle>N\<rangle>; xP' = P'\<rbrakk> \<Longrightarrow>
                                         Prop"
  and     rScope:  "\<And>P'. \<lbrakk>\<Psi> \<rhd> P \<longmapsto>x\<alpha> \<prec> P'; xP' = \<lparr>\<nu>x\<rparr>P'\<rbrakk> \<Longrightarrow> Prop"

  shows "Prop"
proof -
  from Trans have "distinct(bn x\<alpha>)" by(auto dest: boundOutputDistinct)
  have "length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xP')" by simp
  note Trans
  moreover have "length [] = inputLength(\<lparr>\<nu>x\<rparr>P)" and "distinct []"
    by(auto simp add: inputLength_inputLength'_inputLength''.simps)
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xP')\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xP')\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xP')\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xP')\<close> \<open>distinct(bn x\<alpha>)\<close>
  ultimately show ?thesis using \<open>bn x\<alpha> \<sharp>* \<Psi>\<close> \<open>bn x\<alpha> \<sharp>* P\<close> \<open>bn x\<alpha> \<sharp>* subject x\<alpha>\<close> \<open>x \<sharp> \<Psi>\<close> \<open>x \<sharp> x\<alpha>\<close> \<open>x \<sharp> xP'\<close> \<open>distinct(bn x\<alpha>)\<close> rScope rOpen
    apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ _ x x])
    apply(auto simp add: psi.inject alpha abs_fresh residualInject boundOutputApp boundOutput.inject eqvts)
    apply(subgoal_tac "y \<in> supp Na")
    apply(auto simp add: residualInject boundOutputApp)
    apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
    by(simp add: calc_atm eqvts)
qed

lemma parCases'[consumes 5, case_names cPar1 cPar2 cComm1 cComm2]:
  fixes \<Psi>    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   \<alpha>    :: "'a action"
  and   T    :: "('a, 'b, 'c) psi"
  and   C    :: "'d::fs_name"

  assumes Trans: "\<Psi> \<rhd> P \<parallel> Q \<longmapsto>x\<alpha> \<prec> xT"
  and     "bn x\<alpha> \<sharp>* \<Psi>"
  and     "bn x\<alpha> \<sharp>* P"
  and     "bn x\<alpha> \<sharp>* Q"
  and     "bn x\<alpha> \<sharp>* subject x\<alpha>"
  and     rPar1: "\<And>P' A\<^sub>Q \<Psi>\<^sub>Q. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>x\<alpha> \<prec> P';  extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
                                  A\<^sub>Q \<sharp>* \<Psi>; A\<^sub>Q \<sharp>* P; A\<^sub>Q \<sharp>* Q; A\<^sub>Q \<sharp>* x\<alpha>; A\<^sub>Q \<sharp>* P'; A\<^sub>Q \<sharp>* C; xT = P' \<parallel> Q\<rbrakk> \<Longrightarrow> Prop"
  and     rPar2: "\<And>Q' A\<^sub>P \<Psi>\<^sub>P. \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>x\<alpha> \<prec> Q';  extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
                                 A\<^sub>P \<sharp>* \<Psi>; A\<^sub>P \<sharp>* P; A\<^sub>P \<sharp>* Q; A\<^sub>P \<sharp>* x\<alpha>; A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* C; xT = P \<parallel> Q'\<rbrakk> \<Longrightarrow> Prop"
  and     rComm1: "\<And>\<Psi>\<^sub>Q M N P' A\<^sub>P \<Psi>\<^sub>P K xvec Q' A\<^sub>Q.
           \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>N\<rparr> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
            \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
            \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
            A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C;
            A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C;
            xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K; xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C; x\<alpha>=\<tau>; xT = \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')\<rbrakk> \<Longrightarrow> Prop"
  and     rComm2: "\<And>\<Psi>\<^sub>Q M xvec N P' A\<^sub>P \<Psi>\<^sub>P K Q' A\<^sub>Q.
           \<lbrakk>\<Psi> \<otimes> \<Psi>\<^sub>Q \<rhd> P \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'; extractFrame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>; distinct A\<^sub>P;
            \<Psi> \<otimes> \<Psi>\<^sub>P \<rhd> Q \<longmapsto>K\<lparr>N\<rparr> \<prec> Q'; extractFrame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>; distinct A\<^sub>Q;
            \<Psi> \<otimes> \<Psi>\<^sub>P \<otimes> \<Psi>\<^sub>Q \<turnstile> M \<leftrightarrow> K; distinct xvec;
            A\<^sub>P \<sharp>* \<Psi>;  A\<^sub>P \<sharp>* \<Psi>\<^sub>Q;  A\<^sub>P \<sharp>* P;  A\<^sub>P \<sharp>* M;  A\<^sub>P \<sharp>* N;  A\<^sub>P \<sharp>* P';  A\<^sub>P \<sharp>* Q;  A\<^sub>P \<sharp>* xvec;  A\<^sub>P \<sharp>* Q'; A\<^sub>P \<sharp>* A\<^sub>Q;  A\<^sub>P \<sharp>* C;
            A\<^sub>Q \<sharp>* \<Psi>;  A\<^sub>Q \<sharp>* \<Psi>\<^sub>P; A\<^sub>Q \<sharp>* P;  A\<^sub>Q \<sharp>* K;  A\<^sub>Q \<sharp>* N;  A\<^sub>Q \<sharp>* P';  A\<^sub>Q \<sharp>* Q;  A\<^sub>Q \<sharp>* xvec;  A\<^sub>Q \<sharp>* Q'; A\<^sub>Q \<sharp>* C;
            xvec \<sharp>* \<Psi>;  xvec \<sharp>* \<Psi>\<^sub>P; xvec \<sharp>* P;  xvec \<sharp>* M;  xvec \<sharp>* K;  xvec \<sharp>* Q;  xvec \<sharp>* \<Psi>\<^sub>Q;  xvec \<sharp>* C; x\<alpha>=\<tau>; xT = \<lparr>\<nu>*xvec\<rparr>(P' \<parallel> Q')\<rbrakk> \<Longrightarrow> Prop"

  shows "Prop"
proof -
  from Trans have "distinct(bn x\<alpha>)" by(auto dest: boundOutputDistinct)
  have "length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xT)" by simp
  note Trans
  moreover have "length [] = inputLength(P \<parallel> Q)" and "distinct []"
    by(auto simp add: inputLength_inputLength'_inputLength''.simps)
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xT)\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xT)\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xT)\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover note \<open>length(bn x\<alpha>) = residualLength(x\<alpha> \<prec> xT)\<close> \<open>distinct(bn x\<alpha>)\<close>
  moreover obtain x::name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> Q" and "x \<sharp> x\<alpha>" and "x \<sharp> xT"
    by(generate_fresh "name") auto
  ultimately show ?thesis using \<open>bn x\<alpha> \<sharp>* \<Psi>\<close> \<open>bn x\<alpha> \<sharp>* P\<close> \<open>bn x\<alpha> \<sharp>* Q\<close> \<open>bn x\<alpha> \<sharp>* subject x\<alpha>\<close> using rPar1 rPar2 rComm1 rComm2
    by(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x x]) (auto simp add: psi.inject residualInject residualInject')
qed

lemma inputCases'[consumes 1, case_names cInput]:
  fixes \<Psi>   :: 'b
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"
  and   \<alpha>    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"

  assumes Trans: "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'"
  and     rInput: "\<And>K Tvec. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; set xvec \<subseteq> supp N; length xvec = length Tvec; distinct xvec; \<alpha>=K\<lparr>N[xvec::=Tvec]\<rparr>; P' = P[xvec::=Tvec]\<rbrakk> \<Longrightarrow> Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"

  shows "Prop \<alpha> P'"
proof -
  {
    fix xvec N P
    assume Trans: "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'"
       and "xvec \<sharp>* \<Psi>" and "xvec \<sharp>* M" and "xvec \<sharp>* \<alpha>" and "xvec \<sharp>* P'" and "distinct xvec"
       and rInput: "\<And>K Tvec. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; set xvec \<subseteq> supp N; length xvec = length Tvec; distinct xvec; \<alpha>=K\<lparr>N[xvec::=Tvec]\<rparr>; P'=P[xvec::=Tvec]\<rbrakk> \<Longrightarrow> Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"

    from Trans have "bn \<alpha> = []"
      apply -
      by(ind_cases "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<alpha> \<prec> P'") (auto simp add: residualInject)
    from Trans have "distinct(bn \<alpha>)" by(auto dest: boundOutputDistinct)
    have "length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')" by simp
    note Trans
    moreover have "length xvec = inputLength(M\<lparr>\<lambda>*xvec N\<rparr>.P)" by auto
    moreover note \<open>distinct xvec\<close>
    moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
    moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
    moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
    moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
    moreover note \<open>length(bn \<alpha>) = residualLength(\<alpha> \<prec> P')\<close> \<open>distinct(bn \<alpha>)\<close>
    moreover obtain x::name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> M" and "x \<sharp> xvec" and "x \<sharp> \<alpha>" and "x \<sharp> P'" and "x \<sharp> N"
      by(generate_fresh "name") auto
    ultimately have "Prop \<alpha> P'" using \<open>bn \<alpha> = []\<close> \<open>xvec \<sharp>* \<Psi>\<close>\<open>xvec \<sharp>* M\<close> \<open>xvec \<sharp>* \<alpha>\<close> \<open>xvec \<sharp>* P'\<close> rInput
      apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x])
      by(fastforce simp add: residualInject psi.inject inputChainFresh)+
  }
  note Goal = this
  moreover obtain p :: "name prm" where "(p \<bullet> xvec) \<sharp>* \<Psi>" and "(p \<bullet> xvec) \<sharp>* M" and "(p \<bullet> xvec) \<sharp>* N" and "(p \<bullet> xvec) \<sharp>* P"
                                    and "(p \<bullet> xvec) \<sharp>* \<alpha>" and "(p \<bullet> xvec) \<sharp>* P'" and S: "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)"
                                    and "distinctPerm p"
    by(rule_tac xvec=xvec and c="(\<Psi>, M, N, P, \<alpha>, P')" in name_list_avoiding) auto
  from Trans \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close> S have "\<Psi> \<rhd> M\<lparr>\<lambda>*(p \<bullet> xvec) (p \<bullet> N)\<rparr>.(p \<bullet> P) \<longmapsto>\<alpha> \<prec> P'"
    by(simp add: inputChainAlpha')
  moreover {
    fix K Tvec
    assume "\<Psi> \<turnstile> M \<leftrightarrow> K"
    moreover assume "set(p \<bullet> xvec) \<subseteq> supp(p \<bullet> N)"
    hence "(p \<bullet> set(p \<bullet> xvec)) \<subseteq> (p \<bullet> supp(p \<bullet> N))" by simp
    with \<open>distinctPerm p\<close> have "set xvec \<subseteq> supp N" by(simp add: eqvts)
    moreover assume "length(p \<bullet> xvec) = length(Tvec::'a list)"
    hence "length xvec = length Tvec" by simp
    moreover assume "distinct xvec"
    moreover assume "\<alpha>=K\<lparr>(p \<bullet> N)[(p \<bullet> xvec)::=Tvec]\<rparr>" and "P' = (p \<bullet> P)[(p \<bullet> xvec)::=Tvec]"
    with \<open>(p \<bullet> xvec) \<sharp>* P\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>distinctPerm p\<close> \<open>length xvec = length Tvec\<close> S
    have "\<alpha>=K\<lparr>(N[xvec::=Tvec])\<rparr>" and "P' = P[xvec::=Tvec]"
      by(simp add: renaming substTerm.renaming)+
    ultimately have "Prop (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"
      by(rule rInput)
    with \<open>length xvec = length Tvec\<close> S \<open>distinctPerm p\<close> \<open>(p \<bullet> xvec) \<sharp>* N\<close> \<open>(p \<bullet> xvec) \<sharp>* P\<close>
    have "Prop (K\<lparr>(p \<bullet> N)[(p \<bullet> xvec)::=Tvec]\<rparr>) ((p \<bullet> P)[(p \<bullet> xvec)::=Tvec])"
      by(simp add: renaming substTerm.renaming)
  }
  moreover from Trans have "distinct xvec" by(rule inputDistinct)
  hence "distinct(p \<bullet> xvec)" by simp
  ultimately show ?thesis using \<open>(p \<bullet> xvec) \<sharp>* \<Psi>\<close> \<open>(p \<bullet> xvec) \<sharp>* M\<close> \<open>(p \<bullet> xvec) \<sharp>* \<alpha>\<close> \<open>(p \<bullet> xvec) \<sharp>* P'\<close> \<open>distinct xvec\<close>
    by(rule_tac Goal) assumption+
qed

lemma outputCases'[consumes 1, case_names cOutput]:
  fixes \<Psi> :: 'b
  and   M  :: 'a
  and   N  :: 'a
  and   P  :: "('a, 'b, 'c) psi"
  and   \<alpha>  :: "'a action"
  and   P' :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>\<alpha> \<prec> P'"
  and     "\<And>K. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; subject \<alpha>=Some K\<rbrakk> \<Longrightarrow> Prop (K\<langle>N\<rangle>) P"

  shows "Prop \<alpha> P'"
using assms
by(cases rule: semantics.cases) (auto simp add: residualInject psi.inject)

lemma tauOutput[dest]:
  fixes \<Psi>   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"

  shows False
proof -
  {
    fix xvec N P'

    assume "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>M\<lparr>\<nu>*xvec\<rparr>\<langle>N\<rangle> \<prec> P'"
    and    "xvec \<sharp>* \<Psi>"
    and    "xvec \<sharp>* P"
    and    "xvec \<sharp>* M"

    moreover obtain x:: name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> xvec" and "x \<sharp> M" and "x \<sharp> N" and "x \<sharp> P'"
                               and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
      by(rule_tac C="(\<Psi>, M, xvec, N, P')" in tauActionUnfold) auto
    ultimately have False
      apply simp
      apply(erule_tac resCases')
      apply simp+
      apply(erule_tac parOutputCases)
      apply(simp add: action.inject psi.inject)+
      apply(drule_tac nilTrans(2)[where xvec="[]", simplified])
      apply simp+
      apply(simp add: action.inject)
      apply(clarify)
      apply(erule outputCases')
      apply(auto simp add: ntEq)
      apply(erule_tac parCases')
      apply(auto simp add: abs_fresh)
      apply(drule_tac nilTrans(2)[where xvec="[]", simplified])
      apply simp
      apply(erule_tac outputCases')
      apply auto
      by(simp add: ntEq)
  }
  moreover obtain p where "set p \<subseteq> set xvec \<times> set(p \<bullet> xvec)" and "(p \<bullet> xvec) \<sharp>* N" and  "(p \<bullet> xvec) \<sharp>* P'"
                      and "(p \<bullet> xvec) \<sharp>* \<Psi>" and "(p \<bullet> xvec) \<sharp>* P" and "(p \<bullet> xvec) \<sharp>* M"
    by(rule_tac c="(N, P', \<Psi>, P, M)" and xvec=xvec in name_list_avoiding) auto
    ultimately show False using assms by(simp add: boundOutputChainAlpha'' residualInject) auto
qed

lemma tauInput[dest]:
  fixes \<Psi> :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>M\<lparr>N\<rparr> \<prec> P'"

  shows False
proof -
  obtain x:: name where "x \<sharp> \<Psi>" and "x \<sharp> P" and "x \<sharp> M" and "x \<sharp> N" and "x \<sharp> P'"
                    and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule_tac C="(\<Psi>, M, N, P')" in tauActionUnfold) auto
  with assms show False
    apply simp
    apply(erule_tac resCases')
    apply auto
    apply(drule_tac  parCases')
    apply(auto simp add: abs_fresh)
    apply(subgoal_tac "\<Psi> \<otimes> \<one> \<rhd> (nameTerm x)\<lparr>\<lambda>*[] (nameTerm x)\<rparr>.\<zero> \<longmapsto>M\<lparr>N\<rparr> \<prec> P'a")
    apply(erule_tac inputCases')
    by(auto simp add: action.inject subst4)
qed

lemma tauPrefixFrame:
  fixes P :: "('a, 'b, 'c) psi"

  shows "extractFrame(\<tau>.(P)) \<simeq>\<^sub>F \<langle>\<epsilon>, \<one>\<rangle>"
proof -
  obtain x:: name where "x \<sharp> P"
                    and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule_tac C="()" in tauActionUnfold) auto
  thus ?thesis
    by(force intro: frameResFresh Identity FrameStatEqTrans)
qed

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

  shows "insertAssertion (extractFrame(\<tau>.(P))) \<Psi> \<simeq>\<^sub>F \<langle>\<epsilon>, \<Psi>\<rangle>"
proof -
  obtain x:: name where "x \<sharp> P" and "x \<sharp> \<Psi>"
                    and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule_tac C=\<Psi> in tauActionUnfold) auto
  thus ?thesis
    apply auto
    apply(rule_tac G="\<langle>\<epsilon>, \<Psi> \<otimes> \<one> \<otimes> \<one>\<rangle>" in FrameStatEqTrans)
    apply(rule_tac frameResFresh) apply auto
    apply(subgoal_tac "x \<sharp> \<one> \<otimes> \<one>")
    apply auto
    by(metis Identity AssertionStatEqTrans AssertionStatEqSym Associativity)
qed

lemma seqSubst4:
  assumes "y \<sharp> \<sigma>"
  and     "wellFormedSubst \<sigma>"

  shows "substTerm.seqSubst (nameTerm y) \<sigma> = nameTerm y"
using assms
by(induct \<sigma>) (auto simp add: subst4)

lemma tauSeqSubst[simp]:
  fixes P :: "('a, 'b, 'c) psi"
  and   \<sigma> :: "(name list \<times> 'a list) list"

  assumes "wellFormedSubst \<sigma>"

  shows "(\<tau>.(P))[<\<sigma>>] = \<tau>.(P[<\<sigma>>])"
proof -
  obtain x:: name where "x \<sharp> P[<\<sigma>>]" and "x \<sharp> \<sigma>" and "x \<sharp> P"
                    and "\<tau>.(P[<\<sigma>>]) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.(P[<\<sigma>>])))"
    by(rule_tac C="(\<sigma>, P)" in tauActionUnfold) auto
  moreover obtain y:: name where "y \<sharp> P[<\<sigma>>]" and "y \<sharp> \<sigma>" and "y \<sharp> P" and "x \<noteq> y"
                    and "\<tau>.(P) = \<lparr>\<nu>y\<rparr>(((nameTerm y)\<lparr>\<lambda>*([]) (nameTerm y)\<rparr>.\<zero>) \<parallel> ((nameTerm y)\<langle>(nameTerm y)\<rangle>.(P)))"
    by(rule_tac C="(\<sigma>, P[<\<sigma>>], x)" in tauActionUnfold) auto
  ultimately show ?thesis using assms
    by(auto simp add: psi.inject alpha eqvts calc_atm psi.inject input.inject seqSubst4)
qed

lemma tauSubst[simp]:
  fixes P    :: "('a, 'b, 'c) psi"
  and   xvec :: "name list"
  and   Tvec :: "'a list"

  assumes "distinct xvec"
  and     "length xvec = length Tvec"

  shows "(\<tau>.(P))[xvec::=Tvec] = \<tau>.(P[xvec::=Tvec])"
proof -
  obtain x:: name where "x \<sharp> P[xvec::=Tvec]" and "x \<sharp> xvec" and "x \<sharp> Tvec" and "x \<sharp> P"
                    and "\<tau>.(P[xvec::=Tvec]) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.(P[xvec::=Tvec])))"
    by(rule_tac C="(xvec, Tvec, P)" in tauActionUnfold) auto
  moreover obtain y:: name where "y \<sharp> P[xvec::=Tvec]" and "y \<sharp> xvec" and "y \<sharp> Tvec" and "y \<sharp> P" and "x \<noteq> y"
                    and "\<tau>.(P) = \<lparr>\<nu>y\<rparr>(((nameTerm y)\<lparr>\<lambda>*([]) (nameTerm y)\<rparr>.\<zero>) \<parallel> ((nameTerm y)\<langle>(nameTerm y)\<rangle>.(P)))"
    by(rule_tac C="(xvec, Tvec, P[xvec::=Tvec], x)" in tauActionUnfold) auto
  ultimately show ?thesis using assms
    by(auto simp add: psi.inject alpha eqvts calc_atm psi.inject input.inject subst4)
qed

lemma tauFresh[simp]:
  fixes P :: "('a, 'b, 'c) psi"
  and   x :: name

  shows "x \<sharp> \<tau>.(P) = x \<sharp> P"
proof -
  obtain y::name where "y \<noteq> x" and "y \<sharp> P" and "\<tau>.(P) = \<lparr>\<nu>y\<rparr>(((nameTerm y)\<lparr>\<lambda>*([]) (nameTerm y)\<rparr>.\<zero>) \<parallel> ((nameTerm y)\<langle>(nameTerm y)\<rangle>.P))"
    by(rule_tac C=x in tauActionUnfold) auto

  thus ?thesis by(auto simp add: abs_fresh)
qed

lemma tauFreshChain[simp]:
  fixes P    :: "('a, 'b, 'c) psi"
  and   xvec :: "name list"

  shows "xvec \<sharp>* (\<tau>.(P)) = (xvec \<sharp>* P)"
by(induct xvec) auto

lemma guardedTau:
  fixes P :: "('a, 'b, 'c) psi"

  shows "guarded(\<tau>.(P))"
proof -
  obtain x::name where "x \<sharp> P" and "\<tau>.(P) = \<lparr>\<nu>x\<rparr>(((nameTerm x)\<lparr>\<lambda>*([]) (nameTerm x)\<rparr>.\<zero>) \<parallel> ((nameTerm x)\<langle>(nameTerm x)\<rangle>.P))"
    by(rule_tac C="()" in tauActionUnfold) auto

  thus ?thesis by auto
qed

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

  assumes "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"
  and     "\<Psi> \<rhd> P \<sim> P''"

  obtains P''' where "\<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" and "\<Psi> \<rhd> P' \<sim> P'''"
using assms
proof(induct arbitrary: thesis rule: tauChainInduct)
  case(TauBase P)
  thus ?case by auto
next
  case(TauStep P P' P''')
  from \<open>\<Psi> \<rhd> P \<sim> P''\<close> obtain P'''' where P''Chain: "\<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''''" and "\<Psi> \<rhd> P' \<sim> P''''"
    by(rule_tac TauStep) auto
  from \<open>\<Psi> \<rhd> P' \<sim> P''''\<close> \<open>\<Psi> \<rhd> P' \<longmapsto>\<tau> \<prec> P'''\<close>
  obtain P''''' where P''''Trans: "\<Psi> \<rhd> P'''' \<longmapsto>\<tau> \<prec> P'''''" and "\<Psi> \<rhd> P''' \<sim> P'''''"
    apply(drule_tac bisimE(4))
    apply(drule_tac bisimE(2))
    apply(drule_tac simE)
    apply auto
    apply(drule_tac bisimE(4))
    by blast
  from P''Chain P''''Trans have "\<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''''" by(drule_tac tauActTauChain) auto
  with \<open>\<Psi> \<rhd> P''' \<sim> P'''''\<close> show ?case
    by(metis TauStep)
qed

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

  assumes PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"

  obtains P'' where "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''" and "\<Psi> \<rhd> P' \<sim> P''"
proof -
  assume Goal: "\<And>P''. \<lbrakk>\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''; \<Psi> \<rhd> P' \<sim> P''\<rbrakk> \<Longrightarrow> thesis"
  obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
    by auto
  from PChain \<open>\<Psi> \<rhd> P \<sim> P''\<close> obtain P''' where P''Chain: "\<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" and "\<Psi> \<rhd> P' \<sim> P'''"
    by(rule tauChainBisim)
  from PTrans P''Chain have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P'''" by(drule_tac tauActTauStepChain) auto
  thus ?thesis using \<open>\<Psi> \<rhd> P' \<sim> P'''\<close>
    by(rule Goal)
qed

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

  assumes "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"

  obtains P'' where "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" and "\<Psi> \<rhd> P' \<sim> P''"
proof -
  assume Goal: "\<And>P''. \<lbrakk>\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''; \<Psi> \<rhd> P' \<sim> P''\<rbrakk> \<Longrightarrow> thesis"
  from assms obtain P'' where "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''" and "\<Psi> \<rhd> P' \<sim> P''"
    by(rule tauChainStepCons)
  thus ?thesis by(rule_tac Goal) auto
qed

lemma weakTransitionTau:
  fixes \<Psi>   :: 'b
  and   Q    :: "('a, 'b, 'c) psi"
  and   P    :: "('a, 'b, 'c) psi"
  and   \<alpha>    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"

  assumes PTrans: "\<Psi> : Q \<rhd> P \<Longrightarrow>\<alpha> \<prec> P'"
  and     "bn \<alpha> \<sharp>* \<Psi>"
  and     "bn \<alpha> \<sharp>* P"

  obtains P'' where "\<Psi> : Q \<rhd> \<tau>.(P) \<Longrightarrow>\<alpha> \<prec> P''" and "\<Psi> \<rhd> P' \<sim> P''"
proof -
  assume Goal: "\<And>P''. \<lbrakk>\<Psi> : Q \<rhd> \<tau>.(P) \<Longrightarrow>\<alpha> \<prec> P''; \<Psi> \<rhd> P' \<sim> P''\<rbrakk> \<Longrightarrow> thesis"
  from PTrans obtain P'' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''"
                           and QimpP'': "insertAssertion (extractFrame Q) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion(extractFrame P'') \<Psi>"
                           and P''Trans: "\<Psi> \<rhd> P'' \<longmapsto>\<alpha> \<prec> P'"
    by(blast dest: weakTransitionE)

  from PChain obtain P''' where tPChain: "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" and "\<Psi> \<rhd> P'' \<sim> P'''" by(rule tauChainCons)
  moreover from QimpP'' \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> have "insertAssertion (extractFrame Q) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion(extractFrame P''') \<Psi>"
    by(metis bisimE FrameStatEq_def FrameStatImpTrans)
  moreover from tPChain \<open>bn \<alpha> \<sharp>* P\<close> have "bn \<alpha> \<sharp>* P'''" by(force intro: tauChainFreshChain)
  with \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> P''Trans \<open>bn \<alpha> \<sharp>* \<Psi>\<close> obtain P'''' where "\<Psi> \<rhd> P''' \<longmapsto>\<alpha> \<prec> P''''" and "\<Psi> \<rhd> P' \<sim> P''''"
    by(metis bisimE simE)
  ultimately show ?thesis
    by(rule_tac Goal) (blast intro: weakTransitionI)
qed

end

end


(*  Title:      HOL/Auth/n_german_lemma_inv__17_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end


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

theory Strengthen_Setup
  imports
    Strengthen
    No_Fail
    NonDetMonadVCG
begin

section \<open>Strengthen setup.\<close>

context strengthen_implementation begin

lemma strengthen_hoare [strg]:
  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>)"
  by (cases F, auto elim: hoare_strengthen_post)

lemma strengthen_validE_R_cong[strg]:
  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, -) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, -)"
  by (cases F, auto intro: hoare_post_imp_R)

lemma strengthen_validE_cong[strg]:
  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>T\<rbrace>)"
  by (cases F, auto elim: hoare_post_impErr)

lemma strengthen_validE_E_cong[strg]:
  "(\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f -, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f -, \<lbrace>T\<rbrace>)"
  by (cases F, auto elim: hoare_post_impErr simp: validE_E_def)

lemma wpfix_strengthen_hoare:
  "(\<And>s. st (\<not> F) (\<longrightarrow>) (P s) (P' s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (Q r s) (Q' r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) (\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>)"
  by (cases F, auto elim: hoare_chain)

lemma wpfix_strengthen_validE_R_cong:
  "(\<And>s. st (\<not> F) (\<longrightarrow>) (P s) (P' s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (Q r s) (Q' r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, -) (\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, -)"
  by (cases F, auto elim: hoare_chainE simp: validE_R_def)

lemma wpfix_strengthen_validE_cong:
  "(\<And>s. st (\<not> F) (\<longrightarrow>) (P s) (P' s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>S\<rbrace>) (\<lbrace>P'\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>T\<rbrace>)"
  by (cases F, auto elim: hoare_chainE)

lemma wpfix_strengthen_validE_E_cong:
  "(\<And>s. st (\<not> F) (\<longrightarrow>) (P s) (P' s))
    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f -, \<lbrace>S\<rbrace>) (\<lbrace>P'\<rbrace> f -, \<lbrace>T\<rbrace>)"
  by (cases F, auto elim: hoare_chainE simp: validE_E_def)

lemma wpfix_no_fail_cong:
  "(\<And>s. st (\<not> F) (\<longrightarrow>) (P s) (P' s))
    \<Longrightarrow> st F (\<longrightarrow>) (no_fail P f) (no_fail P' f)"
  by (cases F, auto elim: no_fail_pre)

lemmas nondet_wpfix_strgs =
    wpfix_strengthen_validE_R_cong
    wpfix_strengthen_validE_E_cong
    wpfix_strengthen_validE_cong
    wpfix_strengthen_hoare
    wpfix_no_fail_cong

end

lemmas nondet_wpfix_strgs[wp_fix_strgs]
    = strengthen_implementation.nondet_wpfix_strgs

end


(*  Title:      HOL/MicroJava/BV/JVM.thy

    Author:     Tobias Nipkow, Gerwin Klein
    Copyright   2000 TUM
*)

section \<open>The Typing Framework for the JVM \label{sec:JVM}\<close>

theory TF_JVM
imports "../DFA/Typing_Framework_err" EffectMono BVSpec
begin

definition exec :: "jvm_prog \<Rightarrow> nat \<Rightarrow> ty \<Rightarrow> ex_table \<Rightarrow> instr list \<Rightarrow> ty\<^sub>i' err step_type"
where
  "exec G maxs rT et bs \<equiv>
  err_step (size bs) (\<lambda>pc. app (bs!pc) G maxs rT pc (size bs) et)
                     (\<lambda>pc. eff (bs!pc) G pc et)"

locale JVM_sl =
  fixes P :: jvm_prog and mxs and mxl\<^sub>0 and n
  fixes Ts :: "ty list" and "is" and xt and T\<^sub>r

  fixes mxl and A and r and f and app and eff and step
  defines [simp]: "mxl \<equiv> 1+size Ts+mxl\<^sub>0"
  defines [simp]: "A   \<equiv> states P mxs mxl"
  defines [simp]: "r   \<equiv> JVM_SemiType.le P mxs mxl"
  defines [simp]: "f   \<equiv> JVM_SemiType.sup P mxs mxl"

  defines [simp]: "app \<equiv> \<lambda>pc. Effect.app (is!pc) P mxs T\<^sub>r pc (size is) xt"
  defines [simp]: "eff \<equiv> \<lambda>pc. Effect.eff (is!pc) P pc xt"
  defines [simp]: "step \<equiv> err_step (size is) app eff"

  defines [simp]: "n \<equiv> size is"

locale start_context = JVM_sl +
  fixes p and C
  assumes wf: "wf_prog p P"
  assumes C:  "is_class P C"
  assumes Ts: "set Ts \<subseteq> types P"

  fixes first :: ty\<^sub>i' and start
  defines [simp]:
  "first \<equiv> Some ([],OK (Class C) # map OK Ts @ replicate mxl\<^sub>0 Err)"
  defines [simp]:
  "start \<equiv> OK first # replicate (size is - 1) (OK None)"

subsection \<open>Connecting JVM and Framework\<close>
lemma (in start_context) semi: "semilat (A, r, f)"
  apply (insert semilat_JVM[OF wf])
  apply (unfold A_def r_def f_def JVM_SemiType.le_def JVM_SemiType.sup_def states_def)
  apply auto
  done

lemma (in JVM_sl) step_def_exec: "step \<equiv> exec P mxs T\<^sub>r xt is"
  by (simp add: exec_def)

lemma special_ex_swap_

lemma ex_in_nlists [iff]:
  "(\<exists>n. ST \<in> nlists n A \<and> n \<le> mxs) = (set ST \<subseteq> A \<and> size ST \<le> mxs)"
  by (unfold nlists_def) auto

lemma singleton_nlists:
  "(\<exists>n. [Class C] \<in> nlists n (types P) \<and> n \<le> mxs) = (is_class P C \<and> 0 < mxs)"
  by auto

lemma set_drop_subset:
  "set xs \<subseteq> A \<Longrightarrow> set (drop n xs) \<subseteq> A"
  by (auto dest: in_set_dropD)

lemma Suc_minus_minus_le:
  "n < mxs \<Longrightarrow> Suc (n - (n - b)) \<le> mxs"
  by arith

lemma in_nlistsE:
  "\<lbrakk> xs \<in> nlists n A; \<lbrakk>size xs = n; set xs \<subseteq> A\<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by (unfold nlists_def) blast

declare is_relevant_entry_def [simp]
declare set_drop_subset [simp]

theorem (in start_context) exec_pres_type:
  "pres_type step (size is) A"
(*<*)
  apply (insert wf)
  apply simp
  apply (unfold JVM_states_unfold)
  apply (rule pres_type_lift)
  apply clarify
  apply (rename_tac s pc pc' s')
  apply (case_tac s)
   apply simp
   apply (drule effNone)
   apply simp
  apply (simp add: Effect.app_def xcpt_app_def Effect.eff_def
                   xcpt_eff_def norm_eff_def relevant_entries_def)
  apply (case_tac "is!pc")

  \<comment> \<open>Load\<close>
  apply clarsimp
  apply (frule nlistsE_nth_in, assumption)
  apply fastforce

  \<comment> \<open>Store\<close>
  apply fastforce

  \<comment> \<open>Push\<close>
  apply (fastforce simp add: typeof_lit_is_type)

  \<comment> \<open>New\<close>
  apply clarsimp apply fastforce

  \<comment> \<open>Getfield\<close>
  apply clarsimp apply (fastforce dest: sees_field_is_type)

  \<comment> \<open>Putfield\<close>
  apply clarsimp apply fastforce

  \<comment> \<open>Checkcast\<close>
  apply clarsimp apply fastforce

  defer

  \<comment> \<open>Return\<close>
  apply fastforce

  \<comment> \<open>Pop\<close>
  apply fastforce

  \<comment> \<open>IAdd\<close>
  apply fastforce

  \<comment> \<open>Goto\<close>
  apply fastforce

  \<comment> \<open>CmpEq\<close>
  apply fastforce

  \<comment> \<open>IfFalse\<close>
  apply fastforce

  \<comment> \<open>Throw\<close>
 apply clarsimp  apply fastforce

  \<comment> \<open>Invoke\<close>
  apply (clarsimp split!: if_splits)
   apply fastforce
  apply (erule disjE)
   prefer 2
   apply fastforce
  apply clarsimp
  apply (rule conjI)
   apply (drule (1) sees_wf_mdecl)
   apply (clarsimp simp add: wf_mdecl_def)
  apply arith
  done
(*>*)

declare is_relevant_entry_def [simp del]
declare set_drop_subset [simp del]

lemma lesubstep_type_simple:
  "xs [\<sqsubseteq>\<^bsub>Product.le (=) r\<^esub>] ys \<Longrightarrow> set xs {\<sqsubseteq>\<^bsub>r\<^esub>} set ys"
(*<*)
  apply (unfold lesubstep_type_def)
  apply clarify
  apply (simp add: set_conv_nth)
  apply clarify
  apply (drule le_listD, assumption)
  apply (clarsimp simp add: lesub_def Product.le_def)
  apply (rule exI)
  apply (rule conjI)
   apply (rule exI)
   apply (rule conjI)
    apply (rule sym)
    apply assumption
   apply assumption
  apply assumption
  done
(*>*)

declare is_relevant_entry_def [simp del]

lemma conjI2: "\<lbrakk> A; A \<Longrightarrow> B \<rbrakk> \<Longrightarrow> A \<and> B" by blast

lemma (in JVM_sl) eff_mono:
  "\<lbrakk>wf_prog p P; pc < length is; s \<sqsubseteq>\<^bsub>sup_state_opt P\<^esub> t; app pc t\<rbrakk>
  \<Longrightarrow> set (eff pc s) {\<sqsubseteq>\<^bsub>sup_state_opt P\<^esub>} set (eff pc t)"
(*<*)
  apply simp
  apply (unfold Effect.eff_def)
  apply (cases t)
   apply (simp add: lesub_def)
  apply (rename_tac a)
  apply (cases s)
   apply simp
  apply (rename_tac b)
  apply simp
  apply (rule lesubstep_union)
   prefer 2
   apply (rule lesubstep_type_simple)
   apply (simp add: xcpt_eff_def)
   apply (rule le_listI)
    apply (simp add: split_beta)
   apply (simp add: split_beta)
   apply (simp add: lesub_def fun_of_def)
   apply (case_tac a)
   apply (case_tac b)
   apply simp
   apply (subgoal_tac "size ab = size aa")
     prefer 2
     apply (clarsimp simp add: list_all2_lengthD)
   apply simp
  apply (clarsimp simp add: norm_eff_def lesubstep_type_def lesub_def iff del: sup_state_conv)
  apply (rule exI)
  apply (rule conjI2)
   apply (rule imageI)
   apply (clarsimp simp add: Effect.app_def iff del: sup_state_conv)
   apply (drule (2) succs_mono)
   apply blast
  apply simp
  apply (erule eff\<^sub>i_mono)
     apply simp
    apply assumption
   apply clarsimp
  apply clarsimp
  done
(*>*)

lemma (in JVM_sl) bounded_step: "bounded step (size is)"
(*<*)
  apply simp
  apply (unfold bounded_def err_step_def Effect.app_def Effect.eff_def)
  apply (auto simp add: error_def map_snd_def split: err.splits option.splits)
  done
(*>*)

theorem (in JVM_sl) step_mono:
  "wf_prog wf_mb P \<Longrightarrow> mono r step (size is) A"
(*<*)
  apply (simp add: JVM_le_Err_conv)
  apply (insert bounded_step)
  apply (unfold JVM_states_unfold)
  apply (rule mono_lift)
     apply blast   \<comment>\<open> order_sup_state_opt' \<close>
    apply (unfold app_mono_def lesub_def)
    apply clarsimp
    apply (erule (2) app_mono)
   apply simp
  apply clarify
  apply (drule eff_mono)
  apply (auto simp add: lesub_def)
  done
(*>*)

lemma (in start_context) first_in_A [iff]: "OK first \<in> A"
  using Ts C by (force intro!: nlists_appendI simp add: JVM_states_unfold)

lemma (in JVM_sl) wt_method_def2:
  "wt_method P C' Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<tau>s =
  (is \<noteq> [] \<and>
   size \<tau>s = size is \<and>
   OK ` set \<tau>s \<subseteq> states P mxs mxl \<and>
   wt_start P C' Ts mxl\<^sub>0 \<tau>s \<and>
   wt_app_eff (sup_state_opt P) app eff \<tau>s)"
(*<*)
  apply (unfold wt_method_def wt_app_eff_def wt_instr_def lesub_def check_types_def)
  apply auto
  done
(*>*)

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__52.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__52 imports n_german_base
begin
section{*All lemmas on causal relation between inv__52 and some rule r*}
lemma n_RecvInvAckVsinv__52:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntSVsinv__52:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__52:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__52:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqESVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqES  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvGntSVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvGntS  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvSVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvS  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvEVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvE  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvGntEVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvGntE  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvAckVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvAck  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReq N i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__52:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqEIVsinv__52:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqEI  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory PolicyExample
imports ArchNoninterference
begin

(* This first example_auth_graphample shows how notifications and endpoints differ.
   Endpoints tend to spray information in all directions, while
   notifications are unidirectional.

   This example is a subset of the SAC example from access *)
datatype auth_graph_label = T | NTFN1 | NTFN2 | CTR | C | EP | RM

abbreviation partition_label where
  "partition_label x \<equiv> OrdinaryLabel x"

definition example_auth_graph :: "(auth_graph_label subject_label \<times> auth \<times> auth_graph_label subject_label) set" where
  "example_auth_graph \<equiv>
   { (partition_label T,Notify,partition_label NTFN1),
     (partition_label CTR,Receive,partition_label NTFN1),
     (partition_label C,Read,partition_label CTR),
     (partition_label C,Write,partition_label CTR),
     (partition_label CTR,Read,partition_label C),
     (partition_label CTR,Write,partition_label C),
     (partition_label CTR,SyncSend,partition_label EP),
     (partition_label T,Notify,partition_label NTFN2),
     (partition_label RM,Receive,partition_label NTFN2),
     (partition_label RM,Receive,partition_label EP)
   } \<union> {(a,b,c). a = c}"

declare example_auth_graph_def [simp]

lemma subjectReads_T:
  "subjectReads example_auth_graph (partition_label T) = {partition_label T}"
  apply(auto elim: subjectReads.induct)
  done

lemma CTR_in_subjectReads_NTFN1:
  "partition_label CTR \<in> subjectReads example_auth_graph (partition_label NTFN1)"
  apply(rule read_sync_ep_read_receivers[where ep="partition_label NTFN1"], auto)
  done

lemma EP_in_subjectReads_NTFN1:
  "partition_label EP \<in> subjectReads example_auth_graph (partition_label NTFN1)"
  apply(rule reads_read_queued_thread_read_ep[where t="partition_label CTR" and a="partition_label EP"], auto intro: CTR_in_subjectReads_NTFN1[simplified])
  done

lemma C_in_subjectReads_NTFN1:
  "partition_label C \<in> subjectReads example_auth_graph (partition_label NTFN1)"
  apply(rule reads_read_thread_read_pages)
  apply (rule CTR_in_subjectReads_NTFN1)
  apply simp
  done

lemma RM_in_subjectReads_NTFN1:
  "partition_label RM \<in> subjectReads example_auth_graph (partition_label NTFN1)"
  by (rule read_sync_ep_read_receivers; fastforce intro: EP_in_subjectReads_NTFN1)

lemma NTFN2_in_subjectReads_NTFN1:
  "partition_label NTFN2 \<in> subjectReads example_auth_graph (partition_label NTFN1)"
  apply (rule reads_read_queued_thread_read_ep[where t="partition_label RM" and a="partition_label NTFN2"])
  by (auto intro: RM_in_subjectReads_NTFN1[simplified])

lemmas subjectReads_NTFN1' = reads_lrefl[of "partition_label NTFN1"]
                            CTR_in_subjectReads_NTFN1
                            EP_in_subjectReads_NTFN1
                            RM_in_subjectReads_NTFN1
                            C_in_subjectReads_NTFN1
                            NTFN2_in_subjectReads_NTFN1

lemma subjectReads_NTFN1:
  "subjectReads example_auth_graph (partition_label NTFN1) = {partition_label NTFN1, partition_label CTR, partition_label EP, partition_label C, partition_label RM, partition_label NTFN2}"
  apply(rule equalityI)
   apply (rule subsetI)
   apply (erule subjectReads.induct)
           apply (fastforce simp: subjectReads_NTFN1'[simplified])+
  done

lemma RM_in_subjectReads_NTFN2:
  "partition_label RM \<in> subjectReads example_auth_graph (partition_label NTFN2)"
  apply(rule read_sync_ep_read_receivers[where ep="partition_label NTFN2"], auto)
  done

lemma EP_in_subjectReads_NTFN2:
  "partition_label EP \<in> subjectReads example_auth_graph (partition_label NTFN2)"
  apply(rule reads_read_queued_thread_read_ep[where t="partition_label RM" and a="partition_label EP"], auto intro: RM_in_subjectReads_NTFN2[simplified])
  done

lemma CTR_in_subjectReads_NTFN2:
  "partition_label CTR \<in> subjectReads example_auth_graph (partition_label NTFN2)"
  apply(rule read_sync_ep_read_senders[where ep="partition_label EP"], auto intro: EP_in_subjectReads_NTFN2[simplified])
  done

lemma C_in_subjectReads_NTFN2:
  "partition_label C \<in> subjectReads example_auth_graph (partition_label NTFN2)"
  apply(rule reads_read_thread_read_pages)
  apply (rule CTR_in_subjectReads_NTFN2)
  apply simp
  done

lemma NTFN1_in_subjectReads_NTFN2:
  "partition_label NTFN1 \<in> subjectReads example_auth_graph (partition_label NTFN2)"
  apply(rule reads_read_queued_thread_read_ep[where t="partition_label CTR" and a="partition_label NTFN1"], auto intro: CTR_in_subjectReads_NTFN2[simplified])
  done

lemmas subjectReads_NTFN2' = reads_lrefl[of "partition_label NTFN2"]
                            CTR_in_subjectReads_NTFN2
                            EP_in_subjectReads_NTFN2
                            RM_in_subjectReads_NTFN2
                            C_in_subjectReads_NTFN2
                            NTFN1_in_subjectReads_NTFN2

lemma subjectReads_NTFN2:
  "subjectReads example_auth_graph (partition_label NTFN2) = {partition_label NTFN2, partition_label NTFN1, partition_label C, partition_label CTR, partition_label RM, partition_label EP}"
  apply(rule equalityI)
   apply (rule subsetI)
   apply (erule subjectReads.induct)
           apply (fastforce simp: subjectReads_NTFN2'[simplified])+
  done

lemma EP_in_subjectReads_CTR:
  "partition_label EP \<in> subjectReads example_auth_graph (partition_label CTR)"
  apply(rule_tac a="partition_label CTR" and t="partition_label CTR" in reads_read_queued_thread_read_ep)
      apply auto
  done

lemma RM_in_subjectReads_CTR:
  "partition_label RM \<in> subjectReads example_auth_graph (partition_label CTR)"
  apply(clarsimp)
  apply(rule_tac ep="partition_label EP" in read_sync_ep_read_receivers)
   apply(rule EP_in_subjectReads_CTR[simplified])
  apply fastforce
  done

lemma C_in_subjectReads_CTR:
  "partition_label C \<in> subjectReads example_auth_graph (partition_label CTR)"
  apply(rule reads_read, auto)
  done

lemma NTFN1_in_subjectReads_CTR:
  "partition_label NTFN1 \<in> subjectReads example_auth_graph (partition_label CTR)"
  apply(rule_tac t="partition_label CTR" and auth="Receive" and a="partition_label T" and auth'="Notify" in reads_read_queued_thread_read_ep)
  apply (auto)
  done

lemma NTFN2_in_subjectReads_CTR:
  "partition_label NTFN2 \<in> subjectReads example_auth_graph (partition_label CTR)"
  apply(rule_tac t="partition_label RM" and auth="Receive" and a="partition_label T" and auth'="Notify" in reads_read_queued_thread_read_ep)
  apply (auto intro: RM_in_subjectReads_CTR[simplified])
  done

lemmas subjectReads_CTR' = reads_lrefl[of "partition_label CTR"]
                           NTFN2_in_subjectReads_CTR NTFN1_in_subjectReads_CTR
                           C_in_subjectReads_CTR RM_in_subjectReads_CTR EP_in_subjectReads_CTR

lemma subjectReads_CTR:
  "subjectReads example_auth_graph (partition_label CTR) = {partition_label CTR,partition_label C,partition_label EP, partition_label RM, partition_label NTFN1, partition_label NTFN2}"
  apply(clarsimp)
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct; auto)
  apply(auto simp: subjectReads_CTR'[simplified])
  done

lemma NTFN1_in_subjectReads_C:
  "partition_label NTFN1 \<in> subjectReads example_auth_graph (partition_label C)"
  apply(rule_tac a="partition_label T" and ep="partition_label NTFN1" and t="partition_label CTR" in reads_read_queued_thread_read_ep)
      apply (auto intro: reads_read)
  done

lemma EP_in_subjectReads_C:
  "partition_label EP \<in> subjectReads example_auth_graph (partition_label C)"
  apply(rule_tac a="partition_label CTR" and t="partition_label CTR" in reads_read_queued_thread_read_ep)
      apply (auto intro: reads_read)
  done

lemma RM_in_subjectReads_C:
  "partition_label RM \<in> subjectReads example_auth_graph (partition_label C)"
  apply(clarsimp)
  apply(rule read_sync_ep_read_receivers[OF EP_in_subjectReads_C[simplified]])
  apply simp
  done

lemma CTR_in_subjectReads_C:
  "partition_label CTR \<in> subjectReads example_auth_graph (partition_label C)"
  apply(rule reads_read, auto)
  done

lemma NTFN2_in_subjectReads_C:
  "partition_label NTFN2 \<in> subjectReads example_auth_graph (partition_label C)"
  apply(rule_tac a="partition_label T" and ep="partition_label NTFN2" and t="partition_label RM" in reads_read_queued_thread_read_ep)
  apply(fastforce simp: RM_in_subjectReads_C[simplified])+
  done

lemmas subjectReads_C' = reads_lrefl[of "partition_label C"]
                         NTFN2_in_subjectReads_C NTFN1_in_subjectReads_C
                         RM_in_subjectReads_C EP_in_subjectReads_C CTR_in_subjectReads_C

lemma subjectReads_C:
  "subjectReads example_auth_graph (partition_label C) = {partition_label C,partition_label CTR,partition_label NTFN1, partition_label EP, partition_label RM, partition_label NTFN2}"
  apply(clarsimp)
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct; auto)
  apply(auto simp: subjectReads_C'[simplified])
  done

lemma CTR_in_subjectReads_EP:
  "partition_label CTR \<in> subjectReads example_auth_graph (partition_label EP)"
  apply(clarsimp)
  apply(rule_tac ep="partition_label EP" in read_sync_ep_read_senders)
     apply simp+
  done

lemma NTFN1_in_subjectReads_EP:
  "partition_label NTFN1 \<in> subjectReads example_auth_graph (partition_label EP)"
  apply(rule reads_read_queued_thread_read_ep[where a="partition_label NTFN1", OF _ _ _ _ CTR_in_subjectReads_EP])
  apply(auto)
  done

lemma C_in_subjectReads_EP:
  "partition_label C \<in> subjectReads example_auth_graph (partition_label EP)"
  apply(rule reads_read_thread_read_pages[OF CTR_in_subjectReads_EP])
  apply(auto)
  done

lemma RM_in_subjectReads_EP:
  "partition_label RM \<in> subjectReads example_auth_graph (partition_label EP)"
  apply(rule read_sync_ep_read_receivers[OF reads_lrefl])
  apply(auto)
  done

lemma NTFN2_in_subjectReads_EP:
  "partition_label NTFN2 \<in> subjectReads example_auth_graph (partition_label EP)"
  apply(rule reads_read_queued_thread_read_ep[where a="partition_label NTFN2", OF _ _ _ _ RM_in_subjectReads_EP])
  apply(auto)
  done

lemmas subjectReads_EP' = reads_lrefl[of "partition_label EP"]
                         CTR_in_subjectReads_EP
                         C_in_subjectReads_EP
                         RM_in_subjectReads_EP
                         NTFN2_in_subjectReads_EP
                         NTFN1_in_subjectReads_EP

lemma subjectReads_EP:
  "subjectReads example_auth_graph (partition_label EP) = {partition_label EP,partition_label CTR,partition_label NTFN1, partition_label C, partition_label RM, partition_label NTFN2}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct; auto)
  apply(auto simp: subjectReads_EP'[simplified])
  done

lemma NTFN2_in_subjectReads_RM:
   "partition_label NTFN2 \<in> subjectReads example_auth_graph (partition_label RM)"
  apply(rule reads_ep, auto)
  done

lemma EP_in_subjectReads_RM:
   "partition_label EP \<in> subjectReads example_auth_graph (partition_label RM)"
  apply(rule reads_ep, auto)
  done

lemma CTR_in_subjectReads_RM:
   "partition_label CTR \<in> subjectReads example_auth_graph (partition_label RM)"
  apply(rule read_sync_ep_read_senders[where ep="partition_label EP", OF EP_in_subjectReads_RM], auto)
  done

lemma C_in_subjectReads_RM:
   "partition_label C \<in> subjectReads example_auth_graph (partition_label RM)"
  apply(rule reads_read_thread_read_pages[where t="partition_label CTR", OF CTR_in_subjectReads_RM], auto)
  done

lemma NTFN1_in_subjectReads_RM:
   "partition_label NTFN1 \<in> subjectReads example_auth_graph (partition_label RM)"
  apply(rule reads_read_queued_thread_read_ep[where a="partition_label T" and t="partition_label CTR", OF _ _ _ _ CTR_in_subjectReads_RM], auto)
  done

lemmas subjectReads_RM' = reads_lrefl[of "partition_label RM"]
                         CTR_in_subjectReads_RM
                         C_in_subjectReads_RM
                         EP_in_subjectReads_RM
                         NTFN1_in_subjectReads_RM
                         NTFN2_in_subjectReads_RM

lemma subjectReads_RM:
  "subjectReads example_auth_graph (partition_label RM) = {partition_label RM, partition_label NTFN2,partition_label EP,partition_label CTR, partition_label C, partition_label NTFN1}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct; auto)
  apply(auto simp: subjectReads_RM'[simplified])
  done

lemma NTFN1_in_subjectAffects_T:
  "partition_label NTFN1 \<in> subjectAffects example_auth_graph (partition_label T)
" apply(auto intro: affects_ep)
  done

lemma NTFN2_in_subjectAffects_T:
  "partition_label NTFN2 \<in> subjectAffects example_auth_graph (partition_label T)
" apply(auto intro: affects_ep)
  done

lemma C_in_subjectAffects_T:
  "partition_label C \<in> subjectAffects example_auth_graph (partition_label T)
" apply(rule affects_send[where auth="Notify" and ep="partition_label NTFN1"], auto)
  done

lemma CTR_in_subjectAffects_T:
  "partition_label CTR \<in> subjectAffects example_auth_graph (partition_label T)
" apply(rule affects_send[where auth="Notify" and ep="partition_label NTFN1"], auto)
  done

lemma RM_in_subjectAffects_T:
  "partition_label RM \<in> subjectAffects example_auth_graph (partition_label T)
" apply(rule affects_send[where auth="Notify" and ep="partition_label NTFN2"], auto)
  done

lemma EP_in_subjectAffects_T:
  "partition_label EP \<in> subjectAffects example_auth_graph (partition_label T)"
  by (rule affects_ep_bound_trans, auto)

lemmas subjectAffects_T' = affects_lrefl[of "partition_label T"]
                           NTFN1_in_subjectAffects_T
                           NTFN2_in_subjectAffects_T
                           C_in_subjectAffects_T
                           CTR_in_subjectAffects_T
                           RM_in_subjectAffects_T
                           EP_in_subjectAffects_T

lemma subjectAffects_T:
  "subjectAffects example_auth_graph (partition_label T) = {partition_label NTFN1,partition_label NTFN2,partition_label T,partition_label C, partition_label CTR, partition_label RM, partition_label EP}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; fastforce)
  apply(auto simp: subjectAffects_T'[simplified])
  done

lemma CTR_in_subjectAffects_NTFN1:
  "partition_label CTR \<in> subjectAffects example_auth_graph (partition_label NTFN1)"
  apply(rule affects_send[where ep="partition_label NTFN1"], auto)
  done

lemma C_in_subjectAffects_NTFN1:
  "partition_label C \<in> subjectAffects example_auth_graph (partition_label NTFN1)"
  apply(rule affects_send[where ep="partition_label NTFN1"], auto)
  done

lemmas subjectAffects_NTFN1' = affects_lrefl[of "partition_label NTFN1"]
                           C_in_subjectAffects_NTFN1
                           CTR_in_subjectAffects_NTFN1

lemma subjectAffects_NTFN1:
  "subjectAffects example_auth_graph (partition_label NTFN1) = {partition_label NTFN1,partition_label CTR,partition_label C}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; fastforce)
  apply(auto simp: subjectAffects_NTFN1'[simplified])
  done

lemma RM_in_subjectAffects_NTFN2:
  "partition_label RM \<in> subjectAffects example_auth_graph (partition_label NTFN2)"
  apply(rule affects_send[where ep="partition_label NTFN2"], auto)
  done

lemma EP_in_subjectAffects_NTFN2:
  "partition_label EP \<in> subjectAffects example_auth_graph (partition_label NTFN2)"
  apply(rule affects_ep_bound_trans, auto)
  done

lemmas subjectAffects_NTFN2' = affects_lrefl[of "partition_label NTFN2"]
                           RM_in_subjectAffects_NTFN2
                           EP_in_subjectAffects_NTFN2

lemma subjectAffects_NTFN2:
  "subjectAffects example_auth_graph (partition_label NTFN2) = {partition_label NTFN2,partition_label RM, partition_label EP}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; fastforce)
  apply(auto simp: subjectAffects_NTFN2'[simplified])
  done

lemma C_in_subjectAffects_CTR:
  "partition_label C \<in> subjectAffects example_auth_graph (partition_label CTR)"
  apply(rule affects_write[where auth="Write"], auto)
  done

lemma EP_in_subjectAffects_CTR:
  "partition_label EP \<in> subjectAffects example_auth_graph (partition_label CTR)"
  apply(rule affects_ep, auto)
  done

lemma NTFN1_in_subjectAffects_CTR:
  "partition_label NTFN1 \<in> subjectAffects example_auth_graph (partition_label CTR)"
  apply(rule affects_ep, auto)
  done

lemma RM_in_subjectAffects_CTR:
  "partition_label RM \<in> subjectAffects example_auth_graph (partition_label CTR)"
  apply(rule affects_send, auto)
  done

lemmas subjectAffects_CTR' = affects_lrefl[of "partition_label CTR"]
                           NTFN1_in_subjectAffects_CTR
                           C_in_subjectAffects_CTR
                           EP_in_subjectAffects_CTR
                           RM_in_subjectAffects_CTR

lemma subjectAffects_CTR:
  "subjectAffects example_auth_graph (partition_label CTR) = {partition_label CTR,partition_label C,partition_label EP,partition_label NTFN1, partition_label RM}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; auto)
  apply(auto simp: subjectAffects_CTR'[simplified])
  done

lemma CTR_in_subjectAffects_C:
  "partition_label CTR \<in> subjectAffects example_auth_graph (partition_label C)"
  apply(rule affects_write[where auth=Write], auto)
  done

lemmas subjectAffects_C' = affects_lrefl[of "partition_label C"]
                           CTR_in_subjectAffects_C

lemma subjectAffects_C:
  "subjectAffects example_auth_graph (partition_label C) = {partition_label C,partition_label CTR}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; auto)
  apply(auto simp: subjectAffects_C'[simplified])
  done

lemma RM_in_subjectAffects_EP:
  "partition_label RM \<in> subjectAffects example_auth_graph (partition_label EP)"
  apply(rule affects_send, auto)
  done

lemma CTR_in_subjectAffects_EP:
  "partition_label CTR \<in> subjectAffects example_auth_graph (partition_label EP)"
  apply(rule affects_recv, auto)
  done

lemma C_in_subjectAffects_EP:
  "partition_label C \<in> subjectAffects example_auth_graph (partition_label EP)"
  apply(rule affects_reset[where ep="partition_label EP" and l'="partition_label CTR"], auto)
  done

lemma NTFN2_in_subjectAffects_EP:
  "partition_label NTFN2 \<in> subjectAffects example_auth_graph (partition_label EP)"
  apply(rule affects_ep_bound_trans, auto)
  done

lemmas subjectAffects_EP' = affects_lrefl[of "partition_label EP"]
                           CTR_in_subjectAffects_EP
                           C_in_subjectAffects_EP
                           RM_in_subjectAffects_EP
                           NTFN2_in_subjectAffects_EP

lemma subjectAffects_EP:
  "subjectAffects example_auth_graph (partition_label EP) = {partition_label EP, partition_label RM, partition_label CTR, partition_label C, partition_label NTFN2}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; fastforce)
  apply(auto simp: subjectAffects_EP'[simplified])
  done

lemma EP_in_subjectAffects_RM:
  "partition_label EP \<in> subjectAffects example_auth_graph (partition_label RM)"
  apply(rule affects_ep, auto)
  done

lemma CTR_in_subjectAffects_RM:
  "partition_label CTR \<in> subjectAffects example_auth_graph (partition_label RM)"
  apply(rule affects_recv, auto)
  done

lemma NTFN2_in_subjectAffects_RM:
  "partition_label NTFN2 \<in> subjectAffects example_auth_graph (partition_label RM)"
  apply(rule affects_ep, auto)
  done

lemmas subjectAffects_RM' = affects_lrefl[of "partition_label RM"]
                            EP_in_subjectAffects_RM
                            NTFN2_in_subjectAffects_RM
                            CTR_in_subjectAffects_RM

lemma subjectAffects_RM:
  "subjectAffects example_auth_graph (partition_label RM) = {partition_label RM,partition_label EP,partition_label CTR,partition_label NTFN2}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.cases; auto)
  apply(auto simp: subjectAffects_RM'[simplified])
  done

lemmas subjectReads = subjectReads_T subjectReads_NTFN1 subjectReads_NTFN2 subjectReads_CTR
                      subjectReads_EP subjectReads_RM subjectReads_C

declare example_auth_graph_def [simp del]

lemma partsSubjectAffects_T:
  "partsSubjectAffects example_auth_graph T = {Partition T,Partition NTFN1, Partition NTFN2, Partition CTR, Partition C, Partition EP, Partition RM}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_T | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_NTFN1:
  "partsSubjectAffects example_auth_graph NTFN1 = {Partition NTFN1, Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN2}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_NTFN1 | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_NTFN2:
  "partsSubjectAffects example_auth_graph NTFN2 = {Partition NTFN2, Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN1}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_NTFN2 | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_CTR:
  "partsSubjectAffects example_auth_graph CTR = {Partition NTFN1, Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN2}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_CTR | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_C:
  "partsSubjectAffects example_auth_graph C = {Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN1, Partition NTFN2}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_C | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_EP:
  "partsSubjectAffects example_auth_graph EP = {Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN1, Partition NTFN2}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_EP | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_RM:
  "partsSubjectAffects example_auth_graph RM = {Partition CTR, Partition C, Partition EP, Partition RM, Partition NTFN2, Partition NTFN1}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_RM | rename_tac xa, case_tac xa)+
  done

lemmas partsSubjectAffects = partsSubjectAffects_T partsSubjectAffects_NTFN1
                            partsSubjectAffects_NTFN2 partsSubjectAffects_CTR
                            partsSubjectAffects_C partsSubjectAffects_RM partsSubjectAffects_EP

definition example_policy :: "(auth_graph_label partition \<times> auth_graph_label partition) set" where
  "example_policy \<equiv> {(PSched,d)|d. True} \<union>
                    {(Partition l,Partition k)|l k. (k = T \<longrightarrow> l = T)}"

lemma "example_policy = policyFlows example_auth_graph"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(clarsimp simp: example_policy_def)
   apply(elim disjE)
    apply(fastforce intro: policy_scheduler)
   apply clarsimp
   apply (rule policy_affects)
   apply (case_tac "k = T")
    apply (clarsimp simp: partsSubjectAffects)
   apply(case_tac l; (auto simp: partsSubjectAffects | case_tac k)+)
  apply(rule subsetI)
  apply(clarsimp simp: example_policy_def)
  apply(erule policyFlows.cases)
   apply(case_tac l, auto simp: partsSubjectAffects)
  done

(* This second example is a classic 'one way information flow'
   example, where information is allowed to flow from Low to High,
   but not the reverse. We consider a typical scenario where
   shared memory and an notification for notifications are used to
   implement a ring-buffer. *)
datatype auth_graph_label2 = High | Low | SharedPage | NTFN

definition example_auth_graph2 :: "(auth_graph_label2 subject_label \<times> auth \<times> auth_graph_label2 subject_label) set" where
  "example_auth_graph2 \<equiv>
   { (partition_label Low,Write,partition_label SharedPage),
     (partition_label Low,Read,partition_label SharedPage),
     (partition_label High,Read,partition_label SharedPage),
     (partition_label Low,Notify,partition_label NTFN),
     (partition_label High,Receive,partition_label NTFN)
   } \<union> {(x,a,y). x = y}"

declare example_auth_graph2_def [simp]

lemma subjectReads_Low: "subjectReads example_auth_graph2 (partition_label Low) = {partition_label Low,partition_label SharedPage}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, fastforce+)
  apply (auto intro: reads_read)
  done

lemma subjectReads_SharedPage: "subjectReads example_auth_graph2 (partition_label SharedPage) = {partition_label Low,partition_label SharedPage}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, fastforce+)
  apply (auto intro: reads_read_page_read_thread)
  done

lemma High_in_subjectReads_NTFN:
  "partition_label High \<in> subjectReads example_auth_graph2 (partition_label NTFN)"
  apply(rule read_sync_ep_read_receivers)
  apply auto
  done

lemma SharedPage_in_subjectReads_NTFN:
  "partition_label SharedPage \<in> subjectReads example_auth_graph2 (partition_label NTFN)"
  apply(rule reads_read_thread_read_pages[OF High_in_subjectReads_NTFN])
  apply auto
  done

lemma Low_in_subjectReads_NTFN:
  "partition_label Low \<in> subjectReads example_auth_graph2 (partition_label NTFN)"
  apply(rule reads_read_page_read_thread[OF SharedPage_in_subjectReads_NTFN])
  apply auto
  done

lemma subjectReads_NTFN: "subjectReads example_auth_graph2 (partition_label NTFN) = {partition_label NTFN,partition_label High,partition_label SharedPage, partition_label Low}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, fastforce+)
  apply (auto intro: High_in_subjectReads_NTFN Low_in_subjectReads_NTFN SharedPage_in_subjectReads_NTFN simp del: example_auth_graph2_def)
  done

lemma NTFN_in_subjectReads_High:
  "partition_label NTFN \<in> subjectReads example_auth_graph2 (partition_label High)"
  apply(fastforce intro: reads_ep)
  done

lemma SharedPage_in_subjectReads_High:
  "partition_label SharedPage \<in> subjectReads example_auth_graph2 (partition_label High)"
  apply(fastforce intro: reads_read_thread_read_pages)
  done

lemma Low_in_subjectReads_High:
  "partition_label Low \<in> subjectReads example_auth_graph2 (partition_label High)"
  apply(fastforce intro: reads_read_page_read_thread[OF SharedPage_in_subjectReads_High])
  done

lemma subjectReads_High: "subjectReads example_auth_graph2 (partition_label High) = {partition_label High,partition_label NTFN, partition_label SharedPage,partition_label Low}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, fastforce+)
  apply(auto intro: NTFN_in_subjectReads_High SharedPage_in_subjectReads_High Low_in_subjectReads_High simp del: example_auth_graph2_def)
  done

lemma SharedPage_in_subjectAffects_Low:
  "partition_label SharedPage \<in> subjectAffects example_auth_graph2 (partition_label Low)"
  apply(fastforce intro: affects_write)
  done

lemma NTFN_in_subjectAffects_Low:
  "partition_label NTFN \<in> subjectAffects example_auth_graph2 (partition_label Low)"
  apply(fastforce intro: affects_ep)
  done

lemma High_in_subjectAffects_Low:
  "partition_label High \<in> subjectAffects example_auth_graph2 (partition_label Low)"
  apply(rule affects_send[where ep="partition_label NTFN"])
  apply(auto)
  done

lemma subjectAffects_Low: "subjectAffects example_auth_graph2 (partition_label Low) = {partition_label Low,partition_label NTFN,partition_label SharedPage, partition_label High}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, fastforce+)
  apply(auto intro: affects_lrefl SharedPage_in_subjectAffects_Low NTFN_in_subjectAffects_Low High_in_subjectAffects_Low simp del: example_auth_graph2_def)
  done

lemma subjectAffects_SharedPage: "subjectAffects example_auth_graph2 (partition_label SharedPage) = {partition_label SharedPage}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, fastforce+)
  apply(auto intro: affects_lrefl)
  done

lemma High_in_subjectAffects_NTFN:
  "partition_label High \<in> subjectAffects example_auth_graph2 (partition_label NTFN)"
  apply(rule affects_send[where ep="partition_label NTFN"])
  apply auto
  done

lemma subjectAffects_NTFN: "subjectAffects example_auth_graph2 (partition_label NTFN) = {partition_label NTFN,partition_label High}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, fastforce+)
  apply(auto intro: affects_lrefl High_in_subjectAffects_NTFN simp del: example_auth_graph2_def)
  done

lemma NTFN_in_subjectAffects_High:
  "partition_label NTFN \<in> subjectAffects example_auth_graph2 (partition_label High)"
  apply(fastforce intro: affects_ep)
  done

lemma subjectAffects_High: "subjectAffects example_auth_graph2 (partition_label High) = {partition_label NTFN,partition_label High}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, fastforce+)
  apply(auto intro: affects_lrefl NTFN_in_subjectAffects_High simp del: example_auth_graph2_def)
  done

lemmas subjectReads_2 = subjectReads_High subjectReads_Low subjectReads_NTFN subjectReads_SharedPage

declare example_auth_graph2_def [simp del]

lemma partsSubjectAffects_Low: "partsSubjectAffects example_auth_graph2 Low = {Partition Low, Partition High, Partition SharedPage, Partition NTFN}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads_2 subjectAffects_Low | case_tac xa, rename_tac xa)+
  done

lemma partsSubjectAffects_SharedPage: "partsSubjectAffects example_auth_graph2 SharedPage = {Partition SharedPage, Partition High, Partition Low, Partition NTFN}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads_2 subjectAffects_SharedPage | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_NTFN: "partsSubjectAffects example_auth_graph2 NTFN = {Partition NTFN, Partition High}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads_2 subjectAffects_NTFN | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_High: "partsSubjectAffects example_auth_graph2 High = {Partition High, Partition NTFN}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads_2 subjectAffects_High | rename_tac xa, case_tac xa)+
  done

lemmas partsSubjectAffects2 =
   partsSubjectAffects_High partsSubjectAffects_Low partsSubjectAffects_NTFN
   partsSubjectAffects_SharedPage

definition example_policy2 where
  "example_policy2 \<equiv> {(PSched, d)|d. True} \<union>
                     {(d,e). d = e} \<union>
                     {(Partition Low, Partition NTFN), (Partition Low, Partition SharedPage),
                      (Partition Low, Partition High)} \<union>
                     {(Partition SharedPage,Partition High), (Partition SharedPage, Partition Low),
                      (Partition SharedPage,Partition NTFN)} \<union>
                     {(Partition NTFN, Partition High)} \<union>
                     {(Partition High, Partition NTFN)}"

lemma "policyFlows example_auth_graph2 = example_policy2"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(clarsimp simp: example_policy2_def)
   apply(erule policyFlows.cases)
    apply(case_tac l; auto simp: partsSubjectAffects2)
   apply assumption
  apply(rule subsetI)
  apply(clarsimp simp: example_policy2_def)
  apply(elim disjE)
           apply(fastforce simp: partsSubjectAffects2 intro: policy_affects)+
   apply(fastforce intro: policy_scheduler)
  apply(fastforce intro: policyFlows_refl refl_onD)
  done

end