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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  shows False
proof -
  {
    fix xvec N P'

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

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

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

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

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

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

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

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

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

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

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

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

  assumes "wellFormedSubst \<sigma>"

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

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

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

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

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

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

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

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

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

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

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

  thus ?thesis by auto
qed

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

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

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

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

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

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

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

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

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

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

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

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

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

end

end


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

header{*The n_mutualExSimp Protocol Case Study*}

theory n_mutualExSimp_lemma_invs_on_rules imports n_mutualExSimp_lemma_inv__1_on_rules n_mutualExSimp_lemma_inv__2_on_rules n_mutualExSimp_lemma_inv__3_on_rules n_mutualExSimp_lemma_inv__4_on_rules n_mutualExSimp_lemma_inv__5_on_rules
begin
lemma invs_on_rules:
  assumes a1: "f \<in> invariants N" and a2: "r \<in> rules N"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have b1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)\<or>
    (\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  p__Inv4)\<or>
    (\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__3  p__Inv3 p__Inv4)\<or>
    (\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__4  p__Inv4)\<or>
    (\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
  apply (cut_tac a1, auto) done
    moreover {
      assume c1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__1_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  p__Inv4)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__2_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__3  p__Inv3 p__Inv4)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__3_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__4  p__Inv4)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__4_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__5_on_rules) done
    }

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

end


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

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

Copyright (C) 2006-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
*)

theory XVcg
imports Vcg

begin

text {* We introduce a syntactic variant of the let-expression so that we can
safely unfold it during verification condition generation. With the new
theorem attribute @{text "vcg_simp"} we can declare equalities to be used
by the verification condition generator, while simplifying assertions.
*}

syntax
"_Let'" :: "[letbinds, basicblock] => basicblock"  ("(LET (_)/ IN (_))" 23)

translations
  "_Let' (_binds b bs) e"  == "_Let' b (_Let' bs e)"
  "_Let' (_bind x a) e"    == "CONST Let' a (%x. e)"

