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

nominal_datatype 'a prefix =
  pInput "'a::fs_name" "name list" 'a
| pOutput 'a 'a
| pTau

context tau
begin

nominal_primrec bindPrefix :: "'a prefix \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi"  ("_\<cdot>_" [100, 100] 100)
where
  "bindPrefix (pInput M xvec N) P = M\<lparr>\<lambda>*xvec N\<rparr>.P"
| "bindPrefix (pOutput M N) P = M\<langle>N\<rangle>.P"
| "bindPrefix (pTau) P = \<tau>.(P)"
by(rule TrueI)+

lemma bindPrefixEqvt[eqvt]:
  fixes p :: "name prm"
  and   \<alpha> :: "'a prefix"
  and   P :: "('a, 'b, 'c) psi"

  shows "(p \<bullet> (\<alpha>\<cdot>P)) = (p \<bullet> \<alpha>)\<cdot>(p \<bullet> P)"
by(nominal_induct \<alpha> rule: prefix.strong_inducts) (auto simp add: eqvts)

lemma prefixCases[consumes 1, case_names cInput cOutput cTau]:
  fixes \<Psi> :: 'b
  and   \<alpha>  :: "'a prefix"
  and   P  :: "('a, 'b, 'c) psi"
  and   \<beta>  :: "'a action"
  and   P' :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<beta> \<prec> P'"
  and     rInput: "\<And>M xvec N K Tvec. \<lbrakk>\<Psi> \<turnstile> M \<leftrightarrow> K; set xvec \<subseteq> supp N; length xvec = length Tvec; distinct xvec\<rbrakk> \<Longrightarrow>
                                       Prop (pInput M xvec N) (K\<lparr>N[xvec::=Tvec]\<rparr>) (P[xvec::=Tvec])"
  and     rOutput: "\<And>M N K. \<Psi> \<turnstile> M \<leftrightarrow> K \<Longrightarrow> Prop (pOutput M N) (K\<langle>N\<rangle>) P"
  and     rTau: "\<Psi> \<rhd> P \<sim> P' \<Longrightarrow> Prop (pTau) (\<tau>) P'"

  shows "Prop \<alpha> \<beta> P'"
using \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<beta> \<prec> P'\<close>
proof(nominal_induct rule: prefix.strong_induct)
  case(pInput M xvec N)
  from \<open>\<Psi> \<rhd> (pInput M xvec N)\<cdot>P \<longmapsto>\<beta> \<prec> P'\<close> have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<longmapsto>\<beta> \<prec> P'" by simp
  thus ?case by(auto elim: inputCases intro: rInput)
next
  case(pOutput M N)
  from \<open>\<Psi> \<rhd> (pOutput M N)\<cdot>P \<longmapsto>\<beta> \<prec> P'\<close> have "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<longmapsto>\<beta> \<prec> P'" by simp
  thus ?case by(auto elim: outputCases intro: rOutput)
next
  case pTau
  from \<open>\<Psi> \<rhd> (pTau)\<cdot>P \<longmapsto>\<beta> \<prec> P'\<close> have "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<beta> \<prec> P'" by simp
  thus ?case
    by(nominal_induct rule: action.strong_induct) (auto dest: tauActionE intro: rTau)
qed

lemma prefixTauCases[consumes 1, case_names cTau]:
  fixes \<alpha>  :: "'a prefix"
  and   P  :: "('a, 'b, 'c) psi"
  and   P' :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<tau> \<prec> P'"
  and     rTau: "\<Psi> \<rhd> P \<sim> P' \<Longrightarrow> Prop (pTau) P'"

  shows "Prop \<alpha> P'"
proof -
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<tau> \<prec> P'\<close> obtain \<beta> where "\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<beta> \<prec> P'" and "\<beta> = \<tau>"
    by auto
  thus ?thesis
    by(induct rule: prefixCases) (auto intro: rTau)
qed

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

  assumes "\<Psi> \<rhd> P \<leadsto><Rel> Q"
  and     C1: "\<And>\<Psi> P Q R. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> Rel"

  shows "\<Psi> \<rhd> \<tau>.(P) \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> P \<leadsto><Rel> Q\<close> \<open>\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close>
  obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
    by(blast dest: weakSimE)

  from PChain obtain P'' where "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''" and "\<Psi> \<rhd> P' \<sim> P''"
    by(rule tauChainStepCons)
  thus ?case using P'RelQ' by(metis bisimE C1)
qed

  assumes PTrans: "\<Psi> \<rhd> P \<longmapsto>\<tau> \<prec> P'"
  and     P'RelQ: "(\<Psi>, P', Q) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R. \<lbrakk>(\<Psi>, P, Q) \<in> Rel; \<Psi> \<rhd> Q \<sim> R\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> Rel"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> \<tau>.(Q)"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<tau>.(Q) \<longmapsto>\<tau> \<prec> Q'\<close> have "\<Psi> \<rhd> Q \<sim> Q'" by(blast dest: tauActionE)
  with PTrans P'RelQ show ?case by(metis C1 tauActTauStepChain)
qed

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

  assumes "\<Psi> \<rhd> P \<leadsto><Rel> Q"
  and     C1: "\<And>Q'. \<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q' \<Longrightarrow> (\<Psi>, P, Q') \<notin> Rel"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> P \<leadsto><Rel> Q\<close> \<open>\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close>
  obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
    by(blast dest: weakSimE)
  with C1 \<open>\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close> show ?case
    by(force simp add: rtrancl_eq_or_trancl)
qed

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

  assumes "\<Psi> \<rhd> P \<leadsto><Rel> Q"
  and     "eqvt Rel"
  and     C1: "\<And>\<Psi> P Q R. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> Rel"

  shows "\<Psi> \<rhd> \<tau>.(P) \<leadsto><Rel> Q"
proof(induct rule: weakSimI2)
  case(cAct \<Psi>' \<alpha> Q')
  from \<open>bn \<alpha> \<sharp>* (\<tau>.(P))\<close> have "bn \<alpha> \<sharp>* P" by simp
  with \<open>\<Psi> \<rhd> P \<leadsto><Rel> Q\<close> \<open>\<Psi> \<rhd> Q \<longmapsto>\<alpha> \<prec> Q'\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>\<alpha> \<noteq> \<tau>\<close>
  obtain P'' P' where PTrans: "\<Psi> : Q \<rhd> P \<Longrightarrow>\<alpha> \<prec> P''" and P''Chain: "\<Psi> \<otimes> \<Psi>' \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"
                  and P'RelQ': "(\<Psi> \<otimes> \<Psi>', P', Q') \<in> Rel"
    by(blast dest: weakSimE)

  from PTrans \<open>bn \<alpha> \<sharp>* \<Psi>\<close> \<open>bn \<alpha> \<sharp>* P\<close> obtain P''' where "\<Psi> : Q \<rhd> \<tau>.(P) \<Longrightarrow>\<alpha> \<prec> P'''" and "\<Psi> \<rhd> P'' \<sim> P'''"
    by(rule weakTransitionTau)
  moreover from \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> have "\<Psi> \<otimes> \<Psi>' \<rhd> P'' \<sim> P'''" by(rule bisimE)
  with P''Chain obtain P'''' where "\<Psi> \<otimes> \<Psi>' \<rhd> P''' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''''" and "\<Psi> \<otimes> \<Psi>' \<rhd> P' \<sim> P''''"
    by(rule tauChainBisim)
  ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', P', Q') \<in> Rel\<close> by(metis bisimE C1)
