Theory Strong_Late_Sim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Sim_SC
  imports Strong_Late_Sim
begin

(************** Zero **********************)

lemma nilSim[dest]:
  fixes a :: name
  and   b :: name
  and   x :: name
  and   P :: pi
  and   Q :: pi

  shows "𝟬 ↝[Rel] τ.(P)  False"
  and   "𝟬 ↝[Rel] a<x>.P  False"
  and   "𝟬 ↝[Rel] a{b}.P  False"
by(fastforce simp add: simulation_def intro: Tau Input Output)+

lemma nilSimRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  shows "P ↝[Rel] 𝟬"
by(auto simp add: simulation_def)

(************** Match *********************)

lemma matchIdLeft:
  fixes a   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "[aa]P ↝[Rel] P"
using assms
by(force simp add: simulation_def dest: Match derivativeReflexive)

lemma matchIdRight:
  fixes P   :: pi
  and   a   :: name
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"

  shows "P ↝[Rel] [aa]P"
using assms
by(fastforce simp add: simulation_def elim: matchCases intro: derivativeReflexive)

lemma matchNilLeft:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"
  
  shows "𝟬 ↝[Rel] [ab]P"
using assms
by(auto simp add: simulation_def)

(************** Mismatch *********************)

lemma mismatchIdLeft:
  fixes a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"
  and     "a  b"

  shows "[ab]P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Mismatch dest: derivativeReflexive)

lemma mismatchIdRight:
  fixes P   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"
  and     aineqb: "a  b"

  shows "P ↝[Rel] [ab]P"
using assms
by(fastforce simp add: simulation_def elim: mismatchCases intro: derivativeReflexive)

lemma mismatchNilLeft:
  fixes a :: name
  and   P :: pi
  
  shows "𝟬 ↝[Rel] [aa]P"
by(auto simp add: simulation_def)

(************** +-operator *****************)

lemma sumSym:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"
  
  shows "P  Q ↝[Rel] Q  P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumIdempLeft:
  fixes P :: pi
  and Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝[Rel] P  P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)

lemma sumIdempRight:
  fixes P :: pi
  and Rel :: "(pi × pi) set"

  assumes I: "Id  Rel"

  shows "P  P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)

lemma sumAssocLeft:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "(P  Q)  R ↝[Rel] P  (Q  R)"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumAssocRight:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P  (Q  R) ↝[Rel] (P  Q)  R"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumZeroLeft:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P  𝟬 ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)

lemma sumZeroRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P ↝[Rel] P  𝟬"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)