lemma Let'_unfold [vcg_simp]: "Let' x f = f x"
  by (simp add: Let'_def Let_def)

lemma Let'_split_conv [vcg_simp]:
  "(Let' x  (\<lambda>p. (split (f p) (g p)))) =
   (Let' x  (\<lambda>p. (f p) (fst (g p)) (snd (g p))))"
  by (simp add: split_def)

end


theory LaunchburyNoBH
imports Terms Heap
begin

inductive reds :: "heap \<Rightarrow> heap \<Rightarrow> bool" ("_ [\<Down>] _" [50,50] 50)
where
  Lambda: "(x, (Lam [y]. e)) # \<Gamma> [\<Down>] (x, (Lam [y]. e)) # \<Gamma>"
 | Application: "\<lbrakk>
      atom n \<sharp> (\<Gamma>,delete x \<Delta>,x,e,y,\<Theta>,z);
      atom z \<sharp> (\<Gamma>,delete x \<Delta>,x,e,y,\<Theta>);
      (n, e) # (x, App (Var n) y) # \<Gamma> [\<Down>] (n, Lam [z]. e') # \<Delta>;
      (x, e'[z ::= y]) # delete x \<Delta> [\<Down>] \<Theta>
    \<rbrakk> \<Longrightarrow>
      (x, App e y) # \<Gamma> [\<Down>] \<Theta>"
 | Variable: "\<lbrakk>
      (y, e) \<in> set ((x, Var y) # \<Gamma>);
      (y, e) # delete y ((x, Var y) # \<Gamma>) [\<Down>] (y, z) # \<Delta>;
      set \<Delta>' = set ((y,z) # \<Delta>)
   \<rbrakk> \<Longrightarrow>
      (x, Var y) # \<Gamma> [\<Down>] (x,z) # delete x \<Delta>'"
 | Let: "\<lbrakk>
      set (bn as) \<sharp>* (\<Gamma>, x, Let as body);
      distinctVars (asToHeap as);
      set \<Gamma>' = set (asToHeap as @ \<Gamma>);
      (x, body) # \<Gamma>' [\<Down>] \<Delta>
   \<rbrakk> \<Longrightarrow>
      (x, Let as body) # \<Gamma> [\<Down>] \<Delta>"

equivariance reds

nominal_inductive reds
  avoids Application: "n" and "z"
  by (auto simp add: fresh_star_def fresh_Cons fresh_Pair exp_assn.fresh)

lemma VariableI:
  "\<lbrakk>
      (y, e) \<in> set ((x, Var y) # \<Gamma>);
      (y, e) # delete y ((x, Var y) # \<Gamma>) [\<Down>] (y, z) # \<Delta>;
      \<Delta>' = delete x ((y,z) # \<Delta>)
   \<rbrakk> \<Longrightarrow>
      (x, Var y) # \<Gamma> [\<Down>] (x,z) # \<Delta>'"
      by (metis Variable)

lemma eval_test:
  "y \<noteq> x \<Longrightarrow> [(x, Let (ACons y (Lam [z]. Var z) ANil) (Var y))] [\<Down>] [(x, (Lam [z]. Var z)), (y, Lam [z]. Var z)]"
apply(auto intro!: Lambda Application VariableI Let
 simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_star_def exp_assn.bn_defs fresh_at_base)
done

lemma eval_test2:
  "y \<noteq> x \<Longrightarrow> z \<noteq> y \<Longrightarrow> z \<noteq> x \<Longrightarrow> [(x,  Let (ACons y (Lam [z]. Var z) ANil) (App (Var y) y))] [\<Down>] [(x, (Lam [z]. Var z)), (y, Lam [z]. Var z)]"
  apply (rule Let)
    apply (simp add: fresh_Pair fresh_Cons fresh_at_base  fresh_Nil exp_assn.fresh fresh_star_def exp_assn.bn_defs)
    apply simp
    apply (rule refl)
  apply (rule obtain_fresh[where x = "(asToHeap (ACons y (Lam [z]. Var z) ANil) @ [], [(y, Lam [z]. Var z)], x, Var y, y,
                        [(x, Lam [z]. Var z), (y, Lam [z]. Var z)], z)", standard])
  apply (rule Application[where z = z])
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh)[1]
    defer
    defer
    apply (rule VariableI)
    apply auto[1]

    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
    apply (rule Lambda)
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
    apply (rule VariableI)
    apply simp
    apply (rule Lambda)
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
    apply (auto simp add: fresh_Pair fresh_Cons fresh_Nil exp_assn.fresh fresh_at_base)[1]
  done

inductive distinct_reds :: "heap \<Rightarrow> heap \<Rightarrow> bool" ("_ [\<Down>]d _" [50,50] 50)
where
  DLambda: "(x, (Lam [y]. e)) # \<Gamma> [\<Down>]d (x, (Lam [y]. e)) # \<Gamma>"
 | DApplication: "\<lbrakk>
      atom n \<sharp> (\<Gamma>,delete x \<Delta>,x,e,y,\<Theta>,z);
      atom z \<sharp> (\<Gamma>,delete x \<Delta>,x,e,y,\<Theta>);

      (n, e) # (x, App (Var n) y) # \<Gamma> [\<Down>]d (n, Lam [z]. e') # \<Delta>;
      (x, e'[z ::= y]) # delete x \<Delta> [\<Down>]d \<Theta>
    \<rbrakk> \<Longrightarrow>
      (x, App e y) # \<Gamma> [\<Down>]d \<Theta>"
 | DVariable: "\<lbrakk>
      (y, e) \<in> set ((x, Var y) # \<Gamma>);
      (y, e) # delete y ((x, Var y) # \<Gamma>) [\<Down>]d (y, z) # \<Delta>
   \<rbrakk> \<Longrightarrow>
      (x, Var y) # \<Gamma> [\<Down>]d (x,z) # delete x ((y,z) # \<Delta>)"
 | DLet: "\<lbrakk>
      set (bn as) \<sharp>* (\<Gamma>, x, Let as body);
      distinctVars (asToHeap as);
      (x, body) # asToHeap as @ \<Gamma> [\<Down>]d \<Delta>
   \<rbrakk> \<Longrightarrow>
      (x, Let as body) # \<Gamma> [\<Down>]d \<Delta>"

equivariance distinct_reds

nominal_inductive distinct_reds
  avoids DApplication: "n" and "z"
  by (auto simp add: fresh_star_def fresh_Cons fresh_Pair exp_assn.fresh)

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                  April 2005               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_op_alpha_par
imports CSP_F_domain CSP_T.CSP_T_op_alpha_par
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite (notick | t = <>)                  *)
(*                                                                     *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

(*********************************************************
             Alphabetized Parallel eval
 *********************************************************)

lemma in_failures_Parallel_SKIP_lm1:
  "[| Y - insert Tick (Ev ` X) = Z - insert Tick (Ev ` X) ;
     (Tick ~: Z | Z <= Evset) |]
   ==> Z - Y <= Ev ` X"
by (auto simp add: Evset_def)

lemma in_failures_Parallel_SKIP_lm2:
  "Y - insert Tick (Ev ` X) = Z - insert Tick (Ev ` X)
   ==> Z - insert Tick Y <= Ev ` X"
by (auto)

(* Para SKIP *)

lemma in_failures_Parallel_SKIP:
  "(f :f failures(P |[X]| SKIP) M) =
   (EX u Y Z. f = (u, Y Un Z) & (u, Y) :f failures(P) M &
              sett(u) Int (Ev ` X) = {} & Z <= Ev ` X)"
apply (simp add: in_failures)
apply (rule iffI)

(* => *)
 apply (elim conjE exE)
 apply (erule disjE)

 (* t = <> *)
  apply (simp add: par_tr_nil)
  apply (elim conjE, simp)
  apply (rule_tac x="Y" in exI)
  apply (rule_tac x="Z - Y" in exI)
  apply (simp add: in_failures_Parallel_SKIP_lm1)

 (* t = <Tick> *)
  apply (simp add: par_tr_Tick)
  apply (elim conjE, simp)
  apply (case_tac "Tick ~: Z")

   apply (rule_tac x="Y" in exI)
   apply (rule_tac x="Z - Y" in exI)
   apply (simp add: in_failures_Parallel_SKIP_lm1)

   (* Tick : Z *)
   apply (rule_tac x="insert Tick Y" in exI)
   apply (rule_tac x="(Z - insert Tick Y)" in exI)
   apply (rule conjI, force)
   apply (simp add: Tick_in_sett)
   apply (erule exE)
   apply (rule conjI)
   apply (simp)
   apply (rule proc_T2_T3)
   apply (simp)
   apply (simp)
   apply (simp add: in_failures_Parallel_SKIP_lm2)

(* <= *)
 apply (elim conjE exE)
 apply (case_tac "Tick ~: sett u")

 (* t = <> *)
  apply (rule_tac x="u" in exI)
  apply (rule_tac x="Y" in exI)
  apply (rule_tac x="Z Un (Y - {Tick})" in exI)
  apply (simp)
  apply (rule conjI)
  apply (fast)
  apply (rule conjI)
  apply (fast)
  apply (rule_tac x="u" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp add: par_tr_nil)
  apply (simp add: Evset_def)
  apply (force)

 (* t = <Tick> *)
  apply (rule_tac x="u" in exI)
  apply (rule_tac x="Y" in exI)
  apply (rule_tac x="Z Un Y" in exI)
  apply (simp)
  apply (rule conjI)
  apply (fast)
  apply (rule conjI)
  apply (fast)
  apply (rule_tac x="u" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp add: par_tr_Tick)
done

(*** complement ***)

lemma in_failures_Parallel_SKIP_comp:
  "(f :f failures(P |[- X]| SKIP) M) =
   (EX u Y Z. f = (u, Y Un Z) & (u, Y) :f failures(P) M &
              sett(u) <= insert Tick (Ev ` X) & Z Int insert Tick (Ev ` X) = {})"
apply (simp add: in_failures_Parallel_SKIP)
apply (auto)
apply (rule_tac x="Y" in exI)
apply (rule_tac x="Z" in exI)
apply (simp)
apply (rule conjI)
 apply (rule subsetI)
 apply (case_tac "x : Ev ` (- X)")
 apply (fast)
 apply (simp add: notin_Ev_set)
 apply (erule disjE, simp)
 apply (force)
apply (force)

apply (rule_tac x="Y" in exI)
apply (rule_tac x="Z" in exI)
apply (auto)
apply (case_tac "x = Tick", simp)
apply (simp add: not_Tick_to_Ev)
apply (auto)
done

(*** Alpha_parallel_evalF ***)

lemma in_failures_Alpha_parallel_lm1:
  "[| Tick ~: Za ; Za Int Ev ` X1 = {};
      Tick ~: Zb ; Zb Int Ev ` X2 = {};
      Ya Un Za - insert Tick (Ev ` (X1 Int X2)) =
      Yb Un Zb - insert Tick (Ev ` (X1 Int X2)) |]
       ==>
       (Ya Un Za Un (Yb Un Zb)) Int insert Tick (Ev ` (X1 Un X2)) =
         (Ya Int insert Tick (Ev ` X1)) Un
         (Yb Int insert Tick (Ev ` X2))"
by (auto)

lemma in_failures_Alpha_parallel_lm2:
  "X Int insert Tick (Ev ` (X1 Un X2)) <= Y Un Z
   ==> X = X Int Ev ` (X1 - X2) Un X Int Y Int insert Tick (Ev ` (X1 Int X2)) Un
               (X - insert Tick (Ev ` X1)) Un
               (X Int Ev ` (X2 - X1) Un X Int Z Int insert Tick (Ev ` (X1 Int X2)) Un
                (X - insert Tick (Ev ` X2)))"
by (auto)

lemma in_failures_Alpha_parallel_lm3:
  "X Int Ev ` (X1 - X2) Un X Int Y Int insert Tick (Ev ` (X1 Int X2)) Un
           (X - insert Tick (Ev ` X1)) -
           insert Tick (Ev ` (X1 Int X2)) =
           X Int Ev ` (X2 - X1) Un X Int Z Int insert Tick (Ev ` (X1 Int X2)) Un
           (X - insert Tick (Ev ` X2)) -
           insert Tick (Ev ` (X1 Int X2))"
by (auto)

(* F *)

lemma in_failures_Alpha_parallel:
  "(f :f failures(P |[X1,X2]| Q) M) =
   (EX u X.
     f = (u, X) &
     (EX Y Z.
         X Int insert Tick (Ev ` (X1 Un X2)) =
         Y Int insert Tick (Ev ` X1) Un Z Int insert Tick (Ev ` X2) &
         (u rest-tr X1, Y) :f failures(P) M &
         (u rest-tr X2, Z) :f failures(Q) M &
          sett u <= insert Tick (Ev ` (X1 Un X2))))"
apply (simp add: Alpha_parallel_def)
apply (simp add: in_failures_Parallel[of _ _ "X1 Int X2"])
apply (simp add: in_failures_Parallel_SKIP_comp)
apply (rule iffI)

(* => *)
 apply (elim conjE exE)
 apply (simp add: par_tr_rest_tr)
 apply (rule_tac x="Ya" in exI, simp)
 apply (rule_tac x="Yb" in exI, simp)
 apply (simp add: in_failures_Alpha_parallel_lm1)

(* <= *)
 apply (elim conjE exE)
 apply (simp)
 apply (rule_tac x=
   "(X Int (Ev ` (X1 - X2))) Un
    (X Int Y Int insert Tick (Ev ` (X1 Int X2))) Un
    (X - insert Tick (Ev ` X1))" in exI)
 apply (rule_tac x=
   "(X Int (Ev ` (X2 - X1))) Un
    (X Int Z Int insert Tick (Ev ` (X1 Int X2))) Un
    (X - insert Tick (Ev ` X2))" in exI)

(* X = Y' Un Z' *)
  apply (rule conjI)
  apply (rule in_failures_Alpha_parallel_lm2)
  apply (fast)

(* Parallel condition *)
  apply (rule conjI)
  apply (simp add: in_failures_Alpha_parallel_lm3)

(* failures *)
  apply (rule_tac x="u rest-tr X1" in exI)
  apply (rule_tac x="u rest-tr X2" in exI)
  apply (simp add: par_tr_rest_tr_if)

  apply (rule conjI)
   apply (rule_tac x=
     "(X Int (Ev ` (X1 - X2))) Un
      (X Int Y Int insert Tick (Ev ` (X1 Int X2)))" in exI)
   apply (rule_tac x= "(X - insert Tick (Ev ` X1))" in exI)
   apply (simp)
   apply (rule conjI)
   apply (rule memF_F2)
   apply (simp)
   apply (force)
   apply (force)

   apply (rule_tac x=
     "(X Int (Ev ` (X2 - X1))) Un
      (X Int Z Int insert Tick (Ev ` (X1 Int X2)))" in exI)
   apply (rule_tac x= "(X - insert Tick (Ev ` X2))" in exI)
   apply (simp)
   apply (rule conjI)
   apply (rule memF_F2)
   apply (simp)
   apply (force)
   apply (force)
done

(*** Semantics for alphabetized parallel on F ***)

lemma failures_Alpha_parallel:
  "failures(P |[X1,X2]| Q) = (%M.
   {f. (EX u X. f = (u, X) &
     (EX Y Z.
         X Int insert Tick (Ev ` (X1 Un X2)) =
         Y Int insert Tick (Ev ` X1) Un Z Int insert Tick (Ev ` X2) &
         (u rest-tr X1, Y) :f failures(P) M &
         (u rest-tr X2, Z) :f failures(Q) M &
          sett u <= insert Tick (Ev ` (X1 Un X2))))}f)"
apply (simp only: in_failures_Alpha_parallel[THEN sym])
apply (simp)
done

(****************** to add it again ******************)

declare disj_not1   [simp]

end