next
  case(cTau Q')
  from \<open>\<Psi> \<rhd> P \<leadsto><Rel> Q\<close> \<open>\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close>
  obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
    by(blast dest: weakSimE)

  from PChain obtain P'' where "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" and "\<Psi> \<rhd> P' \<sim> P''"
    by(rule tauChainCons)
  thus ?case using P'RelQ' by(metis bisimE C1)
qed

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

  assumes "eqvt Rel"
  and     "(\<Psi>, P, Q) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R. \<lbrakk>(\<Psi>, P, Q) \<in> Rel; \<Psi> \<rhd> Q \<sim> R\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> Rel"

  shows "\<Psi> \<rhd> P \<leadsto><Rel> \<tau>.(Q)"
using \<open>eqvt Rel\<close>
proof(induct rule: weakSimI[where C=Q])
  case(cAct \<Psi>' \<alpha> Q')
  hence False by(cases rule: actionCases[where \<alpha>=\<alpha>]) auto
  thus ?case by simp
next
  case(cTau Q')
  have "\<Psi> \<rhd> Q \<Longrightarrow>\<^sup>^\<^sub>\<tau> Q" by simp
  moreover from \<open>\<Psi> \<rhd> \<tau>.(Q) \<longmapsto>\<tau> \<prec> Q'\<close> have "\<Psi> \<rhd> Q \<sim> Q'" by(rule tauActionE)
  with \<open>(\<Psi>, P, Q) \<in> Rel\<close> have "(\<Psi>, P, Q') \<in> Rel" by(rule C1)
  ultimately show ?case by blast
qed

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

  assumes "eqvt Rel"
  and     "(\<Psi>, P, Q) \<in> Rel"
  and     Subst: "\<And>xvec Tvec. length xvec = length Tvec \<Longrightarrow> (\<Psi>, P[xvec::=Tvec], Q[xvec::=Tvec]) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"
  and     rExt: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> Rel \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<leadsto><Rel> \<alpha>\<cdot>Q"
using \<open>eqvt Rel\<close>
proof(induct rule: weakSimI[where C=Q])
  case(cAct \<Psi>' \<beta> Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>Q \<longmapsto>\<beta> \<prec> Q'\<close> \<open>\<beta> \<noteq> \<tau>\<close> show ?case
  proof(induct rule: prefixCases)
    case(cInput M xvec N K Tvec)
    note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
    moreover have "insertAssertion (extractFrame(M\<lparr>\<lambda>*xvec N\<rparr>.Q)) \<Psi> \<hookrightarrow>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>" by auto
    ultimately have "\<Psi> : (M\<lparr>\<lambda>*xvec N\<rparr>.Q) \<rhd> (M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P))) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P))[xvec::=Tvec]"
      by(rule weakInput)
    hence "\<Psi> : (M\<lparr>\<lambda>*xvec N\<rparr>.Q) \<rhd> (M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P))) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> \<tau>.(P[xvec::=Tvec])"
      using \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close>
      by simp

    moreover obtain P' where PTrans: "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P[xvec::=Tvec]) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<otimes> \<Psi>' \<rhd> (P[xvec::=Tvec]) \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P[xvec::=Tvec]) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
    moreover from \<open>length xvec = length Tvec\<close> have "(\<Psi>, P[xvec::=Tvec], Q[xvec::=Tvec]) \<in> Rel" by(rule Subst)
    hence "(\<Psi> \<otimes> \<Psi>', P[xvec::=Tvec], Q[xvec::=Tvec]) \<in> Rel" by(rule rExt)
    with \<open>\<Psi> \<otimes> \<Psi>' \<rhd> P[xvec::=Tvec] \<sim> P'\<close> have "(\<Psi> \<otimes> \<Psi>', P', Q[xvec::=Tvec]) \<in> Rel" by(blast intro: bisimE C1 bisimReflexive)
    ultimately show ?case by fastforce
  next
    case(cOutput M N K)
    note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close>
    moreover have "insertAssertion (extractFrame (M\<langle>N\<rangle>.Q)) \<Psi> \<hookrightarrow>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>" by auto
    ultimately have "\<Psi> : M\<langle>N\<rangle>.Q \<rhd> M\<langle>N\<rangle>.(\<tau>.(P)) \<Longrightarrow>K\<langle>N\<rangle> \<prec> \<tau>.(P)" by(rule weakOutput)
    moreover obtain P' where PTrans: "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<otimes> \<Psi>' \<rhd> P \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
    moreover from \<open>(\<Psi>, P, Q) \<in> Rel\<close> have "(\<Psi> \<otimes> \<Psi>', P, Q) \<in> Rel" by(rule rExt)
    with \<open>\<Psi> \<otimes> \<Psi>' \<rhd> P \<sim> P'\<close> have "(\<Psi> \<otimes> \<Psi>', P', Q) \<in> Rel" by(blast intro: bisimE C1 bisimReflexive)
    ultimately show ?case by fastforce
  next
    case cTau
    with \<open>\<tau> \<noteq> \<tau>\<close> show ?case
      by simp
  qed
next
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>Q \<longmapsto>\<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where tPTrans: "\<Psi> \<rhd> \<tau>.(\<tau>.(P)) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> \<tau>.(P) \<sim> P'" using tauActionI
      by auto
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    from PTrans \<open>\<Psi> \<rhd> \<tau>.(P) \<sim> 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, auto)
      by(metis bisimE)
    from tPTrans P'Trans have "\<Psi> \<rhd> \<tau>.(\<tau>.(P)) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" by(fastforce dest: tauActTauChain)
    moreover from \<open>(\<Psi>, P, Q) \<in> Rel\<close> \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> \<open>\<Psi> \<rhd> Q \<sim> Q'\<close> have "(\<Psi>, P''', Q') \<in> Rel"
      by(metis bisimTransitive C1 bisimSymmetric)
    ultimately show ?case by fastforce
  qed
qed

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

  assumes "eqvt Rel"
  and     Subst: "\<And>\<Psi> xvec Tvec. length xvec = length Tvec \<Longrightarrow> (\<Psi>, P[xvec::=Tvec], \<tau>.(Q[xvec::=Tvec])) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"
  and     "\<And>\<Psi>. (\<Psi>, P, \<tau>.(Q)) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>P \<leadsto><Rel> \<alpha>\<cdot>(\<tau>.(Q))"
using \<open>eqvt Rel\<close>
proof(induct rule: weakSimI[where C=Q])
  case(cAct \<Psi>' \<beta> Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(Q)) \<longmapsto>\<beta> \<prec> Q'\<close> \<open>\<beta> \<noteq> \<tau>\<close>
  show ?case
  proof(induct rule: prefixCases)
    case(cInput M xvec N K Tvec)
    note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec=length Tvec\<close>
    moreover have "insertAssertion (extractFrame (M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(Q)))) \<Psi> \<hookrightarrow>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>" by auto
    ultimately have "\<Psi> : (M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(Q))) \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.P \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> P[xvec::=Tvec]"
      by(rule weakInput)
    moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> P[xvec::=Tvec] \<Longrightarrow>\<^sup>^\<^sub>\<tau> P[xvec::=Tvec]" by auto
    ultimately show ?case using Subst \<open>length xvec=length Tvec\<close> \<open>distinct xvec\<close>
      by fastforce
  next
    case(cOutput M N K)
    note \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close>
    moreover have "insertAssertion (extractFrame (M\<langle>N\<rangle>.(\<tau>.(Q)))) \<Psi> \<hookrightarrow>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>" by auto
    ultimately have "\<Psi> : M\<langle>N\<rangle>.(\<tau>.(Q)) \<rhd> M\<langle>N\<rangle>.P \<Longrightarrow>K\<langle>N\<rangle> \<prec> P" by(rule weakOutput)
    moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P" by auto
    ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', P, \<tau>.(Q)) \<in> Rel\<close> by fastforce
  next
    case cTau
    with \<open>\<tau> \<noteq> \<tau>\<close> show ?case by simp
  qed
next
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(Q)) \<longmapsto>\<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> P \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
    moreover from \<open>\<Psi> \<rhd> P \<sim> P'\<close> \<open>\<Psi> \<rhd> \<tau>.(Q) \<sim> Q'\<close>  \<open>(\<Psi>, P, \<tau>.(Q)) \<in> Rel\<close>
    have "(\<Psi>, P', Q') \<in> Rel" by(metis bisimTransitive bisimSymmetric C1)
    ultimately show ?case by fastforce
  qed
qed

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

  assumes "(\<Psi>, P, Q) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"
  and     rExt: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> Rel \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<leadsto>\<guillemotleft>Rel\<guillemotright> \<alpha>\<cdot>Q"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>Q \<longmapsto>\<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where tPTrans: "\<Psi> \<rhd> \<tau>.(\<tau>.(P)) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> \<tau>.(P) \<sim> P'" using tauActionI
      by auto
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    from PTrans \<open>\<Psi> \<rhd> \<tau>.(P) \<sim> 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, auto)
      by(metis bisimE)
    from tPTrans P'Trans have "\<Psi> \<rhd> \<tau>.(\<tau>.(P)) \<Longrightarrow>\<^sub>\<tau> P'''" by(fastforce dest: tauActTauStepChain)
    moreover from \<open>(\<Psi>, P, Q) \<in> Rel\<close> \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> \<open>\<Psi> \<rhd> Q \<sim> Q'\<close> have "(\<Psi>, P''', Q') \<in> Rel"
      by(metis bisimTransitive C1 bisimSymmetric)
    ultimately show ?case by fastforce
  qed
qed

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

  assumes "(\<Psi>, P, Q) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"
  and     "\<And>\<Psi>. (\<Psi>, P, \<tau>.(Q)) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>P \<leadsto>\<guillemotleft>Rel\<guillemotright> \<alpha>\<cdot>(\<tau>.(Q))"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(Q)) \<longmapsto>\<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> P \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauActTauStepChain)
    moreover from \<open>\<Psi> \<rhd> P \<sim> P'\<close> \<open>\<Psi> \<rhd> \<tau>.(Q) \<sim> Q'\<close>  \<open>(\<Psi>, P, \<tau>.(Q)) \<in> Rel\<close>
    have "(\<Psi>, P', Q') \<in> Rel" by(metis bisimTransitive bisimSymmetric C1)
    ultimately show ?case by fastforce
  qed
qed

end

locale tauSum = tau + sum
begin

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

  assumes Id: "\<And>\<Psi> P. (\<Psi>, P, P) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"

  shows "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<leadsto><Rel> \<tau>.(P)"
proof(induct rule: weakSimI2)
  case(cAct \<Psi>' \<alpha> P')
  thus ?case by(nominal_induct \<alpha> rule: action.strong_inducts) auto
next
  case(cTau P')
  from \<open>\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close> have "\<Psi> \<rhd> P \<sim> P'" by(rule tauActionE)
  obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
    by auto
  have "guarded(\<tau>.(P))" by(rule guardedTau)
  with PTrans have "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" by(rule Sum2)
  hence "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" by(rule tauActTauChain)
  moreover from \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>(\<Psi>, P, P) \<in> Rel\<close> \<open>\<Psi> \<rhd> P \<sim> P'\<close> have "(\<Psi>, P'', P') \<in> Rel"
    by(metis C1 bisimE)
  ultimately show ?case by blast
qed

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

  assumes Id: "\<And>\<Psi> P. (\<Psi>, P, P) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> Rel; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> Rel"

  shows "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<leadsto>\<guillemotleft>Rel\<guillemotright> \<tau>.(P)"
proof(induct rule: weakCongSimI)
  case(cTau P')
  from \<open>\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close> have "\<Psi> \<rhd> P \<sim> P'" by(rule tauActionE)
  obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
    by auto
  have "guarded(\<tau>.(P))" by(rule guardedTau)
  with PTrans have "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" by(rule Sum2)
  hence "\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''" by(rule tauActTauStepChain)
  moreover from \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>(\<Psi>, P, P) \<in> Rel\<close> \<open>\<Psi> \<rhd> P \<sim> P'\<close> have "(\<Psi>, P'', P') \<in> Rel"
    by(metis C1 bisimE)
  ultimately show ?case by blast
qed

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

  assumes C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<tau>.(P) \<leadsto><Rel> P \<oplus> \<tau>.(P)"