lemma sumResLeft:
  fixes x   :: name
  and   P   :: pi
  and   Q   :: pi

  assumes Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "(x>P)  (x>Q) ↝[Rel] x>(P  Q)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by(simp add: fresh_prod)+
  hence "y  P  Q" by simp
  with x>(P  Q) a«y»  PQ y  x show ?case
  proof(induct rule: resCasesB)
    case(cOpen a PQ)
    from P  Q a[x]  PQ y  P y  Q have "y  PQ" by(force dest: freshFreeDerivative)
    from P  Q a[x]  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1
      from P a[x]  PQ a  x have "x>P ax>  PQ" by(rule Open)
      hence "(x>P)  (x>Q) ax>  PQ" by(rule Sum1)
      with y  PQ have "(x>P)  (x>Q) ay>  ([(y, x)]  PQ)" 
        by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  PQ) ([(y, x)]  PQ) (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from Q a[x]  PQ a  x have "x>Q ax>  PQ" by(rule Open)
      hence "(x>P)  (x>Q) ax>  PQ" by(rule Sum2)
      with y  PQ have "(x>P)  (x>Q) ay>  ([(y, x)]  PQ)" 
        by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  PQ) ([(y, x)]  PQ) (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case(cRes PQ)
    from P  Q a«y»  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1
      from P a«y»  PQ x  a y  x have "x>P a«y»  x>PQ" by(rule_tac ResB) auto
      hence "(x>P)  (x>Q) a«y»  x>PQ" by(rule Sum1)
      moreover from Id have "derivative (x>PQ) (x>PQ) a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from Q a«y»  PQ x  a y  x have "x>Q a«y»  x>PQ" by(rule_tac ResB) auto
      hence "(x>P)  (x>Q) a«y»  x>PQ" by(rule Sum2)
      moreover from Id have "derivative (x>PQ) (x>PQ) a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQ)
  from x>(P  Q) α  PQ show ?case
  proof(induct rule: resCasesF)
    case(cRes PQ)
    from P  Q α  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1 
      from P α  PQ x  α have "x>P α  x>PQ" by(rule ResF)
      hence "(x>P)  (x>Q) α  x>PQ" by(rule Sum1)
      with Id show ?case by blast
    next
      case cSum2
      from Q α  PQ x  α have "x>Q α  x>PQ" by(rule ResF)
      hence "(x>P)  (x>Q) α  x>PQ" by(rule Sum2)
      with Id show ?case by blast
    qed
  qed
qed

lemma sumResRight:
  fixes x   :: name
  and   P   :: pi
  and   Q   :: pi

  assumes Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "x>(P  Q) ↝[Rel] (x>P)  (x>Q)"
using eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by(simp add: fresh_prod)+
  from (x>P)  (x>Q) a«y»  PQ show ?case
  proof(induct rule: sumCases)
    case cSum1
    from x>P a«y»  PQ show ?case using y  x y  P
    proof(induct rule: resCasesB)
      case(cOpen a P')
      from P a[x]  P' y  P have "y  P'" by(rule freshFreeDerivative)
      
      from P a[x]  P' have "P  Q a[x]  P'" by(rule Sum1)
      hence "x>(P  Q) ax>  P'" using a  x by(rule Open)
      with y  P' have "x>(P  Q) ay>  [(y, x)]  P'" by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  P') ([(y, x)]  P') (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cRes P')
      from P a«y»  P' have "P  Q a«y»  P'" by(rule Sum1)
      hence "x>(P  Q) a«y»  x>P'" using x  a y  x by(rule_tac ResB) auto
      moreover from Id have "derivative (x>P') (x>P') a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case cSum2
    from x>Q a«y»  PQ show ?case using y  x y  Q
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      from Q a[x]  Q' y  Q have "y  Q'" by(rule freshFreeDerivative)
      
      from Q a[x]  Q' have "P  Q a[x]  Q'" by(rule Sum2)
      hence "x>(P  Q) ax>  Q'" using a  x by(rule Open)
      with y  Q' have "x>(P  Q) ay>  [(y, x)]  Q'" by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  Q') ([(y, x)]  Q') (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cRes Q')
      from Q a«y»  Q' have "P  Q a«y»  Q'" by(rule Sum2)
      hence "x>(P  Q) a«y»  x>Q'" using x  a y  x by(rule_tac ResB) auto
      moreover from Id have "derivative (x>Q') (x>Q') a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQ)
  from (x>P)  (x>Q) α  PQ show ?case
  proof(induct rule: sumCases)
    case cSum1
    from x>P α  PQ show ?case
    proof(induct rule: resCasesF)
      case(cRes P')
      from P α  P' have "P  Q α  P'" by(rule Sum1)
      hence "x>(P  Q) α  x>P'" using x  α by(rule ResF)
      with Id show ?case by blast
    qed
  next
    case cSum2
    from x>Q α  PQ show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from Q α  Q' have "P  Q α  Q'" by(rule Sum2)
      hence "x>(P  Q) α  x>Q'" using x  α by(rule ResF)
      with Id show ?case by blast
    qed
  qed
qed

(************** |-operator *************)

lemma parZeroLeft:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ParZero: "Q. (Q  𝟬, Q)  Rel"

  shows "P  𝟬 ↝[Rel] P"
proof -
  {
    fix P Q a x
    from ParZero have "derivative (P  𝟬) P a x Rel"
      by(case_tac a) (auto simp add: derivative_def)
  }
  thus ?thesis using assms
    by(fastforce simp add: simulation_def intro: Par1B Par1F)
qed

lemma parZeroRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ParZero: "Q. (Q, Q  𝟬)  Rel"

  shows "P ↝[Rel] P  𝟬"
proof -
  {
    fix P Q a x
    from ParZero have "derivative P (P  𝟬) a x Rel"
      by(case_tac a) (auto simp add: derivative_def)
  }
  thus ?thesis using assms
    by(fastforce simp add: simulation_def elim: parCasesF parCasesB)+
qed
  
lemma parSym:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  
  assumes Sym: "R S. (R  S, S  R)  Rel"
  and     Res: "R S x. (R, S)  Rel  (x>R, x>S)  Rel"
  
  shows "P  Q ↝[Rel] Q  P"
proof(induct rule: simCases)
  case(Bound a x QP)
  from x  (P  Q) have "x  Q" and "x  P" by simp+
  with Q  P  a«x»  QP show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    from Q a«x»  Q' have "P  Q a«x»  P  Q'" using x  P by(rule Par2B)
    moreover have "derivative (P  Q')  (Q'  P) a x Rel"
      by(cases a, auto simp add: derivative_def intro: Sym)
    ultimately show ?case by blast
  next
    case(cPar2 P')
    from P a«x»  P' have "P  Q a«x»  P'  Q" using x  Q by(rule Par1B)
    moreover have "derivative (P'  Q)  (Q  P') a x Rel"
      by(cases a, auto simp add: derivative_def intro: Sym)
    ultimately show ?case by blast
  qed
next
  case(Free α QP)
  from Q  P  α  QP show ?case
  proof(induct rule: parCasesF[where C="()"])
    case(cPar1 Q')
    from Q  α  Q' have "P  Q  α  P  Q'" by(rule Par2F)
    moreover have "(P  Q', Q'  P)  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cPar2 P')
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    moreover have "(P'  Q, Q  P')  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cComm1 Q' P' a b x)
    from P a[b]  P' Q a<x>  Q'
    have "P  Q  τ  P'  (Q'[x::=b])" by(rule Comm2)
    moreover have "(P'  Q'[x::=b], Q'[x::=b]  P')  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cComm2 Q' P' a b x)
    from P a<x>  P' Q a[b]  Q'
    have "P  Q  τ  (P'[x::=b])  Q'" by(rule Comm1)
    moreover have "(P'[x::=b]  Q', Q'  P'[x::=b])  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cClose1 Q' P' a x y)
    from P  ay>  P' Q  a<x>  Q' y  Q
    have "P  Q  τ  y>(P'  (Q'[x::=y]))" by(rule Close2)
    moreover have "(y>(P'  Q'[x::=y]), y>(Q'[x::=y]  P'))  Rel" by(metis Res Sym)
    ultimately show ?case by blast
  next
    case(cClose2 Q' P' a x y)
    from P  a<x>  P' Q  ay>  Q' y  P
    have "P  Q  τ  y>((P'[x::=y])  Q')" by(rule Close1)
    moreover have "(y>(P'[x::=y]  Q'), y>(Q'  P'[x::=y]))  Rel" by(metis Res Sym)
    ultimately show ?case by blast
  qed
qed

lemma parAssocLeft:
  fixes P    :: pi
  and   Q    :: pi
  and   R    :: pi
  and   Rel  :: "(pi × pi) set"

  assumes Ass:       "S T U. ((S  T)  U, S  (T  U))  Rel"
  and     Res:       "S T x. (S, T)  Rel  (x>S, x>T)  Rel"
  and     FreshExt:  "S T U x. x  S  (x>((S  T)  U), S  x>(T  U))  Rel"
  and     FreshExt': "S T U x. x  U  ((x>(S  T))  U, x>(S  (T  U)))  Rel"

  shows "(P  Q)  R ↝[Rel] P  (Q  R)"
proof(induct rule: simCases)
  case(Bound a x PQR)
  from x  (P  Q)  R have "x  P" and "x  Q" and "x  R" by simp+
  hence "x  (Q  R)" by simp
  with P  (Q  R)  a«x»  PQR x  P show ?case
  proof(induct rule: parCasesB)
    case(cPar1 P')
    from P  a«x»  P' have "P  Q  a«x»  P'  Q" using x  Q by(rule Par1B)
    hence "(P  Q)  R  a«x»  (P'  Q)  R" using x  R by(rule Par1B)
    moreover have "derivative ((P'  Q)  R) (P'  (Q  R)) a x Rel"
      by(cases a, auto intro: Ass simp add: derivative_def)
    ultimately show ?case by blast
  next
    case(cPar2 QR)
    from Q  R  a«x»  QR x  Q x  R show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from Q  a«x»  Q' have "P  Q  a«x»  P  Q'" using x  P by(rule Par2B)
      hence "(P  Q)  R  a«x»  (P  Q')  R" using x  Rby(rule Par1B)
      moreover have "derivative ((P  Q')  R) (P  (Q'  R)) a x Rel"
        by(cases a, auto intro: Ass simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R  a«x»  R' have "(P  Q)  R  a«x»  (P  Q)  R'" using x  P x  Q 
        by(rule_tac Par2B) auto
      moreover have "derivative ((P  Q)  R') (P  (Q  R')) a x Rel"
        by(cases a, auto intro: Ass simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQR)
  from P  (Q  R)  α  PQR show ?case
  proof(induct rule: parCasesF[where C="Q"])
    case(cPar1 P')
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    hence "(P  Q)  R  α  (P'  Q)  R" by(rule Par1F)
    moreover from Ass have "((P'  Q)  R, P'  (Q  R))  Rel" by blast
    ultimately show ?case by blast
  next
    case(cPar2 QR)
    from Q  R  α  QR show ?case
    proof(induct rule: parCasesF[where C="P"])
      case(cPar1 Q')
      from Q  α  Q' have "(P  Q)  α  P  Q'" by(rule Par2F)
      hence "(P  Q)  R  α  (P  Q')  R" by(rule Par1F)
      moreover from Ass have "((P  Q')  R, P  (Q'  R))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R  α  R' have "(P  Q)  R  α  (P  Q)  R'" by(rule Par2F)
      moreover from Ass have "((P  Q)  R', P  (Q  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm1 Q' R' a b x)
      from Q a<x>  Q' x  P have "P  Q a<x>  P  Q'" by(rule Par2B)
      hence "(P  Q)  R  τ  (P  Q')[x::=b]  R'" using R a[b]  R' by(rule Comm1)
      with x  P have "(P  Q)  R  τ  (P  (Q'[x::=b]))  R'" by(simp add: forget)
      moreover from Ass have "((P  (Q'[x::=b]))  R', P  (Q'[x::=b]  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm2 Q' R' a b x)
      from Q a[b]  Q' have "P  Q a[b]  P  Q'" by(rule Par2F)
      with x  P x  Q R a<x>  R' have "(P  Q)  R  τ  (P  Q')  R'[x::=b]"
        by(force intro: Comm2)
      moreover from Ass have "((P  Q')  R'[x::=b], P  (Q'  R'[x::=b]))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cClose1 Q' R' a x y)
      from Q a<x>  Q' x  P have "P  Q a<x>  P  Q'" by(rule Par2B)
      with y  P y  Q x  P R ay>  R' have "(P  Q)  R  τ  y>((P  Q')[x::=y]  R')"
        by(rule_tac Close1) auto
      with x  P have "(P  Q)  R  τ  y>((P  (Q'[x::=y]))  R')" by(simp add: forget)
      moreover from y  P have "(y>((P  Q'[x::=y])  R'), P  y>(Q'[x::=y]  R'))  Rel"
        by(rule FreshExt)
      ultimately show ?case by blast
    next
      case(cClose2 Q' R' a x y)
      from Q ay>  Q' y  P have "P  Q ay>  P  Q'" by(rule Par2B)
      hence Act: "(P  Q)  R  τ  y>((P  Q')  R'[x::=y])" using R a<x>  R' y  R by(rule Close2)
      moreover from y  P have "(y>((P  Q')  R'[x::=y]), P  y>(Q'  R'[x::=y]))  Rel"
        by(rule FreshExt)
      ultimately show ?case by blast
    qed
  next
    case(cComm1 P' QR a b x)
    from Q  R  a[b]  QR show ?case
    proof(induct rule: parCasesF[where C="()"])
      case(cPar1 Q')
      from P a<x>  P' Q a[b]  Q' have "P  Q  τ  P'[x::=b]  Q'" by(rule Comm1)
      hence "(P  Q)  R  τ  (P'[x::=b]  Q')  R" by(rule Par1F)
      moreover from Ass have "((P'[x::=b]  Q')  R, P'[x::=b]  (Q'  R))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a<x>  P' x  Q have "P  Q  a<x>  P'  Q" by(rule Par1B)
      hence "(P  Q)  R  τ  (P'  Q)[x::=b]  R'" using R  a[b]  R' by(rule Comm1)
      with x  Q have "(P  Q)  R  τ  (P'[x::=b]  Q)  R'" by(simp add: forget)
      moreover from Ass have "((P'[x::=b]  Q)  R', P'[x::=b]  (Q  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm1 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cComm2 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cClose1 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cClose2 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    qed
  next
    case(cComm2 P' QR a b x)
    from x  Q  R have "x  Q" and "x  R" by simp+
    with Q  R  a<x>  QR show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P a[b]  P' Q  a<x>  Q' have "P  Q  τ  P'  (Q'[x::=b])" by(rule Comm2)
      hence "(P  Q)  R  τ  (P'  Q'[x::=b])  R" by(rule Par1F)
      moreover from Ass have "((P'  Q'[x::=b])  R, P'  Q'[x::=b]  R)  Rel" by blast
      with x  R have "((P'  Q'[x::=b])  R, P'  (Q'  R)[x::=b])  Rel" by(force simp add: forget)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a[b]  P' have "P  Q  a[b]  P'  Q" by(rule Par1F)
      hence "(P  Q)  R  τ  (P'  Q)  (R'[x::=b])" using R a<x>  R' by (rule Comm2)
      moreover from Ass have "((P'  Q)  R'[x::=b], P'  Q  (R'[x::=b]))  Rel" by blast
      hence "((P'  Q)  R'[x::=b], P'  (Q  R')[x::=b])  Rel" using x  Q by(force simp add: forget)
      ultimately show ?case by blast
    qed
  next
    case(cClose1 P' QR a x y)
    from x  Q  R have "x  Q" by simp
    from y  Q  R have "y  Q" and "y  R" by simp+
    from Q  R  ay>  QR y  Q y  R show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P a<x>  P' Q  ay>  Q' y  P have "P  Q  τ  y>(P'[x::=y]  Q')" by(rule Close1)
      hence "(P  Q)  R  τ  (y>(P'[x::=y]  Q'))  R" by(rule Par1F)
      moreover from y  R have "((y>(P'[x::=y]  Q'))  R, y>(P'[x::=y]  Q'  R))  Rel"
        by(rule FreshExt')
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a<x>  P' x  Q have "P  Q  a<x>  P'  Q" by(rule Par1B)
      with R  ay>  R' y  P y  Q have "(P  Q)  R  τ  y>((P'  Q)[x::=y]  R')"
        by(rule_tac Close1) auto
      with x  Q have "(P  Q)  R  τ  y>((P'[x::=y]  Q)  R')" by(simp add: forget)
      moreover have "(y>((P'[x::=y]  Q)  R'), y>(P'[x::=y]  (Q  R')))  Rel" by(metis Ass Res)
      ultimately show ?case by blast
    qed
  next
    case(cClose2 P' QR a x y)
    from y  Q  R have "y  Q" and "y  R" by simp+
    from x  Q  R have "x  Q" and "x  R" by simp+
    with Q  R  a<x>  QR show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P ay>  P' Q a<x>  Q' have "P  Q  τ  y>(P'  Q'[x::=y])" using y  Q
        by(rule Close2)
      hence "(P  Q)  R  τ  (y>(P'  Q'[x::=y]))  R" by(rule Par1F)
      moreover from y  R have "((y>(P'  Q'[x::=y]))  R, y>(P'   (Q'[x::=y]  R)))  Rel"
        by(rule FreshExt')
      with x  R have "((y>(P'  Q'[x::=y]))  R, y>(P'   (Q'  R)[x::=y]))  Rel"
        by(simp add: forget)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P ay>  P' y  Q have "P  Q  ay>  P'  Q" by(rule Par1B)
      hence "(P  Q)  R  τ  y>((P'  Q)  R'[x::=y])" using R  a<x>  R' y  R by(rule Close2)
      moreover have "((P'  Q)  R'[x::=y], P'  (Q  R'[x::=y]))  Rel" by(rule Ass)
      hence "(y>((P'  Q)  R'[x::=y]), y>(P'  (Q  R'[x::=y])))  Rel" by(rule Res) 
      hence "(y>((P'  Q)  R'[x::=y]), y>(P'  (Q  R')[x::=y]))  Rel" using x  Q
        by(simp add: forget)
      ultimately show ?case by blast
    qed
  qed
qed

lemma substRes3:
  fixes a :: name
  and   P :: pi
  and   x :: name

  shows "(a>P)[x::=a] = x>([(x, a)]  P)"
proof -
  have "a  a>P" by(simp add: name_fresh_abs)
  hence "(a>P)[x::=a] = [(x, a)]  a>P" by(rule injPermSubst[THEN sym])
  thus "(a>P)[x::=a] = x>([(x, a)]  P)" by(simp add: name_calc)
qed

lemma scopeExtParLeft:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: name
  and   lst :: "name list"
  and   Rel :: "(pi × pi) set"

  assumes "x  P"
  and     Id:         "Id  Rel"
  and     EqvtRel:    "eqvt Rel"
  and     Res:        "R S y. y  R  (y>(R  S), R  y>S)  Rel"
  and     ScopeExt:   "R S y z. y  R  (y>z>(R  S), z>(R  y>S))  Rel"

  shows "x>(P  Q) ↝[Rel] P  x>Q"
using eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PxQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by simp+
  hence "y  P" and "y  x>Q" by(simp add: abs_fresh)+
  with P  x>Q  a«y»  PxQ show ?case
  proof(induct rule: parCasesB)
    case(cPar1 P')
    from P a«y»  P' x  P y  x have "x  a" and "x  P'"
      by(force intro: freshBoundDerivative)+

    from P a«y»  P' y  Q have "P  Q a«y»  P'  Q" by(rule Par1B)
    with x  a y  x have "x>(P  Q)  a«y»  x>(P'  Q)" by(rule_tac ResB) auto
    moreover have "derivative (x>(P'  Q)) (P'  x>Q) a y Rel"
    proof(cases a, auto simp add: derivative_def)
      fix u

      show "((x>(P'  Q))[y::=u],  P'[y::=u]   ((x>Q)[y::=u]))  Rel"
      proof(cases "x=u")
        case True
        have "(x>(P'  Q))[y::=x] = y>(([(y, x)]  P')  ([(y, x)]  Q))"
          by(simp add: substRes3)
        moreover from x  P' have "P'[y::=x] = [(y, x)]  P'" by(rule injPermSubst[THEN sym])
        moreover have "(x>Q)[y::=x] = y>([(y, x)]  Q)" by(rule substRes3)
        moreover from x  P' y  x have "y  [(y, x)]  P'" by(simp add: name_fresh_left name_calc)
        ultimately show ?thesis using x = uby(force intro: Res)
      next
        case False
        with y  x have "(x>(P'  Q))[y::=u] = x>(P'[y::=u]  Q[y::=u])"
          by(simp add: fresh_prod name_fresh)
        moreover from x  u y  x have "(x>Q)[y::=u] = x>(Q[y::=u])"
          by(simp add: fresh_prod name_fresh)
        moreover from x  P' x  u have "x  P'[y::=u]" by(simp add: fresh_fact1)
        ultimately show ?thesis by(force intro: Res)
      qed
    next
      from x  P' show "(x>(P'  Q), P'  x>Q)  Rel" by(rule Res)
    qed
    
    ultimately show ?case by blast
  next
    case(cPar2 xQ)
    from x>Q a«y»  xQ y  x y  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      from Q a[x]  Q' y  Q have yFreshQ': "y  Q'" by(force intro: freshFreeDerivative)

      from Q  a[x]  Q' have "P  Q  a[x]  P  Q'" by(rule Par2F)
      hence "x>(P  Q)  ax>  P  Q'" using a  x by(rule Open)
      with y  P y  Q' have "x>(P  Q)  ay>  [(x, y)]  (P  Q')"
        by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
      with y  P x  P have "x>(P  Q)  ay>  P  ([(x, y)]  Q')"
        by(simp add: name_fresh_fresh)

      moreover have "derivative (P  ([(x, y)]  Q')) (P  ([(y, x)]  Q')) (BoundOutputS a) y Rel" using Id
        by(auto simp add: derivative_def name_swap)
         
      ultimately show ?case by blast
    next
      case(cRes Q')

      from Q  a«y»  Q' y  P have "P  Q  a«y»  P  Q'" by(rule Par2B)
      hence "x>(P  Q)  a«y»  x>(P  Q')" using x  a y  x
        by(rule_tac ResB) auto
      moreover have "derivative (x>(P  Q')) (P  x>Q') a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u
        show "((x>(P  Q'))[y::=u],  P[y::=u]   (x>Q')[y::=u])  Rel"
        proof(cases "x=u")
          case True
          from x  P y  P have "(x>(P  Q'))[y::=x] = y>(P  ([(y, x)]  Q'))"
            by(simp add: substRes3 perm_fresh_fresh)
          moreover from y  P have "P[y::=x] = P" by(simp add: forget)
          moreover have "(x>Q')[y::=x] = y>([(y, x)]  Q')" by(rule substRes3)
          ultimately show ?thesis using x=u y  P by(force intro: Res)
        next
          case False
          with y  x have "(x>(P  Q'))[y::=u] = x>((P  Q')[y::=u])"
            by(simp add: fresh_prod name_fresh)
          moreover from y  x x  u have "(x>Q')[y::=u] = x>(Q'[y::=u])"
            by(simp add: fresh_prod name_fresh)
          moreover from x  P x  u have "x  P[y::=u]" by(force simp add: fresh_fact1)
          ultimately show ?thesis by(force intro: Res)
        qed
      next
        from x  P show "(x>(P  Q'), P  x>Q')  Rel" by(rule Res)
      qed
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PxQ)
  from P  x>Q α  PxQ show ?case
  proof(induct rule: parCasesF[where C="x"])
    case(cPar1 P')
    from P  α  P' x  Phave "x  α" and "x  P'" by(force intro: freshFreeDerivative)+
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    hence "x>(P  Q)  α  x>(P'  Q)" using x  α by(rule ResF)
    moreover from x  P' have "(x>(P'  Q), P'  x>Q)  Rel" by(rule Res)
    ultimately show ?case by blast
  next
    case(cPar2 Q')
    from x>Q  α  Q' show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from Q  α  Q' have "P  Q  α  P  Q'" by(rule Par2F)
      hence "x>(P  Q) α  x>(P  Q')" using x  α  by(rule ResF)
      moreover from x  P have "(x>(P  Q'), P  x>Q')  Rel" by(rule Res)
      ultimately show ?case by blast
    qed
  next
    case(cComm1 P' xQ a b y)
    from y  x have "y  x" by simp
    from P  a<y>  P' x  P y  x have "x  P'" by(force intro: freshBoundDerivative)
    from x>Q a[b]  xQ show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from x  a[b] have "x  b" by simp
      from P  a<y>  P' Q  a[b]  Q' have "P  Q  τ  P'[y::=b]  Q'" by(rule Comm1)
      hence "x>(P  Q)  τ  x>(P'[y::=b]  Q')" by(rule_tac ResF) auto
      moreover from x  P' x  b have "x  P'[y::=b]" by(force intro: fresh_fact1)
      hence "(x>(P'[y::=b]  Q'), P'[y::=b]  x>Q')  Rel" by(rule Res)
      ultimately show ?case by blast
    qed
  next
    case(cComm2 P' xQ a b y)
    from y  x y  x>Q have "y  x" and "y  Q" by(simp add: abs_fresh)+ 
    with x>Q a<y>  xQ show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from InputS a = BoundOutputS b have False by simp
      thus ?case by simp
    next
      case(cRes Q')
      from P a[b]  P' Q a<y>  Q' have "P  Q  τ  P'  Q'[y::=b]" by(rule Comm2)
      hence "x>(P  Q)  τ  x>(P'  Q'[y::=b])" by(rule_tac ResF) auto
      moreover from P a[b]  P' x  P have "x  P'" and "x  b" by(force dest: freshFreeDerivative)+
      from x  P' have "(x>(P'  Q'[y::=b]), P'  x>(Q'[y::=b]))  Rel" by(rule Res)
      with y  x x  b have "(x>(P'  Q'[y::=b]), P'  (x>Q')[y::=b])  Rel" by simp
      ultimately show ?case by blast
    qed
  next
    case(cClose1 P' Q' a y z)
    from y  x have "y  x" by simp
    from z  x z  x>Q have "z  Q" and "z  x" by(simp add: abs_fresh)+
    from P a<y>  P' z  P have "z  a" by(force dest: freshBoundDerivative)
    from x>Q  az>  Q' z  x z  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from BoundOutputS a = BoundOutputS b have "a = b" by simp
      with Q  b[x]  Q' have "([(z, x)]  Q)  [(z, x)]  (a[x]  Q')"
        by(rule_tac transitions.eqvt) simp
      with b  x z  a a = b z  x have "([(z, x)]  Q)  a[z]  ([(z, x)]  Q')"
        by(simp add: name_calc eqvts)
      with P a<y>  P' have "P  ([(z, x)]  Q) τ  P'[y::=z]  ([(z, x)]  Q')"
        by(rule Comm1)
      hence "z>(P  ([(x, z)]  Q))  τ  z>(P'[y::=z]  ([(z, x)]  Q'))"
        by(rule_tac ResF) auto
      hence "x>(P  Q)  τ  z>(P'[y::=z]  ([(z, x)]  Q'))" using z  P z  Q x  P
        by(subst alphaRes[where c=z]) auto
      with Id show ?case by force
    next
      case(cRes Q')
      from P a<y>  P' Q az>  Q' z  P have "P  Q  τ  z>(P'[y::=z]  Q')"
        by(rule Close1)
      hence "x>(P  Q)  τ  x>z>(P'[y::=z]  Q')" by(rule_tac ResF) auto
      moreover from P a<y>  P' y  x x  P have "x  P'"
        by(force dest: freshBoundDerivative)
      with z  x have "x  P'[y::=z]" by(simp add: fresh_fact1)
      hence "(x>z>(P'[y::=z]  Q'), z>(P'[y::=z]  x>Q'))  Rel"
        by(rule ScopeExt)
      ultimately show ?case by blast
    qed
  next
    case(cClose2 P' xQ a y z)
    from z  x z  x>Q have "z  x" and "z  Q" by(auto simp add: abs_fresh)
    from y  x y  x>Q have "y  x" and "y  Q" by(auto simp add: abs_fresh)
    with x>Q a<y>  xQ show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from InputS a = BoundOutputS b have False by simp
      thus ?case by simp
    next
      case(cRes Q')
      from P az>  P' Q a<y>  Q' z  Q have "P  Q  τ  z>(P'  Q'[y::=z])"
        by(rule Close2)
      hence "x>(P  Q)  τ  x>z>(P'  (Q'[y::=z]))"
        by(rule_tac ResF) auto
      moreover from P az>  P' x  P z  x have "x  P'" by(force dest: freshBoundDerivative)
      hence "(x>z>(P'  (Q'[y::=z])), z>(P'  (x>(Q'[y::=z]))))  Rel"
        by(rule ScopeExt)
      with z  x y  x have "(x>z>(P'  (Q'[y::=z])), z>(P'  (x>Q')[y::=z]))  Rel"
        by simp
      ultimately show ?case by blast
    qed
  qed
qed

lemma scopeExtParRight:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: name
  and   Rel :: "(pi × pi) set"

  assumes "x  P"
  and     Id:         "Id  Rel"
  and     "eqvt Rel"
  and     Res:        "R S y. y  R  (R  y>S, y>(R  S))  Rel"
  and     ScopeExt:   "R S y z. y  R  (z>(R  y>S), y>z>(R  S))  Rel"

  shows "P  x>Q ↝[Rel] x>(P  Q)"
using eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y xPQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by simp+
  hence "y  x" and "y  P  Q" by(auto simp add: abs_fresh)
  with x>(P  Q) a«y»  xPQ show ?case
  proof(induct rule: resCasesB)
    case(cOpen a PQ)
    from P  Q a[x]  PQ show ?case
    proof(induct rule: parCasesF[where C="()"])
      case(cPar1 P')
      from P a[x]  P' x  P have "x  x" by(force dest: freshFreeDerivative)
      thus ?case by simp
    next
      case(cPar2 Q')
      from Q a[x]  Q' y  Q have "y  Q'" by(force dest: freshFreeDerivative)
      from Q a[x]  Q' a  x have "x>Q ax>  Q'" by(rule Open)
      hence "P  x>Q ax>  P  Q'" using x  P by(rule Par2B)
      with y  P y  Q' x  P have "P  x>Q ay>  ([(y, x)]  (P  Q'))"
        by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
      moreover with Id have "derivative ([(y, x)]  (P   Q'))
                                        ([(y, x)]  (P  Q')) (BoundOutputS a) y Rel"
        by(auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cComm1 P' Q' b c y)
      from a[x] = τ show ?case by simp
    next
      case(cComm2 P' Q' b c y)
      from a[x] = τ show ?case by simp
    next
      case(cClose1 P' Q' b y z)
      from a[x] = τ show ?case by simp
    next
      case(cClose2 P' Q' b y z)
      from a[x] = τ show ?case by simp
    qed
  next
    case(cRes PQ)
    from P  Q a«y»  PQ y  P y  Q
    show ?case
    proof(induct rule: parCasesB)
      case(cPar1 P')
      from y  x x  P P a«y»  P' have "x  P'" by(force dest: freshBoundDerivative)
      
      from P a«y»  P' y  Q have "P  x>Q a«y»  P'  x>Q"
        by(rule_tac Par1B) (auto simp add: abs_fresh)
      moreover have "derivative (P'  x>Q) (x>(P'  Q)) a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u::name
        obtain z::name where "z  Q" and "y  z" and "z  u" and "z  P" and "z  P'"
          by(generate_fresh "name") auto
        thus "(P'[y::=u]  (x>Q)[y::=u], (x>(P'  Q))[y::=u])  Rel" using x  P'
          by(subst alphaRes[where c=z and a=x], auto)
            (subst alphaRes[where c=z and a=x], auto intro: Res simp add: fresh_fact1)
      next
        from x  P' show "(P'  x>Q, x>(P'  Q))  Rel"
          by(rule Res)
      qed

      ultimately show ?case by blast
    next
      case(cPar2 Q')
      from Q a«y»  Q' have "x>Q a«y»  x>Q'" using x  a y  x 
        by(rule_tac ResB) auto
      hence "P  x>Q a«y»  P  x>Q'" using y  P by(rule Par2B)
      
      moreover have "derivative (P  x>Q') (x>(P  Q')) a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u::name
        obtain z::name where "z  Q" and "z  y" and "z  u" and "z  P" and "z  Q'"
          by(generate_fresh "name") auto
        
        thus  "(P[y::=u]  (x>Q')[y::=u], (x>(P  Q'))[y::=u])  Rel" using x  P
          by(subst alphaRes[where a=x and c=z], auto)
            (subst alphaRes[where a=x and c=z], auto intro: Res simp add: fresh_fact1)
      next
        from x  P show "(P  x>Q', x>(P  Q'))  Rel"
          by(rule Res)
      qed
      
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α xPQ)
  from x>(P  Q) α  xPQ show ?case
  proof(induct rule: resCasesF)
    case(cRes PQ)
    from P  Q α  PQ show ?case
    proof(induct rule: parCasesF[where C="x"])
      case(cPar1 P')
      from P α  P' have "P  x>Q α  P'  x>Q" by(rule Par1F)
      moreover from P α  P' x  P have "x  P'" by(rule freshFreeDerivative)
      hence "(P'  x>Q, x>(P'  Q))  Rel" by(rule Res)
      ultimately show ?case by blast
    next
      case(cPar2 Q')
      from Q α  Q' x  α have "x>Q α  x>Q'" by(rule ResF)
      hence "P  x>Q α  P  x>Q'" by(rule Par2F)
      moreover from x  P have "(P  x>Q', x>(P  Q'))  Rel" by(rule Res)
      ultimately show ?case by blast
    next
      case(cComm1 P' Q' a b y)
      from x  P y  x P a<y>  P' have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      show ?case
      proof(cases "b=x")
        case True
        from Q a[b]  Q' x  a b = x have "x>Q ax>  Q'" by(rule_tac Open) auto
        with P a<y>  P' have "P  x>Q τ  x>(P'[y::=x]  Q')" using x  P by(rule Close1)
        moreover from Id have "(x>(P'[y::=b]  Q'), x>(P'[y::=b]  Q'))  Rel" by blast
        ultimately show ?thesis using b=x by blast
      next
        case False
        from Q a[b]  Q' x  a b  x have "x>Q a[b]  x>Q'" by(rule_tac ResF) auto
        with P a<y>  P' have "P  x>Q τ  (P'[y::=b]  x>Q')" by(rule Comm1)
        moreover from x  P' b  x have "(P'[y::=b]  x>Q', x>(P'[y::=b]  Q'))  Rel"
          by(force intro: Res simp add: fresh_fact1)
        ultimately show ?thesis by blast
      qed
    next
      case(cComm2 P' Q' a b y)
      from P a[b]  P' x  P have "x  a" and "x  b" and "x  P'" by(force dest: freshFreeDerivative)+
      from Q a<y>  Q' y  x x  a have "x>Q a<y>  x>Q'" by(rule_tac ResB) auto
      with P a[b]  P' have "P  x>Q τ  P'  (x>Q')[y::=b]" by(rule Comm2)
      moreover from x  P' have "(P'  x>(Q'[y::=b]), x>(P'  Q'[y::=b]))  Rel" by(rule Res)
      ultimately show ?case using y  x x  b by force
    next
      case(cClose1 P' Q' a y z)
      from P a<y>  P' x  P y  x have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      from Q az>  Q' z  x x  a have "x>Q az>  x>Q'" by(rule_tac ResB) auto
      with P a<y>  P' have "P  x>Q τ  z>(P'[y::=z]  x>Q')" using z  P by(rule Close1)
      moreover from x  P' z  x have "(z>(P'[y::=z]  x>Q'), x>(z>(P'[y::=z]  Q')))  Rel" 
        by(rule_tac ScopeExt) (auto simp add: fresh_fact1)
      ultimately show ?case by blast
    next
      case(cClose2 P' Q' a y z)
      from P az>  P' x  P z  x have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      from Q a<y>  Q' y  x x  a have "x>Q a<y>  x>Q'" by(rule_tac ResB) auto
      with P az>  P' have "P  x>Q τ  z>(P'  (x>Q')[y::=z])" using z  Q
        by(rule_tac Close2) (auto simp add: abs_fresh)
      moreover from x  P' have "(z>(P'  x>(Q'[y::=z])), x>z>(P'  Q'[y::=z]))  Rel" by(rule ScopeExt)
      ultimately show ?case using z  x y  x by force
    qed
  qed
qed

lemma resNilRight:
  fixes x   :: name
  and   Rel :: "(pi × pi) set"

  shows "𝟬 ↝[Rel] x>𝟬"
by(fastforce simp add: simulation_def pi.inject alpha' elim: resCasesB' resCasesF)

lemma resComm:
  fixes a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ResComm: "c d Q. (c>d>Q, d>c>Q)  Rel"
  and     Id:      "Id  Rel"
  and     EqvtRel: "eqvt Rel"

  shows "a>b>P ↝[Rel] b>a>P"
proof(cases "a=b")
  assume "a=b"
  with Id show ?thesis by(force intro: Strong_Late_Sim.reflexive)
next
  assume aineqb: "a  b"
  from EqvtRel show ?thesis
  proof(induct rule: simCasesCont[where C="(a, b, P)"])
    case(Bound c x baP)
    from x  (a, b, P) have "x  a" and "x  b" and "x  P" by simp+
    from x  P have "x  a>P" by(simp add: abs_fresh)
    with b>a>P  c«x»  baP x  b show ?case
    proof(induct rule: resCasesB)
      case(cOpen c aP)
      from a>P c[b]  aP
      show ?case
      proof(induct rule: resCasesF)
        case(cRes P')
        from a  c[b] have "a  c" and "a  b" by simp+
        from x  P P c[b]  P' have "x  c" and "x  P'" by(force dest: freshFreeDerivative)+
        from P  c[b]  P' have "([(x, b)]  P)  [(x, b)]  (c[b]  P')" by(rule transitions.eqvt)
        with x  c c  b x  b have "([(x, b)]  P)  c[x]  [(x, b)]  P'" by(simp add: eqvts calc_atm)
        hence "x>([(x, b)]  P)  cx>  [(x, b)]  P'" using x  c by(rule_tac Open) auto
        with x  P have "b>P  cx>  [(x, b)]  P'" by(simp add: alphaRes)
        hence "a>b>P  cx>  a>([(x, b)]  P')" using a  c x  a
          by(rule_tac ResB) auto
        moreover from Id have "derivative (a>([(x, b)]  P')) (a>([(x, b)]  P')) (BoundOutputS c) x Rel"
          by(force simp add: derivative_def)
        ultimately show ?case using a  b x  a a  c by(force simp add: eqvts calc_atm)
      qed
    next
      case(cRes aP)
      from a>P  c«x»  aP x  a x  P b  c show ?case
      proof(induct rule: resCasesB)
        case(cOpen c P')
        from P c[a]  P' x  P have "x  P'" by(force intro: freshFreeDerivative)
        from b  BoundOutputS c have "b  c" by simp
        with P c[a]  P' a  b have "b>P  c[a]  b>P'" by(rule_tac ResF) auto
        with c  a have "a>b>P  ca>  b>P'" by(rule_tac Open) auto
        hence "a>b>P cx>  b>([(x, a)]  P')" using x  b a  b x  P'
          apply(subst alphaBoundResidual[where x'=a]) by(auto simp add: abs_fresh fresh_left calc_atm)
        moreover have "derivative (b>([(x, a)]  P')) (b>([(x, a)]  P')) (BoundOutputS c) x Rel" using Id
          by(force simp add: derivative_def)
        ultimately show ?case by blast
      next
        case(cRes P')
        from P c«x»  P' b  c x  b have "b>P  c«x»  b>P'" by(rule_tac ResB) auto
        hence "a>b>P  c«x»  a>b>P'" using a  c x  a by(rule_tac ResB) auto
        moreover have "derivative (a>b>P') (b>a>P') c x Rel"
        proof(cases c, auto simp add: derivative_def)
          fix u::name
          show  "((a>b>P')[x::=u],  (b>a>P')[x::=u])  Rel"
          proof(cases "u=a")
            case True
            from u = a a  b show ?thesis
              by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
                (subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
          next
            case False
            show ?thesis
            proof(cases "u=b")
              case True
              from u = b u  a show ?thesis
              by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
                (subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
            next
              case False
              from u  a u  b x  a x  b show ?thesis by(auto intro: ResComm)
            qed
          qed
        next
          show "(a>b>P', b>a>P')  Rel" by(rule ResComm)
        qed
        ultimately show ?case by blast
      qed
    qed
  next
    case(Free α baP)
    from b>a>P  α  baP show ?case
    proof(induct rule: resCasesF)
      case(cRes aP)
      from a>P  α  aP show ?case
      proof(induct rule: resCasesF)
        case(cRes P')
        from P  α  P' b  α have "b>P  α  b>P'" by(rule ResF)
        hence "a>b>P  α  a>b>P'" using a  α by(rule ResF)
        moreover have "(a>b>P', b>a>P')  Rel" by(rule ResComm)
        ultimately show ?case by blast
      qed
    qed
  qed
qed

(***************** !-operator ********************)

lemma bangLeftSC:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "!P ↝[Rel] P  !P"
using assms
by(force simp add: simulation_def dest: Bang derivativeReflexive)

lemma bangRightSC:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"

  shows "P  !P ↝[Rel] !P"
using assms
by(fastforce simp add: pi.inject simulation_def intro: derivativeReflexive elim: bangCases)

lemma resNilLeft:
  fixes x   :: name
  and   y   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"
  and   b   :: name

  shows "𝟬 ↝[Rel] x>(x<y>.P)"
  and   "𝟬 ↝[Rel] x>(x{b}.P)"
by(auto simp add: simulation_def)

lemma resInputLeft:
  fixes x :: name
  and   a :: name
  and   y :: name
  and   P :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqy: "x  y"
  and     Eqvt: "eqvt Rel"
  and     Id: "Id  Rel"

  shows "x>a<y>.P ↝[Rel] a<y>.(x>P)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
  case(Bound b z P')
  from z  (x, y, a, P) have "z  x" and "z  y" and "z  P" and "z  a"  by simp+
  from z  P have "z  x>P" by(simp add: abs_fresh)
  with a<y>.(x>P) b«z»  P' z  a z  y show ?case
  proof(induct rule: inputCases)
    case cInput
    have "a<y>.P a<y>  P" by(rule Input)
    with x  y x  a have "x>a<y>.P a<y>  x>P" by(rule_tac ResB) auto
    hence "x>a<y>.P a<z>  [(y,  z)]  x>P" using z  P 
      by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh fresh_left calc_atm)
    moreover from Id have "derivative ([(y, z)]  x>P) ([(y, z)]  x>P) (InputS a) z Rel" 
      by(rule derivativeReflexive)
    ultimately show ?case by blast
  qed
next
  case(Free α P')
  from a<y>.(x>P) α  P' have False by auto
  thus ?case by simp
qed

lemma resInputRight:
  fixes a :: name
  and   y :: name
  and   x :: name
  and   P :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqy: "x  y"
  and     Eqvt: "eqvt Rel"
  and     Id: "Id  Rel"

  shows "a<y>.(x>P) ↝[Rel] x>a<y>.P"
  using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
  case(Bound b z xP)
  from z  (x, y, a, P) have "z  x" and "z  y" and "z  P" and "z  a" by simp+
  from z  a z  P have "z  a<y>.P" by(simp add: abs_fresh)
  with x>a<y>.P b«z»  xP z  x show ?case
  proof(induct rule: resCasesB)
    case(cOpen b P')
    from a<y>.P b[x]  P' have False by auto
    thus ?case by simp
  next
    case(cRes P')
    from a<y>.P b«z»  P'z  a z  y z  P show ?case
    proof(induct rule: inputCases)
      case cInput
      have "a<y>.(x>P) a<y>  (x>P)" by(rule Input)
      with z  P x  y z  x have "a<y>.(x>P) a<z>  (x>([(y, z)]  P))"
        by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh calc_atm fresh_left)
      moreover from Id have "derivative (x>([(y, z)]  P)) (x>([(y, z)]  P)) (InputS a) z Rel"
        by(rule derivativeReflexive)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α P')
  from x>a<y>.P α  P' have False by auto
  thus ?case by simp
qed

lemma resOutputLeft:
  fixes x   :: name
  and   a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqb: "x  b"
  and     Id: "Id  Rel"

  shows "x>a{b}.P ↝[Rel] a{b}.(x>P)"
using assms
by(fastforce simp add: simulation_def elim: outputCases intro: Output ResF)

lemma resOutputRight:
  fixes x   :: name
  and   a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqb: "x  b"
  and     Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a{b}.(x>P) ↝[Rel] x>a{b}.P"
using assms
by(erule_tac simCasesCont[where C=x])
  (force simp add: abs_fresh elim: resCasesB resCasesF outputCases intro: ResF Output)+

lemma resTauLeft:
  fixes x   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "x>(τ.(P)) ↝[Rel] τ.(x>P)"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)

lemma resTauRight: 
  fixes x   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id:   "Id  Rel"

  shows "τ.(x>P) ↝[Rel] x>(τ.(P))"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)

end