proof(induct rule: weakSimI2)
  case(cAct \<Psi>' \<alpha> P')
  from \<open>\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<longmapsto>\<alpha> \<prec> P'\<close>
  show ?case
  proof(induct rule: sumCases)
    case cSum1
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    from PTrans have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" by(rule tauActTauChain)
    moreover from \<open>guarded P\<close> have "insertAssertion (extractFrame P) \<Psi> \<simeq>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>"
      by(rule insertGuardedAssertion)
    with \<open>\<Psi> \<rhd> P \<sim> P''\<close> have "insertAssertion (extractFrame P'') \<Psi> \<simeq>\<^sub>F \<langle>\<epsilon>, \<Psi> \<otimes> \<one>\<rangle>"
      by(metis bisimE FrameStatEqTrans FrameStatEqSym)
    hence "insertAssertion (extractFrame(P \<oplus> \<tau>.(P))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame P'') \<Psi>"
      by(simp add: FrameStatEq_def)
    moreover from PTrans \<open>bn \<alpha> \<sharp>* (\<tau>.(P))\<close> have "bn \<alpha> \<sharp>* P''" by(rule tauFreshChainDerivative)
    with \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>\<Psi> \<rhd> P \<longmapsto>\<alpha> \<prec> P'\<close> \<open>bn \<alpha> \<sharp>* \<Psi>\<close>
    obtain P''' where P''Trans: "\<Psi> \<rhd> P'' \<longmapsto>\<alpha> \<prec> P'''" and "\<Psi> \<rhd> P''' \<sim> P'"
      by(metis bisimE simE)
    ultimately have "\<Psi> : (P \<oplus> \<tau>.(P)) \<rhd> \<tau>.(P) \<Longrightarrow>\<alpha> \<prec> P'''"
      by(rule_tac weakTransitionI)
    moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> P''' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" by auto
    moreover from \<open>\<Psi> \<rhd> P''' \<sim> P'\<close> have "\<Psi> \<otimes> \<Psi>' \<rhd> P''' \<sim> P'" by(rule bisimE)
    hence "(\<Psi> \<otimes> \<Psi>', P''', P') \<in> Rel" by(rule C1)
    ultimately show ?case by blast
  next
    case cSum2
    thus ?case using \<open>\<alpha> \<noteq> \<tau>\<close>
      by(nominal_induct \<alpha> rule: action.strong_inducts) auto
  qed
next
  case(cTau P')
  from \<open>\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close>
  show ?case
  proof(induct rule: sumCases)
    case cSum1
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    moreover 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))
      by(drule_tac simE, auto)
    ultimately have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" by(auto dest: tauActTauChain rtrancl_into_rtrancl)
    moreover from \<open>\<Psi> \<rhd> P''' \<sim> P'\<close> have "(\<Psi>, P''', P') \<in> Rel" by(rule C1)
    ultimately show ?case by blast
  next
    case cSum2
    from \<open>\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close> have "\<Psi> \<rhd> P \<sim> P'" by(rule tauActionE)
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    hence "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" by(rule_tac tauActTauChain)
    moreover from \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>\<Psi> \<rhd> P \<sim> P'\<close> have "(\<Psi>, P'', P') \<in> Rel"
      by(metis C1 bisimTransitive bisimE)
    ultimately show ?case by blast
  qed
qed

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

  assumes C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<tau>.(P) \<leadsto>\<guillemotleft>Rel\<guillemotright> P \<oplus> \<tau>.(P)"
proof(induct rule: weakCongSimI)
  case(cTau P')
  from \<open>\<Psi> \<rhd> P \<oplus> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close>
  show ?case
  proof(induct rule: sumCases)
    case cSum1
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    moreover 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))
      by(drule_tac simE) auto
    ultimately have "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P'''" by(auto dest: tauActTauStepChain trancl_into_trancl)
    moreover from \<open>\<Psi> \<rhd> P''' \<sim> P'\<close> have "(\<Psi>, P''', P') \<in> Rel" by(rule C1)
    ultimately show ?case by blast
  next
    case cSum2
    from \<open>\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'\<close> have "\<Psi> \<rhd> P \<sim> P'" by(rule tauActionE)
    obtain P'' where PTrans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
      by auto
    hence "\<Psi> \<rhd> \<tau>.(P) \<Longrightarrow>\<^sub>\<tau> P''" by(rule_tac tauActTauStepChain)
    moreover from \<open>\<Psi> \<rhd> P \<sim> P''\<close> \<open>\<Psi> \<rhd> P \<sim> P'\<close> have "(\<Psi>, P'', P') \<in> Rel"
      by(metis C1 bisimTransitive bisimE)
    ultimately show ?case by blast
  qed
qed

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

  assumes "\<And>\<Psi> P. (\<Psi>, P, P) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<leadsto><Rel> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)"
proof(induct rule: weakSimI2)
  case(cAct \<Psi>' \<beta> PQ)
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<longmapsto>\<beta> \<prec> PQ\<close> \<open>\<beta> \<noteq> \<tau>\<close>
  show ?case
  proof(induct rule: prefixCases)
    case(cInput M xvec N K Tvec)
    have "\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)" by auto
    moreover have "insertAssertion (extractFrame(\<alpha>\<cdot>(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(\<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q))) \<Psi>"
      using insertTauAssertion Identity
      by(nominal_induct \<alpha> rule: prefix.strong_inducts, auto)
        (rule FrameStatImpTrans[where G="\<langle>\<epsilon>, \<Psi>\<rangle>"], auto simp add: FrameStatEq_def AssertionStatEq_def)
    moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec=length Tvec\<close>
    have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]"
      by(rule Input)
    hence "\<Psi> \<rhd> (M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]"
      by(rule_tac Sum2) auto
    ultimately have "\<Psi> : (M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)) \<rhd> (M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]"
      by(rule_tac weakTransitionI) auto
    moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec] \<Longrightarrow>\<^sup>^\<^sub>\<tau> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]" by auto
    ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', (\<tau>.(P) \<oplus> Q)[xvec::=Tvec], (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]) \<in> Rel\<close> by fastforce
  next
    case(cOutput M N K)
    have "\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)" by auto
    moreover have "insertAssertion (extractFrame(\<alpha>\<cdot>(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(\<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q))) \<Psi>"
      using insertTauAssertion Identity
      by(nominal_induct \<alpha> rule: prefix.strong_inducts, auto)
        (rule FrameStatImpTrans[where G="\<langle>\<epsilon>, \<Psi>\<rangle>"], auto simp add: FrameStatEq_def AssertionStatEq_def)

    moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)"
      by(rule Output)
    hence "\<Psi> \<rhd> M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)" by(rule_tac Sum2) auto
    ultimately have "\<Psi> : (M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)"
      by(rule_tac weakTransitionI) auto
    moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P) \<oplus> Q \<Longrightarrow>\<^sup>^\<^sub>\<tau> \<tau>.(P) \<oplus> Q" by auto
    ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', \<tau>.(P) \<oplus> Q, \<tau>.(P) \<oplus> Q) \<in> Rel\<close> by fastforce
  next
    case cTau
    from \<open>\<tau> \<noteq> \<tau>\<close> show ?case
      by simp
  qed
next
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<oplus>\<^sub>\<top> Q \<longmapsto> \<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> \<tau>.(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" by(rule_tac Sum2) (auto intro: guardedTau)
    hence "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> \<tau>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
    moreover from \<open>\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> P'\<close> \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> Q'\<close> have "\<Psi> \<rhd> P' \<sim> Q'" by(metis bisimSymmetric bisimTransitive)
    hence "(\<Psi>, P', Q') \<in> Rel" by(rule C1)
    ultimately show ?case by fastforce
  qed
qed

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

  assumes "\<And>\<Psi> P. (\<Psi>, P, P) \<in> Rel"
  and     C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<leadsto>\<guillemotleft>Rel\<guillemotright> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<oplus>\<^sub>\<top> Q \<longmapsto> \<tau> \<prec> Q'\<close> show ?case
  proof(induct rule: prefixTauCases)
    case cTau
    obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> P'" using tauActionI
      by auto
    from PTrans have "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> \<tau>.(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" by(rule_tac Sum2) (auto intro: guardedTau)
    hence "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> \<tau>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauActTauStepChain)
    moreover from \<open>\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> P'\<close> \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> Q'\<close> have "\<Psi> \<rhd> P' \<sim> Q'" by(metis bisimSymmetric bisimTransitive)
    hence "(\<Psi>, P', Q') \<in> Rel" by(rule C1)
    ultimately show ?case by fastforce
  qed
qed

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

  assumes C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"
  and         "\<And>\<Psi> P. (\<Psi>, P, P) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<leadsto><Rel> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)"
proof(induct rule: weakSimI2)
  case(cAct \<Psi>' \<beta> PQ)
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<longmapsto>\<beta> \<prec> PQ\<close> show ?case
  proof(induct rule: sumCases)
    case cSum1
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto>\<beta> \<prec> PQ\<close> \<open>\<beta> \<noteq> \<tau>\<close> show ?case
    proof(induct rule: prefixCases)
      case(cInput M xvec N K Tvec)
      have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)" by auto
      moreover have "insertAssertion (extractFrame((M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q))) \<Psi>"
        by auto
      moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
      have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]" by(rule Input)
      ultimately have "\<Psi> : ((M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr>\<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]"
        by(rule_tac weakTransitionI) auto
      with \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close>
      have "\<Psi> : ((M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P[xvec::=Tvec]) \<oplus> Q[xvec::=Tvec])"
        by auto
      moreover obtain P' where PTrans: "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P[xvec::=Tvec]) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<otimes> \<Psi>' \<rhd> P[xvec::=Tvec] \<sim> P'" using tauActionI
        by auto
      have "guarded(\<tau>.(P[xvec::=Tvec]))" by(rule guardedTau)
      with PTrans have "\<Psi> \<otimes> \<Psi>' \<rhd> (\<tau>.(P[xvec::=Tvec])) \<oplus> (Q[xvec::=Tvec]) \<longmapsto>\<tau> \<prec> P'" by(rule Sum1)
      hence "\<Psi> \<otimes> \<Psi>' \<rhd> (\<tau>.(P[xvec::=Tvec])) \<oplus> (Q[xvec::=Tvec]) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
      moreover from \<open>\<Psi> \<otimes> \<Psi>' \<rhd> P[xvec::=Tvec] \<sim> P'\<close> have "(\<Psi> \<otimes> \<Psi>', P', P[xvec::=Tvec]) \<in> Rel" by(metis bisimE C1)
      ultimately show ?case by fastforce
    next
      case(cOutput M N K)
      have "\<Psi> \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q)" by auto
      moreover have "insertAssertion (extractFrame(M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q))) \<Psi>"
        by auto
      moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)" by(rule Output)
      ultimately have "\<Psi> : (M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)"
        by(rule_tac weakTransitionI) auto
      moreover obtain P' where PTrans: "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<otimes> \<Psi>' \<rhd> P \<sim> P'" using tauActionI
        by auto
      have "guarded(\<tau>.(P))" by(rule guardedTau)
      with PTrans have "\<Psi> \<otimes> \<Psi>' \<rhd> (\<tau>.(P)) \<oplus> Q \<longmapsto>\<tau> \<prec> P'" by(rule Sum1)
      hence "\<Psi> \<otimes> \<Psi>' \<rhd> (\<tau>.(P)) \<oplus> Q \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
      moreover from \<open>\<Psi> \<otimes> \<Psi>' \<rhd> P \<sim> P'\<close> have "(\<Psi> \<otimes> \<Psi>', P', P) \<in> Rel" by(metis bisimE C1)
      ultimately show ?case by fastforce
    next
      case cTau
      from \<open>\<tau> \<noteq> \<tau>\<close> show ?case by simp
    qed
  next
    case cSum2
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<longmapsto>\<beta> \<prec> PQ\<close> \<open>\<beta> \<noteq> \<tau>\<close> show ?case
    proof(induct rule: prefixCases)
      case(cInput M xvec N K Tvec)
      have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)" by auto
      moreover have "insertAssertion (extractFrame((M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q))) \<Psi>"
        by auto
      moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> \<open>distinct xvec\<close> \<open>set xvec \<subseteq> supp N\<close> \<open>length xvec = length Tvec\<close>
      have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P) \<oplus> Q)[xvec::=Tvec]"
        by(rule Input)
      with \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close>
      have "\<Psi> \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P[xvec::=Tvec]) \<oplus> Q[xvec::=Tvec])"
        by simp
      ultimately have "\<Psi> : ((M\<lparr>\<lambda>*xvec N\<rparr>.P) \<oplus> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<lparr>\<lambda>*xvec N\<rparr>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<lparr>(N[xvec::=Tvec])\<rparr> \<prec> (\<tau>.(P[xvec::=Tvec]) \<oplus> Q[xvec::=Tvec])"
        by(rule_tac weakTransitionI) auto
      moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P[xvec::=Tvec]) \<oplus> (Q[xvec::=Tvec]) \<Longrightarrow>\<^sup>^\<^sub>\<tau> \<tau>.(P[xvec::=Tvec]) \<oplus> (Q[xvec::=Tvec])" by auto
      ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', \<tau>.(P[xvec::=Tvec]) \<oplus> (Q[xvec::=Tvec]), \<tau>.(P[xvec::=Tvec]) \<oplus> (Q[xvec::=Tvec])) \<in> Rel\<close> \<open>length xvec = length Tvec\<close> \<open>distinct xvec\<close>
        by fastforce
    next
      case(cOutput M N K)
      have "\<Psi> \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q)" by auto
      moreover have "insertAssertion (extractFrame(M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q))) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame(M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q))) \<Psi>"
        by auto
      moreover from \<open>\<Psi> \<turnstile> M \<leftrightarrow> K\<close> have "\<Psi> \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<longmapsto>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)"
        by(rule Output)
      ultimately have "\<Psi> : (M\<langle>N\<rangle>.P \<oplus> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q)) \<rhd> M\<langle>N\<rangle>.(\<tau>.(P) \<oplus> Q) \<Longrightarrow>K\<langle>N\<rangle> \<prec> (\<tau>.(P) \<oplus> Q)"
        by(rule_tac weakTransitionI) auto
      moreover have "\<Psi> \<otimes> \<Psi>' \<rhd> \<tau>.(P) \<oplus> Q \<Longrightarrow>\<^sup>^\<^sub>\<tau> \<tau>.(P) \<oplus> Q" by auto
      ultimately show ?case using \<open>(\<Psi> \<otimes> \<Psi>', \<tau>.(P) \<oplus> Q, \<tau>.(P) \<oplus> Q) \<in> Rel\<close> by fastforce
    next
      case cTau
      from \<open>\<tau> \<noteq> \<tau>\<close> show ?case by simp
    qed
  qed
next
  case(cTau PQ)
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> PQ\<close> show ?case
  proof(induct rule: sumCases)
    case cSum1
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto> \<tau> \<prec> PQ\<close> show ?case
    proof(induct rule: prefixTauCases)
      case cTau
      obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'" using tauActionI
        by auto
      obtain P'' where P'Trans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
        by auto
      from P'Trans have "\<Psi> \<rhd> \<tau>.(P) \<oplus> Q\<longmapsto>\<tau> \<prec> P''" by(rule_tac Sum1) (auto intro: guardedTau)
      with \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> 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)
        by(auto dest: bisimE)
      from PTrans P''Trans have "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''" by(fastforce dest: tauActTauChain)
      moreover from \<open>\<Psi> \<rhd> P \<sim> PQ\<close> \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> \<open>\<Psi> \<rhd> P \<sim> P''\<close> have "\<Psi> \<rhd> P''' \<sim> PQ"
        by(metis bisimSymmetric bisimTransitive)
      hence "(\<Psi>, P''', PQ) \<in> Rel" by(rule C1)
      ultimately show ?case by fastforce
    qed
  next
    case cSum2
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> PQ\<close> show ?case
    proof(induct rule: prefixTauCases)
      case cTau
      obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'" using tauActionI
        by auto
      from PTrans have "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'" by(rule tauActTauChain)
      moreover from \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'\<close> \<open>\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> PQ\<close> have "\<Psi> \<rhd> P' \<sim> PQ"
        by(metis bisimSymmetric bisimTransitive)
      hence "(\<Psi>, P', PQ) \<in> Rel" by(rule C1)
      ultimately show ?case by fastforce
    qed
  qed
qed

  assumes C1: "\<And>\<Psi> P Q. \<Psi> \<rhd> P \<sim> Q \<Longrightarrow> (\<Psi>, P, Q) \<in> Rel"

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<leadsto>\<guillemotleft>Rel\<guillemotright> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q)"
proof(induct rule: weakCongSimI)
  case(cTau PQ)
  from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<oplus> \<alpha>\<cdot>(\<tau>.(P) \<oplus> Q) \<longmapsto>\<tau> \<prec> PQ\<close> show ?case
  proof(induct rule: sumCases)
    case cSum1
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>P \<longmapsto> \<tau> \<prec> PQ\<close> show ?case
    proof(induct rule: prefixTauCases)
      case cTau
      obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'" using tauActionI
        by auto
      obtain P'' where P'Trans: "\<Psi> \<rhd> \<tau>.(P) \<longmapsto>\<tau> \<prec> P''" and "\<Psi> \<rhd> P \<sim> P''" using tauActionI
        by auto
      from P'Trans have "\<Psi> \<rhd> \<tau>.(P) \<oplus> Q\<longmapsto>\<tau> \<prec> P''" by(rule_tac Sum1) (auto intro: guardedTau)
      with \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> 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)
        by(auto dest: bisimE)
      from PTrans P''Trans have "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<Longrightarrow>\<^sub>\<tau> P'''" by(fastforce dest: tauActTauStepChain)
      moreover from \<open>\<Psi> \<rhd> P \<sim> PQ\<close> \<open>\<Psi> \<rhd> P'' \<sim> P'''\<close> \<open>\<Psi> \<rhd> P \<sim> P''\<close> have "\<Psi> \<rhd> P''' \<sim> PQ"
        by(metis bisimSymmetric bisimTransitive)
      hence "(\<Psi>, P''', PQ) \<in> Rel" by(rule C1)
      ultimately show ?case by fastforce
    qed
  next
    case cSum2
    from \<open>\<Psi> \<rhd> \<alpha>\<cdot>((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> PQ\<close> show ?case
    proof(induct rule: prefixTauCases)
      case cTau
      obtain P' where PTrans: "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<longmapsto>\<tau> \<prec> P'" and "\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'" using tauActionI
        by auto
      from PTrans have "\<Psi> \<rhd> \<tau>.((\<tau>.(P)) \<oplus> Q) \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauActTauStepChain)
      moreover from \<open>\<Psi> \<rhd> (\<tau>.(P)) \<oplus> Q \<sim> P'\<close> \<open>\<Psi> \<rhd> \<tau>.(P) \<oplus> Q \<sim> PQ\<close> have "\<Psi> \<rhd> P' \<sim> PQ"
        by(metis bisimSymmetric bisimTransitive)
      hence "(\<Psi>, P', PQ) \<in> Rel" by(rule C1)
      ultimately show ?case by fastforce
    qed
  qed
qed

end

end


(* @TAG(OTHER_LGPL) *)

(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      HoareTotalDef.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2004-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section {* Hoare Logic for Total Correctness *}

theory HoareTotalDef imports HoarePartialDef Termination begin

subsection {* Validity of Hoare Tuples: @{text  "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"} *}

definition
  validt :: "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com,'s assn,'s assn] \<Rightarrow> bool"
                ("_\<Turnstile>\<^sub>t\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60)
where
 "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<equiv> \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<and> (\<forall>s \<in> Normal ` P. \<Gamma>\<turnstile>c\<down>s)"

definition
  cvalidt::
  "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
    's assn,('s,'p,'f) com,'s assn,'s assn] \<Rightarrow> bool"
                ("_,_\<Turnstile>\<^sub>t\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60, 60,1000, 20, 1000,1000] 60)
where
 "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<equiv> (\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A) \<longrightarrow> \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"

notation (ascii)
  validt  ("_|=t'/_/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60) and
  cvalidt  ("_,_|=t'/_ / _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60)

subsection {* Properties of Validity *}

lemma validtI:
 "\<lbrakk>\<And>s t. \<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;t \<notin> Fault ` F\<rbrakk> \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A;
   \<And>s. s \<in> P \<Longrightarrow> \<Gamma>\<turnstile> c\<down>(Normal s) \<rbrakk>
  \<Longrightarrow> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  by (auto simp add: validt_def valid_def)

lemma cvalidtI:
 "\<lbrakk>\<And>s t. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;
          t \<notin> Fault ` F\<rbrakk>
          \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A;
   \<And>s. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A; s\<in>P\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>c\<down>(Normal s)\<rbrakk>
  \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  by (auto simp add: cvalidt_def validt_def valid_def)

lemma cvalidt_postD:
 "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t;
   s \<in> P;t \<notin> Fault ` F\<rbrakk>
  \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A"
  by (simp add: cvalidt_def validt_def valid_def)

lemma cvalidt_termD:
 "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;s \<in> P\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>c\<down>(Normal s)"
  by (simp add: cvalidt_def validt_def valid_def)

lemma validt_augment_Faults:
  assumes valid:"\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  assumes F': "F \<subseteq> F'"
  shows "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F'\<^esub> P c Q,A"
  using valid F'
  by (auto intro: valid_augment_Faults simp add: validt_def)

subsection {* The Hoare Rules: @{text "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" } *}

inductive "hoaret"::"[('s,'p,'f) body,('s,'p) quadruple set,'f set,
                        's assn,('s,'p,'f) com,'s assn,'s assn]
                       => bool"
    ("(3_,_/\<turnstile>\<^sub>t\<^bsub>'/_\<^esub> (_/ (_)/ _,_))" [61,60,60,1000,20,1000,1000]60)
   for \<Gamma>::"('s,'p,'f) body"
where
  Skip: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> Q Skip Q,A"

| Basic: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. f s \<in> Q} (Basic f) Q,A"

| Spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. (\<forall>t. (s,t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s,t) \<in> r)} (Spec r) Q,A"

| Seq: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk>
        \<Longrightarrow>
        \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Seq c\<^sub>1 c\<^sub>2 Q,A"

| Cond: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> b) c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> - b) c\<^sub>2 Q,A\<rbrakk>
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"

| While: "\<lbrakk>wf r; \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P \<inter> b) c ({t. (t,\<sigma>)\<in>r} \<inter> P),A\<rbrakk>
          \<Longrightarrow>
          \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (While b c) (P \<inter> - b),A"

| Guard: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A
          \<Longrightarrow>
          \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) Guard f g c Q,A"

| Guarantee: "\<lbrakk>f \<in> F; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A\<rbrakk>
              \<Longrightarrow>
              \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"

| CallRec:
  "\<lbrakk>(P,p,Q,A) \<in> Specs;
    wf r;
    Specs_wf = (\<lambda>p \<sigma>. (\<lambda>(P,q,Q,A). (P \<inter> {s. ((s,q),(\<sigma>,p)) \<in> r},q,Q,A)) ` Specs);
    \<forall>(P,p,Q,A)\<in> Specs.
      p \<in> dom \<Gamma> \<and> (\<forall>\<sigma>. \<Gamma>,\<Theta> \<union> Specs_wf p \<sigma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P) (the (\<Gamma> p)) Q,A)
    \<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"

| DynCom:  "\<forall>s \<in> P. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (c s) Q,A
            \<Longrightarrow>
            \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (DynCom c) Q,A"

| Throw: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> A Throw Q,A"

| Catch: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"

| Conseq: "\<forall>s \<in> P. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A' \<and> s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A
           \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"

| Asm: "(P,p,Q,A) \<in> \<Theta>
        \<Longrightarrow>
        \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"

| ExFalso: "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<not> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  -- {* This is a hack rule that enables us to derive completeness for
        an arbitrary context @{text "\<Theta>"}, from completeness for an empty context.*}

text {* Does not work, because of rule ExFalso, the context @{text \<Theta>} is to blame.
 A weaker version with empty context can be derived from soundness
 later on. *}
lemma hoaret_to_hoarep:
  assumes hoaret: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
using hoaret
proof (induct)
  case Skip thus ?case by (rule hoarep.intros)
next
  case Basic thus ?case by (rule hoarep.intros)
next
  case Seq thus ?case by - (rule hoarep.intros)
next
  case Cond thus ?case by - (rule hoarep.intros)
next
  case (While r \<Theta> F P b c A)
  hence "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P \<inter> b) c ({t. (t, \<sigma>) \<in> r} \<inter> P),A"
    by iprover
  hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c P,A"
    by (rule HoarePartialDef.conseq) blast
  then show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P While b c (P \<inter> - b),A"
    by (rule hoarep.While)
next
  case Guard thus ?case by - (rule hoarep.intros)
(*next
  case (CallRec A F P Procs Q Z \<Theta>  p r)
  hence hyp: "\<forall>p\<in>Procs. \<forall>\<tau> Z.
           \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                      Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
              ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
    by blast
  have "\<forall>p\<in>Procs. \<forall>Z.
           \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z,
                      Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
              (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
  proof (intro ballI allI)
    fix p Z
    assume "p \<in> Procs"
    with hyp
    have hyp': "\<And> \<tau>.
           \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                      Call q, Q q Z, A q Z)})\<turnstile>\<^bsub>/F\<^esub>
              ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
      by blast
    have "\<forall>\<tau>.
           \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z,
                      Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
              ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
      (is "\<forall>\<tau>. \<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)")
    proof (rule allI, rule WeakenContext [OF hyp'],clarify)
      fix \<tau> P' c Q' A'
      assume "(P', c, Q', A') \<in> \<Theta> \<union>
         (\<Union>q\<in>Procs.
             \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                  Call q, Q q Z,
                  A q Z)})" (is "(P', c, Q', A') \<in> \<Theta> \<union> ?Spec")
      then show "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> P' c Q',A'"
      proof (cases rule: UnE [consumes 1])
        assume "(P',c,Q',A') \<in> \<Theta>"
        then show ?thesis
          by (blast intro: HoarePartialDef.Asm)
      next
        assume "(P',c,Q',A') \<in> ?Spec"
        then show ?thesis
        proof (clarify)
          fix q Z
          assume q: "q \<in> Procs"
          show "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r})
                         Call  q
                        (Q q Z),(A q Z)"
          proof -
            from q
            have "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P q Z) Call q (Q q Z),(A q Z)"
              by - (rule HoarePartialDef.Asm,blast)
            thus ?thesis
              by (rule HoarePartialDef.conseqPre) blast
          qed
        qed
      qed
    qed
    then show "\<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z, Call q, Q q Z,A q Z)})
                \<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
      by (rule HoarePartialDef.conseq) blast
  qed
  thus ?case
    by - (rule hoarep.CallRec)*)
next
  case DynCom thus ?case by (blast intro: hoarep.DynCom)
next
  case Throw thus ?case by - (rule hoarep.Throw)
next
  case Catch thus ?case by - (rule hoarep.Catch)
next
  case Conseq thus ?case by - (rule hoarep.Conseq,blast)
next
  case Asm thus ?case by (rule HoarePartialDef.Asm)
next
  case (ExFalso \<Theta> F P c Q A)
  assume "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  hence "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
    oops

lemma hoaret_augment_context:
  assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
  shows "\<And>\<Theta>'. \<Theta> \<subseteq> \<Theta>' \<Longrightarrow> \<Gamma>,\<Theta>'\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
using deriv
proof (induct)
  case (CallRec P p Q A Specs r Specs_wf \<Theta> F \<Theta>')
  have aug: "\<Theta> \<subseteq> \<Theta>'" by fact
  then
  have h: "\<And>\<tau> p. \<Theta> \<union> Specs_wf p \<tau>
       \<subseteq> \<Theta>' \<union> Specs_wf p \<tau>"
    by blast
  have "\<forall>(P,p,Q,A)\<in>Specs. p \<in> dom \<Gamma> \<and>
     (\<forall>\<tau>. \<Gamma>,\<Theta> \<union> Specs_wf p \<tau>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A \<and>
           (\<forall>x. \<Theta> \<union> Specs_wf p \<tau>
                 \<subseteq> x \<longrightarrow>
                 \<Gamma>,x\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A))" by fact
  hence "\<forall>(P,p,Q,A)\<in>Specs. p \<in> dom \<Gamma> \<and>
         (\<forall>\<tau>. \<Gamma>,\<Theta>'\<union> Specs_wf p \<tau> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A)"
    apply (clarify)
    apply (rename_tac P p Q A)
    apply (drule (1) bspec)
    apply (clarsimp)
    apply (erule_tac x=\<tau> in allE)
    apply clarify
    apply (erule_tac x="\<Theta>' \<union> Specs_wf p \<tau>" in allE)
    apply (insert aug)
    apply auto
    done
  with CallRec show ?case by - (rule hoaret.CallRec)
next
  case DynCom thus ?case by (blast intro: hoaret.DynCom)
next
  case (Conseq P \<Theta> F c Q A \<Theta>')
  from Conseq
  have "\<forall>s \<in> P. (\<exists>P' Q' A'. (\<Gamma>,\<Theta>' \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A') \<and> s \<in> P'\<and> Q' \<subseteq> Q \<and> A' \<subseteq> A)"
    by blast
  with Conseq show ?case by - (rule hoaret.Conseq)
next
  case (ExFalso \<Theta> F P  c Q A \<Theta>')
  have "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" "\<not> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" "\<Theta> \<subseteq> \<Theta>'"  by fact+
  then show ?case
    by (fastforce intro: hoaret.ExFalso simp add: cvalidt_def)
qed (blast intro: hoaret.intros)+

subsection {* Some Derived Rules *}

lemma  Conseq': "\<forall>s. s \<in> P \<longrightarrow>
            (\<exists>P' Q' A'.
              (\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)) \<and>
                    (\<exists>Z. s \<in> P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A)))
           \<Longrightarrow>
           \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
apply (rule Conseq)
apply (rule ballI)
apply (erule_tac x=s in allE)
apply (clarify)
apply (rule_tac x="P' Z" in exI)
apply (rule_tac x="Q' Z" in exI)
apply (rule_tac x="A' Z" in exI)
apply blast
done

lemma conseq:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
              \<forall>s. s \<in> P \<longrightarrow> (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q)\<and> (A' Z \<subseteq> A))\<rbrakk>
              \<Longrightarrow>
              \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  by (rule Conseq) blast

theorem conseqPrePost:
  "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A' \<Longrightarrow> P \<subseteq> P' \<Longrightarrow>  Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  by (rule conseq [where ?P'="\<lambda>Z. P'" and ?Q'="\<lambda>Z. Q'"]) auto

lemma conseqPre: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q,A \<Longrightarrow> P \<subseteq> P' \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
by (rule conseq) auto

lemma conseqPost: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q',A'\<Longrightarrow> Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A \<Longrightarrow>   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  by (rule conseq) auto

lemma Spec_wf_conv:
  "(\<lambda>(P, q, Q, A). (P \<inter> {s. ((s, q), \<tau>, p) \<in> r}, q, Q, A)) `
                (\<Union>p\<in>Procs. \<Union>Z. {(P p Z, p, Q p Z, A p Z)}) =
        (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r}, q, Q q Z, A q Z)})"
apply (rule)
apply  fastforce
apply (fastforce simp add: image_def)
done

lemma CallRec':
  "\<lbrakk>p\<in>Procs; Procs \<subseteq> dom \<Gamma>;
    wf r;
   \<forall>p\<in>Procs. \<forall>\<tau> Z.
   \<Gamma>,\<Theta>\<union>(\<Union>q\<in>Procs. \<Union>Z.
    {((P q Z) \<inter> {s. ((s,q),(\<tau>,p)) \<in> r},q,Q q Z,(A q Z))})
     \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> (P p Z)) (the (\<Gamma> p)) (Q p Z),(A p Z)\<rbrakk>
   \<Longrightarrow>
   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P p Z) (Call p) (Q p Z),(A p Z)"
apply (rule CallRec [where Specs="\<Union>p\<in>Procs. \<Union>Z. {((P p Z),p,Q p Z,A p Z)}" and
         r=r])
apply    blast
apply   assumption
apply  (rule refl)
apply (clarsimp)
apply (rename_tac p')
apply (rule conjI)
apply  blast
apply (intro allI)
apply (rename_tac Z \<tau>)
apply (drule_tac x=p' in bspec, assumption)
apply (erule_tac x=\<tau> in allE)
apply (erule_tac x=Z in allE)
apply (fastforce simp add: Spec_wf_conv)
done

end


(*<*)
(*
 * Knowledge-based programs.
 * (C)opyright 2011, Peter Gammie, peteg42 at gmail.com.
 * License: BSD
 *)

theory Extra
imports
  Main
  Equiv_Relations
  "~~/src/HOL/Library/Option_ord"
  "~~/src/HOL/Library/Product_Lexorder"
begin

(* Extra lemmas that are not noteworthy. *)

lemma relation_mono:
  "\<lbrakk> A \<subseteq> C; B \<subseteq> D \<rbrakk> \<Longrightarrow> A \<times> B \<subseteq> C \<times> D"
  by bestsimp

lemma quotientI2:
  "\<lbrakk> x \<in> A; X = r `` {x} \<rbrakk> \<Longrightarrow> X \<in> A // r"
  by (simp add: quotientI)

(*

Concretely enumerate all the agent action functions. Can't be too
abstract here as we want extensionality.

Introduced in the clock view.

*)

definition
  listToFun :: "('a \<times> 'b list) list \<Rightarrow> ('a \<Rightarrow> 'b) list"
where
  "listToFun xs \<equiv> foldr (\<lambda>(a, acts) M. [ m(a := act) . m \<leftarrow> M, act \<leftarrow> acts ])
                     xs
                     [(\<lambda>_. undefined)]"

lemma listToFun_futz:
  "\<lbrakk> M \<in> set (listToFun xs); x \<in> fst ` set xs \<rbrakk>
     \<Longrightarrow> M x \<in> { y |y ys. (x, ys) \<in> set xs \<and> y \<in> set ys}"
  unfolding listToFun_def
  apply (induct xs arbitrary: M)
   apply (simp_all add: split_def)
  apply (case_tac a)
  apply clarsimp
  apply auto
  done

lemma distinct_map_fst:
  "\<lbrakk> x \<notin> fst ` set xs; distinct (map fst xs) \<rbrakk> \<Longrightarrow> (x, y) \<notin> set xs"
  by (induct xs) auto

lemma listToFun_futz_rev:
  "\<lbrakk> \<And>x. M x \<in> (if x \<in> fst ` set xs then { y |y ys. (x, ys) \<in> set xs \<and> y \<in> set ys} else {undefined}); distinct (map fst xs) \<rbrakk>
      \<Longrightarrow> M \<in> set (listToFun xs)"
proof(induct xs arbitrary: M)
  case Nil thus ?case
    unfolding listToFun_def by simp
next
  case (Cons x xs)
  let ?M' = "M(fst x := undefined)"
  have M': "?M' \<in> set (listToFun xs)"
    apply (rule Cons.hyps)
     prefer 2
     using Cons(3)
     apply simp
    apply (case_tac "xa = fst x")
     using Cons(3)
     apply simp
    apply (case_tac "xa \<in> fst ` set xs")
     apply (cut_tac x=xa in Cons(2))
     apply (cases x)
     apply auto[1]
    apply (cut_tac x=xa in Cons(2))
    apply simp
    done
  then show ?case
    unfolding listToFun_def
    apply (cases x)
    apply simp
    apply (rule bexI[where x="?M'"])
     apply simp_all
    apply (rule_tac x="M a" in image_eqI)
     apply simp
    apply (cut_tac x=a in Cons(2))
    using Cons(3)
    apply clarsimp
    apply (erule disjE)
     apply simp
    apply (auto dest: distinct_map_fst)
    done
qed

definition
  listToFuns :: "('a \<Rightarrow> 'b list) \<Rightarrow> 'a list \<Rightarrow> ('a \<Rightarrow> 'b) list"
where
  "listToFuns f \<equiv> listToFun \<circ> map (\<lambda>x. (x, f x))"

lemma map_id_clunky:
  "set xs = UNIV \<Longrightarrow> x \<in> fst ` set (map (\<lambda>x. (x, f x)) xs)"
  apply (simp only: set_map[symmetric] map_map)
  apply simp
  done

(*

The main result is that we can freely move between representations.

*)

lemma listToFuns_ext:
  assumes xs: "set xs = UNIV"
  assumes d: "distinct xs"
  shows "g \<in> set (listToFuns f xs) \<longleftrightarrow> (\<forall>x. g x \<in> set (f x))"
  unfolding listToFuns_def
  apply simp
  apply rule
   apply clarsimp
   apply (cut_tac x=x in listToFun_futz[where M=g, OF _ map_id_clunky[OF xs]])
    apply simp
   apply clarsimp
  apply (rule listToFun_futz_rev)
   using map_id_clunky[OF xs]
   apply auto[1]
   apply (rule_tac x="f xa" in exI)
    apply simp
   apply simp
  using d
  apply (simp add: distinct_map)
  apply (auto intro: inj_onI)
  done

lemma listToFun_splice:
  assumes xs: "set xs = UNIV"
  assumes d: "distinct xs"
  assumes g: "g \<in> set (listToFuns f xs)"
  assumes h: "h \<in> set (listToFuns f xs)"
  shows "g(x := h x) \<in> set (listToFuns f xs)"
  using g h by (auto iff: listToFuns_ext[OF xs d])
(*<*)

end
(*>*)


(*  Title:      HOL/HOLCF/IOA/CompoExecs.thy
    Author:     Olaf Müller
*)

section \<open>Compositionality on Execution level\<close>

theory CompoExecs
imports Traces
begin

definition ProjA2 :: "('a, 's \<times> 't) pairs \<rightarrow> ('a, 's) pairs"
  where "ProjA2 = Map (\<lambda>x. (fst x, fst (snd x)))"

definition ProjA :: "('a, 's \<times> 't) execution \<Rightarrow> ('a, 's) execution"
  where "ProjA ex = (fst (fst ex), ProjA2 \<cdot> (snd ex))"

definition ProjB2 :: "('a, 's \<times> 't) pairs \<rightarrow> ('a, 't) pairs"
  where "ProjB2 = Map (\<lambda>x. (fst x, snd (snd x)))"

definition ProjB :: "('a, 's \<times> 't) execution \<Rightarrow> ('a, 't) execution"
  where "ProjB ex = (snd (fst ex), ProjB2 \<cdot> (snd ex))"

definition Filter_ex2 :: "'a signature \<Rightarrow> ('a, 's) pairs \<rightarrow> ('a, 's) pairs"
  where "Filter_ex2 sig = Filter (\<lambda>x. fst x \<in> actions sig)"

definition Filter_ex :: "'a signature \<Rightarrow> ('a, 's) execution \<Rightarrow> ('a, 's) execution"
  where "Filter_ex sig ex = (fst ex, Filter_ex2 sig \<cdot> (snd ex))"

definition stutter2 :: "'a signature \<Rightarrow> ('a, 's) pairs \<rightarrow> ('s \<Rightarrow> tr)"
  where "stutter2 sig =
    (fix \<cdot>
      (LAM h ex.
        (\<lambda>s.
          case ex of
            nil \<Rightarrow> TT
          | x ## xs \<Rightarrow>
              (flift1
                (\<lambda>p.
                  (If Def (fst p \<notin> actions sig) then Def (s = snd p) else TT)
                  andalso (h\<cdot>xs) (snd p)) \<cdot> x))))"

definition stutter :: "'a signature \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "stutter sig ex \<longleftrightarrow> (stutter2 sig \<cdot> (snd ex)) (fst ex) \<noteq> FF"

definition par_execs ::
  "('a, 's) execution_module \<Rightarrow> ('a, 't) execution_module \<Rightarrow> ('a, 's \<times> 't) execution_module"
  where "par_execs ExecsA ExecsB =
    (let
      exA = fst ExecsA; sigA = snd ExecsA;
      exB = fst ExecsB; sigB = snd ExecsB
     in
       ({ex. Filter_ex sigA (ProjA ex) \<in> exA} \<inter>
        {ex. Filter_ex sigB (ProjB ex) \<in> exB} \<inter>
        {ex. stutter sigA (ProjA ex)} \<inter>
        {ex. stutter sigB (ProjB ex)} \<inter>
        {ex. Forall (\<lambda>x. fst x \<in> actions sigA \<union> actions sigB) (snd ex)},
        asig_comp sigA sigB))"

lemmas [simp del] = split_paired_All

section \<open>Recursive equations of operators\<close>

subsection \<open>\<open>ProjA2\<close>\<close>

lemma ProjA2_UU: "ProjA2 \<cdot> UU = UU"
  by (simp add: ProjA2_def)

lemma ProjA2_nil: "ProjA2 \<cdot> nil = nil"
  by (simp add: ProjA2_def)

lemma ProjA2_cons: "ProjA2 \<cdot> ((a, t) \<leadsto> xs) = (a, fst t) \<leadsto> ProjA2 \<cdot> xs"
  by (simp add: ProjA2_def)

subsection \<open>\<open>ProjB2\<close>\<close>

lemma ProjB2_UU: "ProjB2 \<cdot> UU = UU"
  by (simp add: ProjB2_def)

lemma ProjB2_nil: "ProjB2 \<cdot> nil = nil"
  by (simp add: ProjB2_def)

lemma ProjB2_cons: "ProjB2 \<cdot> ((a, t) \<leadsto> xs) = (a, snd t) \<leadsto> ProjB2 \<cdot> xs"
  by (simp add: ProjB2_def)

subsection \<open>\<open>Filter_ex2\<close>\<close>

lemma Filter_ex2_UU: "Filter_ex2 sig \<cdot> UU = UU"
  by (simp add: Filter_ex2_def)

lemma Filter_ex2_nil: "Filter_ex2 sig \<cdot> nil = nil"
  by (simp add: Filter_ex2_def)

lemma Filter_ex2_cons:
  "Filter_ex2 sig \<cdot> (at \<leadsto> xs) =
    (if fst at \<in> actions sig
     then at \<leadsto> (Filter_ex2 sig \<cdot> xs)
     else Filter_ex2 sig \<cdot> xs)"
  by (simp add: Filter_ex2_def)

subsection \<open>\<open>stutter2\<close>\<close>

lemma stutter2_unfold:
  "stutter2 sig =
    (LAM ex.
      (\<lambda>s.
        case ex of
          nil \<Rightarrow> TT
        | x ## xs \<Rightarrow>
            (flift1
              (\<lambda>p.
                (If Def (fst p \<notin> actions sig) then Def (s= snd p) else TT)
                andalso (stutter2 sig\<cdot>xs) (snd p)) \<cdot> x)))"
  apply (rule trans)
  apply (rule fix_eq2)
  apply (simp only: stutter2_def)
  apply (rule beta_cfun)
  apply (simp add: flift1_def)
  done

lemma stutter2_UU: "(stutter2 sig \<cdot> UU) s = UU"
  apply (subst stutter2_unfold)
  apply simp
  done

lemma stutter2_nil: "(stutter2 sig \<cdot> nil) s = TT"
  apply (subst stutter2_unfold)
  apply simp
  done

lemma stutter2_cons:
  "(stutter2 sig \<cdot> (at \<leadsto> xs)) s =
    ((if fst at \<notin> actions sig then Def (s = snd at) else TT)
      andalso (stutter2 sig \<cdot> xs) (snd at))"
  apply (rule trans)
  apply (subst stutter2_unfold)
  apply (simp add: Consq_def flift1_def If_and_if)
  apply simp
  done

declare stutter2_UU [simp] stutter2_nil [simp] stutter2_cons [simp]

subsection \<open>\<open>stutter\<close>\<close>

lemma stutter_UU: "stutter sig (s, UU)"
  by (simp add: stutter_def)

lemma stutter_nil: "stutter sig (s, nil)"
  by (simp add: stutter_def)

lemma stutter_cons:
  "stutter sig (s, (a, t) \<leadsto> ex) \<longleftrightarrow> (a \<notin> actions sig \<longrightarrow> (s = t)) \<and> stutter sig (t, ex)"
  by (simp add: stutter_def)

declare stutter2_UU [simp del] stutter2_nil [simp del] stutter2_cons [simp del]

lemmas compoex_simps = ProjA2_UU ProjA2_nil ProjA2_cons
  ProjB2_UU ProjB2_nil ProjB2_cons
  Filter_ex2_UU Filter_ex2_nil Filter_ex2_cons
  stutter_UU stutter_nil stutter_cons

declare compoex_simps [simp]

section \<open>Compositionality on execution level\<close>

lemma lemma_1_1a:
  \<comment> \<open>\<open>is_ex_fr\<close> propagates from \<open>A \<parallel> B\<close> to projections \<open>A\<close> and \<open>B\<close>\<close>
  "\<forall>s. is_exec_frag (A \<parallel> B) (s, xs) \<longrightarrow>
    is_exec_frag A (fst s, Filter_ex2 (asig_of A) \<cdot> (ProjA2 \<cdot> xs)) \<and>
    is_exec_frag B (snd s, Filter_ex2 (asig_of B) \<cdot> (ProjB2 \<cdot> xs))"
  apply (pair_induct xs simp: is_exec_frag_def)
  text \<open>main case\<close>
  apply (auto simp add: trans_of_defs2)
  done

lemma lemma_1_1b:
  \<comment> \<open>\<open>is_ex_fr (A \<parallel> B)\<close> implies stuttering on projections\<close>
  "\<forall>s. is_exec_frag (A \<parallel> B) (s, xs) \<longrightarrow>
    stutter (asig_of A) (fst s, ProjA2 \<cdot> xs) \<and>
    stutter (asig_of B) (snd s, ProjB2 \<cdot> xs)"
  apply (pair_induct xs simp: stutter_def is_exec_frag_def)
  text \<open>main case\<close>
  apply (auto simp add: trans_of_defs2)
  done

lemma lemma_1_1c:
  \<comment> \<open>Executions of \<open>A \<parallel> B\<close> have only \<open>A\<close>- or \<open>B\<close>-actions\<close>
  "\<forall>s. is_exec_frag (A \<parallel> B) (s, xs) \<longrightarrow> Forall (\<lambda>x. fst x \<in> act (A \<parallel> B)) xs"
  apply (pair_induct xs simp: Forall_def sforall_def is_exec_frag_def)
  text \<open>main case\<close>
  apply auto
  apply (simp add: trans_of_defs2 actions_asig_comp asig_of_par)
  done

lemma lemma_1_2:
  \<comment> \<open>\<open>ex A\<close>, \<open>exB\<close>, stuttering and forall \<open>a \<in> A \<parallel> B\<close> implies \<open>ex (A \<parallel> B)\<close>\<close>
  "\<forall>s.
    is_exec_frag A (fst s, Filter_ex2 (asig_of A) \<cdot> (ProjA2 \<cdot> xs)) \<and>
    is_exec_frag B (snd s, Filter_ex2 (asig_of B) \<cdot> (ProjB2 \<cdot> xs)) \<and>
    stutter (asig_of A) (fst s, ProjA2 \<cdot> xs) \<and>
    stutter (asig_of B) (snd s, ProjB2 \<cdot> xs) \<and>
    Forall (\<lambda>x. fst x \<in> act (A \<parallel> B)) xs \<longrightarrow>
    is_exec_frag (A \<parallel> B) (s, xs)"
  apply (pair_induct xs simp: Forall_def sforall_def is_exec_frag_def stutter_def)
  apply (auto simp add: trans_of_defs1 actions_asig_comp asig_of_par)
  done

theorem compositionality_ex:
  "ex \<in> executions (A \<parallel> B) \<longleftrightarrow>
    Filter_ex (asig_of A) (ProjA ex) \<in> executions A \<and>
    Filter_ex (asig_of B) (ProjB ex) \<in> executions B \<and>
    stutter (asig_of A) (ProjA ex) \<and>
    stutter (asig_of B) (ProjB ex) \<and>
    Forall (\<lambda>x. fst x \<in> act (A \<parallel> B)) (snd ex)"
  apply (simp add: executions_def ProjB_def Filter_ex_def ProjA_def starts_of_par)
  apply (pair ex)
  apply (rule iffI)
  text \<open>\<open>\<Longrightarrow>\<close>\<close>
  apply (erule conjE)+
  apply (simp add: lemma_1_1a lemma_1_1b lemma_1_1c)
  text \<open>\<open>\<Longleftarrow>\<close>\<close>
  apply (erule conjE)+
  apply (simp add: lemma_1_2)
  done

theorem compositionality_ex_modules: "Execs (A \<parallel> B) = par_execs (Execs A) (Execs B)"
  apply (unfold Execs_def par_execs_def)
  apply (simp add: asig_of_par)
  apply (rule set_eqI)
  apply (simp add: compositionality_ex actions_of_par)
  done

end


(*  Title:      HOL/TLA/Memory/Memory.thy
    Author:     Stephan Merz, University of Munich
*)

section \<open>RPC-Memory example: Memory specification\<close>

theory Memory
imports MemoryParameters ProcedureInterface
begin

type_synonym memChType = "(memOp, Vals) channel"
type_synonym memType = "(Locs \<Rightarrow> Vals) stfun"  (* intention: MemLocs \<Rightarrow> MemVals *)
type_synonym resType = "(PrIds \<Rightarrow> Vals) stfun"

(* state predicates *)

definition MInit :: "memType \<Rightarrow> Locs \<Rightarrow> stpred"
  where "MInit mm l == PRED mm!l = #InitVal"

definition PInit :: "resType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "PInit rs p == PRED rs!p = #NotAResult"

(* auxiliary predicates: is there a pending read/write request for
   some process id and location/value? *)

definition RdRequest :: "memChType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> stpred"
  where "RdRequest ch p l == PRED Calling ch p \<and> (arg<ch!p> = #(read l))"

definition WrRequest :: "memChType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> Vals \<Rightarrow> stpred"
  where "WrRequest ch p l v == PRED Calling ch p \<and> (arg<ch!p> = #(write l v))"

(* actions *)

(* a read that doesn't raise BadArg *)
definition GoodRead :: "memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> action"
  where "GoodRead mm rs p l == ACT #l \<in> #MemLoc \<and> ((rs!p)$ = $(mm!l))"

(* a read that raises BadArg *)
definition BadRead :: "memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> action"
  where "BadRead mm rs p l == ACT #l \<notin> #MemLoc \<and> ((rs!p)$ = #BadArg)"

(* the read action with l visible *)
definition ReadInner :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> action"
  where "ReadInner ch mm rs p l == ACT
    $(RdRequest ch p l)
    \<and> (GoodRead mm rs p l  \<or>  BadRead mm rs p l)
    \<and> unchanged (rtrner ch ! p)"

(* the read action with l quantified *)
definition Read :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> action"
  where "Read ch mm rs p == ACT (\<exists>l. ReadInner ch mm rs p l)"

(* similar definitions for the write action *)
definition GoodWrite :: "memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> Vals \<Rightarrow> action"
  where "GoodWrite mm rs p l v ==
    ACT #l \<in> #MemLoc \<and> #v \<in> #MemVal
      \<and> ((mm!l)$ = #v) \<and> ((rs!p)$ = #OK)"

definition BadWrite :: "memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> Vals \<Rightarrow> action"
  where "BadWrite mm rs p l v == ACT
    \<not> (#l \<in> #MemLoc \<and> #v \<in> #MemVal)
    \<and> ((rs!p)$ = #BadArg) \<and> unchanged (mm!l)"

definition WriteInner :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> Vals \<Rightarrow> action"
  where "WriteInner ch mm rs p l v == ACT
    $(WrRequest ch p l v)
    \<and> (GoodWrite mm rs p l v  \<or>  BadWrite mm rs p l v)
    \<and> unchanged (rtrner ch ! p)"

definition Write :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> Locs \<Rightarrow> action"
  where "Write ch mm rs p l == ACT (\<exists>v. WriteInner ch mm rs p l v)"

(* the return action *)
definition MemReturn :: "memChType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> action"
  where "MemReturn ch rs p == ACT
   (   ($(rs!p) \<noteq> #NotAResult)
    \<and> ((rs!p)$ = #NotAResult)
    \<and> Return ch p (rs!p))"

(* the failure action of the unreliable memory *)
definition MemFail :: "memChType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> action"
  where "MemFail ch rs p == ACT
    $(Calling ch p)
    \<and> ((rs!p)$ = #MemFailure)
    \<and> unchanged (rtrner ch ! p)"

(* next-state relations for reliable / unreliable memory *)
definition RNext :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> action"
  where "RNext ch mm rs p == ACT
   (  Read ch mm rs p
    \<or> (\<exists>l. Write ch mm rs p l)
    \<or> MemReturn ch rs p)"

definition UNext :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> action"
  where "UNext ch mm rs p == ACT (RNext ch mm rs p \<or> MemFail ch rs p)"

(* temporal formulas *)

definition RPSpec :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> temporal"
  where "RPSpec ch mm rs p == TEMP
    Init(PInit rs p)
    \<and> \<box>[ RNext ch mm rs p ]_(rtrner ch ! p, rs!p)
    \<and> WF(RNext ch mm rs p)_(rtrner ch ! p, rs!p)
    \<and> WF(MemReturn ch rs p)_(rtrner ch ! p, rs!p)"

definition UPSpec :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> PrIds \<Rightarrow> temporal"
  where "UPSpec ch mm rs p == TEMP
    Init(PInit rs p)
    \<and> \<box>[ UNext ch mm rs p ]_(rtrner ch ! p, rs!p)
    \<and> WF(RNext ch mm rs p)_(rtrner ch ! p, rs!p)
    \<and> WF(MemReturn ch rs p)_(rtrner ch ! p, rs!p)"

definition MSpec :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> Locs \<Rightarrow> temporal"
  where "MSpec ch mm rs l == TEMP
    Init(MInit mm l)
    \<and> \<box>[ \<exists>p. Write ch mm rs p l ]_(mm!l)"

definition IRSpec :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> temporal"
  where "IRSpec ch mm rs == TEMP
    (\<forall>p. RPSpec ch mm rs p)
    \<and> (\<forall>l. #l \<in> #MemLoc \<longrightarrow> MSpec ch mm rs l)"

definition IUSpec :: "memChType \<Rightarrow> memType \<Rightarrow> resType \<Rightarrow> temporal"
  where "IUSpec ch mm rs == TEMP
    (\<forall>p. UPSpec ch mm rs p)
    \<and> (\<forall>l. #l \<in> #MemLoc \<longrightarrow> MSpec ch mm rs l)"

definition RSpec :: "memChType \<Rightarrow> resType \<Rightarrow> temporal"
  where "RSpec ch rs == TEMP (\<exists>\<exists>mm. IRSpec ch mm rs)"

definition USpec :: "memChType \<Rightarrow> temporal"
  where "USpec ch == TEMP (\<exists>\<exists>mm rs. IUSpec ch mm rs)"

(* memory invariant: in the paper, the invariant is hidden in the definition of
   the predicate S used in the implementation proof, but it is easier to verify
   at this level. *)
definition MemInv :: "memType \<Rightarrow> Locs \<Rightarrow> stpred"
  where "MemInv mm l == PRED  #l \<in> #MemLoc \<longrightarrow> mm!l \<in> #MemVal"

lemmas RM_action_defs =
  MInit_def PInit_def RdRequest_def WrRequest_def MemInv_def
  GoodRead_def BadRead_def ReadInner_def Read_def
  GoodWrite_def BadWrite_def WriteInner_def Write_def
  MemReturn_def RNext_def

lemmas UM_action_defs = RM_action_defs MemFail_def UNext_def

lemmas RM_temp_defs = RPSpec_def MSpec_def IRSpec_def
lemmas UM_temp_defs = UPSpec_def MSpec_def IUSpec_def

(* The reliable memory is an implementation of the unreliable one *)
lemma ReliableImplementsUnReliable: "\<turnstile> IRSpec ch mm rs \<longrightarrow> IUSpec ch mm rs"
  by (force simp: UNext_def UPSpec_def IUSpec_def RM_temp_defs elim!: STL4E [temp_use] squareE)

(* The memory spec implies the memory invariant *)
lemma MemoryInvariant: "\<turnstile> MSpec ch mm rs l \<longrightarrow> \<box>(MemInv mm l)"
  by (auto_invariant simp: RM_temp_defs RM_action_defs)

(* The invariant is trivial for non-locations *)
lemma NonMemLocInvariant: "\<turnstile> #l \<notin> #MemLoc \<longrightarrow> \<box>(MemInv mm l)"
  by (auto simp: MemInv_def intro!: necT [temp_use])

lemma MemoryInvariantAll:
    "\<turnstile> (\<forall>l. #l \<in> #MemLoc \<longrightarrow> MSpec ch mm rs l) \<longrightarrow> (\<forall>l. \<box>(MemInv mm l))"
  apply clarify
  apply (auto elim!: MemoryInvariant [temp_use] NonMemLocInvariant [temp_use])
  done

(* The memory engages in an action for process p only if there is an
   unanswered call from p.
   We need this only for the reliable memory.
*)

lemma Memoryidle: "\<turnstile> \<not>$(Calling ch p) \<longrightarrow> \<not> RNext ch mm rs p"
  by (auto simp: AReturn_def RM_action_defs)

(* Enabledness conditions *)

lemma MemReturn_change: "\<turnstile> MemReturn ch rs p \<longrightarrow> <MemReturn ch rs p>_(rtrner ch ! p, rs!p)"
  by (force simp: MemReturn_def angle_def)

lemma MemReturn_enabled: "\<And>p. basevars (rtrner ch ! p, rs!p) \<Longrightarrow>
      \<turnstile> Calling ch p \<and> (rs!p \<noteq> #NotAResult)
         \<longrightarrow> Enabled (<MemReturn ch rs p>_(rtrner ch ! p, rs!p))"
  apply (tactic
    \<open>action_simp_tac \<^context> [@{thm MemReturn_change} RSN (2, @{thm enabled_mono}) ] [] 1\<close>)
  apply (tactic
    \<open>action_simp_tac (\<^context> addsimps [@{thm MemReturn_def}, @{thm AReturn_def},
      @{thm rtrner_def}]) [exI] [@{thm base_enabled}, @{thm Pair_inject}] 1\<close>)
  done

lemma ReadInner_enabled: "\<And>p. basevars (rtrner ch ! p, rs!p) \<Longrightarrow>
      \<turnstile> Calling ch p \<and> (arg<ch!p> = #(read l)) \<longrightarrow> Enabled (ReadInner ch mm rs p l)"
  apply (case_tac "l \<in> MemLoc")
  apply (force simp: ReadInner_def GoodRead_def BadRead_def RdRequest_def
    intro!: exI elim!: base_enabled [temp_use])+
  done

lemma WriteInner_enabled: "\<And>p. basevars (mm!l, rtrner ch ! p, rs!p) \<Longrightarrow>
      \<turnstile> Calling ch p \<and> (arg<ch!p> = #(write l v))
         \<longrightarrow> Enabled (WriteInner ch mm rs p l v)"
  apply (case_tac "l \<in> MemLoc \<and> v \<in> MemVal")
  apply (force simp: WriteInner_def GoodWrite_def BadWrite_def WrRequest_def
    intro!: exI elim!: base_enabled [temp_use])+
  done

lemma ReadResult: "\<turnstile> Read ch mm rs p \<and> (\<forall>l. $(MemInv mm l)) \<longrightarrow> (rs!p)` \<noteq> #NotAResult"
  by (force simp: Read_def ReadInner_def GoodRead_def BadRead_def MemInv_def)

lemma WriteResult: "\<turnstile> Write ch mm rs p l \<longrightarrow> (rs!p)` \<noteq> #NotAResult"
  by (auto simp: Write_def WriteInner_def GoodWrite_def BadWrite_def)

lemma ReturnNotReadWrite: "\<turnstile> (\<forall>l. $MemInv mm l) \<and> MemReturn ch rs p
         \<longrightarrow> \<not> Read ch mm rs p \<and> (\<forall>l. \<not> Write ch mm rs p l)"
  by (auto simp: MemReturn_def dest!: WriteResult [temp_use] ReadResult [temp_use])

lemma RWRNext_enabled: "\<turnstile> (rs!p = #NotAResult) \<and> (\<forall>l. MemInv mm l)
         \<and> Enabled (Read ch mm rs p \<or> (\<exists>l. Write ch mm rs p l))
         \<longrightarrow> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  by (force simp: RNext_def angle_def elim!: enabled_mono2
    dest: ReadResult [temp_use] WriteResult [temp_use])

(* Combine previous lemmas: the memory can make a visible step if there is an
   outstanding call for which no result has been produced.
*)
lemma RNext_enabled: "\<And>p. \<forall>l. basevars (mm!l, rtrner ch!p, rs!p) \<Longrightarrow>
      \<turnstile> (rs!p = #NotAResult) \<and> Calling ch p \<and> (\<forall>l. MemInv mm l)
         \<longrightarrow> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  apply (auto simp: enabled_disj [try_rewrite] intro!: RWRNext_enabled [temp_use])
  apply (case_tac "arg (ch w p)")
   apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm Read_def},
     temp_rewrite \<^context> @{thm enabled_ex}]) [@{thm ReadInner_enabled}, exI] [] 1\<close>)
   apply (force dest: base_pair [temp_use])
  apply (erule contrapos_np)
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm Write_def},
    temp_rewrite \<^context> @{thm enabled_ex}])
    [@{thm WriteInner_enabled}, exI] [] 1\<close>)
  done

end