Theory Semantics

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

nominal_datatype ('a, 'b, 'c) boundOutput = 
  BOut "'a::fs_name" "('a, 'b::fs_name, 'c::fs_name) psi" ("_ ≺'' _" [110, 110] 110)
| BStep "«name» ('a, 'b, 'c) boundOutput"                ("⦇ν_⦈_" [110, 110] 110)

primrec BOresChain :: "name list ⇒ ('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput ⇒ 
                      ('a, 'b, 'c) boundOutput" where
  Base: "BOresChain [] B = B"
| Step: "BOresChain (x#xs) B = ⦇νx⦈(BOresChain xs B)"

abbreviation
  BOresChainJudge ("⦇ν*_⦈_" [80, 80] 80) where "⦇ν*xvec⦈B ≡ BOresChain xvec B"

lemma BOresChainEqvt[eqvt]:
  fixes perm :: "name prm"
  and   lst  :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  
  shows "perm ∙ (⦇ν*xvec⦈B) = ⦇ν*(perm ∙ xvec)⦈(perm ∙ B)"
by(induct_tac xvec, auto)

lemma BOresChainSimps[simp]:
  fixes xvec :: "name list"
  and   N    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   N'   :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   B'    :: "('a, 'b, 'c) boundOutput"

  shows "(⦇ν*xvec⦈N ≺' P = N' ≺' P') = (xvec = [] ∧ N = N' ∧ P = P')"
  and   "(N' ≺' P' = ⦇ν*xvec⦈N ≺' P) = (xvec = [] ∧ N = N' ∧ P = P')"
  and   "(N' ≺' P' = N ≺' P) = (N = N' ∧ P = P')"
  and   "(⦇ν*xvec⦈B = ⦇ν*xvec⦈B') = (B = B')"
by(induct xvec) (auto simp add: boundOutput.inject alpha)

lemma outputFresh[simp]:
  fixes Xs   :: "name set"
  and   xvec :: "name list"
  and   N    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"

  shows "(Xs ♯* (N ≺' P)) = ((Xs ♯* N) ∧ (Xs ♯* P))"
  and   "(xvec ♯* (N ≺' P)) = ((xvec ♯* N) ∧ (xvec ♯* P))"
by(auto simp add: fresh_star_def)

lemma boundOutputFresh: 
  fixes x    :: name
  and   xvec :: "name list"
  and   B   :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"

  shows "(x ♯ (⦇ν*xvec⦈B)) = (x ∈ set xvec ∨ x ♯ B)"
by (induct xvec) (simp_all add: abs_fresh)

lemma boundOutputFreshSet: 
  fixes Xs   :: "name set"
  and   xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"
  and   x    :: name

  shows "Xs ♯* (⦇ν*xvec⦈B) = (∀x∈Xs. x ∈ set xvec ∨ x ♯ B)"
  and   "yvec ♯* (⦇ν*xvec⦈B) = (∀x∈(set yvec). x ∈ set xvec ∨ x ♯ B)"
  and   "Xs ♯* (⦇νx⦈B) = Xs ♯* [x].B"
  and   "xvec ♯* (⦇νx⦈B) = xvec ♯* [x].B"
by(simp add: fresh_star_def boundOutputFresh)+

lemma BOresChainSupp:
  fixes xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"

  shows "(supp(⦇ν*xvec⦈B)::name set) = (supp B) - (supp xvec)" 
by(induct xvec)
  (auto simp add: boundOutput.supp supp_list_nil supp_list_cons abs_supp supp_atm)

lemma boundOutputFreshSimps[simp]:
  fixes Xs   :: "name set"
  and   xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"
  and   x    :: name

  shows "Xs ♯* xvec ⟹ (Xs ♯* (⦇ν*xvec⦈B)) = (Xs ♯* B)"
  and   "yvec ♯* xvec ⟹ yvec ♯* (⦇ν*xvec⦈B) = yvec ♯* B"
  and   "xvec ♯* (⦇ν*xvec⦈B)"
  and   "x ♯ xvec ⟹ x ♯ ⦇ν*xvec⦈B = x ♯ B"
apply(simp add: boundOutputFreshSet) apply(force simp add: fresh_star_def name_list_supp fresh_def)
apply(simp add: boundOutputFreshSet) apply(force simp add: fresh_star_def name_list_supp fresh_def)
apply(simp add: boundOutputFreshSet)  
by(simp add: BOresChainSupp fresh_def)

lemma boundOutputChainAlpha:
  fixes p    :: "name prm"
  and   xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"

  assumes xvecFreshB: "(p ∙ xvec) ♯* B"
  and     S: "set p ⊆ set xvec × set (p ∙ xvec)"
  and     "(set xvec) ⊆ (set yvec)"

  shows "(⦇ν*yvec⦈B) = (⦇ν*(p ∙ yvec)⦈(p ∙ B))"
proof -
  note pt_name_inst at_name_inst S
  moreover from ‹(set xvec) ⊆ (set yvec)› have "set xvec ♯* (⦇ν*yvec⦈B)"
    by(force simp add: boundOutputFreshSet)
  moreover from xvecFreshB ‹(set xvec) ⊆ (set yvec)› have "set (p ∙ xvec) ♯* (⦇ν*yvec⦈B)"
    by (simp add: boundOutputFreshSet) (simp add: fresh_star_def)
  ultimately have "(⦇ν*yvec⦈B) = p ∙ (⦇ν*yvec⦈B)"
    by (rule_tac pt_freshs_freshs [symmetric])
  then show ?thesis by(simp add: eqvts)
qed

lemma boundOutputChainAlpha':
  fixes p    :: "name prm"
  and   xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"
  and   zvec :: "name list"

  assumes xvecFreshB: "xvec ♯* B"
  and     S: "set p ⊆ set xvec × set yvec"
  and     "yvec ♯* (⦇ν*zvec⦈B)"

  shows "(⦇ν*zvec⦈B) = (⦇ν*(p ∙ zvec)⦈(p ∙ B))"
proof -
  note pt_name_inst at_name_inst S ‹yvec ♯* (⦇ν*zvec⦈B)›
  moreover from xvecFreshB have "set (xvec) ♯* (⦇ν*zvec⦈B)"
    by (simp add: boundOutputFreshSet) (simp add: fresh_star_def)
  ultimately have "(⦇ν*zvec⦈B) = p ∙ (⦇ν*zvec⦈B)"
    by (rule_tac pt_freshs_freshs [symmetric]) auto
  then show ?thesis by(simp add: eqvts)
qed

lemma boundOutputChainAlpha'':
  fixes p    :: "name prm"
  and   xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"

  assumes "(p ∙ xvec) ♯* M"
  and     "(p ∙ xvec) ♯* P"
  and      "set p ⊆ set xvec × set (p ∙ xvec)"
  and     "(set xvec) ⊆ (set yvec)"

  shows "(⦇ν*yvec⦈M ≺' P) = (⦇ν*(p ∙ yvec)⦈(p ∙ M) ≺' (p ∙ P))"
using assms
by(subst boundOutputChainAlpha) auto

lemma boundOutputChainSwap:
  fixes x    :: name
  and   y    :: name
  and   N    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   xvec :: "name list"

  assumes "y ♯ N"
  and     "y ♯ P"
  and     "x ∈ (set xvec)"

  shows "⦇ν*xvec⦈N ≺' P = ⦇ν*([(x, y)] ∙ xvec)⦈([(x ,y)] ∙ N) ≺' ([(x, y)] ∙ P)"
proof(case_tac "x=y")
  assume "x=y"
  thus ?thesis by simp
next
  assume "x ≠ y"
  with assms show ?thesis
    by(rule_tac xvec="[x]" in boundOutputChainAlpha'') (auto simp add: calc_atm)
qed

lemma alphaBoundOutput:
  fixes x  :: name
  and   y  :: name
  and   B  :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"

  assumes "y ♯ B"

  shows "⦇νx⦈B = ⦇νy⦈([(x, y)] ∙ B)"
using assms
by(auto simp add: boundOutput.inject alpha fresh_left calc_atm)

lemma boundOutputEqFresh:
  fixes B :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   C :: "('a, 'b, 'c) boundOutput"
  and   x :: name
  and   y :: name

  assumes "⦇νx⦈B = ⦇νy⦈C"
  and     "x ♯ B"
  
  shows "y ♯ C"
using assms
by(auto simp add: boundOutput.inject alpha fresh_left calc_atm)  

lemma boundOutputEqSupp:
  fixes B :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   C :: "('a, 'b, 'c) boundOutput"
  and   x :: name
  and   y :: name

  assumes "⦇νx⦈B = ⦇νy⦈C"
  and     "x ∈ supp B"
  
  shows "y ∈ supp C"
using assms
apply(auto simp add: boundOutput.inject alpha fresh_left calc_atm)
apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
by(simp add: eqvts calc_atm)

lemma boundOutputChainEq:
  fixes xvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"
  and   B'   :: "('a, 'b, 'c) boundOutput"

  assumes "⦇ν*xvec⦈B = ⦇ν*yvec⦈B'"
  and     "xvec ♯* yvec"
  and     "length xvec = length yvec"

  shows "∃p. (set p) ⊆ (set xvec) × set (yvec) ∧ distinctPerm p ∧  B = p ∙ B' ∧ (set (map fst p)) ⊆ (supp B) ∧ xvec ♯* B' ∧ yvec ♯* B"
proof -
  obtain n where "n = length xvec" by auto
  with assms show ?thesis
  proof(induct n arbitrary: xvec yvec B B')
    case(0 xvec yvec B B')
    have Eq: "⦇ν*xvec⦈B = ⦇ν*yvec⦈B'" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with ‹length xvec = length yvec› have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec B B')
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈B = ⦇ν*yvec⦈B'› ‹xvec = x # xvec'› ‹length xvec = length yvec›
    obtain y yvec' where "⦇ν*(x#xvec')⦈B = ⦇ν*(y#yvec')⦈B'"
      and "yvec = y#yvec'" and "length xvec' = length yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈B) = ⦇νy⦈(⦇ν*yvec'⦈B')"
      by simp
    from ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹xvec ♯* yvec›
    have "x ≠ y" and "xvec' ♯* yvec'" and "x ♯ yvec'" and "y ♯ xvec'"
      by auto
    have IH: "⋀xvec yvec B B'. ⟦⦇ν*xvec⦈(B::('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput) = ⦇ν*yvec⦈B'; xvec ♯* yvec; length xvec = length yvec; n = length xvec⟧ ⟹ ∃p. (set p) ⊆ (set xvec) × (set yvec) ∧ distinctPerm p ∧  B = p ∙ B' ∧ set(map fst p) ⊆ supp B ∧ xvec ♯* B' ∧ yvec ♯* B"
      by fact
    from EQ ‹x ≠ y› have EQ': "⦇ν*xvec'⦈B = ([(x, y)] ∙ (⦇ν*yvec'⦈B'))" 
                     and xFreshB': "x ♯ (⦇ν*yvec'⦈B')"
                     and yFreshB: "y ♯ (⦇ν*xvec'⦈B)"
      by(metis boundOutput.inject alpha)+
    from xFreshB' ‹x ♯ yvec'› have "x ♯ B'"
      by(auto simp add: boundOutputFresh) (simp add: fresh_def name_list_supp)+
    from yFreshB ‹y ♯ xvec'› have "y ♯ B"
      by(auto simp add: boundOutputFresh) (simp add: fresh_def name_list_supp)+
    show ?case
    proof(case_tac "x ♯ ⦇ν*xvec'⦈B")
      assume xFreshB: "x ♯ ⦇ν*xvec'⦈B"
      with EQ have yFreshB': "y ♯ ⦇ν*yvec'⦈B'"
        by(rule boundOutputEqFresh)
      with xFreshB' EQ' have "⦇ν*xvec'⦈B = ⦇ν*yvec'⦈B'" 
        by(simp)
      with ‹xvec' ♯* yvec'› ‹length xvec' = length yvec'› ‹length xvec' = n› IH
      obtain p where S: "(set p) ⊆ (set xvec') × (set yvec')" and "distinctPerm p" and "B = p ∙ B'"
                 and "set(map fst p) ⊆ supp B" and "xvec' ♯* B'"  and "yvec' ♯* B"
        by blast
      from S have "(set p) ⊆ set(x#xvec') × set(y#yvec')" by auto
      moreover note ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹distinctPerm p› ‹B = p ∙ B'›
                    ‹xvec' ♯* B'› ‹x ♯ B'› ‹x ♯ B'› ‹yvec' ♯* B› ‹y ♯ B› ‹set(map fst p) ⊆ supp B›

      ultimately show ?case by auto
    next
      assume "¬(x ♯ ⦇ν*xvec'⦈B)"
      hence xSuppB: "x ∈ supp(⦇ν*xvec'⦈B)"
        by(simp add: fresh_def)
      with EQ have ySuppB': "y ∈ supp (⦇ν*yvec'⦈B')"
        by(rule boundOutputEqSupp)
      hence "y ♯ yvec'"
        by(induct yvec') (auto simp add: boundOutput.supp abs_supp)      
      with ‹x ♯ yvec'› EQ' have "⦇ν*xvec'⦈B = ⦇ν*yvec'⦈([(x, y)] ∙ B')"
        by(simp add: eqvts)
      with  ‹xvec' ♯* yvec'› ‹length xvec' = length yvec'› ‹length xvec' = n› IH
      obtain p where S: "(set p) ⊆ (set xvec') × (set yvec')" and "distinctPerm p" and "B = p ∙ [(x, y)] ∙ B'"
                 and "set(map fst p) ⊆ supp B" and "xvec' ♯* ([(x, y)] ∙ B')" and "yvec' ♯* B" 
        by blast

      from xSuppB have "x ♯ xvec'"
        by(induct xvec') (auto simp add: boundOutput.supp abs_supp)      
      with ‹x ♯ yvec'› ‹y ♯ xvec'› ‹y ♯ yvec'› S have "x ♯ p" and "y ♯ p"
        apply(induct p)
        by(auto simp add: name_list_supp) (auto simp add: fresh_def) 
      from S have "(set ((x, y)#p)) ⊆ (set(x#xvec')) × (set(y#yvec'))"
        by force
      moreover from ‹x ≠ y› ‹x ♯ p› ‹y ♯ p› S ‹distinctPerm p›
      have "distinctPerm((x,y)#p)" by simp
      moreover from ‹B = p ∙ [(x, y)] ∙ B'› ‹x ♯ p› ‹y ♯ p› have "B = [(x, y)] ∙ p ∙ B'"
        by(subst perm_compose) simp
      hence "B = ((x, y)#p) ∙ B'" by simp
      moreover from ‹xvec' ♯* ([(x, y)] ∙ B')› have "([(x, y)] ∙ xvec') ♯* ([(x, y)] ∙ [(x, y)] ∙ B')"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ xvec'› ‹y ♯ xvec'› ‹x ♯ B'› have "(x#xvec') ♯* B'" by simp
      moreover from ‹y ♯ B› ‹yvec' ♯* B› have "(y#yvec') ♯* B" by simp
      moreover from ‹set(map fst p) ⊆ supp B› xSuppB ‹x ♯ xvec'›
      have "set(map fst ((x, y)#p)) ⊆ supp B"
        by(simp add: BOresChainSupp)
      ultimately show ?case using ‹xvec=x#xvec'› ‹yvec=y#yvec'›
        by metis
    qed
  qed
qed

lemma boundOutputChainEqLength:
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: "'a::fs_name"
  and   Q    :: "('a, 'b::fs_name, 'c::fs_name) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q"

  shows "length xvec = length yvec"
proof -
  obtain n where "n = length xvec" by auto
  with assms show ?thesis
  proof(induct n arbitrary: xvec yvec M P N Q)
    case(0 xvec yvec M P N Q)
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q› have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case by simp
  next
    case(Suc n xvec yvec M P N Q)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' Q"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)"
      by simp
    have IH: "⋀xvec yvec M P N Q. ⟦⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q::('a, 'b, 'c) psi); n = length xvec⟧ ⟹ length xvec = length yvec"
      by fact
    show ?case
    proof(case_tac "x = y")
      assume "x = y"
      with EQ have "⦇ν*xvec'⦈M ≺' P  = ⦇ν*yvec'⦈N ≺' Q"
        by(simp add: alpha boundOutput.inject)
      with IH ‹length xvec' = n› have "length xvec' = length yvec'"
        by blast
      with ‹xvec = x#xvec'› ‹yvec=y#yvec'›
      show ?case by simp
    next
      assume "x ≠ y"
      with EQ have "⦇ν*xvec'⦈M ≺' P = [(x, y)] ∙ ⦇ν*yvec'⦈N ≺' Q"
        by(simp add: alpha boundOutput.inject)
      hence "⦇ν*xvec'⦈M ≺' P = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
        by(simp add: eqvts)
      with IH ‹length xvec' = n› have "length xvec' = length ([(x, y)] ∙ yvec')"
        by blast
      hence "length xvec' = length yvec'"
        by simp
      with ‹xvec = x#xvec'› ‹yvec=y#yvec'›
      show ?case by simp
    qed
  qed
qed

lemma boundOutputChainEq':
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q"
  and     "xvec ♯* yvec"

  shows "∃p. (set p) ⊆ (set xvec) × set (yvec) ∧ distinctPerm p ∧  M = p ∙ N ∧  P = p ∙ Q ∧ xvec ♯* N ∧ xvec ♯* Q ∧ yvec ♯* M ∧ yvec ♯* P"
using assms
apply(frule_tac boundOutputChainEqLength)
apply(drule_tac boundOutputChainEq)
by(auto simp add: boundOutput.inject)

lemma boundOutputChainEq'':
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q"
  and     "xvec ♯* yvec"
  and     "distinct xvec"
  and     "distinct yvec"

  obtains p where "(set p) ⊆ (set xvec) × set (p ∙ xvec)" and "distinctPerm p" and "yvec = p ∙ xvec" and "N = p ∙ M" and "Q = p ∙ P" and "xvec ♯* N" and "xvec ♯* Q" and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* P"
proof -

  assume "⋀p. ⟦set p ⊆ set xvec × set (p ∙ xvec); distinctPerm p; yvec = p ∙ xvec; N = p ∙ M; Q = p ∙ P; xvec ♯* N; xvec ♯* Q; (p ∙ xvec) ♯* M; (p ∙ xvec) ♯* P⟧ ⟹ thesis"

  moreover obtain n where "n = length xvec" by auto
  with assms have "∃p. (set p) ⊆ (set xvec) × set (yvec) ∧ distinctPerm p ∧  yvec = p ∙ xvec ∧ N = p ∙ M ∧ Q = p ∙ P ∧ xvec ♯* N ∧ xvec ♯* Q ∧ (p ∙ xvec) ♯* M ∧ (p ∙ xvec) ♯* P"
  proof(induct n arbitrary: xvec yvec M P N Q)
    case(0 xvec yvec M P N Q)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M P N Q)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' Q"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)"
      by simp
    from ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹xvec ♯* yvec›
    have "x ≠ y" and "xvec' ♯* yvec'" and "x ♯ yvec'" and "y ♯ xvec'"
      by auto
    from ‹distinct xvec› ‹distinct yvec› ‹xvec=x#xvec'› ‹yvec=y#yvec'› have "x ♯ xvec'" and "y ♯ yvec'" and "distinct xvec'" and "distinct yvec'"
      by simp+
    have IH: "⋀xvec yvec M P N Q. ⟦⦇ν*xvec⦈(M::'a) ≺' (P::('a, 'b, 'c) psi) = ⦇ν*yvec⦈N ≺' Q; xvec ♯* yvec; distinct xvec; distinct yvec; n = length xvec⟧ ⟹ ∃p. (set p) ⊆ (set xvec) × (set yvec) ∧ distinctPerm p ∧  yvec = p ∙ xvec ∧ N = p ∙ M ∧ Q = p ∙ P ∧ xvec ♯* N ∧ xvec ♯* Q ∧ (p ∙ xvec) ♯* M ∧ (p ∙ xvec) ♯* P"
      by fact 
    from EQ ‹x ≠ y›  ‹x ♯ yvec'› ‹y ♯ yvec'› ‹y ♯ xvec'› ‹x ♯ xvec'› have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)" and "x ♯ N" and "x ♯ Q" and "y ♯ M" and "y ♯ P"
      apply -
      apply(simp add: boundOutput.inject alpha eqvts)
      apply(simp add: boundOutput.inject alpha eqvts)
      apply(simp add: boundOutput.inject alpha eqvts)
      by(simp add: boundOutput.inject alpha' eqvts)+
    with ‹xvec' ♯* yvec'› ‹distinct xvec'› ‹distinct yvec'› ‹length xvec' = n› IH
    obtain p where S: "(set p) ⊆ (set xvec') × (set yvec')" and "distinctPerm p" and "yvec' = p ∙ xvec'" and "([(x, y)] ∙ N) = p ∙ M" and "([(x, y)] ∙ Q) = p ∙ P" and "xvec' ♯* ([(x, y)] ∙ N)" and "xvec' ♯* ([(x, y)] ∙ Q)" and "yvec' ♯* M" and "yvec' ♯* P"
      by metis
    from S have "set((x, y)#p) ⊆ set(x#xvec') × set(y#yvec')" by auto
    moreover from ‹x ♯ xvec'› ‹x ♯ yvec'› ‹y ♯ xvec'› ‹y ♯ yvec'› S have "x ♯ p" and "y ♯ p"
      apply(induct p)
      by(auto simp add: fresh_prod name_list_supp) (auto simp add: fresh_def) 

    with S ‹distinctPerm p› ‹x ≠ y› have "distinctPerm((x, y)#p)" by auto
    moreover from ‹yvec' = p ∙ xvec'› ‹x ♯ p› ‹y ♯ p› ‹x ♯ xvec'› ‹y ♯ xvec'› have "(y#yvec') = ((x, y)#p) ∙ (x#xvec')"
      by(simp add: eqvts calc_atm perm_compose freshChainSimps)
    moreover from ‹([(x, y)] ∙ N) = p ∙ M›
    have "([(x, y)] ∙ [(x, y)] ∙ N) = [(x, y)] ∙ p ∙ M"
      by(simp add: pt_bij)
    hence "N = ((x, y)#p) ∙ M" by simp
    moreover from ‹([(x, y)] ∙ Q) = p ∙ P›
    have "([(x, y)] ∙ [(x, y)] ∙ Q) = [(x, y)] ∙ p ∙ P"
      by(simp add: pt_bij)
    hence "Q = ((x, y)#p) ∙ P" by simp
    moreover from ‹xvec' ♯* ([(x, y)] ∙ N)› have "([(x, y)] ∙ xvec') ♯* ([(x, y)] ∙ [(x, y)] ∙ N)"
      by(subst fresh_star_bij)
    with ‹x ♯ xvec'› ‹y ♯ xvec'› have "xvec' ♯* N" by simp
    with ‹x ♯ N› have "(x#xvec') ♯* N" by simp
    moreover from ‹xvec' ♯* ([(x, y)] ∙ Q)› have "([(x, y)] ∙ xvec') ♯* ([(x, y)] ∙ [(x, y)] ∙ Q)"
      by(subst fresh_star_bij)
    with ‹x ♯ xvec'› ‹y ♯ xvec'› have "xvec' ♯* Q" by simp
    with ‹x ♯ Q› have "(x#xvec') ♯* Q" by simp
    moreover from ‹y ♯ M› ‹yvec' ♯* M› have "(y#yvec') ♯* M" by simp
    moreover from ‹y ♯ P› ‹yvec' ♯* P› have "(y#yvec') ♯* P" by simp
    ultimately show ?case using ‹xvec=x#xvec'› ‹yvec=y#yvec'›
      by metis
  qed
  ultimately show ?thesis by blast
qed

lemma boundOutputEqSupp':
  fixes x    :: name
  and   xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   y    :: name
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"

  assumes Eq: "⦇νx⦈(⦇ν*xvec⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec⦈N ≺' Q)"
  and     "x ≠ y"
  and     "x ♯ yvec"
  and     "x ♯ xvec"
  and     "y ♯ xvec"
  and     "y ♯ yvec"
  and     "xvec ♯* yvec"
  and     "x ∈ supp M"
  
  shows "y ∈ supp N"
proof -
  from Eq ‹x ≠ y› ‹x ♯ yvec› ‹y ♯ yvec› have "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
    by(simp add: boundOutput.inject alpha eqvts)
  then obtain p where S: "set p ⊆ set xvec × set yvec" and "M = p ∙ [(x, y)] ∙ N" and "distinctPerm p" using ‹xvec ♯* yvec›
    by(blast dest: boundOutputChainEq')
  with ‹x ∈ supp M› have "x ∈ supp(p ∙ [(x, y)] ∙ N)" by simp
  hence "(p ∙ x) ∈ p ∙ supp(p ∙ [(x, y)] ∙ N)"
    by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
  with ‹x ♯ xvec› ‹x ♯ yvec› S ‹distinctPerm p› have "x ∈ supp([(x, y)] ∙ N)"
    by(simp add: eqvts)
  hence "([(x, y)] ∙ x) ∈ ([(x, y)] ∙ (supp([(x, y)] ∙ N)))"
    by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
  with ‹x ≠ y› show ?thesis by(simp add: calc_atm eqvts)
qed

lemma boundOutputChainOpenIH:
  fixes xvec :: "name list"
  and   x    :: name
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"
  and   yvec :: "name list"
  and   y    :: name
  and   B'   :: "('a, 'b, 'c) boundOutput"

  assumes Eq: "⦇ν*xvec⦈(⦇νx⦈B) = ⦇ν*yvec⦈(⦇νy⦈B')"
  and     L: "length xvec = length yvec"
  and     xFreshB': "x ♯ B'"
  and     xFreshxvec: "x ♯ xvec"
  and     xFreshyvec: "x ♯ yvec"

  shows "⦇ν*xvec⦈B = ⦇ν*yvec⦈([(x, y)] ∙ B')"
using assms
proof(induct n=="length xvec" arbitrary: xvec yvec y B' rule: nat.induct)
  case(zero xvec yvec y B')
  have "0 = length xvec" and "length xvec = length yvec" by fact+
  moreover have "⦇ν*xvec⦈⦇νx⦈B = ⦇ν*yvec⦈⦇νy⦈B'" by fact
  ultimately show ?case by(auto simp add: boundOutput.inject alpha)
next
  case(Suc n xvec yvec y B')
  have L: "length xvec = length yvec" and "Suc n = length xvec" by fact+
  then obtain x' xvec' y' yvec' where xEq: "xvec = x'#xvec'" and yEq: "yvec = y'#yvec'"
                                  and L': "length xvec' = length yvec'"
    by(cases xvec, auto, cases yvec, auto)
  have xFreshB': "x ♯ B'" by fact
  have "x ♯ xvec" and "x ♯ yvec" by fact+
  with xEq yEq have xineqx': "x ≠ x'" and xFreshxvec': "x ♯ xvec'"
                and xineqy': "x ≠ y'" and xFreshyvec': "x ♯ yvec'"
    by simp+
  have "⦇ν*xvec⦈⦇νx⦈B = ⦇ν*yvec⦈⦇νy⦈B'" by fact
  with xEq yEq have Eq: "⦇νx'⦈(⦇ν*xvec'⦈⦇νx⦈B) = ⦇νy'⦈(⦇ν*yvec'⦈⦇νy⦈B')" by simp
  have "Suc n = length xvec" by fact
  with xEq have L'': "n = length xvec'" by simp
  have "⦇νx'⦈(⦇ν*xvec'⦈B) = ⦇νy'⦈(⦇ν*yvec'⦈([(x, y)] ∙ B'))"
  proof(case_tac "x'=y'")
    assume x'eqy': "x' = y'"
    with Eq have "⦇ν*xvec'⦈⦇νx⦈B = ⦇ν*yvec'⦈⦇νy⦈B'" by(simp add: boundOutput.inject alpha)
    hence "⦇ν*xvec'⦈B = ⦇ν*yvec'⦈([(x, y)] ∙ B')" using L' xFreshB' xFreshxvec' xFreshyvec' L'' 
      by(rule_tac Suc)
    with x'eqy' show ?thesis by(simp add: boundOutput.inject alpha)
  next
    assume x'ineqy': "x' ≠ y'"
    with Eq have Eq': "⦇ν*xvec'⦈⦇νx⦈B = ⦇ν*([(x', y')] ∙ yvec')⦈⦇ν([(x', y')] ∙ y)⦈([(x', y')] ∙ B')"
             and x'FreshB': "x' ♯ ⦇ν*yvec'⦈⦇νy⦈B'"
      by(simp add: boundOutput.inject alpha eqvts)+
    from L' have "length xvec' = length ([(x', y')] ∙ yvec')" by simp
    moreover from xineqx' xineqy' xFreshB' have "x ♯ [(x', y')] ∙ B'" by(simp add: fresh_left calc_atm)
    moreover from xineqx' xineqy' xFreshyvec' have "x ♯ [(x', y')] ∙ yvec'" by(simp add: fresh_left calc_atm)
    ultimately have "⦇ν*xvec'⦈B = ⦇ν*([(x', y')] ∙ yvec')⦈([(x, ([(x', y')] ∙ y))] ∙ [(x', y')] ∙ B')" using Eq' xFreshxvec' L''
      by(rule_tac Suc)
    moreover from x'FreshB' have "x' ♯ ⦇ν*yvec'⦈([(x, y)] ∙ B')"
    proof(case_tac "x' ♯ yvec'")
      assume "x' ♯ yvec'"
      with x'FreshB' have x'FreshB': "x' ♯ ⦇νy⦈B'"
        by(simp add: fresh_def BOresChainSupp)
      show ?thesis
      proof(case_tac "x'=y")
        assume x'eqy: "x' = y"
        show ?thesis
        proof(case_tac "x=y")
          assume "x=y"
          with xFreshB' x'eqy show ?thesis by(simp add: BOresChainSupp fresh_def)
        next
          assume "x ≠ y"
          with ‹x ♯ B'› have "y ♯ [(x, y)] ∙ B'" by(simp add: fresh_left calc_atm)
          with x'eqy show ?thesis by(simp add: BOresChainSupp fresh_def)
        qed
      next
        assume x'ineqy: "x' ≠ y"
        with x'FreshB' have "x' ♯ B'" by(simp add: abs_fresh)
        with xineqx' x'ineqy have "x' ♯ ([(x, y)] ∙ B')" by(simp add: fresh_left calc_atm)
        thus ?thesis by(simp add: BOresChainSupp fresh_def)
      qed
    next
      assume "¬x' ♯ yvec'"
      thus ?thesis by(simp add: BOresChainSupp fresh_def)
    qed
    ultimately show ?thesis using x'ineqy' xineqx' xineqy'
      apply(simp add: boundOutput.inject alpha eqvts)
      apply(subst perm_compose[of "[(x', y')]"])
      by(simp add: calc_atm)
  qed
  with xEq yEq show ?case by simp
qed

lemma boundOutputPar1Dest:
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"
  and   R    :: "('a, 'b, 'c) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)"
  and     "xvec ♯* R"
  and     "yvec ♯* R"

  obtains T where "P = T ∥ R" and "⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q"
proof -
  assume "⋀T. ⟦P = T ∥ R; ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃T. P = T ∥ R ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q"
  proof(induct n arbitrary: xvec yvec M N P Q R)
    case(0 xvec yvec M N P Q R)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M N P Q R)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' (Q ∥ R)"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
      by simp
    from ‹xvec ♯* R› ‹yvec ♯* R› ‹xvec = x#xvec'› ‹yvec = y#yvec'›
    have "x ♯ R" and "xvec' ♯* R" and "y ♯ R" and "yvec' ♯* R" by auto
    show ?case
    proof(case_tac "x = y")
      assume "x = y"
      with EQ have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(simp add: boundOutput.inject alpha)
      with ‹xvec' ♯* R› ‹yvec' ♯* R› ‹length xvec' = n›
      obtain T where "P = T ∥ R" and "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈N ≺' Q"
        by(drule_tac Suc) auto
      with ‹xvec=x#xvec'› ‹yvec=y#yvec'› ‹x=y› show ?case
        by(force simp add: boundOutput.inject alpha)
    next
      assume "x ≠ y"
      with EQ ‹x ♯ R› ‹y ♯ R›
      have "⦇ν*xvec'⦈M ≺' P = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' (([(x, y)] ∙ Q) ∥ R)"
       and xFreshQR: "x ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(simp add: boundOutput.inject alpha eqvts)+
      moreover from ‹yvec' ♯* R› have "([(x, y)] ∙ yvec') ♯* ([(x, y)] ∙ R)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ R› ‹y ♯ R› have "([(x, y)] ∙ yvec') ♯* R" by simp
      moreover note ‹xvec' ♯* R› ‹length xvec' = n›
      ultimately obtain T where "P = T ∥ R" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
        by(drule_tac Suc) auto

      from A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νx⦈(⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q))"
        by(simp add: boundOutput.inject alpha)
      moreover from xFreshQR have "x ♯ ⦇ν*yvec'⦈N ≺' Q"
        by(force simp add: boundOutputFresh)
      ultimately show ?thesis using ‹P = T ∥ R› ‹xvec=x#xvec'› ‹yvec=y#yvec'› xFreshQR
        by(force simp add: alphaBoundOutput name_swap eqvts)
    qed
  qed
  ultimately show ?thesis
    by blast
qed

lemma boundOutputPar1Dest':
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"
  and   R    :: "('a, 'b, 'c) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)"
  and     "xvec ♯* yvec"

  obtains T p where "set p ⊆ set xvec × set yvec" and "P = T ∥ (p ∙ R)" and "⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q"
proof -
  assume "⋀p T. ⟦set p ⊆ set xvec × set yvec; P = T ∥ (p ∙ R); ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃p T. set p ⊆ set xvec × set yvec ∧ P = T ∥ (p ∙ R) ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q"
  proof(induct n arbitrary: xvec yvec M N P Q R)
    case(0 xvec yvec M N P Q R)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M N P Q R)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' (Q ∥ R)"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence Eq: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
      by simp
    from ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹xvec ♯* yvec› have "x ≠ y" and "x ♯ yvec'" and "y ♯ xvec'" and "xvec' ♯* yvec'"
      by auto
    from Eq ‹x ≠ y› have Eq': "⦇ν*xvec'⦈M ≺' P = [(x, y)] ∙ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
                     and xFreshQR: "x ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
      by(simp add: boundOutput.inject alpha)+
    have IH: "⋀xvec yvec M N P Q R. ⟦⦇ν*xvec⦈M ≺' (P::('a, 'b, 'c) psi) = ⦇ν*yvec⦈N ≺' (Q ∥ R);  xvec ♯* yvec; n = length xvec⟧ ⟹ ∃p T. set p ⊆ set xvec × set yvec ∧ P = T ∥ (p ∙ R) ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' Q"
      by fact
    show ?case
    proof(case_tac "x ♯ ⦇ν*xvec'⦈M ≺' P")
      assume "x ♯ ⦇ν*xvec'⦈M ≺' P"
      with Eq have yFreshQR: "y ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(rule boundOutputEqFresh)
      with Eq' xFreshQR have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by simp
      with ‹xvec' ♯* yvec'› ‹length xvec' = n›
      obtain p T where S: "set p ⊆ set xvec' × set yvec'" and "P = T ∥ (p ∙ R)" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈N ≺' Q"
        by(drule_tac IH) auto
      from yFreshQR xFreshQR have yFreshQ: "y ♯ ⦇ν*yvec'⦈N ≺' Q" and xFreshQ: "x ♯ ⦇ν*yvec'⦈N ≺' Q" 
        by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
      hence "⦇νx⦈(⦇ν*yvec'⦈N ≺' Q) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)" by (subst alphaBoundOutput) simp+
      with A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)" by simp
      with ‹xvec=x#xvec'› ‹yvec=y#yvec'› S ‹P = T ∥ (p ∙ R)› show ?case
        by auto
    next
      assume "¬(x ♯ ⦇ν*xvec'⦈M ≺' P)"
      hence "x ∈ supp(⦇ν*xvec'⦈M ≺' P)" by(simp add: fresh_def)
      with Eq have "y ∈ supp(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
        by(rule boundOutputEqSupp)
      hence "y ♯ yvec'" by(simp add: BOresChainSupp fresh_def)
      with Eq' ‹x ♯ yvec'› have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' (([(x, y)] ∙ Q) ∥ ([(x, y)] ∙ R))"
        by(simp add: eqvts)
      moreover note ‹xvec' ♯* yvec'› ‹length xvec' = n›
      ultimately obtain p T where S: "set p ⊆ set xvec' × set yvec'" and "P = T ∥ (p ∙ [(x, y)] ∙ R)" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
        by(drule_tac IH) auto

      from S have "set(p@[(x, y)]) ⊆ set(x#xvec') × set(y#yvec')" by auto
      moreover from ‹P = T ∥ (p ∙ [(x, y)] ∙ R)›  have "P = T ∥ ((p @ [(x, y)]) ∙ R)"
        by(simp add: pt2[OF pt_name_inst])
      moreover from xFreshQR have xFreshQ: "x ♯ ⦇ν*yvec'⦈N ≺' Q" 
        by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
      with ‹x ♯ yvec'› ‹y ♯ yvec'› ‹x ≠ y› have "y ♯ ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
        by(simp add: fresh_left calc_atm)
      with ‹x ♯ yvec'› ‹y ♯ yvec'› have "⦇νx⦈(⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)"
        by(subst alphaBoundOutput) (assumption | simp add: eqvts)+
      with  A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' Q)" by simp
      ultimately show ?thesis using ‹xvec=x#xvec'› ‹yvec=y#yvec'›
        by(rule_tac x="p@[(x, y)]" in exI) force
    qed
  qed
  ultimately show ?thesis
    by blast
qed

lemma boundOutputPar2Dest:
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"
  and   R    :: "('a, 'b, 'c) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)"
  and     "xvec ♯* Q"
  and     "yvec ♯* Q"

  obtains T where "P = Q ∥ T" and "⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
proof -
  assume "⋀T. ⟦P = Q ∥ T; ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃T. P = Q ∥ T ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
  proof(induct n arbitrary: xvec yvec M N P Q R)
    case(0 xvec yvec M N P Q R)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M N P Q R)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' (Q ∥ R)"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
      by simp
    from ‹xvec ♯* Q› ‹yvec ♯* Q› ‹xvec = x#xvec'› ‹yvec = y#yvec'›
    have "x ♯ Q" and "xvec' ♯* Q" and "y ♯ Q" and "yvec' ♯* Q" by auto
    have IH: "⋀xvec yvec M N P Q R. ⟦⦇ν*xvec⦈M ≺' (P::('a, 'b, 'c) psi) = ⦇ν*yvec⦈N ≺' (Q ∥ R); xvec ♯* Q; yvec ♯* Q; n = length xvec⟧ ⟹ ∃T. P = Q ∥ T ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
      by fact
    show ?case
    proof(case_tac "x = y")
      assume "x = y"
      with EQ have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(simp add: boundOutput.inject alpha)
      with ‹xvec' ♯* Q› ‹yvec' ♯* Q› ‹length xvec' = n›
      obtain T where "P = Q ∥ T" and "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈N ≺' R"
        by(drule_tac IH) auto
      with ‹xvec=x#xvec'› ‹yvec=y#yvec'› ‹x=y› show ?case
        by(force simp add: boundOutput.inject alpha)
    next
      assume "x ≠ y"
      with EQ ‹x ♯ Q› ‹y ♯ Q›
      have "⦇ν*xvec'⦈M ≺' P = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' (Q ∥ ([(x, y)] ∙ R))"
       and xFreshQR: "x ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(simp add: boundOutput.inject alpha eqvts)+
      moreover from ‹yvec' ♯* Q› have "([(x, y)] ∙ yvec') ♯* ([(x, y)] ∙ Q)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ Q› ‹y ♯ Q› have "([(x, y)] ∙ yvec') ♯* Q" by simp
      moreover note ‹xvec' ♯* Q› ‹length xvec' = n›
      ultimately obtain T where "P = Q ∥ T" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ R)"
        by(drule_tac IH) auto

      from A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νx⦈(⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ R))"
        by(simp add: boundOutput.inject alpha)
      moreover from xFreshQR have "x ♯ ⦇ν*yvec'⦈N ≺' R"
        by(force simp add: boundOutputFresh)
      ultimately show ?thesis using ‹P = Q ∥ T› ‹xvec=x#xvec'› ‹yvec=y#yvec'› xFreshQR
        by(force simp add: alphaBoundOutput name_swap eqvts)
    qed
  qed
  ultimately show ?thesis
    by blast
qed

lemma boundOutputPar2Dest':
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"
  and   R    :: "('a, 'b, 'c) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)"
  and     "xvec ♯* yvec"

  obtains T p where "set p ⊆ set xvec × set yvec" and "P = (p ∙ Q) ∥ T" and "⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
proof -
  assume "⋀p T. ⟦set p ⊆ set xvec × set yvec; P = (p ∙ Q) ∥ T; ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃p T. set p ⊆ set xvec × set yvec ∧ P = (p ∙ Q) ∥ T ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
  proof(induct n arbitrary: xvec yvec M N P Q R)
    case(0 xvec yvec M N P Q R)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M N P Q R)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (Q ∥ R)› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' (Q ∥ R)"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence Eq: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
      by simp
    from ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹xvec ♯* yvec› have "x ≠ y" and "x ♯ yvec'" and "y ♯ xvec'" and "xvec' ♯* yvec'"
      by auto
    from Eq ‹x ≠ y› have Eq': "⦇ν*xvec'⦈M ≺' P = [(x, y)] ∙ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
                     and xFreshQR: "x ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
      by(simp add: boundOutput.inject alpha)+
    have IH: "⋀xvec yvec M N P Q R. ⟦⦇ν*xvec⦈M ≺' (P::('a, 'b, 'c) psi) = ⦇ν*yvec⦈N ≺' (Q ∥ R);  xvec ♯* yvec; n = length xvec⟧ ⟹ ∃p T. set p ⊆ set xvec × set yvec ∧ P = (p ∙ Q) ∥ T ∧ ⦇ν*xvec⦈M ≺' T = ⦇ν*yvec⦈N ≺' R"
      by fact
    show ?case
    proof(case_tac "x ♯ ⦇ν*xvec'⦈M ≺' P")
      assume "x ♯ ⦇ν*xvec'⦈M ≺' P"
      with Eq have yFreshQR: "y ♯ ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by(rule boundOutputEqFresh)
      with Eq' xFreshQR have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈N ≺' (Q ∥ R)"
        by simp
      with ‹xvec' ♯* yvec'› ‹length xvec' = n›
      obtain p T where S: "set p ⊆ set xvec' × set yvec'" and "P = (p ∙ Q) ∥ T" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈N ≺' R"
        by(drule_tac IH) auto
      from yFreshQR xFreshQR have yFreshR: "y ♯ ⦇ν*yvec'⦈N ≺' R" and xFreshQ: "x ♯ ⦇ν*yvec'⦈N ≺' R" 
        by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
      hence "⦇νx⦈(⦇ν*yvec'⦈N ≺' R) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' R)" by (subst alphaBoundOutput) simp+
      with A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' R)" by simp
      with ‹xvec=x#xvec'› ‹yvec=y#yvec'› S ‹P = (p ∙ Q) ∥ T› show ?case
        by auto
    next
      assume "¬(x ♯ ⦇ν*xvec'⦈M ≺' P)"
      hence "x ∈ supp(⦇ν*xvec'⦈M ≺' P)" by(simp add: fresh_def)
      with Eq have "y ∈ supp(⦇ν*yvec'⦈N ≺' (Q ∥ R))"
        by(rule boundOutputEqSupp)
      hence "y ♯ yvec'" by(simp add: BOresChainSupp fresh_def)
      with Eq' ‹x ♯ yvec'› have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' (([(x, y)] ∙ Q) ∥ ([(x, y)] ∙ R))"
        by(simp add: eqvts)
      moreover note ‹xvec' ♯* yvec'› ‹length xvec' = n›
      ultimately obtain p T where S: "set p ⊆ set xvec' × set yvec'" and "P = (p ∙ [(x, y)] ∙ Q) ∥ T" and A: "⦇ν*xvec'⦈M ≺' T = ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ R)"
        by(drule_tac IH) auto

      from S have "set(p@[(x, y)]) ⊆ set(x#xvec') × set(y#yvec')" by auto
      moreover from ‹P = (p ∙ [(x, y)] ∙ Q) ∥ T›  have "P = ((p @ [(x, y)]) ∙ Q) ∥ T"
        by(simp add: pt2[OF pt_name_inst])
      moreover from xFreshQR have xFreshR: "x ♯ ⦇ν*yvec'⦈N ≺' R" 
        by(force simp add: BOresChainSupp fresh_def boundOutput.supp psi.supp)+
      with ‹x ♯ yvec'› ‹y ♯ yvec'› ‹x ≠ y› have "y ♯ ⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ R)"
        by(simp add: fresh_left calc_atm)
      with ‹x ♯ yvec'› ‹y ♯ yvec'› have "⦇νx⦈(⦇ν*yvec'⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ R)) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' R)"
        by(subst alphaBoundOutput) (assumption | simp add: eqvts)+
      with  A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' T) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' R)" by simp
      ultimately show ?thesis using ‹xvec=x#xvec'› ‹yvec=y#yvec'›
        by(rule_tac x="p@[(x, y)]" in exI) force
    qed
  qed
  ultimately show ?thesis
    by blast
qed

lemma boundOutputApp:
  fixes xvec :: "name list"
  and   yvec :: "name list"
  and   B    :: "('a::fs_name, 'b::fs_name, 'c::fs_name) boundOutput"

  shows "⦇ν*(xvec@yvec)⦈B = ⦇ν*xvec⦈(⦇ν*yvec⦈B)"
by(induct xvec) auto
  
lemma openInjectAuxAuxAux:
  fixes x    :: name
  and   xvec :: "name list"

  shows "∃y yvec. x # xvec = yvec @ [y] ∧ length xvec = length yvec"
apply(induct xvec arbitrary: x)
apply auto
apply(subgoal_tac "∃y yvec. a # xvec = yvec @ [y] ∧ length xvec = length yvec")
apply(clarify)
apply(rule_tac x=y in exI)
by auto

lemma openInjectAuxAux:
  fixes xvec1 :: "name list"
  and   xvec2 :: "name list"
  and   yvec  :: "name list"

  assumes "length(xvec1@xvec2) = length yvec"

  shows "∃yvec1 yvec2. yvec = yvec1@yvec2 ∧ length xvec1 = length yvec1 ∧ length xvec2 = length yvec2"
using assms
apply(induct yvec arbitrary: xvec1)
apply simp
apply simp
apply(case_tac xvec1)
apply simp
apply simp
apply(subgoal_tac "∃yvec1 yvec2.
                   yvec = yvec1 @ yvec2 ∧ length list = length yvec1 ∧ length xvec2 = length yvec2")
apply(clarify)
apply(rule_tac x="a#yvec1" in exI)
apply(rule_tac x=yvec2 in exI)
by auto

lemma openInjectAux:
  fixes xvec1 :: "name list"
  and   x     :: name
  and   xvec2 :: "name list"
  and   yvec  :: "name list"

  assumes "length(xvec1@x#xvec2) = length yvec"

  shows "∃yvec1 y yvec2. yvec = yvec1@y#yvec2 ∧ length xvec1 = length yvec1 ∧ length xvec2 = length yvec2"
using assms
apply(case_tac yvec)
apply simp
apply simp
apply(subgoal_tac "∃(yvec1::name list) (yvec2::name list). yvec1@yvec2 = list ∧ length xvec1 = length yvec1 ∧ length xvec2 = length yvec2")
apply(clarify)
apply hypsubst_thin
apply simp
apply(subgoal_tac "∃y (yvec::name list). a # yvec1 = yvec @ [y] ∧ length yvec1 = length yvec")
apply(clarify)
apply(rule_tac x=yvec in exI)
apply(rule_tac x=y in exI)
apply simp
apply(rule_tac x=yvec2 in exI)
apply simp
apply(rule openInjectAuxAuxAux)
apply(insert openInjectAuxAux)
apply simp
by blast

lemma boundOutputOpenDest:
  fixes yvec  :: "name list"
  and   M     :: "'a::fs_name"
  and   P     :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   xvec1 :: "name list"
  and   x     :: name
  and   xvec2 :: "name list"
  and   N     :: 'a
  and   Q     :: "('a, 'b, 'c) psi"

  assumes Eq: "⦇ν*(xvec1@x#xvec2)⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q"
  and     "x ♯ xvec1"
  and     "x ♯ yvec"
  and     "x ♯ N"
  and     "x ♯ Q"
  and     "distinct yvec"
  

  obtains yvec1 y yvec2 where "yvec=yvec1@y#yvec2" and "length xvec1 = length yvec1" and "length xvec2 = length yvec2" 
                          and "⦇ν*(xvec1@xvec2)⦈M ≺' P = ⦇ν*(yvec1@yvec2)⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
proof -
  assume Ass: "⋀yvec1 y yvec2.
        ⟦yvec = yvec1 @ y # yvec2; length xvec1 = length yvec1; length xvec2 = length yvec2;
         ⦇ν*(xvec1 @ xvec2)⦈M ≺' P = ⦇ν*(yvec1 @ yvec2)⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)⟧
        ⟹ thesis"
  from Eq have "length(xvec1@x#xvec2) = length yvec" by(rule boundOutputChainEqLength)
  then obtain yvec1 y yvec2 where A: "yvec = yvec1@y#yvec2" and "length xvec1 = length yvec1"
          and "length xvec2 = length yvec2"
    by(metis openInjectAux sym)

  from ‹distinct yvec› A have "y ♯ yvec2" by simp
  from A ‹x ♯ yvec› have "x ♯ yvec2" and "x ♯ yvec1"  by simp+
  with Eq ‹length xvec1 = length yvec1› ‹x ♯ N› ‹x ♯ Q› ‹y ♯ yvec2› ‹x ♯ xvec1› A
  have "⦇ν*(xvec1@xvec2)⦈M ≺' P = ⦇ν*(yvec1@yvec2)⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
    by(force dest: boundOutputChainOpenIH simp add: boundOutputApp BOresChainSupp fresh_def boundOutput.supp eqvts)
  with ‹length xvec1 = length yvec1› ‹length xvec2 = length yvec2› A Ass show ?thesis
    by blast
qed

lemma boundOutputOpenDest':
  fixes yvec  :: "name list"
  and   M     :: "'a::fs_name"
  and   P     :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   xvec1 :: "name list"
  and   x     :: name
  and   xvec2 :: "name list"
  and   N     :: 'a
  and   Q     :: "('a, 'b, 'c) psi"

  assumes Eq: "⦇ν*(xvec1@x#xvec2)⦈M ≺' P = ⦇ν*yvec⦈N ≺' Q"
  and     "x ♯ xvec1"
  and     "x ♯ yvec"
  and     "x ♯ N"
  and     "x ♯ Q"
  

  obtains yvec1 y yvec2 where "yvec=yvec1@y#yvec2" and "length xvec1 = length yvec1" and "length xvec2 = length yvec2" 
                          and "⦇ν*(xvec1@xvec2)⦈M ≺' P = ⦇ν*(yvec1@[(x, y)] ∙ yvec2)⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
proof -
  assume Ass: "⋀yvec1 y yvec2.
        ⟦yvec = yvec1 @ y # yvec2; length xvec1 = length yvec1; length xvec2 = length yvec2;
         ⦇ν*(xvec1 @ xvec2)⦈M ≺' P = ⦇ν*(yvec1 @ ([(x, y)] ∙ yvec2))⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)⟧
        ⟹ thesis"
  from Eq have "length(xvec1@x#xvec2) = length yvec" by(rule boundOutputChainEqLength)
  then obtain yvec1 y yvec2 where A: "yvec = yvec1@y#yvec2" and "length xvec1 = length yvec1"
          and "length xvec2 = length yvec2"
    by(metis openInjectAux sym)

  from A ‹x ♯ yvec› have "x ♯ yvec2" and "x ♯ yvec1"  by simp+
  with Eq ‹length xvec1 = length yvec1› ‹x ♯ N› ‹x ♯ Q› ‹x ♯ xvec1› A
  have "⦇ν*(xvec1@xvec2)⦈M ≺' P = ⦇ν*(yvec1@([(x, y)] ∙ yvec2))⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
    by(force dest: boundOutputChainOpenIH simp add: boundOutputApp BOresChainSupp fresh_def boundOutput.supp eqvts)
  with ‹length xvec1 = length yvec1› ‹length xvec2 = length yvec2› A Ass show ?thesis
    by blast
qed

lemma boundOutputScopeDest:
  fixes xvec :: "name list"
  and   M    :: "'a::fs_name"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   yvec :: "name list"
  and   N    :: 'a
  and   x    :: name
  and   Q    :: "('a, 'b, 'c) psi"

  assumes "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' ⦇νz⦈Q"
  and     "z ♯ xvec"
  and     "z ♯ yvec"

  obtains R where "P = ⦇νz⦈R" and "⦇ν*xvec⦈M ≺' R = ⦇ν*yvec⦈N ≺' Q"
proof -
  assume "⋀R. ⟦P = ⦇νz⦈R; ⦇ν*xvec⦈M ≺' R = ⦇ν*yvec⦈N ≺' Q⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃R. P = ⦇νz⦈R ∧ ⦇ν*xvec⦈M ≺' R = ⦇ν*yvec⦈N ≺' Q"
  proof(induct n arbitrary: xvec yvec M N P Q z)
    case(0 xvec yvec M N P Q z)
    have Eq: "⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' ⦇νz⦈Q" by fact
    from ‹0 = length xvec› have "xvec = []" by auto
    moreover with Eq have "yvec = []"
      by(case_tac yvec) auto
    ultimately show ?case using Eq
      by(simp add: boundOutput.inject)
  next
    case(Suc n xvec yvec M N P Q z)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹⦇ν*xvec⦈M ≺' P = ⦇ν*yvec⦈N ≺' (⦇νz⦈Q)› ‹xvec = x # xvec'›
    obtain y yvec' where "⦇ν*(x#xvec')⦈M ≺' P = ⦇ν*(y#yvec')⦈N ≺' ⦇νz⦈Q"
      and "yvec = y#yvec'"
      by(case_tac yvec) auto
    hence EQ: "⦇νx⦈(⦇ν*xvec'⦈M ≺' P) = ⦇νy⦈(⦇ν*yvec'⦈N ≺' ⦇νz⦈Q)"
      by simp
    from ‹z ♯ xvec› ‹z ♯ yvec› ‹xvec = x#xvec'› ‹yvec = y#yvec'›
    have "z ≠ x" and "z ≠ y" and "z ♯ xvec'" and "z ♯ yvec'"
      by simp+
    have IH: "⋀xvec yvec M N P Q z. ⟦⦇ν*xvec⦈M ≺' (P::('a, 'b, 'c) psi) = ⦇ν*yvec⦈N ≺' ⦇νz⦈Q; z ♯ xvec; z ♯ yvec; n = length xvec⟧ ⟹ ∃R. P = ⦇νz⦈R ∧ ⦇ν*xvec⦈M ≺' R = ⦇ν*yvec⦈N ≺' Q"
      by fact
    show ?case
    proof(case_tac "x = y")
      assume "x = y"
      with EQ have "⦇ν*xvec'⦈M ≺' P = ⦇ν*yvec'⦈N ≺' ⦇νz⦈Q"
        by(simp add: boundOutput.inject alpha)
      with ‹z ♯ xvec'› ‹z ♯ yvec'› ‹length xvec' = n›
      obtain R where "P = ⦇νz⦈R" and "⦇ν*xvec'⦈M ≺' R = ⦇ν*yvec'⦈N ≺' Q"
        by(drule_tac IH) auto
      with ‹xvec=x#xvec'› ‹yvec=y#yvec'› ‹x=y› show ?case
        by(force simp add: boundOutput.inject alpha)
    next
      assume "x ≠ y"
      with EQ ‹z ≠ x› ‹z ≠ y›
      have "⦇ν*xvec'⦈M ≺' P = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ⦇νz⦈([(x, y)] ∙ Q)"
       and xFreshzQ: "x ♯ ⦇ν*yvec'⦈N ≺' ⦇νz⦈Q"
        by(simp add: boundOutput.inject alpha eqvts)+
      moreover from ‹z ≠ x› ‹z ≠ y› ‹z ♯ yvec'› ‹x ≠ y› have "z ♯ ([(x, y)] ∙ yvec')"
        by(simp add: fresh_left calc_atm)
      moreover note ‹z ♯ xvec'› ‹length xvec' = n›
      ultimately obtain R where "P = ⦇νz⦈R" and A: "⦇ν*xvec'⦈M ≺' R = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q)"
        by(drule_tac IH) auto

      from A have "⦇νx⦈(⦇ν*xvec'⦈M ≺' R) = ⦇νx⦈(⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ N) ≺' ([(x, y)] ∙ Q))"
        by(simp add: boundOutput.inject alpha)
      moreover from xFreshzQ ‹z ≠ x› have "x ♯ ⦇ν*yvec'⦈N ≺' Q"
        by(simp add: boundOutputFresh abs_fresh)
      ultimately show ?thesis using ‹P = ⦇νz⦈R› ‹xvec=x#xvec'› ‹yvec=y#yvec'› xFreshzQ
        by(force simp add: alphaBoundOutput name_swap eqvts)
    qed
  qed
  ultimately show ?thesis
    by blast
qed

nominal_datatype ('a, 'b, 'c) residual = 
  RIn "'a::fs_name" 'a "('a, 'b::fs_name, 'c::fs_name) psi" 
| ROut 'a "('a, 'b, 'c) boundOutput"
| RTau "('a, 'b, 'c) psi"

nominal_datatype 'a action = In "'a::fs_name" 'a      ("_⦇_⦈" [90, 90] 90)
                   | Out "'a::fs_name" "name list" 'a ("_⦇ν*_⦈⟨_⟩" [90, 90, 90] 90)
                   | Tau                              ("τ" 90)

nominal_primrec bn :: "('a::fs_name) action ⇒ name list"
  where
  "bn (M⦇N⦈) = []"
| "bn (M⦇ν*xvec⦈⟨N⟩) = xvec"
| "bn (τ) = []"
by(rule TrueI)+

lemma bnEqvt[eqvt]:
  fixes p :: "name prm"
  and   α :: "('a::fs_name) action"

  shows "(p ∙ bn α) = bn(p ∙ α)"
by(nominal_induct α rule: action.strong_induct) auto

nominal_primrec create_residual :: "('a::fs_name) action ⇒ ('a, 'b::fs_name, 'c::fs_name) psi ⇒ ('a, 'b, 'c) residual" ("_ ≺ _" [80, 80] 80)
where 
  "(M⦇N⦈) ≺ P = RIn M N P"
| "M⦇ν*xvec⦈⟨N⟩ ≺ P = ROut M (⦇ν*xvec⦈(N ≺' P))"
| "τ ≺ P = (RTau P)"
by(rule TrueI)+

nominal_primrec subject :: "('a::fs_name) action ⇒ 'a option" 
  where 
  "subject (M⦇N⦈) = Some M"
| "subject (M⦇ν*xvec⦈⟨N⟩) = Some M"
| "subject (τ) = None"
by(rule TrueI)+

nominal_primrec object :: "('a::fs_name) action ⇒ 'a option" 
  where 
  "object (M⦇N⦈) = Some N"
| "object (M⦇ν*xvec⦈⟨N⟩) = Some N"
| "object (τ) = None"
by(rule TrueI)+

lemma optionFreshChain[simp]:
  fixes xvec :: "name list"
  and   X    :: "name set"

  shows "xvec ♯* (Some x) = xvec ♯* x"
  and   "X ♯* (Some x) = X ♯* x"
  and   "xvec ♯* None"
  and   "X ♯* None"
by(auto simp add: fresh_star_def fresh_some fresh_none)

lemmas [simp] = fresh_some fresh_none
  
lemma actionFresh[simp]:
  fixes x :: name
  and   α :: "('a::fs_name) action"

  shows "(x ♯ α)  = (x ♯ (subject α) ∧ x ♯ (bn α) ∧ x ♯ (object α))"
by(nominal_induct α rule: action.strong_induct) auto
  
lemma actionFreshChain[simp]:
  fixes X    :: "name set"
  and   α    :: "('a::fs_name) action"
  and   xvec :: "name list"

  shows "(X ♯* α) = (X ♯* (subject α) ∧ X ♯* (bn α) ∧ X ♯* (object α))"
  and   "(xvec ♯* α) = (xvec ♯* (subject α) ∧ xvec ♯* (bn α) ∧ xvec ♯* (object α))"
by(auto simp add: fresh_star_def)

lemma subjectEqvt[eqvt]:
  fixes p :: "name prm"
  and   α :: "('a::fs_name) action"

  shows "(p ∙ subject α) = subject(p ∙ α)"
by(nominal_induct α rule: action.strong_induct) auto

lemma okjectEqvt[eqvt]:
  fixes p :: "name prm"
  and   α :: "('a::fs_name) action"

  shows "(p ∙ object α) = object(p ∙ α)"
by(nominal_induct α rule: action.strong_induct) auto

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

  shows "(p ∙ (α ≺ P)) = (p ∙ α) ≺ (p ∙ P)"
by(nominal_induct α rule: action.strong_induct)
  (auto simp add: eqvts)

lemma residualFresh:
  fixes x :: name
  and   α :: "'a::fs_name action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"

  shows "(x ♯ (α ≺ P)) = (x ♯ (subject α) ∧ (x ∈ (set(bn(α))) ∨ (x ♯ object(α) ∧ x ♯ P)))"
by(nominal_induct α rule: action.strong_induct)
  (auto simp add: fresh_some fresh_none boundOutputFresh)

lemma residualFresh2[simp]:
  fixes x :: name
  and   α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"

  assumes "x ♯ α"
  and     "x ♯ P"

  shows "x ♯ α ≺ P"
using assms
by(nominal_induct α rule: action.strong_induct) auto

lemma residualFreshChain2[simp]:
  fixes xvec :: "name list"
  and   X    :: "name set"
  and   α    :: "('a::fs_name) action"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"

  shows "⟦xvec ♯* α; xvec ♯* P⟧ ⟹ xvec ♯* (α ≺ P)"
  and   "⟦X ♯* α; X ♯* P⟧ ⟹ X ♯* (α ≺ P)"
by(auto simp add: fresh_star_def)

lemma residualFreshSimp[simp]:
  fixes x :: name
  and   M :: "'a::fs_name"
  and   N :: 'a
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  

  shows "x ♯ (M⦇N⦈ ≺ P) = (x ♯ M ∧ x ♯ N ∧ x ♯ P)"
  and   "x ♯ (M⦇ν*xvec⦈⟨N⟩ ≺ P) = (x ♯ M ∧ x ♯ (⦇ν*xvec⦈(N ≺' P)))"
  and   "x ♯ (τ ≺ P) = (x ♯ P)"
by(auto simp add: residualFresh)

lemma residualInject':

  shows "(α ≺ P = RIn M N Q) = (P = Q ∧ α = M⦇N⦈)"
  and   "(α ≺ P = ROut M B) = (∃xvec N. α = M⦇ν*xvec⦈⟨N⟩ ∧ B = ⦇ν*xvec⦈(N ≺' P))"
  and   "(α ≺ P = RTau Q) = (α = τ ∧ P = Q)"
  and   "(RIn M N Q = α ≺ P) = (P = Q ∧ α = M⦇N⦈)"
  and   "(ROut M B = α ≺ P) = (∃xvec N. α = M⦇ν*xvec⦈⟨N⟩ ∧ B = ⦇ν*xvec⦈(N ≺' P))"
  and   "(RTau Q = α ≺ P) = (α = τ ∧ P = Q)"
proof -
  show "(α ≺ P = RIn M N Q) = (P = Q ∧ α = M⦇N⦈)"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
next
  show "(α ≺ P = ROut M B) = (∃xvec N. α = M⦇ν*xvec⦈⟨N⟩ ∧ B = ⦇ν*xvec⦈(N ≺' P))"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
next
  show  "(α ≺ P = RTau Q) = (α = τ ∧ P = Q)"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
next
  show "(RIn M N Q = α ≺ P) = (P = Q ∧ α = M⦇N⦈)"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
next
  show "(ROut M B = α ≺ P) = (∃xvec N. α = M⦇ν*xvec⦈⟨N⟩ ∧ B = ⦇ν*xvec⦈(N ≺' P))"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
next
  show  "(RTau Q = α ≺ P) = (α = τ ∧ P = Q)"
    by(nominal_induct α rule: action.strong_induct)
      (auto simp add: residual.inject action.inject)
qed

lemma residualFreshChainSimp[simp]:
  fixes xvec :: "name list"
  and   X    :: "name set"
  and   M    :: "'a::fs_name"
  and   N    :: 'a
  and   yvec :: "name list"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"

  shows "xvec ♯* (M⦇N⦈ ≺ P) = (xvec ♯* M ∧ xvec ♯* N ∧ xvec ♯* P)"
  and   "xvec ♯* (M⦇ν*yvec⦈⟨N⟩ ≺ P) = (xvec ♯* M ∧ xvec ♯* (⦇ν*yvec⦈(N ≺' P)))"
  and   "xvec ♯* (τ ≺ P) = (xvec ♯* P)"
  and   "X ♯* (M⦇N⦈ ≺ P) = (X ♯* M ∧ X ♯* N ∧ X ♯* P)"
  and   "X ♯* (M⦇ν*yvec⦈⟨N⟩ ≺ P) = (X ♯* M ∧ X ♯* (⦇ν*yvec⦈(N ≺' P)))"
  and   "X ♯* (τ ≺ P) = (X ♯* P)"
by(auto simp add: fresh_star_def)

lemma residualFreshChainSimp2[simp]:
  fixes xvec :: "name list"
  and   X    :: "name set"
  and   M    :: "'a::fs_name"
  and   N    :: 'a
  and   yvec :: "name list"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"

  shows "xvec ♯* (RIn M N P) = (xvec ♯* M ∧ xvec ♯* N ∧ xvec ♯* P)"
  and   "xvec ♯* (ROut M B) = (xvec ♯* M ∧ xvec ♯* B)"
  and   "xvec ♯* (RTau P) = (xvec ♯* P)"
  and   "X ♯* (RIn M N P) = (X ♯* M ∧ X ♯* N ∧ X ♯* P)"
  and   "X ♯* (ROut M B) = (X ♯* M ∧ X ♯* B)"
  and   "X ♯* (RTau P) = (X ♯* P)"
by(auto simp add: fresh_star_def)

lemma freshResidual3[dest]:
  fixes x :: name
  and   α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  
  assumes "x ♯ bn α"
  and     "x ♯ α ≺ P"

  shows "x ♯ α" and "x ♯ P"
using assms
by(nominal_induct rule: action.strong_induct) auto

lemma freshResidualChain3[dest]:
  fixes xvec :: "name list"
  and   α    :: "('a::fs_name) action"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  
  assumes "xvec ♯* (α ≺ P)"
  and     "xvec ♯* bn α"

  shows "xvec ♯* α" and "xvec ♯* P"
using assms
by(nominal_induct rule: action.strong_induct) auto

lemma freshResidual4[dest]:
  fixes x :: name
  and   α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  
  assumes "x ♯ α ≺ P"

  shows "x ♯ subject α"
using assms
by(nominal_induct rule: action.strong_induct) auto

lemma freshResidualChain4[dest]:
  fixes xvec :: "name list"
  and   α    :: "('a::fs_name) action"
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  
  assumes "xvec ♯* (α ≺ P)"

  shows "xvec ♯* subject α"
using assms
by(nominal_induct rule: action.strong_induct) auto

lemma alphaOutputResidual:
  fixes M    :: "'a::fs_name"
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   p    :: "name prm"

  assumes "(p ∙ xvec) ♯* N"
  and     "(p ∙ xvec) ♯* P"
  and     "set p ⊆ set xvec × set(p ∙ xvec)"
  and     "set xvec ⊆ set yvec"

  shows "M⦇ν*yvec⦈⟨N⟩ ≺ P = M⦇ν*(p ∙ yvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ P)"
using assms
by(simp add: boundOutputChainAlpha'')

lemmas[simp del] =  create_residual.simps

lemma residualInject'':

  assumes "bn α = bn β"

  shows "(α ≺ P = β ≺ Q) = (α = β ∧ P = Q)"
using assms
apply(nominal_induct α rule: action.strong_induct)
apply(auto simp add: residual.inject create_residual.simps residualInject' action.inject boundOutput.inject)
by(rule_tac x="bn β" in exI) auto

lemmas residualInject = residual.inject create_residual.simps residualInject' residualInject''

lemma bnFreshResidual[simp]:
  fixes α :: "('a::fs_name) action"

  shows "(bn α) ♯* (α ≺ P) = bn α ♯* (subject α)"
by(nominal_induct α rule: action.strong_induct)
  (auto simp add: residualFresh fresh_some fresh_star_def)

lemma actionCases[case_names cInput cOutput cTau]:
  fixes α :: "('a::fs_name) action"

  assumes "⋀M N. α = M⦇N⦈ ⟹ Prop"
  and     "⋀M xvec N. α = M⦇ν*xvec⦈⟨N⟩ ⟹ Prop"
  and     "α = τ ⟹ Prop"

  shows Prop
using assms
by(nominal_induct α rule: action.strong_induct) auto

lemma actionPar1Dest:
  fixes α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   β :: "('a::fs_name) action"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ (Q ∥ R)"
  and     "bn α ♯* bn β"

  obtains T p where "set p ⊆ set(bn α) × set(bn β)" and "P = T ∥ (p ∙ R)" and "α ≺ T = β ≺ Q"
using assms
apply(cases rule: actionCases[where α=α])
apply(auto simp add: residualInject)
by(drule_tac boundOutputPar1Dest') auto

lemma actionPar2Dest:
  fixes α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   β :: "('a::fs_name) action"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ (Q ∥ R)"
  and     "bn α ♯* bn β"

  obtains T p where "set p ⊆ set(bn α) × set(bn β)" and "P = (p ∙ Q) ∥ T" and "α ≺ T = β ≺ R"
using assms
apply(cases rule: actionCases[where α=α])
apply(auto simp add: residualInject)
by(drule_tac boundOutputPar2Dest') auto

lemma actionScopeDest:
  fixes α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  fixes β :: "('a::fs_name) action"
  and   x :: name
  and   Q :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ ⦇νx⦈Q"
  and     "x ♯ bn α"
  and     "x ♯ bn β"

  obtains R where "P = ⦇νx⦈R" and "α ≺ R = β ≺ Q"
using assms
apply(cases rule: actionCases[where α=α])
apply(auto simp add: residualInject)
by(drule_tac boundOutputScopeDest) auto

abbreviation
  outputJudge ("_⟨_⟩" [110, 110] 110) where "M⟨N⟩ ≡ M⦇ν*([])⦈⟨N⟩"

declare [[unify_trace_bound=100]]

locale env = substPsi substTerm substAssert substCond + 
             assertion SCompose' SImp' SBottom' SChanEq'
  for substTerm :: "('a::fs_name) ⇒ name list ⇒ 'a::fs_name list ⇒ 'a"
  and substAssert :: "('b::fs_name) ⇒ name list ⇒ 'a::fs_name list ⇒ 'b"
  and substCond :: "('c::fs_name) ⇒ name list ⇒ 'a::fs_name list ⇒ 'c"
  and SCompose'  :: "'b ⇒ 'b ⇒ 'b"
  and SImp'      :: "'b ⇒ 'c ⇒ bool"
  and SBottom'   :: 'b
  and SChanEq'   :: "'a ⇒ 'a ⇒ 'c"
begin
notation SCompose' (infixr "⊗" 90)
notation SImp' ("_ ⊢ _" [85, 85] 85)
notation FrameImp ("_ ⊢⇩F _" [85, 85] 85) 
abbreviation
  FBottomJudge ("⊥⇩F" 90) where "⊥⇩F ≡ (FAssert SBottom')"
notation SChanEq' ("_ ↔ _" [90, 90] 90)
notation substTerm ("_[_::=_]" [100, 100, 100] 100)
notation subs ("_[_::=_]" [100, 100, 100] 100)
notation AssertionStatEq ("_ ≃ _" [80, 80] 80)
notation FrameStatEq ("_ ≃⇩F _" [80, 80] 80)
notation SBottom' ("𝟭" 190)
abbreviation insertAssertion' ("insertAssertion") where "insertAssertion' ≡ assertionAux.insertAssertion (⊗)"

inductive semantics :: "'b ⇒ ('a, 'b, 'c) psi ⇒ ('a, 'b, 'c) residual ⇒ bool"
                       ("_ ⊳ _ ⟼ _" [50, 50, 50] 50)
where
  cInput:  "⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N; xvec ♯* Tvec;
            length xvec = length Tvec;
            xvec ♯* Ψ; xvec ♯* M; xvec ♯* K⟧ ⟹ Ψ ⊳ M⦇λ*xvec N⦈.P ⟼ K⦇(N[xvec::=Tvec])⦈ ≺ P[xvec::=Tvec]"
| Output: "⟦Ψ ⊢ M ↔ K⟧ ⟹ Ψ ⊳ M⟨N⟩.P ⟼ K⟨N⟩ ≺ P"
| Case:   "⟦Ψ ⊳ P ⟼ Rs; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ Ψ ⊳ Cases Cs ⟼ Rs"

| cPar1:   "⟦(Ψ ⊗ Ψ⇩Q) ⊳ P ⟼α ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
             A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* P'; distinct(bn α); 
             bn α ♯* Ψ; bn α ♯* Ψ⇩Q; bn α ♯* Q; bn α ♯* P; bn α ♯* (subject α)⟧ ⟹
             Ψ ⊳ P ∥ Q ⟼α ≺ (P' ∥ Q)"
| cPar2:   "⟦(Ψ ⊗ Ψ⇩P) ⊳ Q ⟼α ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
             A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* Q'; distinct(bn α); 
             bn α ♯* Ψ; bn α ♯* Ψ⇩P; bn α ♯* P; bn α ♯* Q; bn α ♯* (subject α)⟧ ⟹
             Ψ ⊳ P ∥ Q ⟼α ≺ (P ∥ Q')"
| cComm1:   "⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼ M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
             Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
             Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; 
             A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
             A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; 
             A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P';
             A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q'; A⇩Q ♯* xvec; distinct xvec;
             xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M;
             xvec ♯* Q; xvec ♯* K⟧ ⟹
             Ψ ⊳ P ∥ Q ⟼ τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
| cComm2:   "⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼ M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
             Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
             Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; 
             A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
             A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; 
             A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P';
             A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q'; A⇩Q ♯* xvec; distinct xvec;
             xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M;
             xvec ♯* Q; xvec ♯* K⟧ ⟹
             Ψ ⊳ P ∥ Q ⟼ τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
| cOpen:    "⟦Ψ ⊳ P ⟼ M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; x ∈ supp N; x ♯ xvec; x ♯ yvec; x ♯ M; x ♯ Ψ;
              distinct xvec; distinct yvec;
              xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* yvec; yvec ♯* Ψ; yvec ♯* P; yvec ♯* M⟧ ⟹
              Ψ ⊳ ⦇νx⦈P ⟼ M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'"
| cScope:  "⟦Ψ ⊳ P ⟼α ≺ P'; x ♯ Ψ; x ♯ α; bn α ♯* Ψ; bn α ♯* P; bn α ♯* (subject α); distinct(bn α)⟧ ⟹ Ψ ⊳ ⦇νx⦈P ⟼α ≺ (⦇νx⦈P')"
| Bang:    "⟦Ψ ⊳ P ∥ !P ⟼ Rs; guarded P⟧ ⟹ Ψ ⊳ !P ⟼ Rs"

abbreviation
  semanticsBottomJudge ("_ ⟼ _" [50, 50] 50) where "P ⟼ Rs ≡ 𝟭 ⊳ P ⟼ Rs"

equivariance env.semantics

nominal_inductive2 env.semantics
  avoids cInput: "set xvec"
       | cPar1: "set A⇩Q ∪ set(bn α)"
       | cPar2: "set A⇩P ∪ set(bn α)"
       | cComm1: "set A⇩P ∪ set A⇩Q ∪ set xvec"
       | cComm2: "set A⇩P ∪ set A⇩Q ∪ set xvec"
       | cOpen:  "{x} ∪ set xvec ∪ set yvec"
       | cScope: "{x} ∪ set(bn α)"
apply(auto intro: substTerm.subst4Chain subst4Chain simp add: abs_fresh residualFresh)
apply(force simp add: fresh_star_def abs_fresh)
apply(simp add: boundOutputFresh)
apply(simp add: boundOutputFreshSet)
apply(simp add: boundOutputFreshSet)
by(simp add: fresh_star_def abs_fresh)

lemma nilTrans[dest]:
  fixes Ψ   :: 'b
  and   Rs   :: "('a, 'b, 'c) residual"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"
  and   K    :: 'a
  and   yvec :: "name list"
  and   N'   :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   CsP  :: "('c ×  ('a, 'b, 'c) psi) list"
  and   Ψ'   :: 'b

  shows "Ψ ⊳ 𝟬 ⟼ Rs ⟹ False"
  and   "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼K⦇ν*yvec⦈⟨N'⟩ ≺ P' ⟹ False"
  and   "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼τ ≺ P' ⟹ False"
  and   "Ψ ⊳ M⟨N⟩.P ⟼K⦇N'⦈ ≺ P' ⟹ False"
  and   "Ψ ⊳ M⟨N⟩.P ⟼τ ≺ P' ⟹ False"
  and   "Ψ ⊳ ⦃Ψ'⦄ ⟼ Rs ⟹ False"
apply(cases rule: semantics.cases) apply auto
apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
apply(cases rule: semantics.cases) apply(auto simp add: residualInject)
by(cases rule: semantics.cases) (auto simp add: residualInject)
  
lemma residualEq:
  fixes α :: "'a action"
  and   P :: "('a, 'b, 'c) psi"
  and   β :: "'a action"
  and   Q :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ Q"
  and     "bn α ♯* (bn β)"
  and     "distinct(bn α)"
  and     "distinct(bn β)"
  and     "bn α ♯* (α ≺ P)"
  and     "bn β ♯* (β ≺ Q)"

  obtains p where "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "β = p ∙ α" and "Q = p ∙ P" and "bn α ♯* β" and "bn α ♯* Q" and "bn(p ∙ α) ♯* α" and "bn(p ∙ α) ♯* P"
using assms
proof(nominal_induct α rule: action.strong_induct)
  case(In M N)
  thus ?case by(simp add: residualInject)
next
  case(Out M xvec N)
  thus ?case 
    by(auto simp add: residualInject)
      (drule_tac boundOutputChainEq'', auto) 
next
  case Tau
  thus ?case by(simp add: residualInject)
qed

lemma semanticsInduct[consumes 3, case_names cAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                'a action ⇒ ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "bn α ♯* (subject α)"
  and     "distinct(bn α)"
  and     rAlpha: "⋀Ψ P α P' p C. ⟦bn α ♯* Ψ; bn α ♯* P; bn α ♯* (subject α); 
                                    bn α ♯* C; bn α ♯* (bn(p ∙ α)); 
                                    set p ⊆ set(bn α) × set(bn(p ∙ α)); distinctPerm p;
                                    (bn(p ∙ α)) ♯* α; (bn(p ∙ α)) ♯* P'; Prop C Ψ P α P'⟧ ⟹
                                     Prop C Ψ P (p ∙ α) (p ∙ P')"
  and     rInput: "⋀Ψ M K xvec N Tvec P C.
                   ⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N;
                    length xvec = length Tvec; xvec ♯* Ψ;
                    xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹
                    Prop C Ψ (M⦇λ*xvec N⦈.P)
                              (K⦇(N[xvec::=Tvec])⦈) (P[xvec::=Tvec])"
  and     rOutput: "⋀Ψ M K N P C. ⟦Ψ ⊢ M ↔ K⟧ ⟹ Prop C Ψ (M⟨N⟩.P) (K⟨N⟩) P"
  and     rCase: "⋀Ψ P α P' φ Cs C. ⟦Ψ ⊳ P ⟼α ≺ P'; ⋀C. Prop C Ψ P α P'; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹
                                      Prop C Ψ (Cases Cs) α P'"
  and     rPar1: "⋀Ψ Ψ⇩Q P α P' A⇩Q Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P α P';
                    A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* P'; A⇩Q ♯* C; distinct(bn α); bn α ♯* Q;
                    bn α ♯* Ψ; bn α ♯* Ψ⇩Q; bn α ♯* P; bn α ♯* subject α; bn α ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) α (P' ∥ Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q α Q' A⇩P P C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q α Q';
                    A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* Q'; A⇩P ♯* C; distinct(bn α); bn α ♯* Q;
                    bn α ♯* Ψ; bn α ♯* Ψ⇩P; bn α ♯* P; bn α ♯* subject α; bn α ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) α (P ∥ Q')"
  and     rComm1: "⋀Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇N⦈) P'; 
                    extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇ν*xvec⦈⟨N⟩) Q'; 
                    extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q'; distinct xvec;
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rComm2: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇ν*xvec⦈⟨N⟩) P'; 
                    extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; 
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇N⦈) Q'; 
                    extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q'; distinct xvec;
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rOpen:  "⋀Ψ P M xvec yvec N P' x C.
                   ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; x ∈ supp N; ⋀C. Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩) P';
                    x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ yvec; xvec ♯* Ψ; xvec ♯* P; xvec ♯* M;  distinct xvec; distinct yvec;
                    yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; yvec ♯* C; x ♯ C; xvec ♯* C⟧ ⟹ 
                    Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@x#yvec)⦈⟨N⟩) P'"
  and     rScope: "⋀Ψ P α P' x C.
                    ⟦Ψ ⊳ P ⟼α ≺ P'; ⋀C. Prop C Ψ P α P';
                    x ♯ Ψ; x ♯ α; bn α ♯* Ψ;
                    bn α ♯* P; bn α ♯* (subject α); x ♯ C; bn α ♯* C; distinct(bn α)⟧ ⟹
                    Prop C Ψ (⦇νx⦈P) α (⦇νx⦈P')"
  and     rBang:    "⋀Ψ P α P' C.
                     ⟦Ψ ⊳ P ∥ !P ⟼α ≺ P'; guarded P; ⋀C. Prop C Ψ (P ∥ !P) α P'⟧ ⟹
                      Prop C Ψ (!P) α P'"

  shows "Prop C Ψ P α P'"
using ‹Ψ ⊳ P ⟼α ≺ P'› ‹bn α ♯* (subject α)› ‹distinct(bn α)›
proof(nominal_induct x3=="α ≺ P'" avoiding: α C arbitrary: P' rule: semantics.strong_induct)
  case(cInput Ψ M K xvec N Tvec P α C P')
  thus ?case by(force intro: rInput simp add: residualInject)
next
  case(Output Ψ M K N P α C P')
  thus ?case by(force intro: rOutput simp add: residualInject)
next
  case(Case Ψ P Rs φ Cs α C)
  thus ?case by(auto intro: rCase)
next
  case(cPar1 Ψ Ψ⇩Q P α P' Q A⇩Q α' C P'')
  note ‹α ≺ (P' ∥ Q) = α' ≺ P''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ P' ∥ Q)" and "bn α' ♯* (α' ≺ P'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and P'eq: "P'' = p ∙ (P' ∥ Q)" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (P' ∥ Q)"
    by(rule residualEq)
    
  note ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P α P'" by(rule_tac cPar1) auto
  moreover note ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* C›
                ‹bn α ♯* Q› ‹distinct(bn α)› ‹bn α ♯* Ψ› ‹bn α ♯* Ψ⇩Q› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) α (P' ∥ Q)"
    by(rule_tac rPar1)

  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* bn α'› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P' ∥ Q)› ‹A⇩Q ♯* C›
  have "Prop C Ψ (P ∥ Q) (p ∙ α) (p ∙ (P' ∥ Q))"
    by(rule_tac rAlpha) auto
  with αEq P'eq ‹distinctPerm p› show ?case by simp
next
  case(cPar2 Ψ Ψ⇩P Q α Q' P A⇩P α' C Q'')
  note ‹α ≺ (P ∥ Q') = α' ≺ Q''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ P ∥ Q')" and "bn α' ♯* (α' ≺ Q'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and Q'eq: "Q'' = p ∙ (P ∥ Q')" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (P ∥ Q')"
    by(rule residualEq)
    
  note ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q α Q'" by(rule_tac cPar2) auto

  moreover note ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α› ‹A⇩P ♯* Q'› ‹A⇩P ♯* C›
                ‹bn α ♯* Q› ‹distinct(bn α)› ‹bn α ♯* Ψ› ‹bn α ♯* Ψ⇩P› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) α (P ∥ Q')"
    by(rule_tac rPar2)
  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* (bn α')› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P ∥ Q')›
  have "Prop C Ψ (P ∥ Q) (p ∙ α) (p ∙ (P ∥ Q'))"
    by(rule_tac rAlpha) auto
  with αEq Q'eq ‹distinctPerm p› show ?case by simp
next
  case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q α C P'')
  hence "Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
    by(rule_tac rComm1) (assumption | simp)+
  thus ?case using ‹τ ≺ ⦇ν*xvec⦈(P' ∥ Q') = α ≺ P''›
    by(simp add: residualInject)
next
  case(cComm2 Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q α C P'')
  hence "Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
    by(rule_tac rComm2) (assumption | simp)+
  thus ?case using ‹τ ≺ ⦇ν*xvec⦈(P' ∥ Q') = α ≺ P''›
    by(simp add: residualInject)
next
  case(cOpen Ψ P M xvec yvec N P' x α C P'')
  note ‹M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P' = α ≺ P''›
  moreover from ‹xvec ♯* α› ‹x ♯ α› ‹yvec ♯* α› have "(xvec@x#yvec) ♯* (bn α)"
    by auto
  moreover from ‹xvec ♯* yvec› ‹x ♯ xvec› ‹x ♯ yvec› ‹distinct xvec› ‹distinct yvec›
  have "distinct(xvec@x#yvec)"
    by(auto simp add: fresh_star_def) (simp add: fresh_def name_list_supp)
  moreover note ‹distinct(bn α)›
  moreover from ‹xvec ♯* M› ‹x ♯ M› ‹yvec ♯* M› have "(xvec@x#yvec) ♯* M" by auto
  hence "(xvec@x#yvec) ♯* (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P')" by auto
  moreover from ‹bn α ♯* subject α› have "bn α ♯* (α ≺ P'')" by simp
  ultimately obtain p where S: "(set p) ⊆ (set(xvec@x#yvec)) × (set(p ∙ (xvec@x#yvec)))" and "distinctPerm p"
             and αeq: "α = (p ∙ M)⦇ν*(p ∙ (xvec@x#yvec))⦈⟨(p ∙ N)⟩" and P'eq: "P'' = (p ∙ P')"
             and A: "(xvec@x#yvec) ♯* ((p ∙ M)⦇ν*(p ∙ (xvec@x#yvec))⦈⟨(p ∙ N)⟩)"
             and B: "(p ∙ (xvec@x#yvec)) ♯* (M⦇ν*(xvec@x#yvec)⦈⟨N⟩)"
             and C: "(p ∙ (xvec@x#yvec)) ♯* P'"
    by(rule_tac residualEq) (assumption | simp)+
    
  note ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'› ‹x ∈ (supp N)›

  moreover {
    fix C
    from ‹xvec ♯* M› ‹yvec ♯* M› have "(xvec@yvec) ♯* M" by simp
    moreover from ‹distinct xvec› ‹distinct yvec› ‹xvec ♯* yvec› have "distinct(xvec@yvec)"
      by auto (simp add: fresh_star_def name_list_supp fresh_def)
    ultimately have "Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩) P'" by(rule_tac cOpen) auto
  }

  moreover note ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ xvec› ‹x ♯ yvec› ‹xvec ♯* Ψ› ‹xvec ♯* P› ‹xvec ♯* M›
                 ‹yvec ♯* Ψ› ‹yvec ♯* P› ‹yvec ♯* M› ‹yvec ♯* C› ‹x ♯ C› ‹xvec ♯* C› ‹distinct xvec› ‹distinct yvec›
  ultimately have "Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@x#yvec)⦈⟨N⟩) P'"
    by(rule_tac rOpen) 

  with ‹xvec ♯* Ψ› ‹yvec ♯* Ψ› ‹xvec ♯* P› ‹yvec ♯* P› ‹xvec ♯* M› ‹yvec ♯* M› 
       ‹yvec ♯* C›  S ‹distinctPerm p› ‹x ♯ C› ‹xvec ♯* C›
       ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ xvec› ‹x ♯ yvec› A B C
  have "Prop C Ψ (⦇νx⦈P) (p ∙ (M⦇ν*(xvec@x#yvec)⦈⟨N⟩)) (p ∙ P')"
    apply(rule_tac α="M⦇ν*(xvec@x#yvec)⦈⟨N⟩" in rAlpha)
    apply(assumption | simp)+
    apply(fastforce simp add: fresh_star_def abs_fresh)
    by(assumption | simp)+
  with αeq P'eq show ?case by simp
next
  case(cScope Ψ P α P' x α' C P'')
  note ‹α ≺ (⦇νx⦈P') = α' ≺ P''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ ⦇νx⦈P')" and "bn α' ♯* (α' ≺ P'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and P'eq: "P'' = p ∙ (⦇νx⦈P')" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (⦇νx⦈P')"
    by(rule residualEq)
    
  note ‹Ψ ⊳ P ⟼α ≺ P'›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)›
  have "⋀C. Prop C Ψ P α P'" by(rule_tac cScope) auto

  moreover note ‹x ♯ Ψ› ‹x ♯ α› ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α›
                ‹x ♯ C› ‹bn α ♯* C› ‹distinct(bn α)›
  ultimately have "Prop C Ψ (⦇νx⦈P) α (⦇νx⦈P')"
    by(rule rScope) 
  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹x ♯ α› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* (bn α')› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (⦇νx⦈P')›
  have "Prop C Ψ (⦇νx⦈P) (p ∙ α) (p ∙ (⦇νx⦈P'))"
    by(rule_tac rAlpha) simp+
  with αEq P'eq ‹distinctPerm p› show ?case by simp
next
  case(Bang Ψ P Rs α C)
  thus ?case by(rule_tac rBang) auto
qed

lemma outputInduct[consumes 1, case_names cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 'a ⇒ ('a, 'b, 'c) boundOutput ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes "Ψ ⊳ P ⟼ROut M B"
  and     rOutput: "⋀Ψ M K N P C. ⟦Ψ ⊢ M ↔ K⟧ ⟹ Prop C Ψ (M⟨N⟩.P) K (N ≺' P)"
  and     rCase: "⋀Ψ P M B φ Cs C.  
                  ⟦Ψ ⊳ P ⟼(ROut M B); ⋀C. Prop C Ψ P M B; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ 
                   Prop C Ψ (Cases Cs) M B"
  and     rPar1: "⋀Ψ Ψ⇩Q P M xvec N  P' A⇩Q Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P M (⦇ν*xvec⦈N ≺' P');
                    A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; 
                    A⇩Q ♯* xvec; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* C; xvec ♯* Q;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) M (⦇ν*xvec⦈N ≺' (P' ∥ Q))"
  and     rPar2: "⋀Ψ Ψ⇩P Q M xvec N  Q' A⇩P P C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q M (⦇ν*xvec⦈N ≺' Q');
                    A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; 
                    A⇩P ♯* xvec; A⇩P ♯* N; A⇩P ♯* Q'; A⇩P ♯* C; xvec ♯* P;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Q; xvec ♯* M; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) M (⦇ν*xvec⦈N ≺' (P ∥ Q'))"
  and     rOpen:  "⋀Ψ P M xvec yvec N P' x C.
                   ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; x ∈ supp N; ⋀C. Prop C Ψ P M (⦇ν*(xvec@yvec)⦈N ≺' P');
                    x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ yvec; xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* yvec; yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; yvec ♯* C; x ♯ C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (⦇νx⦈P) M (⦇ν*(xvec@x#yvec)⦈N ≺' P')"
  and     rScope: "⋀Ψ P M xvec N P' x C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; ⋀C. Prop C Ψ P M (⦇ν*xvec⦈N ≺' P');
                    x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ N; xvec ♯* Ψ; xvec ♯* P; xvec ♯* M;
                    x ♯ C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (⦇νx⦈P) M (⦇ν*xvec⦈N ≺' ⦇νx⦈P')"
  and     rBang:    "⋀Ψ P M B C.
                     ⟦Ψ ⊳ P ∥ !P ⟼(ROut M B); guarded P; ⋀C. Prop C Ψ (P ∥ !P) M B⟧ ⟹
                      Prop C Ψ (!P) M B"
  shows "Prop C Ψ P M B"
using ‹Ψ ⊳ P ⟼(ROut M B)›
proof(nominal_induct Ψ P Rs=="(ROut M B)" avoiding: C arbitrary: B rule: semantics.strong_induct)
  case(cInput Ψ M K xvec N Tvec P C)
  thus ?case by(simp add: residualInject)
next
  case(Output Ψ M K N P C)
  thus ?case by(force simp add: residualInject intro: rOutput)
next
  case(Case Ψ P Rs φ Cs C)
  thus ?case by(force intro: rCase) 
next
  case(cPar1 Ψ Ψ⇩Q P α P' Q A⇩Q C)
  thus ?case by(force intro: rPar1 simp add: residualInject)
next
  case(cPar2 Ψ Ψ⇩P Q α Q' P A⇩P C)
  thus ?case by(force intro: rPar2 simp add: residualInject)
next
  case cComm1
  thus ?case by(simp add: residualInject)
next
  case cComm2
  thus ?case by(simp add: residualInject)
next
  case(cOpen Ψ P M xvec yvec N P' x C B)
  thus ?case by(force intro: rOpen simp add: residualInject)
next
  case(cScope Ψ P M α P' x C)
  thus ?case by(force intro: rScope simp add: residualInject)
next
  case(Bang  Ψ P Rs C)
  thus ?case by(force intro: rBang)
qed

lemma boundOutputBindObject:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   yvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   y    :: name

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     "y ∈ set(bn α)"

  shows "y ∈ supp(object α)"
using assms
proof(nominal_induct avoiding: P' arbitrary: y rule: semanticsInduct)
  case(cAlpha Ψ P α P' p P'' y)
  from ‹y ∈ set(bn(p ∙ α))› have "(p ∙ y) ∈ (p ∙ set(bn(p ∙ α)))"
    by(rule pt_set_bij2[OF pt_name_inst, OF at_name_inst])
  hence "(p ∙ y) ∈ set(bn α)" using ‹distinctPerm p›
    by(simp add: eqvts)
  hence "(p ∙ y) ∈ supp(object α)" by(rule cAlpha)
  hence "(p ∙ p ∙ y) ∈ (p ∙ supp(object α))"
    by(rule pt_set_bij2[OF pt_name_inst, OF at_name_inst])
  thus ?case using ‹distinctPerm p›
    by(simp add: eqvts)
next
  case cInput 
  thus ?case by(simp add: supp_list_nil)
next
  case cOutput
  thus ?case by(simp add: supp_list_nil)
next
  case cCase
  thus ?case by simp
next
  case cPar1
  thus ?case by simp
next
  case cPar2
  thus ?case by simp
next
  case cComm1
  thus ?case by(simp add: supp_list_nil)
next
  case cComm2
  thus ?case by(simp add: supp_list_nil)
next
  case cOpen
  thus ?case by(auto simp add: supp_list_cons supp_list_append supp_atm supp_some)
next
  case cScope
  thus ?case by simp
next
  case cBang
  thus ?case by simp
qed

lemma alphaBoundOutputChain':
  fixes yvec :: "name list"
  and   xvec :: "name list"
  and   B    :: "('a, 'b, 'c) boundOutput"

  assumes "length xvec = length yvec"
  and     "yvec ♯* B"
  and     "yvec ♯* xvec"
  and     "distinct yvec"

  shows "⦇ν*xvec⦈B = ⦇ν*yvec⦈([xvec yvec] ∙⇩v B)"
using assms
proof(induct rule: composePermInduct)
  case cBase
  show ?case by simp
next
  case(cStep x xvec y yvec)
  thus ?case
    apply auto
    by(subst alphaBoundOutput[of y]) (auto simp add: eqvts)
qed

lemma alphaBoundOutputChain'':
  fixes yvec :: "name list"
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"

  assumes "length xvec = length yvec"
  and     "yvec ♯* N"
  and     "yvec ♯* P"
  and     "yvec ♯* xvec"
  and     "distinct yvec"

  shows "⦇ν*xvec⦈(N ≺' P) = ⦇ν*yvec⦈(([xvec yvec] ∙⇩v N) ≺' ([xvec yvec] ∙⇩v P))"
proof -
  from assms have "⦇ν*xvec⦈(N ≺' P) = ⦇ν*yvec⦈([xvec yvec] ∙⇩v (N ≺' P))"
    by(simp add: alphaBoundOutputChain')
  thus ?thesis by simp
qed

lemma alphaDistinct:
  fixes xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"
  and   yvec :: "name list"
  and   M    :: 'a
  and   Q    :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ Q"
  and     "distinct(bn α)"
  and     "⋀x. x ∈ set(bn α) ⟹ x ∈ supp(object α)"
  and     "bn α ♯* bn β"
  and     "bn α ♯* (object β)"
  and     "bn α ♯* Q"

  shows "distinct(bn β)"
using assms
proof(rule_tac actionCases[where α=α], auto simp add: residualInject supp_some)
  fix xvec M yvec N
  assume Eq: "⦇ν*xvec⦈N ≺' P = ⦇ν*yvec⦈M ≺' Q" 
  assume "distinct xvec" and "xvec ♯* M" and "xvec ♯* yvec" and "xvec ♯* Q" 
  assume Mem: "⋀x. x ∈ set xvec ⟹ x ∈ (supp N)"
  show "distinct yvec"
proof -
  from Eq have "length xvec = length yvec"
    by(rule boundOutputChainEqLength)
  with Eq ‹distinct xvec› ‹xvec ♯* yvec› ‹xvec ♯* M› ‹xvec ♯* Q› Mem show ?thesis
  proof(induct n=="length xvec" arbitrary: xvec yvec M Q rule: nat.induct)
    case(zero xvec yvec M Q)
    thus ?case by simp
  next
    case(Suc n xvec yvec M Q)
    have L: "length xvec = length yvec" and "Suc n = length xvec" by fact+
    then obtain x xvec' y yvec' where xEq: "xvec = x#xvec'" and yEq: "yvec = y#yvec'"
                                  and L': "length xvec' = length yvec'"
      by(cases xvec, auto, cases yvec, auto)
    have xvecFreshyvec: "xvec ♯* yvec" and xvecDist: "distinct xvec" by fact+
    with xEq yEq have xineqy: "x ≠ y" and xvec'Freshyvec': "xvec' ♯* yvec'"
                  and xvec'Dist: "distinct xvec'" and xFreshxvec': "x ♯ xvec'"
                  and xFreshyvec': "x ♯ yvec'" and yFreshxvec': "y ♯ xvec'"
      by auto
    have Eq: "⦇ν*xvec⦈N ≺' P = ⦇ν*yvec⦈M ≺' Q" by fact
    with xEq yEq xineqy have Eq': "⦇ν*xvec'⦈N ≺' P = ⦇ν*([(x, y)] ∙ yvec')⦈([(x, y)] ∙ M) ≺' ([(x, y)] ∙ Q)"
      by(simp add: boundOutput.inject alpha eqvts) 
    moreover have Mem:"⋀x. x ∈ set xvec ⟹ x ∈ supp N" by fact
    with xEq have "⋀x. x ∈ set xvec' ⟹ x ∈ supp N" by simp
    moreover have "xvec ♯* M" by fact
    with xEq xFreshxvec' yFreshxvec' have "xvec' ♯* ([(x, y)] ∙ M)" by simp
    moreover have xvecFreshQ: "xvec ♯* Q" by fact
    with xEq xFreshxvec' yFreshxvec' have "xvec' ♯* ([(x, y)] ∙ Q)" by simp
    moreover have "Suc n = length xvec" by fact
    with xEq have "n = length xvec'" by simp
    moreover from xvec'Freshyvec' xFreshxvec' yFreshxvec' have "xvec' ♯* ([(x, y)] ∙ yvec')"
      by simp
    moreover from L' have "length xvec' = length([(x, y)] ∙ yvec')" by simp
    ultimately have "distinct([(x, y)] ∙ yvec')" using xvec'Dist
      by(rule_tac Suc) (assumption | simp)+
    hence "distinct yvec'" by simp
    from Mem xEq have xSuppN: "x ∈ supp N" by simp
    from L ‹distinct xvec› ‹xvec ♯* yvec› ‹xvec ♯* M› ‹xvec ♯* Q› 
    have "⦇ν*yvec⦈M ≺' Q = ⦇ν*xvec⦈([yvec xvec] ∙⇩v M) ≺' ([yvec xvec] ∙⇩v Q)"
      by(simp add: alphaBoundOutputChain'')
    with Eq have "N = [yvec xvec] ∙⇩v M" by simp
    with xEq yEq have "N = [(y, x)] ∙ [yvec' xvec'] ∙⇩v M"
      by simp
    with xSuppN have ySuppM: "y ∈ supp([yvec' xvec'] ∙⇩v M)"
      by(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
        (simp add: calc_atm eqvts name_swap)
    have "y ♯ yvec'"
    proof(simp add: fresh_def, rule notI)
      assume "y ∈ supp yvec'"
      hence "y mem yvec'"
        by(induct yvec') (auto simp add: supp_list_nil supp_list_cons supp_atm)
      moreover from ‹xvec ♯* M› xEq xFreshxvec' have "xvec' ♯* M" by simp
      ultimately have "y ♯ [yvec' xvec'] ∙⇩v  M" using L' xvec'Freshyvec' xvec'Dist
        by(force intro: freshChainPerm)
      with ySuppM show "False" by(simp add: fresh_def)
    qed
    with ‹distinct yvec'›  yEq show ?case by simp
  qed
qed
qed

lemma boundOutputDistinct:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"

  assumes "Ψ ⊳ P ⟼α ≺ P'"

  shows "distinct(bn α)"
using assms
proof(nominal_induct Ψ P x3=="α ≺ P'" avoiding: α P' rule: semantics.strong_induct)
  case cInput
  thus ?case by(simp add: residualInject)
next
  case Output
  thus ?case by(simp add: residualInject)
next
  case Case
  thus ?case by(simp add: residualInject)
next
  case cPar1
  thus ?case by(force intro: alphaDistinct boundOutputBindObject)
next
  case cPar2
  thus ?case by(force intro: alphaDistinct boundOutputBindObject)
next 
  case cComm1
  thus ?case by(simp add: residualInject)
next
  case cComm2
  thus ?case by(simp add: residualInject)
next
  case(cOpen Ψ P M xvec yvec N P' x α P'')
  note ‹M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P' = α ≺ P''›
  moreover from ‹xvec ♯* yvec› ‹x ♯ xvec› ‹x ♯ yvec› ‹distinct xvec› ‹distinct yvec›
  have "distinct(bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩))"
    by auto (simp add: fresh_star_def fresh_def name_list_supp)
  moreover {
    fix y
    from ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'› ‹x ∈ supp N› ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ M› ‹x ♯ Ψ› ‹distinct xvec› ‹distinct yvec› ‹xvec ♯* Ψ› ‹xvec ♯* P› ‹xvec ♯* M› ‹xvec ♯* yvec› ‹yvec ♯* Ψ› ‹yvec ♯* P› ‹yvec ♯* M›
    have "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'" by(rule semantics.cOpen)
    moreover moreover from ‹xvec ♯* M› ‹x ♯ M› ‹yvec ♯* M› 
    have "bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩) ♯* (subject(M⦇ν*(xvec@x#yvec)⦈⟨N⟩))"
      by simp
    moreover note ‹distinct(bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩))›
    moreover assume "y ∈ set(bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩))"

    ultimately have "y ∈ supp(object(M⦇ν*(xvec@x#yvec)⦈⟨N⟩))"
      by(rule_tac boundOutputBindObject)
  }
  moreover from ‹xvec ♯* α› ‹x ♯ α› ‹yvec ♯* α›
  have "bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩) ♯* bn α" and "bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩) ♯* object α" by simp+
  moreover from ‹xvec ♯* P''› ‹x ♯ P''› ‹yvec ♯* P''›
  have "bn(M⦇ν*(xvec@x#yvec)⦈⟨N⟩) ♯* P''" by simp
  ultimately show ?case by(rule alphaDistinct)
next
  case cScope
  thus ?case
    by(rule_tac alphaDistinct, auto) (rule_tac boundOutputBindObject, auto)
next
  case Bang
  thus ?case by simp
qed

lemma inputDistinct:
  fixes Ψ   :: 'b
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"
  and   Rs   :: "('a, 'b, 'c) residual"

  assumes "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼ Rs"

  shows "distinct xvec"
using assms
by(nominal_induct Ψ P=="M⦇λ*xvec N⦈.P" Rs avoiding: xvec N P rule: semantics.strong_induct)
  (auto simp add: psi.inject intro: alphaInputDistinct)

lemma outputInduct'[consumes 2, case_names cAlpha cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   yvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 'a ⇒ name list ⇒ 'a ⇒ ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     rAlpha: "⋀Ψ P M xvec N P' p C. ⟦xvec ♯* Ψ; xvec ♯* P; xvec ♯* M;  xvec ♯* C; xvec ♯* (p ∙ xvec); 
                                           set p ⊆ set xvec × set(p ∙ xvec); distinctPerm p;
                                           (p ∙ xvec) ♯* N; (p ∙ xvec) ♯* P'; Prop C Ψ P M xvec N P'⟧ ⟹
                                           Prop C Ψ P M (p ∙ xvec) (p ∙ N) (p ∙ P')"
  and     rOutput: "⋀Ψ M K N P C. ⟦Ψ ⊢ M ↔ K⟧ ⟹ Prop C Ψ (M⟨N⟩.P) K ([]) N P"
  and     rCase: "⋀Ψ P M xvec N P' φ Cs C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; ⋀C. Prop C Ψ P M xvec N P'; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹
                                             Prop C Ψ (Cases Cs) M xvec N P'"
  and     rPar1: "⋀Ψ Ψ⇩Q P M xvec N  P' A⇩Q Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P M xvec N P';
                    A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; 
                    A⇩Q ♯* xvec; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* C; xvec ♯* Q;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) M xvec N (P' ∥ Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q M xvec N  Q' A⇩P P C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩;  distinct A⇩P;
                    ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q M xvec N Q';
                    A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; 
                    A⇩P ♯* xvec; A⇩P ♯* N; A⇩P ♯* Q'; A⇩P ♯* C; xvec ♯* Q;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* P; xvec ♯* M; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) M xvec N (P ∥ Q')"
  and     rOpen:  "⋀Ψ P M xvec yvec N P' x C.
                   ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; x ∈ supp N; ⋀C. Prop C Ψ P M (xvec@yvec) N P';
                    x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ yvec; xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; 
                    yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; yvec ♯* C; x ♯ C; xvec ♯* C⟧ ⟹ 
                    Prop C Ψ (⦇νx⦈P) M (xvec@x#yvec) N P'"
  and     rScope: "⋀Ψ P M xvec N P' x C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; ⋀C. Prop C Ψ P M xvec N P';
                    x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ N; xvec ♯* Ψ;
                    xvec ♯* P; xvec ♯* M; x ♯ C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (⦇νx⦈P) M xvec N (⦇νx⦈P')"
  and     rBang:    "⋀Ψ P M xvec N P' C.
                     ⟦Ψ ⊳ P ∥ !P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; guarded P; ⋀C. Prop C Ψ (P ∥ !P) M xvec N P'⟧ ⟹
                      Prop C Ψ (!P) M xvec N P'"
  shows "Prop C Ψ P M xvec N P'"
proof -
  note ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'›
  moreover from ‹xvec ♯* M› have "bn(M⦇ν*xvec⦈⟨N⟩) ♯* subject(M⦇ν*xvec⦈⟨N⟩)" by simp
  moreover from ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› have "distinct(bn(M⦇ν*xvec⦈⟨N⟩))"
    by(rule boundOutputDistinct)
  ultimately show ?thesis
  proof(nominal_induct Ψ P α=="M⦇ν*xvec⦈⟨N⟩" P' avoiding: C arbitrary: M xvec N rule: semanticsInduct)
    case(cAlpha Ψ P α P' p C M xvec N)
    from ‹(p ∙ α) = M⦇ν*xvec⦈⟨N⟩› have "(p ∙ p ∙ α) = p ∙ (M⦇ν*xvec⦈⟨N⟩)"
      by(simp add: fresh_bij)
    with ‹distinctPerm p› have A: "α = (p ∙ M)⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩"
      by(simp add: eqvts)
    with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α › ‹bn α ♯* C› ‹bn α ♯* bn(p ∙ α)› ‹distinctPerm p›
    have "(p ∙ xvec) ♯* Ψ" and  "(p ∙ xvec) ♯* P" and  "(p ∙ xvec) ♯* (p ∙ M)" and  "(p ∙ xvec) ♯* C" and  "(p ∙ xvec) ♯* (p ∙ p ∙ xvec)"
      by auto
    moreover from A ‹set p ⊆ set(bn α) × set(bn(p ∙ α))› ‹distinctPerm p›
    have S: "set p ⊆ set(p ∙ xvec) × set(p ∙ p ∙ xvec)" by simp
    moreover note ‹distinctPerm p›
    moreover from A ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* P'›
    have "(p ∙ p ∙ xvec) ♯* (p ∙ N)" and "(p ∙ p ∙ xvec) ♯* P'" by simp+
    moreover from A have "Prop C Ψ P (p ∙ M) (p ∙ xvec) (p ∙ N) P'"
      by(rule cAlpha)
    ultimately have "Prop C Ψ P (p ∙ M) (p ∙ p ∙ xvec) (p ∙ p ∙ N) (p ∙ P')"
      by(rule rAlpha)
    moreover from A ‹bn α ♯* subject α› have "(p ∙ xvec) ♯* (p ∙ M)" by simp
    hence "xvec ♯* M" by(simp add: fresh_star_bij)
    from A ‹bn(p ∙ α) ♯* α› ‹distinctPerm p› have "xvec ♯* (p ∙ M)" by simp
    hence "(p ∙ xvec) ♯* (p ∙ p ∙ M)" by(simp add: fresh_star_bij)
    with ‹distinctPerm p› have "(p ∙ xvec) ♯* M" by simp
    with ‹xvec ♯* M› S ‹distinctPerm p› have  "(p ∙ M) = M" by simp
    ultimately show ?case using S ‹distinctPerm p› by simp 
  next
    case cInput
    thus ?case by(simp add: residualInject)
  next
    case cOutput
    thus ?case by(force dest: rOutput simp add: action.inject)
  next
    case cCase
    thus ?case by(force intro: rCase)
  next
    case cPar1
    thus ?case by(force intro: rPar1)
  next
    case cPar2
    thus ?case by(force intro: rPar2)
  next
    case cComm1
    thus ?case by(simp add: action.inject)
  next
    case cComm2
    thus ?case by(simp add: action.inject)
  next
    case cOpen
    thus ?case by(fastforce intro: rOpen simp add: action.inject)
  next
    case cScope
    thus ?case by(fastforce intro: rScope)
  next
    case cBang
    thus ?case by(fastforce intro: rBang)
  qed
qed

lemma inputInduct[consumes 1, case_names cInput cCase cPar1 cPar2 cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 'a ⇒ 'a ⇒ ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     rInput: "⋀Ψ M K xvec N Tvec P C.
                   ⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N;
                    length xvec = length Tvec; xvec ♯* Ψ;
                    xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹
                    Prop C Ψ (M⦇λ*xvec N⦈.P)
                              K (N[xvec::=Tvec]) (P[xvec::=Tvec])"
  and     rCase: "⋀Ψ P M N P' φ Cs C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; ⋀C. Prop C Ψ P M N P'; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹
                                        Prop C Ψ (Cases Cs) M N P'" 
  and     rPar1: "⋀Ψ Ψ⇩Q P M N P' A⇩Q Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P M N P'; distinct A⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; A⇩Q ♯* N;
                   A⇩Q ♯* P'; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M N (P' ∥ Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q M N Q' A⇩P P C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇N⦈ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q M N Q'; distinct A⇩P;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; A⇩P ♯* N;
                   A⇩P ♯* Q'; A⇩P ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M N (P ∥ Q')"
  and     rScope: "⋀Ψ P M N P' x C.
                    ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; ⋀C. Prop C Ψ P M N P'; x ♯ Ψ; x ♯ M; x ♯ N; x ♯ C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) M N (⦇νx⦈P')"
  and     rBang:    "⋀Ψ P M N P' C.
                     ⟦Ψ ⊳ P ∥ !P ⟼M⦇N⦈ ≺ P'; guarded P; ⋀C. Prop C Ψ (P ∥ !P) M N P'⟧ ⟹ Prop C Ψ (!P) M N P'"
  shows "Prop C Ψ P M N P'"
using Trans
proof(nominal_induct Ψ P Rs=="M⦇N⦈ ≺ P'" avoiding: C arbitrary: P' rule: semantics.strong_induct)
  case(cInput Ψ M K xvec N Tvec P C)
  thus ?case
    by(force intro: rInput simp add: residualInject action.inject)
next
  case(Output Ψ M K N P C)
  thus ?case by(simp add: residualInject)
next
  case(Case Ψ P Rs φ CS C)
  thus ?case by(force intro: rCase)
next
  case(cPar1 Ψ Ψ⇩Q P α P' Q A⇩Q C P'')
  thus ?case by(force intro: rPar1 simp add: residualInject)
next 
  case(cPar2 Ψ ΨP Q α Q' xvec P C Q'')
  thus ?case by(force intro: rPar2 simp add: residualInject)
next
  case(cComm1 Ψ ΨQ P M N P' xvec ΨP Q K zvec Q' yvec C PQ)
  thus ?case by(simp add: residualInject)
next
  case(cComm2 Ψ ΨQ P M zvec N P' xvec ΨP Q K yvec Q' C PQ)
  thus ?case by(simp add: residualInject)
next
  case(cOpen Ψ P M xvec N P' x yvec C P'') 
  thus ?case by(simp add: residualInject)
next
  case(cScope Ψ P α P' x C P'')
  thus ?case by(force intro: rScope simp add: residualInject)
next
  case(Bang Ψ P Rs C)
  thus ?case by(force intro: rBang)
qed

lemma tauInduct[consumes 1, case_names cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Rs   :: "('a, 'b, 'c) residual"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼τ ≺ P'"
  and     rCase: "⋀Ψ P P' φ Cs C. ⟦Ψ ⊳ P ⟼τ ≺ P'; ⋀C. Prop C Ψ P P'; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ 
                                    Prop C Ψ (Cases Cs) P'"
  and     rPar1: "⋀Ψ Ψ⇩Q P P' A⇩Q Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼τ ≺ P'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P P';
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ;
                   A⇩Q ♯* P'; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (P' ∥ Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q Q' A⇩P P C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼τ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q Q';
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ;
                   A⇩P ♯* Q'; A⇩P ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (P ∥ Q')"
  and     rComm1: "⋀Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rComm2: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P';  extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; 
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rScope: "⋀Ψ P P' x C.
                    ⟦Ψ ⊳ P ⟼τ ≺ P'; ⋀C. Prop C Ψ P P'; x ♯ Ψ; x ♯ C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) (⦇νx⦈P')"
  and     rBang:    "⋀Ψ P P' C.
                     ⟦Ψ ⊳ P ∥ !P ⟼τ ≺ P'; guarded P; ⋀C. Prop C Ψ (P ∥ !P) P'⟧ ⟹ Prop C Ψ (!P) P'"
  shows "Prop C Ψ P P'"
using Trans
proof(nominal_induct Ψ P Rs=="τ ≺ P'" avoiding: C arbitrary: P' rule: semantics.strong_induct)
  case(cInput M K xvec N Tvec P C)
  thus ?case by(simp add: residualInject)
next
  case(Output Ψ M K N P C)
  thus ?case by(simp add: residualInject)
next
  case(Case Ψ P Rs φ Cs C)
  thus ?case by(force intro: rCase simp add: residualInject)
next
  case(cPar1 Ψ Ψ⇩Q P α P' A⇩Q Q C P'')
  thus ?case by(force intro: rPar1 simp add: residualInject)
next
  case(cPar2 Ψ Ψ⇩P Q α Q' A⇩P P C Q'')
  thus ?case by(force intro: rPar2 simp add: residualInject)
next
  case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C PQ)
  thus ?case by(force intro: rComm1 simp add: residualInject)
next
  case(cComm2 Ψ Ψ⇩Q P M xvec N P' A⇩P ΨP Q' A⇩Q C PQ)
  thus ?case by(force intro: rComm2 simp add: residualInject)
next
  case(cOpen Ψ P M xvec N P' x yvec C P'')
  thus ?case by(simp add: residualInject)
next
  case(cScope Ψ P α P' x C P'')
  thus ?case by(force intro: rScope simp add: residualInject)
next
  case(Bang Ψ P Rs C )
  thus ?case by(force intro: rBang simp add: residualInject)
qed

lemma semanticsFrameInduct[consumes 3, case_names cAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Rs   :: "('a, 'b, 'c) residual"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 ('a, 'b, 'c) residual ⇒ name list ⇒ 'b ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼ Rs"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     rAlpha: "⋀Ψ P A⇩P Ψ⇩P p Rs C. ⟦A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* (p ∙ A⇩P); A⇩P ♯* Rs; A⇩P ♯* C;
                                         set p ⊆ set A⇩P × set(p ∙ A⇩P); distinctPerm p;
                                          Prop C Ψ P Rs A⇩P Ψ⇩P⟧ ⟹ Prop C Ψ P Rs (p ∙ A⇩P) (p ∙ Ψ⇩P)"
  and     rInput: "⋀Ψ M K xvec N Tvec P C.
                   ⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N;
                    length xvec = length Tvec; xvec ♯* Ψ;
                    xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹
                    Prop C Ψ (M⦇λ*xvec N⦈.P)
                              (K⦇(N[xvec::=Tvec])⦈ ≺ (P[xvec::=Tvec])) ([]) (𝟭)"
  and     rOutput: "⋀Ψ M K N P C. Ψ ⊢ M ↔ K ⟹ Prop C Ψ (M⟨N⟩.P) (K⟨N⟩ ≺ P) ([]) (𝟭)"
  and     rCase: "⋀Ψ P Rs φ Cs A⇩P Ψ⇩P C. ⟦Ψ ⊳ P ⟼ Rs; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; ⋀C. Prop C Ψ P Rs A⇩P Ψ⇩P;
                                            (φ, P) mem Cs; Ψ ⊢ φ; guarded P;  Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                                            A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Rs; A⇩P ♯* C⟧ ⟹ Prop C Ψ (Cases Cs) Rs ([]) (𝟭)"
  and     rPar1: "⋀Ψ Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (α ≺ P') A⇩P Ψ⇩P; distinct(bn α);
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* P'; A⇩Q ♯* Ψ⇩P;
                   bn α ♯* Ψ; bn α ♯* P; bn α ♯* Q; bn α ♯* subject α; bn α ♯* Ψ⇩P; bn α ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; bn α ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (α ≺ (P' ∥ Q)) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (α ≺ Q') A⇩Q Ψ⇩Q; distinct(bn α);
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* Q'; A⇩Q ♯* Ψ⇩P;
                   bn α ♯* Ψ; bn α ♯* P; bn α ♯* Q; bn α ♯* subject α; bn α ♯* Ψ⇩P; bn α ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; bn α ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (α ≺ (P ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm1: "⋀Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P ((M⦇N⦈) ≺ P') A⇩P Ψ⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇ν*xvec⦈⟨N⟩ ≺ Q') A⇩Q Ψ⇩Q; distinct xvec;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm2: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇ν*xvec⦈⟨N⟩ ≺ P') A⇩P Ψ⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇N⦈ ≺ Q') A⇩Q Ψ⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rOpen: "⋀Ψ P M xvec yvec N P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P') A⇩P Ψ⇩P; x ∈ supp N; x ♯ Ψ; x ♯ M;
                     x ♯ A⇩P; x ♯ xvec; x ♯ yvec; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
                     A⇩P ♯* xvec; A⇩P ♯* yvec; xvec ♯* yvec; distinct xvec; distinct yvec;
                     xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* Ψ⇩P; yvec ♯* Ψ⇩P;
                     yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; A⇩P ♯* C; x ♯ C; xvec ♯* C; yvec ♯* C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P') (x#A⇩P) Ψ⇩P"
  and     rScope: "⋀Ψ P α P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼α ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P (α ≺ P') A⇩P Ψ⇩P;
                     x ♯ Ψ; x ♯ α; x ♯ A⇩P; A⇩P ♯* Ψ; A⇩P ♯* P;
                     A⇩P ♯* α; A⇩P ♯* P'; distinct(bn α);
                     bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* Ψ⇩P;
                     A⇩P ♯* C; x ♯ C; bn α ♯* C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) (α ≺ (⦇νx⦈P')) (x#A⇩P) Ψ⇩P"
  and     rBang:    "⋀Ψ P Rs A⇩P Ψ⇩P C.
                     ⟦Ψ ⊳ P ∥ !P ⟼ Rs; guarded P; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                      ⋀C. Prop C Ψ (P ∥ !P) Rs A⇩P (Ψ⇩P ⊗ 𝟭); Ψ⇩P ≃ 𝟭; supp Ψ⇩P = ({}::name set);
                      A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Rs; A⇩P ♯* C⟧ ⟹ Prop C Ψ (!P) Rs ([]) (𝟭)"
  shows "Prop C Ψ P Rs A⇩P Ψ⇩P"
using Trans FrP ‹distinct A⇩P›
proof(nominal_induct  avoiding: A⇩P Ψ⇩P C rule: semantics.strong_induct)
  case(cInput Ψ M K xvec N Tvec P A⇩P Ψ⇩P C)
  from ‹extractFrame (M⦇λ*xvec N⦈.P) = ⟨A⇩P, Ψ⇩P⟩›
  have "A⇩P = []" and "Ψ⇩P = 𝟭"
    by auto
  with ‹Ψ ⊢ M ↔ K› ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec›
       ‹xvec ♯* Ψ› ‹xvec ♯* M› ‹xvec ♯* K› ‹xvec ♯* C›
  show ?case by(blast intro: rInput)
next
  case(Output Ψ M K N P A⇩P Ψ⇩P)
  from ‹extractFrame (M⟨N⟩.P) = ⟨A⇩P, Ψ⇩P⟩›
  have "A⇩P = []" and "Ψ⇩P = 𝟭"
    by auto
  with ‹Ψ ⊢ M ↔ K› show ?case
    by(blast intro: rOutput)
next
  case(Case Ψ P Rs φ Cs A⇩c⇩P Ψ⇩c⇩P C)
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                  and "A⇩P ♯* (Ψ, P, Rs, C)"
    by(rule freshFrame)
  hence "A⇩P ♯* Ψ" and "A⇩P ♯* P" and "A⇩P ♯* Rs" and "A⇩P ♯* C"
    by simp+
  note ‹Ψ ⊳ P ⟼ Rs› FrP ‹distinct A⇩P›
  moreover from FrP ‹distinct A⇩P› ‹⋀A⇩P Ψ⇩P C. ⟦extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P⟧ ⟹ Prop C Ψ P Rs A⇩P Ψ⇩P› 
  have "⋀C. Prop C Ψ P Rs A⇩P Ψ⇩P" by simp
  moreover note ‹(φ, P) mem Cs› ‹Ψ ⊢ φ› ‹guarded P›
  moreover from ‹guarded P› FrP have "Ψ⇩P ≃ 𝟭" and "supp Ψ⇩P = ({}::name set)" by(metis guardedStatEq)+
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Rs› ‹A⇩P ♯* C›
  ultimately have "Prop C Ψ (Cases Cs) Rs ([]) (𝟭)"
    by(rule rCase)
  thus ?case using ‹extractFrame(Cases Cs) = ⟨A⇩c⇩P, Ψ⇩c⇩P⟩› by simp
next
  case(cPar1 Ψ Ψ⇩Q P α P' Q A⇩Q A⇩P⇩Q Ψ⇩P⇩Q C)
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                           "A⇩P ♯* (P, Q, Ψ, α, P', A⇩Q, A⇩P⇩Q, C, Ψ⇩Q)"
    by(rule freshFrame)
  hence "A⇩P ♯* P" and "A⇩P ♯* Q" and "A⇩P ♯* Ψ" and "A⇩P ♯* α" and "A⇩P ♯* P'"
    and "A⇩P ♯* A⇩Q" and "A⇩P ♯* A⇩P⇩Q" and "A⇩P ♯* C" and "A⇩P ♯* Ψ⇩Q"
    by simp+

  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact

  from ‹A⇩Q ♯* P› ‹A⇩P ♯* A⇩Q› FrP have "A⇩Q ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹bn α ♯* P› ‹A⇩P ♯* α› FrP have "bn α ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
    by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "set p ⊆ set(A⇩P@A⇩Q) × set((p ∙ A⇩P)@(p ∙ A⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = p ∙ (Ψ⇩P ⊗ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = (p ∙ A⇩P)@(p ∙ A⇩Q)"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+
  
  note ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› FrP ‹distinct A⇩P› FrQ ‹distinct A⇩Q›

  moreover from FrP ‹distinct A⇩P› ‹⋀A⇩P Ψ⇩P C. ⟦extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P⟧ ⟹ Prop C (Ψ ⊗ Ψ⇩Q) P (α ≺ P') A⇩P Ψ⇩P›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (α ≺ P') A⇩P Ψ⇩P" by simp

  moreover note ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q›
                ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* Ψ⇩P› ‹distinct(bn α)›
                ‹bn α ♯* Ψ› ‹bn α ♯* P›  ‹bn α ♯* Q›  ‹bn α ♯* subject α›  ‹bn α ♯* Ψ⇩P›  ‹bn α ♯* Ψ⇩Q› 
                ‹A⇩P ♯* C› ‹A⇩Q ♯* C› ‹bn α ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) (α ≺ (P' ∥ Q)) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rPar1)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩P ♯* C›
       ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* α› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* A⇩P⇩Q› ‹A⇩Q ♯* C›
       S ‹distinctPerm p› Aeq
  have "Prop C Ψ (P ∥ Q) (α ≺ (P' ∥ Q)) (p ∙ (A⇩P@A⇩Q)) (p ∙ (Ψ⇩P ⊗ Ψ⇩Q))"
    by(rule_tac rAlpha) (assumption | simp add: eqvts)+
  with Ψeq Aeq show ?case by(simp add: eqvts)
next
  case(cPar2 Ψ Ψ⇩P Q α Q' P A⇩P A⇩P⇩Q Ψ⇩P⇩Q C)
  obtain A⇩Q Ψ⇩Q where FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" and "distinct A⇩Q"
                           "A⇩Q ♯* (P, Q, Ψ, α, Q', A⇩P, A⇩P⇩Q, C, Ψ⇩P)"
    by(rule freshFrame)
  hence "A⇩Q ♯* P" and "A⇩Q ♯* Q" and "A⇩Q ♯* Ψ" and "A⇩Q ♯* α" and "A⇩Q ♯* Q'"
    and "A⇩Q ♯* A⇩P" and "A⇩Q ♯* A⇩P⇩Q" and "A⇩Q ♯* C" and "A⇩Q ♯* Ψ⇩P"
    by simp+

  from ‹A⇩Q ♯* A⇩P› have "A⇩P ♯* A⇩Q" by simp
  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact

  from ‹A⇩P ♯* Q› ‹A⇩Q ♯* A⇩P› FrQ have "A⇩P ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)
  from ‹bn α ♯* Q› ‹A⇩Q ♯* α› FrQ have "bn α ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
    by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "(set p ⊆ (set(A⇩P@A⇩Q)) × (set A⇩P⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = p ∙ (Ψ⇩P ⊗ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = ((p ∙ A⇩P)@(p ∙ A⇩Q))"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  note ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› FrP ‹distinct A⇩P› FrQ ‹distinct A⇩Q›

  moreover from FrQ ‹distinct A⇩Q› ‹⋀A⇩Q Ψ⇩Q C. ⟦extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q⟧ ⟹ Prop C (Ψ ⊗ Ψ⇩P) Q (α ≺ Q') A⇩Q Ψ⇩Q›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (α ≺ Q') A⇩Q Ψ⇩Q" by simp

  moreover note ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α› ‹A⇩P ♯* Q'› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q›
                ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α› ‹A⇩Q ♯* Q'› ‹A⇩Q ♯* Ψ⇩P› ‹distinct(bn α)›
                ‹bn α ♯* Ψ› ‹bn α ♯* P›  ‹bn α ♯* Q›  ‹bn α ♯* subject α›  ‹bn α ♯* Ψ⇩P›  ‹bn α ♯* Ψ⇩Q› 
                ‹A⇩P ♯* C› ‹A⇩Q ♯* C› ‹bn α ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) (α ≺ (P ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rPar2)

  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* α› ‹A⇩P ♯* Q'› ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩P ♯* C›
       ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* α› ‹A⇩Q ♯* Q'› ‹A⇩Q ♯* A⇩P⇩Q› ‹A⇩Q ♯* C›
       S ‹distinctPerm p› Aeq
  have "Prop C Ψ (P ∥ Q) (α ≺ (P ∥ Q')) (p ∙ (A⇩P@A⇩Q)) (p ∙ (Ψ⇩P ⊗ Ψ⇩Q))"
    by(rule_tac rAlpha) (assumption | simp add: eqvts)+
  with Ψeq Aeq show ?case by(simp add: eqvts)
next
  case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q A⇩P⇩Q Ψ⇩P⇩Q C)
  from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  from cComm1 have  "Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rComm1)
  moreover from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›
                ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), (Ψ⇩P ⊗ Ψ⇩Q)⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
    by simp
  with ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct(A⇩P@A⇩Q)› ‹distinct A⇩P⇩Q›
  obtain p where S: "(set p ⊆ (set(A⇩P@A⇩Q)) × (set A⇩P⇩Q))"  and "distinctPerm p"
             and Ψeq: "Ψ⇩P⇩Q = p ∙ (Ψ⇩P ⊗ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = p ∙ (A⇩P@A⇩Q)"
    by(rule_tac frameChainEq') (assumption | simp)+
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P ♯* xvec›
                ‹A⇩Q ♯* xvec› ‹A⇩P ♯* P'› ‹A⇩Q ♯* P'› ‹A⇩P ♯* Q'› ‹A⇩Q ♯* Q'› ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q›
                ‹A⇩P ♯* C› ‹A⇩Q ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (p ∙ (A⇩P@A⇩Q)) (p ∙ (Ψ⇩P ⊗ Ψ⇩Q))"
    by(rule_tac rAlpha) auto
  with Ψeq Aeq show ?case by simp
next
  case(cComm2 Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q A⇩P⇩Q Ψ⇩P⇩Q C)
  from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  from cComm2 have  "Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rComm2)
  moreover from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›
                ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), (Ψ⇩P ⊗ Ψ⇩Q)⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
    by simp
  with ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct(A⇩P@A⇩Q)› ‹distinct A⇩P⇩Q›
  obtain p where S: "(set p ⊆ (set(A⇩P@A⇩Q)) × (set A⇩P⇩Q))"  and "distinctPerm p"
             and Ψeq: "Ψ⇩P⇩Q = p ∙ (Ψ⇩P ⊗ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = p ∙ (A⇩P@A⇩Q)"
    by(rule_tac frameChainEq') (assumption | simp)+
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P ♯* xvec›
                ‹A⇩Q ♯* xvec› ‹A⇩P ♯* P'› ‹A⇩Q ♯* P'› ‹A⇩P ♯* Q'› ‹A⇩Q ♯* Q'› ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q›
                ‹A⇩P ♯* C› ‹A⇩Q ♯* C›
  ultimately have "Prop C Ψ (P ∥ Q) (τ ≺ ⦇ν*xvec⦈(P' ∥ Q')) (p ∙ (A⇩P@A⇩Q)) (p ∙ (Ψ⇩P ⊗ Ψ⇩Q))"
    by(rule_tac rAlpha) auto
  with Ψeq Aeq show ?case by simp
next
  case(cOpen Ψ P M xvec yvec N P' x A⇩x⇩P Ψ⇩x⇩P C)
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                  and "A⇩P ♯* (Ψ, P, M, xvec, yvec, N, P', A⇩x⇩P, Ψ⇩x⇩P, C, x)"
    by(rule freshFrame)
  hence "A⇩P ♯* Ψ" and "A⇩P ♯* P" and "A⇩P ♯* M" and "A⇩P ♯* xvec"and "A⇩P ♯* yvec" and "A⇩P ♯* N" and "A⇩P ♯* P'"
    and "A⇩P ♯* A⇩x⇩P" and "A⇩P ♯* Ψ⇩x⇩P" and "A⇩P ♯* C" and "x ♯ A⇩P"
    by simp+

  from ‹xvec ♯* P› ‹A⇩P ♯* xvec› FrP have "xvec ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)
  from ‹yvec ♯* P› ‹A⇩P ♯* yvec› FrP have "yvec ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(⦇νx⦈P) = ⟨A⇩x⇩P, Ψ⇩x⇩P⟩› FrP
  have "⟨(x#A⇩P), Ψ⇩P⟩ = ⟨A⇩x⇩P, Ψ⇩x⇩P⟩"
    by simp
  moreover from ‹x ♯ A⇩P› ‹distinct A⇩P› have "distinct(x#A⇩P)" by simp
  ultimately obtain p where S: "set p ⊆ set (x#A⇩P) × set (p ∙ (x#A⇩P))" and "distinctPerm p"
                        and Ψeq: "Ψ⇩x⇩P = p ∙ Ψ⇩P" and Aeq: "A⇩x⇩P = (p ∙ x)#(p ∙ A⇩P)"
    using ‹A⇩P ♯* A⇩x⇩P›‹x ♯ A⇩x⇩P› ‹distinct A⇩x⇩P›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  note ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'› FrP ‹distinct A⇩P›
  moreover from FrP ‹distinct A⇩P› ‹⋀A⇩P Ψ⇩P C. ⟦extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P⟧ ⟹ Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P') A⇩P Ψ⇩P›
  have "⋀C. Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P') A⇩P Ψ⇩P" by simp
  moreover note ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ xvec› ‹x ♯ yvec› ‹x ∈ supp N› ‹x ♯ A⇩P› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* xvec› ‹A⇩P ♯* yvec› ‹A⇩P ♯* N› ‹A⇩P ♯* P'›
                ‹xvec ♯* Ψ› ‹xvec ♯* P›  ‹xvec ♯* M›  ‹xvec ♯* Ψ⇩P› ‹yvec ♯* Ψ› ‹yvec ♯* P›  ‹yvec ♯* M›  ‹yvec ♯* Ψ⇩P› 
                ‹A⇩P ♯* C› ‹x ♯ C› ‹xvec ♯* C› ‹yvec ♯* C› ‹xvec ♯* yvec› ‹distinct xvec› ‹distinct yvec›
  ultimately have "Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P') (x#A⇩P) Ψ⇩P"
    by(rule_tac rOpen)
  
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* xvec› ‹A⇩P ♯* yvec› ‹A⇩P ♯* N› ‹A⇩P ♯* P'› ‹A⇩P ♯* A⇩x⇩P› ‹A⇩P ♯* C› ‹x ♯ A⇩x⇩P› ‹A⇩P ♯* A⇩x⇩P› ‹x ♯ A⇩P›
       ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ C› ‹x ♯ xvec› ‹x ♯ yvec› Aeq
       S ‹distinctPerm p›
  have "Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P') (p ∙ (x#A⇩P)) (p ∙ Ψ⇩P)"
    by(rule_tac A⇩P="x#A⇩P" in rAlpha) (assumption | simp add: abs_fresh fresh_star_def boundOutputFresh)+
  with Ψeq Aeq show ?case by(simp add: eqvts)
next
  case(cScope Ψ P α P' x A⇩x⇩P Ψ⇩x⇩P C)
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                  and "A⇩P ♯* (Ψ, P, α, P', A⇩x⇩P, Ψ⇩x⇩P, C, x)"
    by(rule freshFrame)
  hence "A⇩P ♯* Ψ" and "A⇩P ♯* P" and "A⇩P ♯* α" and "A⇩P ♯* P'"
    and "A⇩P ♯* A⇩x⇩P" and "A⇩P ♯* Ψ⇩x⇩P" and "A⇩P ♯* C" and "x ♯ A⇩P"
    by simp+

  from ‹bn α ♯* P› ‹A⇩P ♯* α› FrP have "bn α ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(⦇νx⦈P) = ⟨A⇩x⇩P, Ψ⇩x⇩P⟩› FrP
  have "⟨(x#A⇩P), Ψ⇩P⟩ = ⟨A⇩x⇩P, Ψ⇩x⇩P⟩"
    by simp
  moreover from ‹x ♯ A⇩P› ‹distinct A⇩P› have "distinct(x#A⇩P)" by simp
  ultimately obtain p where S: "set p ⊆ set (x#A⇩P) × set (p ∙ (x#A⇩P))" and "distinctPerm p"
                        and Ψeq: "Ψ⇩x⇩P = p ∙ Ψ⇩P" and Aeq: "A⇩x⇩P = (p ∙ x)#(p ∙ A⇩P)"
    using ‹A⇩P ♯* A⇩x⇩P›‹x ♯ A⇩x⇩P› ‹distinct A⇩x⇩P›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  note ‹Ψ ⊳ P ⟼α ≺ P'› FrP ‹distinct A⇩P›
  moreover from FrP ‹distinct A⇩P› ‹⋀A⇩P Ψ⇩P C. ⟦extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P⟧ ⟹ Prop C Ψ P (α ≺ P') A⇩P Ψ⇩P›
  have "⋀C. Prop C Ψ P (α ≺ P') A⇩P Ψ⇩P" by simp
  moreover note ‹x ♯ Ψ› ‹x ♯ α› ‹x ♯ A⇩P› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹distinct(bn α)›
                ‹bn α ♯* Ψ› ‹bn α ♯* P›  ‹bn α ♯* subject α›  ‹bn α ♯* Ψ⇩P› ‹A⇩P ♯* C› ‹x ♯ C› ‹bn α ♯* C› 
  ultimately have "Prop C Ψ (⦇νx⦈P) (α ≺ (⦇νx⦈P')) (x#A⇩P) Ψ⇩P"
    by(rule_tac rScope)
  
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹A⇩P ♯* A⇩x⇩P› ‹A⇩P ♯* C› ‹x ♯ A⇩x⇩P› ‹A⇩P ♯* A⇩x⇩P› ‹x ♯ A⇩P›
       ‹x ♯ Ψ› ‹x ♯ α› ‹x ♯ C› Aeq
       S ‹distinctPerm p›
  have "Prop C Ψ (⦇νx⦈P) (α ≺ (⦇νx⦈P')) (p ∙ (x#A⇩P)) (p ∙ Ψ⇩P)"
    by(rule_tac A⇩P="x#A⇩P" in rAlpha) (assumption | simp add: abs_fresh fresh_star_def)+
  with Ψeq Aeq show ?case by(simp add: eqvts)
next
  case(Bang Ψ P Rs A⇩b⇩P Ψ⇩b⇩P C)

  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                  and "A⇩P ♯* (Ψ, P, Rs, C)"
    by(rule freshFrame)
  hence "A⇩P ♯* Ψ" and "A⇩P ♯* P" and "A⇩P ♯* Rs" and "A⇩P ♯* C" 
    by simp+

  note ‹Ψ ⊳ P ∥ !P ⟼ Rs› ‹guarded P› FrP ‹distinct A⇩P›
  moreover from FrP have "extractFrame (P ∥ !P) = ⟨A⇩P, Ψ⇩P ⊗ 𝟭⟩"
    by simp
  with ‹distinct A⇩P› ‹⋀A⇩P Ψ⇩P C. ⟦extractFrame (P ∥ !P) = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P⟧ ⟹ Prop C Ψ (P ∥ !P) Rs A⇩P Ψ⇩P›
  have "⋀C. Prop C Ψ (P ∥ !P) Rs A⇩P (Ψ⇩P ⊗ 𝟭)" by simp
  moreover from ‹guarded P› FrP have "Ψ⇩P ≃ 𝟭" and "supp Ψ⇩P = ({}::name set)" by(metis guardedStatEq)+
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Rs› ‹A⇩P ♯* C›
  ultimately have "Prop C Ψ (!P) Rs ([]) (𝟭)"
    by(rule rBang) 
  thus ?case using ‹extractFrame(!P) = ⟨A⇩b⇩P, Ψ⇩b⇩P⟩› by simp
qed

lemma semanticsFrameInduct'[consumes 5, case_names cAlpha cFrameAlpha cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Rs   :: "('a, 'b, 'c) residual"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒ 'a action ⇒
                 ('a, 'b, 'c) psi ⇒ name list ⇒ 'b ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼α ≺ P'"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     rAlpha: "⋀Ψ P α P' p A⇩P Ψ⇩P C. ⟦bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* Ψ⇩P;
                                           bn α ♯* C; bn α ♯* (p ∙ α); A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* C;
                                           set p ⊆ set(bn α) × set(bn(p ∙ α)); distinctPerm p;
                                           bn(p ∙ α) ♯* α; (bn(p ∙ α)) ♯* P'; Prop C Ψ P α P' A⇩P Ψ⇩P⟧ ⟹
                                           Prop C Ψ P (p ∙ α) (p ∙ P') A⇩P Ψ⇩P"
  and     rFrameAlpha: "⋀Ψ P A⇩P Ψ⇩P p α P' C. ⟦A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* (p ∙ A⇩P); A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* C;
                                                set p ⊆ set A⇩P × set(p ∙ A⇩P); distinctPerm p; A⇩P ♯* subject α;
                                                Prop C Ψ P α P' A⇩P Ψ⇩P⟧ ⟹ Prop C Ψ P α P' (p ∙ A⇩P) (p ∙ Ψ⇩P)"
  and     rInput: "⋀Ψ M K xvec N Tvec P C.
                   ⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N;
                    length xvec = length Tvec; xvec ♯* Ψ;
                    xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹
                    Prop C Ψ (M⦇λ*xvec N⦈.P)
                              (K⦇(N[xvec::=Tvec])⦈) (P[xvec::=Tvec]) ([]) (𝟭)"
  and     rOutput: "⋀Ψ M K N P C. Ψ ⊢ M ↔ K ⟹ Prop C Ψ (M⟨N⟩.P) (K⟨N⟩) P ([]) (𝟭)"
  and     rCase: "⋀Ψ P α P' φ Cs A⇩P Ψ⇩P C. ⟦Ψ ⊳ P ⟼α ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; ⋀C. Prop C Ψ P α P' A⇩P Ψ⇩P;
                                            (φ, P) mem Cs; Ψ ⊢ φ; guarded P;  Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                                            A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (Cases Cs) α P' ([]) (𝟭)"
  and     rPar1: "⋀Ψ Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P α P' A⇩P Ψ⇩P;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* P'; A⇩Q ♯* Ψ⇩P;
                   bn α ♯* Ψ; bn α ♯* P; bn α ♯* Q; bn α ♯* subject α; bn α ♯* Ψ⇩P; bn α ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; bn α ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) α (P' ∥ Q) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q α Q' A⇩Q Ψ⇩Q;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* Q'; A⇩Q ♯* Ψ⇩P;
                   bn α ♯* Ψ; bn α ♯* P; bn α ♯* Q; bn α ♯* subject α; bn α ♯* Ψ⇩P; bn α ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; bn α ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) α (P ∥ Q') (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm1: "⋀Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇N⦈) P' A⇩P Ψ⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇ν*xvec⦈⟨N⟩) Q' A⇩Q Ψ⇩Q;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm2: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇ν*xvec⦈⟨N⟩) P' A⇩P Ψ⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇N⦈) Q' A⇩Q Ψ⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (τ) (⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rOpen: "⋀Ψ P M xvec yvec N P' x A⇩P Ψ⇩P y C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩) P' A⇩P Ψ⇩P; x ∈ supp N; x ♯ Ψ; x ♯ M;
                     x ♯ A⇩P; x ♯ xvec; x ♯ yvec; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
                     A⇩P ♯* xvec; A⇩P ♯* yvec; xvec ♯* yvec; distinct xvec; distinct yvec;
                     xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* Ψ⇩P; 
                     yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; A⇩P ♯* C; x ♯ C; xvec ♯* C; yvec ♯* C;
                     y ≠ x; y ♯ Ψ; y ♯ P; y ♯ M; y ♯ xvec; y ♯ yvec; y ♯ N; y ♯ P'; y ♯ A⇩P; y ♯ Ψ⇩P; y ♯ C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@y#yvec)⦈⟨([(x, y)] ∙ N)⟩) ([(x, y)] ∙ P') (x#A⇩P) Ψ⇩P"
  and     rScope: "⋀Ψ P α P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼α ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P α P' A⇩P Ψ⇩P;
                     x ♯ Ψ; x ♯ α; x ♯ A⇩P; A⇩P ♯* Ψ; A⇩P ♯* P;
                     A⇩P ♯* α; A⇩P ♯* P';
                     bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* Ψ⇩P;
                     A⇩P ♯* C; x ♯ C; bn α ♯* C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) α (⦇νx⦈P') (x#A⇩P) Ψ⇩P"
  and     rBang:    "⋀Ψ P α P' A⇩P Ψ⇩P C.
                     ⟦Ψ ⊳ P ∥ !P ⟼α ≺ P'; guarded P; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                      ⋀C. Prop C Ψ (P ∥ !P) α P' A⇩P (Ψ⇩P ⊗ 𝟭); Ψ⇩P ≃ 𝟭; supp Ψ⇩P = ({}::name set);
                      A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* α; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (!P) α P' ([]) (𝟭)"
  shows "Prop C Ψ P α P' A⇩P Ψ⇩P"
using Trans FrP ‹distinct A⇩P› ‹bn α ♯* subject α› ‹distinct(bn α)›
proof(nominal_induct Ψ P Rs=="α ≺ P'" A⇩P Ψ⇩P avoiding: C α P' rule: semanticsFrameInduct)
  case cAlpha 
  thus ?case using rFrameAlpha
    by auto
next
  case cInput
  thus ?case using rInput
    by(auto simp add: residualInject)
next
  case cOutput
  thus ?case using rOutput
    by(auto simp add: residualInject)
next
  case cCase
  thus ?case using rCase
    by(auto simp add: residualInject)
next
  case(cPar1 Ψ Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P C α' P'')
  note ‹α ≺ (P' ∥ Q) = α' ≺ P''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ P' ∥ Q)" and "bn α' ♯* (α' ≺ P'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and P'eq: "P'' = p ∙ (P' ∥ Q)" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (P' ∥ Q)"
    by(rule residualEq)
    
  note ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)› ‹A⇩P ♯* α›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P α P' A⇩P Ψ⇩P" by(rule_tac cPar1) auto

  moreover note ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* C› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹A⇩P ♯* C›
                ‹bn α ♯* Q› ‹distinct(bn α)› ‹bn α ♯* Ψ› ‹bn α ♯* Ψ⇩Q› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C›
                ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P› ‹bn α ♯* Ψ⇩P›
  ultimately have "Prop C Ψ (P ∥ Q) α (P' ∥ Q) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rPar1)
  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* (bn α')› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P' ∥ Q)› ‹bn α ♯* Ψ⇩P› ‹bn α ♯* Ψ⇩Q› ‹A⇩P ♯* α› ‹A⇩Q ♯* α› ‹A⇩P ♯* α'› ‹A⇩Q ♯* α'› αEq ‹bn α ♯* Ψ⇩P› ‹bn α ♯* α'› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P ♯* P'› ‹A⇩Q ♯* P'› ‹A⇩P ♯* C› ‹A⇩Q ♯* C›
  have "Prop C Ψ (P ∥ Q) (p ∙ α) (p ∙ (P' ∥ Q)) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rAlpha) auto
  with αEq P'eq ‹distinctPerm p› show ?case by simp
next
  case(cPar2 Ψ Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q C α' Q'')
  note ‹α ≺ (P ∥ Q') = α' ≺ Q''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ P ∥ Q')" and "bn α' ♯* (α' ≺ Q'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and Q'eq: "Q'' = p ∙ (P ∥ Q')" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (P ∥ Q')"
    by(rule residualEq)
    
  note ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)› ‹A⇩Q ♯* α›
  have "⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q α Q' A⇩Q Ψ⇩Q" by(rule_tac cPar2) auto

  moreover note ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α› ‹A⇩Q ♯* Q'› ‹A⇩Q ♯* C› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α› ‹A⇩P ♯* Q'› ‹A⇩P ♯* C›
                ‹bn α ♯* Q› ‹distinct(bn α)› ‹bn α ♯* Ψ› ‹bn α ♯* Ψ⇩Q› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C›
                ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P› ‹bn α ♯* Ψ⇩P›
  ultimately have "Prop C Ψ (P ∥ Q) α (P ∥ Q') (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
    by(rule_tac rPar2) auto
  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* (bn α')› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P ∥ Q')› ‹bn α ♯* Ψ⇩P› ‹bn α ♯* Ψ⇩Q› ‹A⇩P ♯* α› ‹A⇩Q ♯* α› ‹A⇩P ♯* α'› ‹A⇩Q ♯* α'› αEq ‹bn α ♯* α'› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P ♯* Q'› ‹A⇩Q ♯* Q'› ‹A⇩P ♯* C› ‹A⇩Q ♯* C›
  have "Prop C Ψ (P ∥ Q) (p ∙ α) (p ∙ (P ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
   by(rule_tac rAlpha) auto
  with αEq Q'eq ‹distinctPerm p› show ?case by simp
next
  case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C α P'')
  thus ?case using rComm1
    apply(auto)
    apply(drule_tac x="M⦇N⦈" in meta_spec)
    apply(drule_tac x="K⦇ν*xvec⦈⟨N⟩" in meta_spec)
    apply(drule_tac x=P' in meta_spec)
    apply(drule_tac x=Q' in meta_spec)
    apply auto
    apply(drule_tac x=Ψ in meta_spec)
    apply(drule_tac x=Ψ⇩Q in meta_spec)
    apply(drule_tac x=P in meta_spec)
    apply(drule_tac x=M in meta_spec)
    apply(drule_tac x=N in meta_spec)
    apply(drule_tac x=P' in meta_spec)
    apply(drule_tac x=A⇩P in meta_spec)
    apply(drule_tac x=Ψ⇩P in meta_spec)
    apply(drule_tac x=Q in meta_spec)
    apply(drule_tac x=K in meta_spec)
    apply(drule_tac x=xvec in meta_spec)
    apply(drule_tac x=Q' in meta_spec)
    apply(drule_tac x=A⇩Q in meta_spec)
    apply auto
    apply(subgoal_tac "⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇ν*xvec⦈⟨N⟩) Q' A⇩Q Ψ⇩Q")
    apply(subgoal_tac "⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇N⦈) P' A⇩P Ψ⇩P")
    by(auto simp add: residualInject)
next
  case(cComm2 Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C α Q'')
  thus ?case using rComm2
    apply(drule_tac x="M⦇ν*xvec⦈⟨N⟩" in meta_spec)
    apply(drule_tac x="K⦇N⦈" in meta_spec)
    apply(drule_tac x=P' in meta_spec)
    apply(drule_tac x=Q' in meta_spec)
    apply auto
    apply(drule_tac x=Ψ in meta_spec)
    apply(drule_tac x=Ψ⇩Q in meta_spec)
    apply(drule_tac x=P in meta_spec)
    apply(drule_tac x=M in meta_spec)
    apply(drule_tac x=xvec in meta_spec)
    apply(drule_tac x=N in meta_spec)
    apply(drule_tac x=P' in meta_spec)
    apply(drule_tac x=A⇩P in meta_spec)
    apply(drule_tac x=Ψ⇩P in meta_spec)
    apply(drule_tac x=Q in meta_spec)
    apply(drule_tac x=K in meta_spec)
    apply(drule_tac x=Q' in meta_spec)
    apply(drule_tac x=A⇩Q in meta_spec)
    apply auto
    apply(subgoal_tac "⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P (M⦇ν*xvec⦈⟨N⟩) P' A⇩P Ψ⇩P")
    apply(subgoal_tac "⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q (K⦇N⦈) Q' A⇩Q Ψ⇩Q")
    by(auto simp add: residualInject)
next
  case(cOpen Ψ P M xvec yvec N P' x A⇩P Ψ⇩P C α P'')
  note ‹M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P' = α ≺ P''›
  moreover from ‹xvec ♯* α› ‹x ♯ α› ‹yvec ♯* α› have "(xvec@x#yvec) ♯* (bn α)"
    by auto
  moreover from ‹xvec ♯* yvec› ‹x ♯ xvec› ‹x ♯ yvec› ‹distinct xvec› ‹distinct yvec›
  have "distinct(xvec@x#yvec)"
    by(auto simp add: fresh_star_def) (simp add: fresh_def name_list_supp)
  moreover note ‹distinct(bn α)›
  moreover from ‹xvec ♯* M› ‹x ♯ M› ‹yvec ♯* M› have "(xvec@x#yvec) ♯* M" by auto
  hence "(xvec@x#yvec) ♯* (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P')" by auto
  moreover from ‹bn α ♯* subject α› have "bn α ♯* (α ≺ P'')" by simp
  ultimately obtain p where S: "(set p) ⊆ (set(xvec@x#yvec)) × (set(p ∙ (xvec@x#yvec)))" and "distinctPerm p"
             and αeq: "α = (p ∙ M)⦇ν*(p ∙ (xvec@x#yvec))⦈⟨(p ∙ N)⟩" and P'eq: "P'' = (p ∙ P')"
             and A: "(xvec@x#yvec) ♯* ((p ∙ M)⦇ν*(p ∙ (xvec@x#yvec))⦈⟨(p ∙ N)⟩)"
             and B: "(p ∙ (xvec@x#yvec)) ♯* (M⦇ν*(xvec@x#yvec)⦈⟨N⟩)"
             and C: "(p ∙ (xvec@x#yvec)) ♯* P'"
    by(rule_tac residualEq) (assumption | simp)+

  note ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'› ‹x ∈ (supp N)›

  moreover {
    fix C
    from ‹xvec ♯* M› ‹yvec ♯* M› have "(xvec@yvec) ♯* M" by simp
    moreover from ‹distinct xvec› ‹distinct yvec› ‹xvec ♯* yvec› have "distinct(xvec@yvec)"
      by auto (simp add: fresh_star_def name_list_supp fresh_def) 
    ultimately have "Prop C Ψ P (M⦇ν*(xvec@yvec)⦈⟨N⟩) P' A⇩P Ψ⇩P" using ‹A⇩P ♯* xvec› ‹A⇩P ♯* yvec› ‹A⇩P ♯* M› ‹A⇩P ♯* N›
      by(rule_tac cOpen) auto
  }
  moreover obtain y::name where "y ♯ Ψ" and "y ≠ x" and "y ♯ P" and "y ♯ xvec" and "y ♯ yvec" and "y ♯ α" and "y ♯ P'" and "y ♯ A⇩P" and "y ♯ Ψ⇩P" and "y ♯ M" and "y ♯ N" and "y ♯ C" and "y ♯ p"
    by(generate_fresh "name") auto
  moreover note ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ xvec› ‹x ♯ yvec› ‹xvec ♯* Ψ› ‹xvec ♯* P› ‹xvec ♯* M›
                 ‹yvec ♯* Ψ› ‹yvec ♯* P› ‹yvec ♯* M› ‹yvec ♯* C› ‹x ♯ C› ‹xvec ♯* C› ‹distinct xvec› ‹distinct yvec›
                 ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹x ♯ A⇩P› ‹xvec ♯* yvec› ‹xvec ♯* Ψ⇩P›
                 ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* xvec› ‹A⇩P ♯* yvec› ‹A⇩P ♯* N› ‹A⇩P ♯* P'› ‹A⇩P ♯* C› 
  ultimately have "Prop C Ψ (⦇νx⦈P) (M⦇ν*(xvec@y#yvec)⦈⟨([(x, y)] ∙ N)⟩) ([(x, y)] ∙ P') (x#A⇩P) Ψ⇩P"
    by(rule_tac rOpen)
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ M) = [(x, y)] ∙ p ∙ M"
    by(subst perm_compose[symmetric]) simp
  with ‹y ♯ M› ‹x ♯ α› αeq ‹y ♯ p› ‹x ♯ M› have D: "(([(x, y)] ∙ p) ∙ M) = p ∙ M"
    by(auto simp add: eqvts freshChainSimps)
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ xvec) = [(x, y)] ∙ p ∙ xvec"
    by(subst perm_compose[symmetric]) simp
  with ‹y ♯ xvec› ‹x ♯ α› αeq ‹y ♯ p› ‹x ♯ xvec› have E: "(([(x, y)] ∙ p) ∙ xvec) = p ∙ xvec"
    by(auto simp add: eqvts freshChainSimps)
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ yvec) = [(x, y)] ∙ p ∙ yvec"
    by(subst perm_compose[symmetric]) simp
  with ‹y ♯ yvec› ‹x ♯ α› αeq ‹y ♯ p› ‹x ♯ yvec› have F: "(([(x, y)] ∙ p) ∙ yvec) = p ∙ yvec"
    by(auto simp add: eqvts freshChainSimps)
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ x) = [(x, y)] ∙ p ∙ x"
    by(subst perm_compose[symmetric]) simp
  with ‹y ≠ x› ‹y ♯ p› have G: "(([(x, y)] ∙ p) ∙ y) = p ∙ x"
    apply(simp add: freshChainSimps calc_atm)
    apply(subgoal_tac "y ≠ p ∙ x")
    apply(clarsimp)
    using A αeq
    apply(simp add: eqvts)
    apply(subst fresh_atm[symmetric])
    apply(simp only: freshChainSimps)
    by simp
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ N) = [(x, y)] ∙ p ∙ N"
    by(subst perm_compose[symmetric]) simp
  with ‹y ♯ N› ‹x ♯ α› ‹y ♯ p› αeq have H: "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ N) = p ∙ N"
    by(auto simp add: eqvts freshChainSimps)
  moreover have "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ P') = [(x, y)] ∙ p ∙ P'"
    by(subst perm_compose[symmetric]) simp
  with ‹y ♯ P'› ‹x ♯ P''› ‹y ♯ p› P'eq have I: "(([(x, y)] ∙ p) ∙ [(x, y)] ∙ P') = p ∙ P'"
    by(auto simp add: eqvts freshChainSimps)
  from ‹y ♯ p› ‹y ≠ x› have "y ≠ p ∙ x"
    apply(subst fresh_atm[symmetric])
    apply(simp only: freshChainSimps)
    by simp
  moreover from S have "([(x, y)] ∙ set p) ⊆ [(x, y)] ∙ (set(xvec@x#yvec) × set(p ∙ (xvec@x#yvec)))"
    by(simp)
  with ‹y ≠ p ∙ x› ‹(([(x, y)] ∙ p) ∙ y) = p ∙ x› ‹x ♯ xvec› ‹y ♯ xvec› ‹x ♯ yvec› ‹y ♯ yvec› ‹y ♯ p› ‹x ♯ α› αeq have 
    "set([(x, y)] ∙ p) ⊆ set(xvec@y#yvec) × set(([(x, y)] ∙ p) ∙ (xvec@y#yvec))"
    by(simp add: eqvts calc_atm perm_compose)
  moreover note ‹xvec ♯* Ψ› ‹yvec ♯* Ψ› ‹xvec ♯* P› ‹yvec ♯* P› ‹xvec ♯* M› ‹yvec ♯* M› 
                ‹yvec ♯* C›  S ‹distinctPerm p› ‹x ♯ C› ‹xvec ♯* C› ‹xvec ♯* Ψ⇩P› ‹yvec ♯* Ψ⇩P› ‹x ♯ Ψ›
                ‹A⇩P ♯* xvec› ‹x ♯ A⇩P› ‹A⇩P ♯* yvec› ‹A⇩P ♯* M› ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ M› ‹x ♯ A⇩P› ‹A⇩P ♯* N›
                 A B C  αeq ‹A⇩P ♯* α› ‹y ♯ Ψ› ‹y ≠ x› ‹y ♯ P› ‹y ♯ M› ‹y ♯ Ψ⇩P› ‹y ♯ C› ‹xvec ♯* α› ‹x ♯ α› ‹yvec ♯* α› ‹y ♯ α› ‹A⇩P ♯* P› ‹A⇩P ♯* Ψ› ‹y ♯ A⇩P› ‹y ♯ N› ‹A⇩P ♯* P'› ‹y ♯ P'› ‹A⇩P ♯* C› P'eq
  ultimately have "Prop C Ψ (⦇νx⦈P) (([(x, y)] ∙ p) ∙ (M⦇ν*(xvec@y#yvec)⦈⟨([(x, y)] ∙ N)⟩)) (([(x, y)] ∙ p) ∙ [(x, y)] ∙ P') (x#A⇩P) Ψ⇩P"
    apply(rule_tac α="M⦇ν*(xvec@y#yvec)⦈⟨([(x, y)] ∙ N)⟩" in rAlpha)
    apply(assumption | simp)+
    apply(simp add: eqvts)
    apply(assumption | simp add: abs_fresh)+
    apply(simp add: fresh_left calc_atm)
    apply(assumption | simp)+
    apply(simp add: fresh_left calc_atm)
    apply(assumption | simp)+
    by(simp add: eqvts fresh_left)+
  with αeq P'eq D E F G H I show ?case 
    by(simp add: eqvts)
next    
 case(cScope Ψ P α P' x A⇩P Ψ⇩P C α' P'')
  note ‹α ≺ (⦇νx⦈P') = α' ≺ P''›
  moreover from ‹bn α ♯* α'› have "bn α ♯* (bn α')" by auto
  moreover note ‹distinct (bn α)› ‹distinct(bn α')›
  moreover from ‹bn α ♯* subject α› ‹bn α' ♯* subject α'›
  have "bn α ♯* (α ≺ ⦇νx⦈P')" and "bn α' ♯* (α' ≺ P'')" by simp+
  ultimately obtain p where S: "(set p) ⊆ (set(bn α)) × (set(bn(p ∙ α)))" and "distinctPerm p"
                        and αEq: "α' = p ∙ α" and P'eq: "P'' = p ∙ (⦇νx⦈P')" and "(bn(p ∙ α)) ♯* α"
                        and "(bn(p ∙ α)) ♯* (⦇νx⦈P')"
    by(rule residualEq)
    
  note ‹Ψ ⊳ P ⟼α ≺ P'›
  moreover from ‹bn α ♯* subject α› ‹distinct(bn α)›
  have "⋀C. Prop C Ψ P α P' A⇩P Ψ⇩P" by(rule_tac cScope) auto

  moreover note ‹x ♯ Ψ› ‹x ♯ α› ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* Ψ⇩P›
                ‹x ♯ C› ‹bn α ♯* C› ‹distinct(bn α)› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩›
                ‹distinct A⇩P› ‹x ♯ A⇩P› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* α› ‹A⇩P ♯* P'› ‹A⇩P ♯* C›
  ultimately have "Prop C Ψ (⦇νx⦈P) α (⦇νx⦈P') (x#A⇩P) Ψ⇩P"
    by(rule_tac rScope) 
  with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹x ♯ α› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹bn α ♯* (bn α')› S ‹distinctPerm p› ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (⦇νx⦈P')› ‹A⇩P ♯* α› ‹A⇩P ♯* α'› αEq ‹x ♯ α'› ‹bn α ♯* Ψ⇩P› ‹bn α ♯* α'› ‹x ♯ Ψ› ‹A⇩P ♯* Ψ› ‹x ♯ A⇩P› ‹A⇩P ♯* P› ‹A⇩P ♯* P'› ‹x ♯ C› ‹A⇩P ♯* C›
  have "Prop C Ψ (⦇νx⦈P) (p ∙ α) (p ∙ (⦇νx⦈P'))  (x#A⇩P) Ψ⇩P" 
    by(rule_tac rAlpha) (simp add: abs_fresh)+
  with αEq P'eq ‹distinctPerm p› show ?case by simp
next
  case(cBang Ψ P Rs A⇩P Ψ⇩P C α)
  thus ?case by(rule_tac rBang) auto 
qed

lemma inputFrameInduct[consumes 3, case_names cAlpha cInput cCase cPar1 cPar2 cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 'a ⇒ 'a ⇒ ('a, 'b, 'c) psi ⇒ name list ⇒ 'b ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     rAlpha: "⋀Ψ P M N P' A⇩P Ψ⇩P p C. ⟦A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* (p ∙ A⇩P); A⇩P ♯* C;
                                            set p ⊆ set A⇩P × set(p ∙ A⇩P); distinctPerm p;
                                             Prop C Ψ P M N P' A⇩P Ψ⇩P⟧ ⟹ Prop C Ψ P M N P' (p ∙ A⇩P) (p ∙ Ψ⇩P)"
  and     rInput: "⋀Ψ M K xvec N Tvec P C.
                   ⟦Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N;
                    length xvec = length Tvec; xvec ♯* Ψ;
                    xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹
                    Prop C Ψ (M⦇λ*xvec N⦈.P)
                              K (N[xvec::=Tvec]) (P[xvec::=Tvec]) ([]) (𝟭)"
  and     rCase: "⋀Ψ P M N P' φ Cs A⇩P Ψ⇩P C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; ⋀C. Prop C Ψ P M N P' A⇩P Ψ⇩P;
                                              (φ, P) mem Cs; Ψ ⊢ φ; guarded P;  Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                                              A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (Cases Cs) M N P' ([]) (𝟭)"
  and     rPar1: "⋀Ψ Ψ⇩Q P M N P' A⇩Q Q A⇩P Ψ⇩P C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P M N P' A⇩P Ψ⇩P;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Ψ⇩P;
                   A⇩P ♯* C; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M N (P' ∥ Q) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q M N Q' A⇩P P A⇩Q Ψ⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇N⦈ ≺ Q';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q M N Q' A⇩Q Ψ⇩Q;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; A⇩Q ♯* N; A⇩Q ♯* Q'; A⇩Q ♯* Ψ⇩P;
                   A⇩P ♯* C; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M N (P ∥ Q') (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rScope: "⋀Ψ P M N P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P M N P' A⇩P Ψ⇩P; x ♯ Ψ; x ♯ M; x ♯ N; 
                     x ♯ A⇩P; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
                     A⇩P ♯* C; x ♯ C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) M N (⦇νx⦈P') (x#A⇩P) Ψ⇩P"
  and     rBang:    "⋀Ψ P M N P' A⇩P Ψ⇩P C.
                     ⟦Ψ ⊳ P ∥ !P ⟼M⦇N⦈ ≺ P'; guarded P; extractFrame P = ⟨A⇩P, Ψ⇩P⟩;  distinct A⇩P;
                      ⋀C. Prop C Ψ (P ∥ !P) M N P' A⇩P (Ψ⇩P ⊗ 𝟭); Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                      A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (!P) M N P' ([]) (𝟭)"
  shows "Prop C Ψ P M N P' A⇩P Ψ⇩P"
using assms
by(nominal_induct Ψ P Rs=="M⦇N⦈ ≺ P'" A⇩P Ψ⇩P avoiding: C arbitrary: P' rule: semanticsFrameInduct)
  (auto simp add: residualInject)

lemma outputFrameInduct[consumes 3, case_names cAlpha cOutput cCase cPar1 cPar2 cOpen cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 'a ⇒ ('a, 'b, 'c) boundOutput ⇒ name list ⇒ 'b ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼ROut M B"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     rAlpha: "⋀Ψ P M A⇩P Ψ⇩P p B C. ⟦A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* (p ∙ A⇩P); A⇩P ♯* B; A⇩P ♯* C;
                                         set p ⊆ set A⇩P × set(p ∙ A⇩P); distinctPerm p;
                                          Prop C Ψ P M B A⇩P Ψ⇩P⟧ ⟹ Prop C Ψ P M B (p ∙ A⇩P) (p ∙ Ψ⇩P)"
  and     rOutput: "⋀Ψ M K N P C. Ψ ⊢ M ↔ K ⟹ Prop C Ψ (M⟨N⟩.P) K (N ≺' P) ([]) (𝟭)"
  and     rCase: "⋀Ψ P M B φ Cs A⇩P Ψ⇩P C. ⟦Ψ ⊳ P ⟼(ROut M B); extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; ⋀C. Prop C Ψ P M B A⇩P Ψ⇩P;
                                            (φ, P) mem Cs; Ψ ⊢ φ; guarded P;  Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                                            A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* B; A⇩P ♯* C⟧ ⟹ Prop C Ψ (Cases Cs) M B ([]) (𝟭)"
  and     rPar1: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩Q Q A⇩P Ψ⇩P C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P M (⦇ν*xvec⦈N ≺' P') A⇩P Ψ⇩P;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M;  A⇩P ♯* xvec; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; A⇩Q ♯* xvec; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Ψ⇩P;
                   xvec ♯* Ψ; xvec ♯* P; xvec ♯* Q; xvec ♯* M; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M (⦇ν*xvec⦈N ≺' (P' ∥ Q)) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q M xvec N Q' A⇩P P A⇩Q Ψ⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q M (⦇ν*xvec⦈N ≺' Q') A⇩Q Ψ⇩Q;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* M; A⇩P ♯* xvec; A⇩P ♯* N; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* M; A⇩Q ♯* xvec; A⇩Q ♯* N; A⇩Q ♯* Q'; A⇩Q ♯* Ψ⇩P;
                   xvec ♯* Ψ; xvec ♯* P; xvec ♯* Q; xvec ♯* M; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q;
                   A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) M (⦇ν*xvec⦈N ≺' (P ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rOpen: "⋀Ψ P M xvec yvec N P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P M (⦇ν*(xvec@yvec)⦈N ≺' P') A⇩P Ψ⇩P; x ∈ supp N; x ♯ Ψ; x ♯ M;
                     x ♯ A⇩P; x ♯ xvec; x ♯ yvec; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P';
                     A⇩P ♯* xvec; A⇩P ♯* yvec;
                     xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* Ψ⇩P; 
                     yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; A⇩P ♯* C; x ♯ C; xvec ♯* C; yvec ♯* C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) M (⦇ν*(xvec@x#yvec)⦈N ≺' P') (x#A⇩P) Ψ⇩P"
  and     rScope: "⋀Ψ P M xvec N P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P M (⦇ν*xvec⦈N ≺' P') A⇩P Ψ⇩P;
                     x ♯ Ψ; x ♯ M; x ♯ xvec; x ♯ N; x ♯ A⇩P; A⇩P ♯* Ψ; A⇩P ♯* P;
                     A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; A⇩P ♯* xvec;
                     xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* Ψ⇩P;
                     A⇩P ♯* C; x ♯ C; xvec ♯* C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) M (⦇ν*xvec⦈N ≺' (⦇νx⦈P')) (x#A⇩P) Ψ⇩P"
  and     rBang:    "⋀Ψ P M B A⇩P Ψ⇩P C.
                     ⟦Ψ ⊳ P ∥ !P ⟼ROut M B; guarded P; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                      ⋀C. Prop C Ψ (P ∥ !P) M B A⇩P (Ψ⇩P ⊗ 𝟭); Ψ⇩P ≃ 𝟭; supp Ψ⇩P = ({}::name set);
                      A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* C⟧ ⟹ Prop C Ψ (!P) M B ([]) (𝟭)"
  shows "Prop C Ψ P M B A⇩P Ψ⇩P"
proof -
  {
    fix B
    assume "Ψ ⊳ P ⟼ROut M B"
    hence "Prop C Ψ P M B A⇩P Ψ⇩P" using FrP ‹distinct A⇩P›
    proof(nominal_induct Ψ P Rs=="ROut M B" A⇩P Ψ⇩P avoiding: C arbitrary: B rule: semanticsFrameInduct)
      case cAlpha
      thus ?case by(fastforce intro: rAlpha) 
    next
      case cInput 
      thus ?case by(simp add: residualInject)
    next
      case cOutput
      thus ?case by(force intro: rOutput simp add: residualInject)
    next
      case cCase
      thus ?case by(force intro: rCase simp add: residualInject)
    next
      case cPar1
      thus ?case
        by(fastforce intro: rPar1 simp add: residualInject)
    next
      case cPar2
      thus ?case
        by(fastforce intro: rPar2 simp add: residualInject)
    next
      case cComm1
      thus ?case by(simp add: residualInject)
    next
      case cComm2
      thus ?case by(simp add: residualInject)
    next
      case cOpen
      thus ?case by(fastforce intro: rOpen simp add: residualInject)
    next
      case cScope
      thus ?case by(force intro: rScope simp add: residualInject)
    next
      case cBang
      thus ?case by(force intro: rBang simp add: residualInject)
    qed
  }
  with Trans show ?thesis by(simp add: residualInject)
qed

lemma tauFrameInduct[consumes 3, case_names cAlpha cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒
                 ('a, 'b, 'c) psi ⇒ name list ⇒ 'b ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ⟼τ ≺ P'"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     rAlpha: "⋀Ψ P P' A⇩P Ψ⇩P p C. ⟦A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* P'; A⇩P ♯* (p ∙ A⇩P); A⇩P ♯* C;
                                        set p ⊆ set A⇩P × set (p ∙ A⇩P); distinctPerm p;
                                         Prop C Ψ P P' A⇩P Ψ⇩P⟧ ⟹ Prop C Ψ P P' (p ∙ A⇩P) (p ∙ Ψ⇩P)"
  and     rCase: "⋀Ψ P P' φ Cs A⇩P Ψ⇩P C. ⟦Ψ ⊳ P ⟼τ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P; ⋀C. Prop C Ψ P P' A⇩P Ψ⇩P;
                                          (φ, P) mem Cs; Ψ ⊢ φ; guarded P;  Ψ⇩P ≃ 𝟭; (supp Ψ⇩P) = ({}::name set);
                                          A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (Cases Cs) P' ([]) (𝟭)"
  and     rPar1: "⋀Ψ Ψ⇩Q P P' A⇩Q Q A⇩P Ψ⇩P C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼τ ≺ P';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩Q) P P' A⇩P Ψ⇩P;
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* P'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* P'; A⇩Q ♯* Ψ⇩P;
                   A⇩P ♯* C; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (P' ∥ Q) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rPar2: "⋀Ψ Ψ⇩P Q Q' A⇩P P A⇩Q Ψ⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼τ ≺ Q';
                   extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                   extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                   ⋀C. Prop C (Ψ ⊗ Ψ⇩P) Q Q' A⇩Q Ψ⇩Q; 
                   A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* Ψ⇩Q;
                   A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* Q'; A⇩Q ♯* Ψ⇩P;
                   A⇩P ♯* C; A⇩Q ♯* C⟧ ⟹
                   Prop C Ψ (P ∥ Q) (P ∥ Q') (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm1: "⋀Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rComm2: "⋀Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C.
                   ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
                    A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* P'; 
                    A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P; 
                    A⇩Q ♯* P; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* K; A⇩Q ♯* Q';
                    A⇩Q ♯* xvec; xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; 
                    xvec ♯* Q; xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C⟧ ⟹
                    Prop C Ψ (P ∥ Q) (⦇ν*xvec⦈(P' ∥ Q')) (A⇩P@A⇩Q) (Ψ⇩P ⊗ Ψ⇩Q)"
  and     rScope: "⋀Ψ P P' x A⇩P Ψ⇩P C.
                    ⟦Ψ ⊳ P ⟼τ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    ⋀C. Prop C Ψ P P' A⇩P Ψ⇩P; x ♯ Ψ;
                     x ♯ A⇩P; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* P';
                     A⇩P ♯* C; x ♯ C⟧ ⟹
                     Prop C Ψ (⦇νx⦈P) (⦇νx⦈P') (x#A⇩P) Ψ⇩P"
  and     rBang:    "⋀Ψ P P' A⇩P Ψ⇩P C.
                     ⟦Ψ ⊳ P ∥ !P ⟼τ ≺ P'; guarded P; extractFrame P = ⟨A⇩P, Ψ⇩P⟩;  distinct A⇩P;
                      ⋀C. Prop C Ψ (P ∥ !P) P' A⇩P (Ψ⇩P ⊗ 𝟭); Ψ⇩P ≃ 𝟭; supp Ψ⇩P = ({}::name set);
                      A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* P'; A⇩P ♯* C⟧ ⟹ Prop C Ψ (!P) P' ([]) (𝟭)"
  shows "Prop C Ψ P P' A⇩P Ψ⇩P"
using Trans FrP ‹distinct A⇩P›
proof(nominal_induct Ψ P Rs=="τ ≺ P'" A⇩P Ψ⇩P avoiding: C arbitrary: P' rule: semanticsFrameInduct)
  case cAlpha
  thus ?case by(force intro: rAlpha simp add: residualInject)
next
  case cInput 
  thus ?case by(simp add: residualInject)
next
  case cOutput
  thus ?case by(simp add: residualInject)
next
  case cCase
  thus ?case by(force intro: rCase simp add: residualInject)
next
  case cPar1
  thus ?case by(force intro: rPar1 simp add: residualInject)
next
  case cPar2
  thus ?case by(force intro: rPar2 simp add: residualInject)
next
  case cComm1
  thus ?case by(force intro: rComm1 simp add: residualInject)
next
  case cComm2
  thus ?case by(force intro: rComm2 simp add: residualInject)
next
  case cOpen
  thus ?case by(simp add: residualInject)
next
  case cScope
  thus ?case by(force intro: rScope simp add: residualInject)
next
  case cBang
  thus ?case by(force intro: rBang simp add: residualInject)
qed

lemma inputFreshDerivative:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "x ♯ P"
  and     "x ♯ N"

  shows "x ♯ P'"
proof -
  have "bn(M⦇N⦈) ♯* subject(M⦇N⦈)" and "distinct(bn(M⦇N⦈))" by simp+
  with ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› show ?thesis using ‹x ♯ P› ‹x ♯ N›
  proof(nominal_induct Ψ P α=="M⦇N⦈" P' avoiding: x rule: semanticsInduct)
    case(cAlpha Ψ P α P' p x)
    thus ?case by simp
  next
    case(cInput Ψ M' K xvec N' Tvec P x)
    from ‹K⦇(N'[xvec::=Tvec])⦈ = M⦇N⦈› have "M = K" and NeqN': "N = N'[xvec::=Tvec]" by(simp add: action.inject)+ 
    note ‹length xvec = length Tvec› ‹distinct xvec› then
    moreover have "x ♯ Tvec" using ‹set xvec ⊆ supp N'› ‹x ♯ N› NeqN'
      by(blast intro: substTerm.subst3)
    moreover from ‹xvec ♯* x› ‹x ♯ M'⦇λ*xvec N'⦈.P›
    have "x ♯ P" by(simp add: inputChainFresh) (simp add: name_list_supp fresh_def)
    ultimately show ?case using ‹xvec ♯* x› by auto
  next
    case(cOutput Ψ M  K N P x)
    thus ?case by simp
  next
    case(cCase Ψ P P' φ Cs x)
    thus ?case by(induct Cs, auto)
  next
    case(cPar1 Ψ Ψ⇩Q P P' xvec Q x)
    thus ?case by simp
  next
    case(cPar2 Ψ Ψ⇩P Q Q' xvec P x)
    thus ?case by simp
  next
    case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q x)
    thus ?case by simp
  next
    case(cComm2 Ψ Ψ⇩Q P M xwec N P' A⇩P Ψ⇩P Q K Q' A⇩Q x)
    thus ?case by simp
  next
    case(cOpen Ψ P M xvec yvec N P' x y)
    thus ?case by simp
  next
    case(cScope Ψ P P' x y)
    thus ?case by(simp add: abs_fresh)
  next
    case(cBang Ψ P P' x)
    thus ?case by simp
  qed
qed
  
lemma inputFreshChainDerivative:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   xvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "xvec ♯* P"
  and     "xvec ♯* N"
  
  shows "xvec ♯* P'"
using assms
by(induct xvec)
  (auto intro: inputFreshDerivative)

lemma outputFreshDerivative:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   x    :: name

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     "distinct xvec"
  and     "x ♯ P"
  and     "x ♯ xvec"

  shows "x ♯ N"
  and   "x ♯ P'"
proof -
  note ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'›
  moreover from ‹xvec ♯* M› have "bn(M⦇ν*xvec⦈⟨N⟩) ♯* subject(M⦇ν*xvec⦈⟨N⟩)" by simp
  moreover from ‹distinct xvec› have "distinct(bn(M⦇ν*xvec⦈⟨N⟩))" by simp
  ultimately show "x ♯ N" using ‹x ♯ P› ‹x ♯ xvec›
  proof(nominal_induct Ψ P α=="M⦇ν*xvec⦈⟨N⟩" P' avoiding: x arbitrary: M xvec N rule: semanticsInduct)
    case(cAlpha Ψ P α P' p x M xvec N)
    have S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" by fact
    from ‹(p ∙ α) = M⦇ν*xvec⦈⟨N⟩› have "(p ∙ p ∙ α) = p ∙ (M⦇ν*xvec⦈⟨N⟩)" by(simp add: fresh_star_bij)
    with ‹distinctPerm p› have "α  = (p ∙ M)⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩" by simp
    moreover from ‹(p ∙ α) = M⦇ν*xvec⦈⟨N⟩› ‹x ♯ xvec› have "x ♯ (bn(p ∙ α))" by simp
    with ‹(bn α) ♯* x› ‹x ♯ xvec› S have "x ♯ (p ∙ xvec)"
      by(drule_tac pt_fresh_bij1[OF pt_name_inst, OF at_name_inst, where pi=p and x=xvec]) simp
    ultimately have "x ♯ (p ∙ N)" using ‹x ♯ P› by(rule_tac cAlpha)
    hence "(p ∙ x) ♯ (p ∙ p ∙ N)" by(simp add: pt_fresh_bij1[OF pt_name_inst, OF at_name_inst])
    with ‹distinctPerm p› ‹bn(α) ♯* x› ‹x ♯ (bn(p ∙ α))›S show ?case by simp
  next
    case cInput
    thus ?case by simp
  next
    case cOutput
    thus ?case by(simp add: action.inject)
  next
    case cCase
    thus ?case
      by(rule_tac cCase) (auto dest: memFresh)
  next
    case cPar1
    thus ?case by simp
  next
    case cPar2
    thus ?case by simp
  next
    case cComm1
    thus ?case by simp
  next
    case cComm2
    thus ?case by simp
  next
    case(cOpen Ψ P M xvec yvec N P' x y M' zvec N')
    from ‹M⦇ν*(xvec@x#yvec)⦈⟨N⟩ = M'⦇ν*zvec⦈⟨N'⟩› have "zvec = xvec@x#yvec" and "N = N'"
      by(simp add: action.inject)+
    from ‹y ♯ ⦇νx⦈P› ‹x ♯ y›  have "y ♯ P" by(simp add: abs_fresh)
    moreover from ‹y ♯ zvec› ‹zvec = xvec@x#yvec›have "y ♯ (xvec@yvec)"
      by simp
    ultimately have "y ♯ N" by(rule_tac cOpen) auto
    with ‹N = N'› show ?case by simp
  next
    case cScope
    thus ?case by(auto simp add: abs_fresh)
  next
    case cBang
    thus ?case by simp
  qed
next
  note ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'›
  moreover from ‹xvec ♯* M› have "bn(M⦇ν*xvec⦈⟨N⟩) ♯* subject(M⦇ν*xvec⦈⟨N⟩)" by simp
  moreover from ‹distinct xvec› have "distinct(bn(M⦇ν*xvec⦈⟨N⟩))" by simp
  ultimately show "x ♯ P'" using ‹x ♯ P› ‹x ♯ xvec›
  proof(nominal_induct Ψ P α=="M⦇ν*xvec⦈⟨N⟩" P' avoiding: x arbitrary: M xvec N rule: semanticsInduct)
    case(cAlpha Ψ P α P' p x M xvec N)
    have S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" by fact
    from ‹(p ∙ α) = M⦇ν*xvec⦈⟨N⟩› have "(p ∙ p ∙ α) = p ∙ (M⦇ν*xvec⦈⟨N⟩)" by(simp add: fresh_star_bij)
    with ‹distinctPerm p› have "α  = (p ∙ M)⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩" by simp
    moreover from ‹(p ∙ α) = M⦇ν*xvec⦈⟨N⟩› ‹x ♯ xvec› have "x ♯ (bn(p ∙ α))" by simp
    with ‹(bn α) ♯* x› ‹x ♯ xvec› S have "x ♯ (p ∙ xvec)"
      by(drule_tac pt_fresh_bij1[OF pt_name_inst, OF at_name_inst, where pi=p and x=xvec]) simp
    ultimately have "x ♯ P'" using ‹x ♯ P› by(rule_tac cAlpha)
    hence "(p ∙ x) ♯ (p ∙ P')" by(simp add: pt_fresh_bij1[OF pt_name_inst, OF at_name_inst])
    with ‹distinctPerm p› ‹bn(α) ♯* x› ‹x ♯ (bn(p ∙ α))›S show ?case by simp
  next
    case cInput
    thus ?case by simp
  next
    case cOutput
    thus ?case by(simp add: action.inject)
  next
    case cCase
    thus ?case by(fastforce simp add: action.inject dest: memFresh)
  next
    case cPar1
    thus ?case by simp
  next
    case cPar2
    thus ?case by simp
  next
    case cComm1
    thus ?case by simp
  next
    case cComm2
    thus ?case by simp
  next
    case(cOpen Ψ P M xvec yvec N P' x y M' zvec N')
    from ‹M⦇ν*(xvec@x#yvec)⦈⟨N⟩ = M'⦇ν*zvec⦈⟨N'⟩› have "zvec = xvec@x#yvec" 
      by(simp add: action.inject)
    from ‹y ♯ ⦇νx⦈P› ‹x ♯ y›  have "y ♯ P" by(simp add: abs_fresh)
    moreover from ‹y ♯ zvec› ‹zvec = xvec@x#yvec›have "y ♯ (xvec@yvec)"
      by simp
    ultimately show "y ♯ P'" by(rule_tac cOpen) auto
  next
    case cScope
    thus ?case by(auto simp add: abs_fresh)
  next
    case cBang
    thus ?case by simp
  qed
qed

lemma outputFreshChainDerivative:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   yvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     "distinct xvec"
  and     "yvec ♯* P"
  and     "yvec ♯* xvec"

  shows "yvec ♯* N"
  and   "yvec ♯* P'"
using assms
by(induct yvec) (auto intro: outputFreshDerivative)

lemma tauFreshDerivative:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name

  assumes "Ψ ⊳ P ⟼τ ≺ P'"
  and     "x ♯ P"

  shows "x ♯ P'"
proof -
  have "bn(τ) ♯* subject(τ)" and "distinct(bn(τ))" by simp+
  with ‹Ψ ⊳ P ⟼τ ≺ P'› show ?thesis using ‹x ♯ P›
  proof(nominal_induct Ψ P α=="(τ::('a action))" P' avoiding: x rule: semanticsInduct)
    case cAlpha
    thus ?case by simp
  next
    case cInput
    thus ?case by simp
  next
    case cOutput
    thus ?case by simp
  next 
    case cCase
    thus ?case by(auto dest: memFresh)
  next
    case cPar1
    thus ?case by simp
  next
    case cPar2
    thus ?case by simp
  next
    case cComm1
    thus ?case
      by(fastforce dest: inputFreshDerivative outputFreshDerivative simp add: resChainFresh)
  next
    case cComm2
    thus ?case
      by(fastforce dest: inputFreshDerivative outputFreshDerivative simp add: resChainFresh)
  next
    case cOpen
    thus ?case by simp
  next
    case cScope
    thus ?case by(simp add: abs_fresh)
  next
    case cBang
    thus ?case by simp
  qed
qed

lemma tauFreshChainDerivative:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   xvec :: "name list"

  assumes "Ψ ⊳ P ⟼τ ≺ P'"
  and     "xvec ♯* P"
  
  shows "xvec ♯* P'"
using assms
by(induct xvec) (auto intro: tauFreshDerivative)

lemma freeFreshDerivative:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   α  :: "'a action"
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     "x ♯ α"
  and     "x ♯ P"

  shows   "x ♯ P'"
using assms
by(rule_tac actionCases[where α=α])
  (auto intro: inputFreshDerivative tauFreshDerivative outputFreshDerivative)

lemma freeFreshChainDerivative:
  fixes Ψ     :: 'b
  and   P     :: "('a, 'b, 'c) psi"
  and   α     :: "'a action"
  and   P'    :: "('a, 'b, 'c) psi"
  and   xvec  :: "name list"

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     "xvec ♯* P"
  and     "xvec ♯* α"

  shows   "xvec ♯* P'"
using assms
by(auto intro: freeFreshDerivative simp add: fresh_star_def)

lemma Input:
  fixes Ψ    :: 'b
  and   M    :: 'a
  and   K    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   Tvec :: "'a list"

  assumes "Ψ ⊢ M ↔ K"
  and     "distinct xvec"
  and     "set xvec ⊆ supp N"
  and     "length xvec = length Tvec"

  shows "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼K⦇N[xvec::=Tvec]⦈ ≺ P[xvec::=Tvec]"
proof -
  obtain p where xvecFreshPsi: "((p::name prm) ∙ (xvec::name list)) ♯* Ψ"
             and xvecFreshM: "(p ∙ xvec) ♯* M"
             and xvecFreshN: "(p ∙ xvec) ♯* N"
             and xvecFreshK: "(p ∙ xvec) ♯* K"
             and xvecFreshTvec: "(p ∙ xvec) ♯* Tvec"
             and xvecFreshP: "(p ∙ xvec) ♯* P"
             and S: "(set p) ⊆ (set xvec) × (set(p ∙ xvec))"
             and dp: "distinctPerm p"
    by(rule_tac xvec=xvec and c="(Ψ, M, K, N, P, Tvec)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)  
  note ‹Ψ ⊢ M ↔ K›
  moreover from ‹distinct xvec› have "distinct(p ∙ xvec)"
    by simp
  moreover from ‹(set xvec) ⊆ (supp N)› have "(p ∙ (set xvec)) ⊆ (p ∙ (supp N))"
    by simp
  hence "set(p ∙ xvec) ⊆ supp(p ∙ N)"
    by(simp add: eqvts)
  moreover from ‹length xvec = length Tvec› have "length(p ∙ xvec) = length Tvec"
    by simp
  ultimately have "Ψ ⊳ M⦇λ*(p ∙ xvec) (p ∙ N)⦈.(p ∙ P) ⟼K⦇(p ∙ N)[(p ∙ xvec)::=Tvec]⦈ ≺ (p ∙ P)[(p ∙ xvec)::=Tvec]"
    using xvecFreshPsi xvecFreshM xvecFreshK xvecFreshTvec
    by(rule_tac cInput)
  thus ?thesis using xvecFreshN xvecFreshP S ‹length xvec = length Tvec› dp
    by(auto simp add: inputChainAlpha' substTerm.renaming renaming)
qed

lemma residualAlpha:
  fixes p :: "name prm"
  and   α :: "'a action"
  and   P :: "('a, 'b, 'c) psi"

  assumes "bn(p ∙ α) ♯* object  α"
  and     "bn(p ∙ α) ♯* P"
  and     "bn α ♯* subject α"
  and     "bn(p ∙ α) ♯* subject α"
  and     "set p ⊆ set(bn α) × set(bn(p ∙ α))"

  shows "α ≺ P = (p ∙ α) ≺ (p ∙ P)"
using assms
apply(rule_tac α=α in actionCases)
apply(simp only: eqvts bn.simps)
apply simp
apply(simp add: boundOutputChainAlpha'' residualInject)
by simp

lemma Par1:
  fixes Ψ    :: 'b
  and   Ψ⇩Q   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩Q   :: "name list"
  and   Q    :: "('a, 'b, 'c) psi"

  assumes Trans: "Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'"
  and     "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
  and     "bn α ♯* Q"
  and     "A⇩Q ♯* Ψ"
  and     "A⇩Q ♯* P"
  and     "A⇩Q ♯* α"
  
  shows "Ψ ⊳ P ∥ Q ⟼α ≺ (P' ∥ Q)"
proof -
  {
    fix Ψ    :: 'b
    and Ψ⇩Q   :: 'b
    and P    :: "('a, 'b, 'c) psi"
    and α    :: "'a action"
    and P'   :: "('a, 'b, 'c) psi"
    and A⇩Q   :: "name list"
    and Q    :: "('a, 'b, 'c) psi"

    assume "Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'"
    and     "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
    and     "bn α ♯* Q"
    and     "bn α ♯* subject α"
    and     "A⇩Q ♯* Ψ"
    and     "A⇩Q ♯* P"
    and     "A⇩Q ♯* α"
    and     "distinct A⇩Q"
  
    have  "Ψ ⊳ P ∥ Q ⟼α ≺ (P' ∥ Q)"
    proof -
      from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› have "distinct(bn α)" by(rule boundOutputDistinct)
      obtain q::"name prm" where "bn(q ∙ α) ♯* Ψ" and "bn(q ∙ α) ♯* P" and "bn(q ∙ α) ♯* Q" and "bn(q ∙ α) ♯* α"
                             and "bn(q ∙ α) ♯* A⇩Q" and "bn(q ∙ α) ♯* P'" and "bn(q ∙ α) ♯* Ψ⇩Q"
                             and Sq: "(set q) ⊆ (set (bn α)) × (set(bn(q ∙ α)))"
        by(rule_tac xvec="bn α" and c="(Ψ, P, Q, α, A⇩Q, Ψ⇩Q, P')" in name_list_avoiding) (auto simp add: eqvts)
      obtain p::"name prm" where "(p ∙ A⇩Q) ♯* Ψ" and "(p ∙ A⇩Q) ♯* P" and "(p ∙ A⇩Q) ♯* Q" and "(p ∙ A⇩Q) ♯* α" 
                              and "(p ∙ A⇩Q) ♯* α" and "(p ∙ A⇩Q) ♯* (q ∙ α)" and "(p ∙ A⇩Q) ♯* P'" 
                             and "(p ∙ A⇩Q) ♯* (q ∙ P')" and "(p ∙ A⇩Q) ♯* Ψ⇩Q" and Sp: "(set p) ⊆ (set A⇩Q) × (set(p ∙ A⇩Q))"
        by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, α, bn α, q ∙ α, P', (q ∙ P'), Ψ⇩Q)" in name_list_avoiding) auto
      from ‹distinct(bn α)› have "distinct(bn(q ∙ α))" 
        by(rule_tac α=α in actionCases) (auto simp add: eqvts)
      from ‹A⇩Q ♯* α› ‹bn(q ∙ α) ♯* A⇩Q› Sq have "A⇩Q ♯* (q ∙ α)"
        apply(rule_tac α=α in actionCases)
        apply(simp only: bn.simps eqvts, simp)
        apply(simp add: freshChainSimps)
        by simp
      from ‹bn α ♯* subject α› have "(q ∙ (bn α)) ♯* (q ∙ (subject α))"
        by(simp add: fresh_star_bij)
      hence "bn(q ∙ α) ♯* subject(q ∙ α)" by(simp add: eqvts)
      from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› ‹bn(q ∙ α) ♯* α› ‹bn(q ∙ α) ♯* P'› ‹bn α ♯* (subject α)› Sq
      have Trans: "Ψ ⊗ Ψ⇩Q ⊳ P ⟼(q ∙ α) ≺ (q ∙ P')"
        by(force simp add: residualAlpha)
      hence "A⇩Q ♯* (q ∙ P')" using  ‹bn(q ∙ α) ♯* subject(q ∙ α)› ‹distinct(bn(q ∙ α))› ‹A⇩Q ♯* P› ‹A⇩Q ♯* (q ∙ α)›
        by(auto intro: freeFreshChainDerivative)
      from Trans have "(p ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ (p ∙ P) ⟼p ∙ ((q ∙ α) ≺ (q ∙ P'))"
        by(rule semantics.eqvt)
      with ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* (q ∙ α)› ‹(p ∙ A⇩Q) ♯* (q ∙ α)› ‹A⇩Q ♯* (q ∙ P')›
           ‹(p ∙ A⇩Q) ♯* Ψ› ‹(p ∙ A⇩Q) ♯* P› ‹(p ∙ A⇩Q) ♯* (q ∙ P')› Sp
      have "Ψ ⊗ (p ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ α) ≺ (q ∙ P')" by(simp add: eqvts)
      moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹(p ∙ A⇩Q) ♯* Ψ⇩Q› Sp have  "extractFrame Q = ⟨(p ∙ A⇩Q), (p ∙ Ψ⇩Q)⟩"
        by(simp add: frameChainAlpha' eqvts)
      moreover from ‹(bn(q ∙ α)) ♯* Ψ⇩Q› ‹(bn(q ∙ α)) ♯* A⇩Q› ‹(p ∙ A⇩Q) ♯* (q ∙ α)› Sp 
      have "(bn(q ∙ α)) ♯* (p ∙ Ψ⇩Q)"
        by(simp add: freshAlphaPerm)
      moreover from ‹distinct A⇩Q› have "distinct(p ∙ A⇩Q)" by simp
      ultimately have "Ψ ⊳ P ∥ Q ⟼(q ∙ α) ≺ ((q ∙ P') ∥ Q)"
        using ‹(p ∙ A⇩Q) ♯* P› ‹(p ∙ A⇩Q) ♯* Q› ‹(p ∙ A⇩Q) ♯* Ψ› ‹(p ∙ A⇩Q) ♯* (q ∙ α)›
              ‹(p ∙ A⇩Q) ♯* (q ∙ P')› ‹(bn(q ∙ α)) ♯* Ψ› ‹(bn(q ∙ α)) ♯* Q› ‹(bn(q ∙ α)) ♯* P› 
              ‹(bn(q ∙ α)) ♯* (subject (q ∙ α))› ‹distinct(bn(q ∙ α))›
        by(rule_tac cPar1)
        
      thus ?thesis using ‹bn(q ∙ α) ♯* α› ‹bn(q ∙ α) ♯* P'› ‹bn α ♯* subject α› ‹bn(q ∙ α) ♯* Q› ‹bn α ♯* Q› Sq
        by(force simp add: residualAlpha) 
    qed
  }
  note Goal = this
  from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* α›
  obtain A⇩Q' where FrQ: "extractFrame Q = ⟨A⇩Q', Ψ⇩Q⟩" and "distinct A⇩Q'" and "A⇩Q' ♯* Ψ" and "A⇩Q' ♯* P" and "A⇩Q' ♯* α"
    by(rule_tac C="(Ψ, P, α)" in distinctFrame) auto
  show ?thesis
  proof(induct rule: actionCases[where α=α])
    case(cInput M N)
    from Trans FrQ ‹A⇩Q' ♯* Ψ› ‹A⇩Q' ♯* P› ‹A⇩Q' ♯* α› ‹distinct A⇩Q'› ‹bn α ♯* Q›
    show ?case using ‹α = M⦇N⦈› by(force intro: Goal)
  next
    case cTau 
    from Trans FrQ ‹A⇩Q' ♯* Ψ› ‹A⇩Q' ♯* P› ‹A⇩Q' ♯* α› ‹distinct A⇩Q'› ‹bn α ♯* Q›
    show ?case using ‹α = τ› by(force intro: Goal)
  next
    case(cOutput M xvec N)
    from ‹α = M⦇ν*xvec⦈⟨N⟩› ‹A⇩Q' ♯* α› ‹bn α ♯* Q› have "xvec ♯* A⇩Q'" and "xvec ♯* Q"
      by simp+
    obtain p where "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* P'" and "(p ∙ xvec) ♯* Q"
               and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* A⇩Q'" 
               and S: "set p ⊆ set xvec × set(p ∙ xvec)"
      by(rule_tac xvec=xvec and c="(N, P', Q, M, A⇩Q')" in name_list_avoiding) auto
    from Trans ‹α=M⦇ν*xvec⦈⟨N⟩› have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" by simp
    with ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P'› S
    have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ P')"
      by(simp add: boundOutputChainAlpha'' create_residual.simps)
    moreover from ‹xvec ♯* A⇩Q'› ‹(p ∙ xvec) ♯* A⇩Q'› ‹A⇩Q' ♯* α› S
    have "A⇩Q' ♯* (p ∙ α)" by(simp add: freshChainSimps del: actionFreshChain)
    ultimately have "Ψ ⊳ P ∥ Q ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ P') ∥ Q"
      using FrQ ‹A⇩Q' ♯* Ψ› ‹A⇩Q' ♯* P› ‹distinct A⇩Q'› ‹(p ∙ xvec) ♯* Q› ‹A⇩Q' ♯* α›
           ‹(p ∙ xvec) ♯* M› ‹α = M⦇ν*xvec⦈⟨N⟩›
      by(force intro: Goal)
    with ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P'› ‹(p ∙ xvec) ♯* Q› ‹xvec ♯* Q› S ‹α = M⦇ν*xvec⦈⟨N⟩›
    show ?case
      by(simp add: boundOutputChainAlpha'' eqvts create_residual.simps)
  qed
qed

lemma Par2:
  fixes Ψ    :: 'b
  and   Ψ⇩P   :: 'b
  and   Q    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   Q'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   P    :: "('a, 'b, 'c) psi"

  assumes Trans: "Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "bn α ♯* P"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* Q"
  and     "A⇩P ♯* α"
  
  shows "Ψ ⊳ P ∥ Q ⟼α ≺ (P ∥ Q')"
proof -
  {
    fix Ψ    :: 'b
    and Ψ⇩P   :: 'b
    and Q    :: "('a, 'b, 'c) psi"
    and α    :: "'a action"
    and Q'   :: "('a, 'b, 'c) psi"
    and A⇩P   :: "name list"
    and P    :: "('a, 'b, 'c) psi"

    assume "Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'"
    and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
    and     "bn α ♯* P"
    and     "bn α ♯* subject α"
    and     "A⇩P ♯* Ψ"
    and     "A⇩P ♯* Q"
    and     "A⇩P ♯* α"
    and     "distinct A⇩P"
  
    have  "Ψ ⊳ P ∥ Q ⟼α ≺ (P ∥ Q')"
    proof -
      from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› have "distinct(bn α)" by(rule boundOutputDistinct)
      obtain q::"name prm" where "bn(q ∙ α) ♯* Ψ" and "bn(q ∙ α) ♯* P" and "bn(q ∙ α) ♯* Q" and "bn(q ∙ α) ♯* α"
                             and "bn(q ∙ α) ♯* A⇩P" and "bn(q ∙ α) ♯* Q'" and "bn(q ∙ α) ♯* Ψ⇩P"
                             and Sq: "(set q) ⊆ (set (bn α)) × (set(bn(q ∙ α)))"
        by(rule_tac xvec="bn α" and c="(Ψ, P, Q, α, A⇩P, Ψ⇩P, Q')" in name_list_avoiding) (auto simp add: eqvts)
      obtain p::"name prm" where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" and "(p ∙ A⇩P) ♯* α" 
                              and "(p ∙ A⇩P) ♯* α" and "(p ∙ A⇩P) ♯* (q ∙ α)" and "(p ∙ A⇩P) ♯* Q'" 
                              and "(p ∙ A⇩P) ♯* (q ∙ Q')" and "(p ∙ A⇩P) ♯* Ψ⇩P" 
                              and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))"
        by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, α, q ∙ α, Q', (q ∙ Q'), Ψ⇩P)" in name_list_avoiding) auto
      from ‹distinct(bn α)› have "distinct(bn(q ∙ α))" 
        by(rule_tac α=α in actionCases) (auto simp add: eqvts)
      from ‹A⇩P ♯* α› ‹bn(q ∙ α) ♯* A⇩P› Sq have "A⇩P ♯* (q ∙ α)"
        apply(rule_tac α=α in actionCases)
        apply(simp only: bn.simps eqvts, simp)
        apply(simp add: freshChainSimps)
        by simp
      from ‹bn α ♯* subject α› have "(q ∙ (bn α)) ♯* (q ∙ (subject α))"
        by(simp add: fresh_star_bij)
      hence "bn(q ∙ α) ♯* subject(q ∙ α)" by(simp add: eqvts)
      from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› ‹bn(q ∙ α) ♯* α› ‹bn(q ∙ α) ♯* Q'› ‹bn α ♯* (subject α)› Sq
      have Trans: "Ψ ⊗ Ψ⇩P ⊳ Q ⟼(q ∙ α) ≺ (q ∙ Q')"
        by(force simp add: residualAlpha)
      hence "A⇩P ♯* (q ∙ Q')" using  ‹bn(q ∙ α) ♯* subject(q ∙ α)› ‹distinct(bn(q ∙ α))› ‹A⇩P ♯* Q› ‹A⇩P ♯* (q ∙ α)›
        by(auto intro: freeFreshChainDerivative)
      from Trans have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ (p ∙ Q) ⟼p ∙ ((q ∙ α) ≺ (q ∙ Q'))"
        by(rule semantics.eqvt)
      with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Q› ‹A⇩P ♯* (q ∙ α)› ‹(p ∙ A⇩P) ♯* (q ∙ α)› ‹A⇩P ♯* (q ∙ Q')›
           ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* Q› ‹(p ∙ A⇩P) ♯* (q ∙ Q')› Sp
      have "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(q ∙ α) ≺ (q ∙ Q')" by(simp add: eqvts)
      moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹(p ∙ A⇩P) ♯* Ψ⇩P› Sp have  "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
        by(simp add: frameChainAlpha' eqvts)
      moreover from ‹(bn(q ∙ α)) ♯* Ψ⇩P› ‹(bn(q ∙ α)) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ α)› Sp 
      have "(bn(q ∙ α)) ♯* (p ∙ Ψ⇩P)"
        by(simp add: freshAlphaPerm)
      moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)" by simp
      ultimately have "Ψ ⊳ P ∥ Q ⟼(q ∙ α) ≺ (P ∥ (q ∙ Q'))"
        using ‹(p ∙ A⇩P) ♯* P› ‹(p ∙ A⇩P) ♯* Q› ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* (q ∙ α)›
              ‹(p ∙ A⇩P) ♯* (q ∙ Q')› ‹(bn(q ∙ α)) ♯* Ψ› ‹(bn(q ∙ α)) ♯* Q› ‹(bn(q ∙ α)) ♯* P› 
              ‹(bn(q ∙ α)) ♯* (subject (q ∙ α))› ‹distinct(bn(q ∙ α))›
        by(rule_tac cPar2)
        
      thus ?thesis using ‹bn(q ∙ α) ♯* α› ‹bn(q ∙ α) ♯* Q'› ‹bn α ♯* subject α› ‹bn(q ∙ α) ♯* P› ‹bn α ♯* P› Sq
        by(force simp add: residualAlpha) 
    qed
  }
  note Goal = this
  from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Q› ‹A⇩P ♯* α›
  obtain A⇩P' where FrP: "extractFrame P = ⟨A⇩P', Ψ⇩P⟩" and "distinct A⇩P'" and "A⇩P' ♯* Ψ" and "A⇩P' ♯* Q" and "A⇩P' ♯* α"
    by(rule_tac C="(Ψ, Q, α)" in distinctFrame) auto
  show ?thesis
  proof(induct rule: actionCases[where α=α])
    case(cInput M N)
    from Trans FrP ‹A⇩P' ♯* Ψ› ‹A⇩P' ♯* Q› ‹A⇩P' ♯* α› ‹distinct A⇩P'› ‹bn α ♯* P›
    show ?case using ‹α = M⦇N⦈› by(force intro: Goal)
  next
    case cTau 
    from Trans FrP ‹A⇩P' ♯* Ψ› ‹A⇩P' ♯* Q› ‹A⇩P' ♯* α› ‹distinct A⇩P'› ‹bn α ♯* P›
    show ?case using ‹α = τ› by(force intro: Goal)
  next
    case(cOutput M xvec N)
    from ‹α = M⦇ν*xvec⦈⟨N⟩› ‹A⇩P' ♯* α› ‹bn α ♯* P› have "xvec ♯* A⇩P'" and "xvec ♯* P"
      by simp+
    obtain p where "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* Q'" and "(p ∙ xvec) ♯* P"
               and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* A⇩P'" 
               and S: "set p ⊆ set xvec × set(p ∙ xvec)"
      by(rule_tac xvec=xvec and c="(N, Q', P, M, A⇩P')" in name_list_avoiding) auto
    from Trans ‹α=M⦇ν*xvec⦈⟨N⟩› have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'" by simp
    with ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* Q'› S
    have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ Q')"
      by(simp add: boundOutputChainAlpha'' create_residual.simps)
    moreover from ‹xvec ♯* A⇩P'› ‹(p ∙ xvec) ♯* A⇩P'› ‹A⇩P' ♯* α› S
    have "A⇩P' ♯* (p ∙ α)" by(simp add: freshChainSimps del: actionFreshChain)
    ultimately have "Ψ ⊳ P ∥ Q ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ P ∥ (p ∙ Q')"
      using FrP ‹A⇩P' ♯* Ψ› ‹A⇩P' ♯* Q› ‹distinct A⇩P'› ‹(p ∙ xvec) ♯* P› ‹A⇩P' ♯* α›
           ‹(p ∙ xvec) ♯* M› ‹α = M⦇ν*xvec⦈⟨N⟩›
      by(force intro: Goal)
    with ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* Q'› ‹(p ∙ xvec) ♯* P› ‹xvec ♯* P› S ‹α = M⦇ν*xvec⦈⟨N⟩›
    show ?case
      by(simp add: boundOutputChainAlpha'' eqvts create_residual.simps)
  qed
qed

lemma Open:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   yvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   x    :: name

  assumes Trans: "Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'"
  and     "x ∈ supp N"
  and     "x ♯ Ψ"
  and     "x ♯ M"
  and     "x ♯ xvec"
  and     "x ♯ yvec"

  shows "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'"
proof -
  from Trans have "distinct(xvec@yvec)" by(force dest: boundOutputDistinct)
  hence "xvec ♯* yvec" by(induct xvec) auto
  
  obtain p where "(p ∙ yvec) ♯* Ψ" and "(p ∙ yvec) ♯* P"  and "(p ∙ yvec) ♯* M"
             and "(p ∙ yvec) ♯* yvec" and "(p ∙ yvec) ♯* N" and "(p ∙ yvec) ♯* P'"
             and "x ♯ (p ∙ yvec)" and "(p ∙ yvec) ♯* xvec"
             and Sp: "(set p) ⊆ (set yvec) × (set(p ∙ yvec))"
    by(rule_tac xvec=yvec and c="(Ψ, P, M, xvec, yvec, N, P', x)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)
  obtain q where "(q ∙ xvec) ♯* Ψ" and "(q ∙ xvec) ♯* P"  and "(q ∙ xvec) ♯* M"
             and "(q ∙ xvec) ♯* xvec" and "(q ∙ xvec) ♯* N" and "(q ∙ xvec) ♯* P'"
             and "x ♯ (q ∙ xvec)" and "(q ∙ xvec) ♯* yvec"
             and "(q ∙ xvec) ♯* p" and "(q ∙ xvec) ♯* (p ∙ yvec)"
             and Sq: "(set q) ⊆ (set xvec) × (set(q ∙ xvec))"
    by(rule_tac xvec=xvec and c="(Ψ, P, M, xvec, yvec, p ∙ yvec, N, P', x, p)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)

  note ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'›
  moreover from ‹(p ∙ yvec) ♯* N› ‹(q ∙ xvec) ♯* N› ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec› Sp Sq 
  have "((p@q) ∙ (xvec @ yvec)) ♯* N" apply(simp only: eqvts) apply(simp only: pt2[OF pt_name_inst])
    by simp
  moreover from ‹(p ∙ yvec) ♯* P'› ‹(q ∙ xvec) ♯* P'› ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec› Sp Sq 
  have "((p@q) ∙ (xvec @ yvec)) ♯* P'" by(simp del: freshAlphaPerm add: eqvts pt2[OF pt_name_inst])
  moreover from Sp Sq ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec›
  have Spq: "set(p@q) ⊆ set(xvec@yvec) × set((p@q) ∙ (xvec@yvec))"
    by(simp add: pt2[OF pt_name_inst] eqvts) blast
  ultimately have "Ψ ⊳ P ⟼M⦇ν*((p@q) ∙ (xvec@yvec))⦈⟨((p@q) ∙ N)⟩ ≺ ((p@q) ∙ P')"
    apply(simp add: create_residual.simps)
    by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)

  with  Sp Sq ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec›
  have "Ψ ⊳ P ⟼M⦇ν*((q ∙ xvec)@(p ∙ yvec))⦈⟨((p@q) ∙ N)⟩ ≺ ((p@q) ∙ P')"
    by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
  moreover from ‹x ∈ supp N› have "((p@q) ∙ x) ∈ (p@q) ∙ (supp N)"
    by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
  with ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ (q ∙ xvec)› ‹x ♯ (p ∙ yvec)› Sp Sq
  have "x ∈ supp((p@q)∙ N)" by(simp add: eqvts pt2[OF pt_name_inst])
  moreover from ‹distinct(xvec@yvec)› have "distinct(q ∙ xvec)" and "distinct(p ∙ yvec)"
    by auto
  moreover note ‹x ♯ (q ∙ xvec)› ‹x ♯ (p ∙ yvec)› ‹x ♯ M› ‹x ♯ Ψ› 
                ‹(q ∙ xvec) ♯* Ψ› ‹(q ∙ xvec) ♯* P› ‹(q ∙ xvec) ♯* M› ‹(q ∙ xvec) ♯* (p ∙ yvec)›
                ‹(p ∙ yvec) ♯* Ψ› ‹(p ∙ yvec) ♯* P› ‹(p ∙ yvec) ♯* M› ‹distinct(q ∙ xvec)›
  ultimately have "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*((q ∙ xvec)@x#(p ∙ yvec))⦈⟨((p@q) ∙ N)⟩ ≺ ((p@q) ∙ P')"
    by(rule_tac cOpen) 
  with ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ (q ∙ xvec)› ‹x ♯ (p ∙ yvec)›
       ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec› Sp Sq
  have "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*((p@q) ∙ (xvec@x#yvec))⦈⟨((p@q) ∙ N)⟩ ≺ ((p@q) ∙ P')"
    by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
  thus ?thesis using ‹((p@q) ∙ (xvec @ yvec)) ♯* N› ‹((p@q) ∙ (xvec @ yvec)) ♯* P'› Spq
    apply(simp add: create_residual.simps)
    by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)
qed

lemma Scope:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   x    :: name

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "x ♯ Ψ"
  and     "x ♯ α"

  shows "Ψ ⊳ ⦇νx⦈P ⟼α ≺ ⦇νx⦈P'"
proof -
  {
    fix Ψ P M xvec N P' x

    assume "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
    and    "(x::name) ♯ Ψ"
    and    "x ♯ M"
    and    "x ♯ xvec"
    and    "x ♯ N"

    obtain p::"name prm" where "(p ∙ xvec) ♯* Ψ" and "(p ∙ xvec) ♯* P" and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* xvec" 
                           and "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* P'" and "x ♯ (p ∙ xvec)"
                           and S: "(set p) ⊆ (set xvec) × (set(p ∙ xvec))"
      by(rule_tac xvec=xvec and c="(Ψ, P, M, xvec, N, P', x)" in name_list_avoiding)
        (auto simp add: eqvts fresh_star_prod)
    from ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P'› S
    have "Ψ ⊳ P ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ P')"
      by(simp add: boundOutputChainAlpha'' create_residual.simps)
    moreover hence "distinct(p ∙ xvec)" by(force dest: boundOutputDistinct)
    moreover note ‹x ♯ Ψ› ‹x ♯ M› ‹x ♯ (p ∙ xvec)›
    moreover from ‹x ♯ xvec› ‹x ♯ p ∙ xvec› ‹x ♯ N› S have "x ♯ (p ∙ N)"
      by(simp add: fresh_left del: freshAlphaSwap)
    ultimately have "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ ⦇νx⦈(p ∙ P')" using ‹(p ∙ xvec) ♯* Ψ› ‹(p ∙ xvec) ♯* P› ‹(p ∙ xvec) ♯* M›
      by(rule_tac cScope) auto
    moreover from ‹x ♯ xvec› ‹x ♯ p ∙ xvec› S have "p ∙ x = x" by simp
    ultimately have "Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*(p ∙ xvec)⦈⟨(p ∙ N)⟩ ≺ (p ∙ (⦇νx⦈P'))" by simp
    moreover from ‹(p ∙ xvec) ♯* P'› ‹x ♯ xvec› ‹x ♯ (p ∙ xvec)› have "(p ∙ xvec) ♯* ⦇νx⦈P'" 
      by(simp add: abs_fresh_star)
    ultimately have"Ψ ⊳ ⦇νx⦈P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ ⦇νx⦈P'" using ‹(p ∙ xvec) ♯* N› S
      by(simp add: boundOutputChainAlpha'' create_residual.simps)
  }
  note Goal = this
  show ?thesis
  proof(induct rule: actionCases[where α=α])
    case(cInput M N)
    with assms show ?case by(force intro: cScope)
  next
    case(cOutput M xvec N)
    with assms show ?case by(force intro: Goal)
  next
    case cTau
    with assms show ?case by(force intro: cScope)
  qed
qed

lemma inputSwapFrameSubject:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name
  and   y  :: name

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "x ♯ P"
  and     "y ♯ P"

  shows "([(x, y)] ∙ Ψ) ⊳ P ⟼ ([(x, y)] ∙ M)⦇N⦈ ≺ P'"
using assms
proof(nominal_induct avoiding: x y rule: inputInduct)
  case(cInput Ψ M K xvec N Tvec P x y)
  from ‹x ♯ M⦇λ*xvec N⦈.P› have "x ♯ M" by simp
  from ‹y ♯ M⦇λ*xvec N⦈.P› have "y ♯ M" by simp
  from ‹Ψ ⊢ M ↔ K› have "([(x, y)] ∙ Ψ) ⊢ ([(x, y)] ∙ M) ↔ ([(x, y)] ∙ K)"
    by(rule chanEqClosed)
  with ‹x ♯ M› ‹y ♯ M›  have "([(x, y)] ∙ Ψ) ⊢ M ↔ ([(x, y)] ∙ K)"
    by(simp)
  thus ?case using ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec›
    by(rule Input)
next
  case(cCase Ψ P M N P' φ Cs x y)
  from ‹x ♯ Cases Cs› ‹y ♯ Cases Cs› ‹(φ, P) mem Cs› have "x ♯ φ" and "x ♯ P" and "y ♯ φ" and "y ♯ P"
    by(auto dest: memFresh)
  from ‹x ♯ P› ‹y ♯ P› have "([(x ,y)] ∙ Ψ) ⊳ P ⟼ ([(x, y)] ∙ M)⦇N⦈ ≺ P'" by(rule cCase)
  moreover note ‹(φ, P) mem Cs›
  moreover from ‹Ψ ⊢ φ› have "([(x, y)] ∙ Ψ) ⊢ ([(x, y)] ∙ φ)" by(rule statClosed)
  with ‹x ♯ φ› ‹y ♯ φ› have "([(x, y)] ∙ Ψ) ⊢ φ" by simp
  ultimately show ?case using ‹guarded P› by(rule Case)
next
  case(cPar1 Ψ Ψ⇩Q P M N P' A⇩Q Q x y)
  from ‹x ♯ P ∥ Q› have "x ♯ P" and "x ♯ Q" by simp+
  from ‹y ♯ P ∥ Q› have "y ♯ P" and "y ♯ Q" by simp+
  from ‹x ♯ P› ‹y ♯ P› ‹⋀x y. ⟦x ♯ P; y ♯ P⟧ ⟹ ([(x, y)] ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'›
  have "([(x, y)] ∙ Ψ) ⊗ ([(x, y)] ∙ Ψ⇩Q) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'"
    by(simp add: eqvts)

  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› have "([(x, y)] ∙ (extractFrame Q)) = ([(x, y)] ∙ ⟨A⇩Q, Ψ⇩Q⟩)"
    by simp
  with ‹A⇩Q ♯* x› ‹x ♯ Q› ‹A⇩Q ♯* y› ‹y ♯ Q› have "⟨A⇩Q, ([(x, y)] ∙ Ψ⇩Q)⟩ = extractFrame Q"
    by(simp add: eqvts)
  moreover from ‹A⇩Q ♯* Ψ› have "([(x, y)] ∙ A⇩Q) ♯* ([(x, y)] ∙ Ψ)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩Q ♯* x› ‹A⇩Q ♯* y› have "A⇩Q ♯* ([(x, y)] ∙ Ψ)" by simp
  moreover from ‹A⇩Q ♯* M› have "([(x, y)] ∙ A⇩Q) ♯* ([(x, y)] ∙ M)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩Q ♯* x› ‹A⇩Q ♯* y› have "A⇩Q ♯* ([(x, y)] ∙ M)" by simp
  ultimately show ?case using ‹A⇩Q ♯* P› ‹A⇩Q ♯* N›
    by(rule_tac Par1) auto
next
  case(cPar2 Ψ Ψ⇩P Q M N Q' A⇩P P x y)
  from ‹x ♯ P ∥ Q› have "x ♯ P" and "x ♯ Q" by simp+
  from ‹y ♯ P ∥ Q› have "y ♯ P" and "y ♯ Q" by simp+
  from ‹x ♯ Q› ‹y ♯ Q› ‹⋀x y. ⟦x ♯ Q; y ♯ Q⟧ ⟹ ([(x, y)] ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼([(x, y)] ∙ M)⦇N⦈ ≺ Q'›
  have "([(x, y)] ∙ Ψ) ⊗ ([(x, y)] ∙ Ψ⇩P) ⊳ Q ⟼([(x, y)] ∙ M)⦇N⦈ ≺ Q'"
    by(simp add: eqvts)

  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› have "([(x, y)] ∙ (extractFrame P)) = ([(x, y)] ∙ ⟨A⇩P, Ψ⇩P⟩)"
    by simp
  with ‹A⇩P ♯* x› ‹x ♯ P› ‹A⇩P ♯* y› ‹y ♯ P› have "⟨A⇩P, ([(x, y)] ∙ Ψ⇩P)⟩ = extractFrame P"
    by(simp add: eqvts)
  moreover from ‹A⇩P ♯* Ψ› have "([(x, y)] ∙ A⇩P) ♯* ([(x, y)] ∙ Ψ)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩P ♯* x› ‹A⇩P ♯* y› have "A⇩P ♯* ([(x, y)] ∙ Ψ)" by simp
  moreover from ‹A⇩P ♯* M› have "([(x, y)] ∙ A⇩P) ♯* ([(x, y)] ∙ M)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩P ♯* x› ‹A⇩P ♯* y› have "A⇩P ♯* ([(x, y)] ∙ M)" by simp
  ultimately show ?case using ‹A⇩P ♯* Q› ‹A⇩P ♯* N›
    by(rule_tac Par2) auto
next
  case(cScope Ψ P M N P' z x y)
  from ‹x ♯ ⦇νz⦈P› ‹z ♯ x› have "x ♯ P" by(simp add: abs_fresh)
  from ‹y ♯ ⦇νz⦈P› ‹z ♯ y› have "y ♯ P" by(simp add: abs_fresh)
  from ‹x ♯ P› ‹y ♯ P› ‹⋀x y. ⟦x ♯ P; y ♯ P⟧ ⟹ ([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'" by simp
  moreover with ‹z ♯ Ψ› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ Ψ"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ Ψ" by simp
  moreover with ‹z ♯ M› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ M"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ M" by simp
  ultimately show ?case using ‹z ♯ N›
    by(rule_tac Scope) (assumption | simp)+
next
  case(cBang Ψ P M N P' x y)
  thus ?case by(force intro: Bang)
qed

lemma inputPermFrameSubject:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   p  :: "name prm"
  and   Xs :: "name set"
  and   Ys :: "name set"

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     S: "set p ⊆ Xs × Ys"
  and     "Xs ♯* P"
  and     "Ys ♯* P"

  shows "(p ∙ Ψ) ⊳ P ⟼ (p ∙ M)⦇N⦈ ≺ P'"
using S
proof(induct p)
  case Nil
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'›
  show ?case by simp
next
  case(Cons a p)
  from ‹set(a#p) ⊆ Xs × Ys› have "set p ⊆ Xs × Ys" by auto
  with ‹set p ⊆ Xs × Ys ⟹ (p ∙ Ψ) ⊳ P ⟼ (p ∙ M)⦇N⦈ ≺ P'›
  have Trans: "(p ∙ Ψ) ⊳ P ⟼ (p ∙ M)⦇N⦈ ≺ P'" by simp
  from ‹set(a#p) ⊆ Xs × Ys› show ?case
  proof(cases a, clarsimp)
    fix a b
    assume "a ∈ Xs" and "b ∈ Ys"
    with ‹Xs ♯* P› ‹Ys ♯* P›
    have "a ♯ P" and "b ♯ P"
      by(auto simp add: fresh_star_def)
    with Trans show "([(a, b)] ∙ p ∙ Ψ) ⊳ P ⟼ ([(a, b)] ∙ p ∙ M)⦇N⦈ ≺ P'"
      by(rule inputSwapFrameSubject)
  qed  
qed

lemma inputSwapSubject:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name
  and   y  :: name

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "x ♯ P"
  and     "y ♯ P"
  and     "x ♯ Ψ"
  and     "y ♯ Ψ"

  shows "Ψ ⊳ P ⟼ ([(x, y)] ∙ M)⦇N⦈ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› ‹x ♯ P› ‹y ♯ P›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'"
    by(rule inputSwapFrameSubject)
  with ‹x ♯ Ψ› ‹y ♯ Ψ› show ?thesis
    by simp
qed

lemma inputPermSubject:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   p  :: "name prm"
  and   Xs :: "name set"
  and   Ys :: "name set"

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     S: "set p ⊆ Xs × Ys"
  and     "Xs ♯* P"
  and     "Ys ♯* P"
  and     "Xs ♯* Ψ"
  and     "Ys ♯* Ψ"

  shows "Ψ ⊳ P ⟼ (p ∙ M)⦇N⦈ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› S ‹Xs ♯* P› ‹Ys ♯* P›
  have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇N⦈ ≺ P'"
    by(rule inputPermFrameSubject)
  with ‹Xs ♯* Ψ› ‹Ys ♯* Ψ› S show ?thesis
    by simp
qed

lemma inputSwapFrame:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   x  :: name
  and   y  :: name

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "x ♯ P"
  and     "y ♯ P"
  and     "x ♯ M"
  and     "y ♯ M"

  shows "([(x, y)] ∙ Ψ) ⊳ P ⟼ M⦇N⦈ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› ‹x ♯ P› ‹y ♯ P›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇N⦈ ≺ P'"
    by(rule inputSwapFrameSubject)
  with ‹x ♯ M› ‹y ♯ M› show ?thesis
    by simp
qed

lemma inputPermFrame:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   p  :: "name prm"
  and   Xs :: "name set"
  and   Ys :: "name set"

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     S: "set p ⊆ Xs × Ys"
  and     "Xs ♯* P"
  and     "Ys ♯* P"
  and     "Xs ♯* M"
  and     "Ys ♯* M"

  shows "(p ∙ Ψ) ⊳ P ⟼ M⦇N⦈ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› S ‹Xs ♯* P› ‹Ys ♯* P›
  have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇N⦈ ≺ P'"
    by(rule inputPermFrameSubject)
  with ‹Xs ♯* M› ‹Ys ♯* M› S show ?thesis
    by simp
qed

lemma inputAlpha:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   p    :: "name prm"
  and   xvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "set p ⊆ (set xvec) × (set (p ∙ xvec))"
  and     "distinctPerm p"
  and     "xvec ♯* P"
  and     "(p ∙ xvec) ♯* P"

  shows "Ψ ⊳ P ⟼M⦇(p ∙ N)⦈ ≺ (p ∙ P')"
proof -
  from ‹Ψ ⊳ P ⟼M⦇N⦈ ≺ P'› ‹set p ⊆ (set xvec) × (set (p ∙ xvec))› ‹xvec ♯* P› ‹(p ∙ xvec) ♯* P›
  have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇N⦈ ≺ P'" by(rule_tac inputPermFrameSubject) auto
  hence "(p ∙ p ∙ Ψ) ⊳ (p ∙ P) ⟼(p ∙ ((p ∙ M)⦇N⦈ ≺ P'))" by(rule eqvts)
  with ‹distinctPerm p› ‹xvec ♯* P› ‹(p ∙ xvec) ♯* P› ‹set p ⊆ (set xvec) × (set (p ∙ xvec))› 
  show ?thesis by(simp add: eqvts)
qed

lemma frameFresh[dest]:
  fixes x  :: name
  and   A⇩F :: "name list"
  and   Ψ⇩F :: 'b

  assumes "x ♯ A⇩F"
  and     "x ♯ ⟨A⇩F, Ψ⇩F⟩"

  shows "x ♯ Ψ⇩F"
using assms
by(simp add: frameResChainFresh) (simp add: fresh_def name_list_supp)

lemma outputSwapFrameSubject:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   x    :: name
  and   y    :: name

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     "x ♯ P"
  and     "y ♯ P"

  shows "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
using assms
proof(nominal_induct avoiding: x y rule: outputInduct')
  case cAlpha
  thus ?case by(simp add: create_residual.simps boundOutputChainAlpha'')
next
  case(cOutput Ψ M K N P x y)
  from ‹x ♯ M⟨N⟩.P› have "x ♯ M" by simp
  from ‹y ♯ M⟨N⟩.P› have "y ♯ M" by simp
  from ‹Ψ ⊢ M ↔ K› have "([(x, y)] ∙ Ψ) ⊢ ([(x, y)] ∙ M) ↔ ([(x, y)] ∙ K)"
    by(rule chanEqClosed)
  with ‹x ♯ M› ‹y ♯ M›  have "([(x, y)] ∙ Ψ) ⊢ M ↔ ([(x, y)] ∙ K)"
    by(simp)
  thus ?case by(rule Output)
next
  case(cCase Ψ P M xvec N P' φ Cs x y)
  from ‹x ♯ Cases Cs› ‹y ♯ Cases Cs› ‹(φ, P) mem Cs› have "x ♯ φ" and "x ♯ P" and "y ♯ φ" and "y ♯ P"
    by(auto dest: memFresh)
  from ‹x ♯ P› ‹y ♯ P› have "([(x ,y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'" by(rule cCase)
  moreover note ‹(φ, P) mem Cs›
  moreover from ‹Ψ ⊢ φ› have "([(x, y)] ∙ Ψ) ⊢ ([(x, y)] ∙ φ)" by(rule statClosed)
  with ‹x ♯ φ› ‹y ♯ φ› have "([(x, y)] ∙ Ψ) ⊢ φ" by simp
  ultimately show ?case using ‹guarded P› by(rule Case)
next
  case(cPar1 Ψ Ψ⇩Q P M xvec N P' A⇩Q Q x y)
  from ‹x ♯ P ∥ Q› have "x ♯ P" and "x ♯ Q" by simp+
  from ‹y ♯ P ∥ Q› have "y ♯ P" and "y ♯ Q" by simp+
  from ‹x ♯ P› ‹y ♯ P› ‹⋀x y. ⟦x ♯ P; y ♯ P⟧ ⟹ ([(x, y)] ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'›
  have "([(x, y)] ∙ Ψ) ⊗ ([(x, y)] ∙ Ψ⇩Q) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
    by(simp add: eqvts)

  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› have "([(x, y)] ∙ ⟨A⇩Q, Ψ⇩Q⟩) = ([(x, y)] ∙ (extractFrame Q))"
    by simp
  with ‹A⇩Q ♯* x› ‹x ♯ Q› ‹A⇩Q ♯* y› ‹y ♯ Q› have "⟨A⇩Q, ([(x, y)] ∙ Ψ⇩Q)⟩ = extractFrame Q"
    by(simp add: eqvts)
  moreover from ‹A⇩Q ♯* Ψ› have "([(x, y)] ∙ A⇩Q) ♯* ([(x, y)] ∙ Ψ)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩Q ♯* x› ‹A⇩Q ♯* y› have "A⇩Q ♯* ([(x, y)] ∙ Ψ)" by simp
  moreover from ‹A⇩Q ♯* M› have "([(x, y)] ∙ A⇩Q) ♯* ([(x, y)] ∙ M)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩Q ♯* x› ‹A⇩Q ♯* y› have "A⇩Q ♯* ([(x, y)] ∙ M)" by simp
  ultimately show ?case using ‹A⇩Q ♯* P› ‹A⇩Q ♯* N› ‹xvec ♯* Q› ‹A⇩Q ♯* xvec›
    by(rule_tac Par1) auto
next
  case(cPar2 Ψ Ψ⇩P Q M xvec N Q' A⇩P P x y)
  from ‹x ♯ P ∥ Q› have "x ♯ P" and "x ♯ Q" by simp+
  from ‹y ♯ P ∥ Q› have "y ♯ P" and "y ♯ Q" by simp+
  from ‹x ♯ Q› ‹y ♯ Q› ‹⋀x y. ⟦x ♯ Q; y ♯ Q⟧ ⟹ ([(x, y)] ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ Q'›
  have "([(x, y)] ∙ Ψ) ⊗ ([(x, y)] ∙ Ψ⇩P) ⊳ Q ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ Q'"
    by(simp add: eqvts)

  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› have "([(x, y)] ∙ ⟨A⇩P, Ψ⇩P⟩) = ([(x, y)] ∙ (extractFrame P))"
    by simp
  with ‹A⇩P ♯* x› ‹x ♯ P› ‹A⇩P ♯* y› ‹y ♯ P› have "⟨A⇩P, ([(x, y)] ∙ Ψ⇩P)⟩ = extractFrame P"
    by(simp add: eqvts)
  moreover from ‹A⇩P ♯* Ψ› have "([(x, y)] ∙ A⇩P) ♯* ([(x, y)] ∙ Ψ)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩P ♯* x› ‹A⇩P ♯* y› have "A⇩P ♯* ([(x, y)] ∙ Ψ)" by simp
  moreover from ‹A⇩P ♯* M› have "([(x, y)] ∙ A⇩P) ♯* ([(x, y)] ∙ M)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩P ♯* x› ‹A⇩P ♯* y› have "A⇩P ♯* ([(x, y)] ∙ M)" by simp
  ultimately show ?case using ‹A⇩P ♯* Q› ‹A⇩P ♯* N› ‹xvec ♯* P› ‹A⇩P ♯* xvec›
    by(rule_tac Par2) auto
next
  case(cOpen Ψ P M xvec yvec N P' z x y)
  from ‹x ♯ ⦇νz⦈P› ‹z ♯ x› have "x ♯ P" by(simp add: abs_fresh)
  from ‹y ♯ ⦇νz⦈P› ‹z ♯ y› have "y ♯ P" by(simp add: abs_fresh)
  from ‹x ♯ P› ‹y ♯ P› ‹⋀x y. ⟦x ♯ P; y ♯ P⟧ ⟹ ([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'" by simp
  moreover with ‹z ♯ Ψ› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ Ψ"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ Ψ" by simp
  moreover with ‹z ♯ M› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ M"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ M" by simp
  ultimately show ?case using ‹z ∈ supp N› ‹z ♯ xvec› ‹z ♯ yvec›
    by(rule_tac Open) (assumption | simp)+
next
  case(cScope Ψ P M xvec N P' z x y)
  from ‹x ♯ ⦇νz⦈P› ‹z ♯ x› have "x ♯ P" by(simp add: abs_fresh)
  from ‹y ♯ ⦇νz⦈P› ‹z ♯ y› have "y ♯ P" by(simp add: abs_fresh)
  from ‹x ♯ P› ‹y ♯ P› ‹⋀x y. ⟦x ♯ P; y ♯ P⟧ ⟹ ([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'" by simp
  moreover with ‹z ♯ Ψ› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ Ψ"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ Ψ" by simp
  moreover with ‹z ♯ M› have "([(x, y)] ∙ z) ♯ [(x, y)] ∙ M"
    by(simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst])
  with ‹z ♯ x› ‹z ♯ y› have "z ♯ [(x, y)] ∙ M" by simp
  ultimately show ?case using ‹z ♯ N› ‹z ♯ xvec›
    by(rule_tac Scope) (assumption | simp)+
next
  case(cBang Ψ P M B x y)
  thus ?case by(force intro: Bang)
qed

lemma outputPermFrameSubject:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   p    :: "name prm"
  and   yvec :: "name list"
  and   zvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     S: "set p ⊆ set yvec × set zvec"
  and     "yvec ♯* P"
  and     "zvec ♯* P"

  shows "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
proof -
  {
    fix xvec N P' Xs YS
    assume "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" and "xvec ♯* M" and "xvec ♯* yvec" and "xvec ♯* zvec"
    have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'" using S
    proof(induct p)
      case Nil
      from ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'›
      show ?case by simp
    next
      case(Cons a p)
      from ‹set(a#p) ⊆ set yvec × set zvec› have "set p ⊆ set yvec × set zvec" by auto
      then have Trans: "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'" by(rule Cons)
      from ‹set(a#p) ⊆ set yvec × set zvec› show ?case
      proof(cases a, clarsimp)
        fix x y
        note Trans
        moreover from ‹xvec ♯* yvec› ‹xvec ♯* zvec› ‹set p ⊆ set yvec × set zvec› ‹xvec ♯* M› have "xvec ♯* (p ∙ M)"
          by(simp add: freshChainSimps)
        moreover assume "x ∈ set yvec" and "y ∈ set zvec"
        with ‹yvec ♯* P› ‹zvec ♯* P› have "x ♯ P" and "y ♯ P"
          by(auto simp add: fresh_star_def)
        ultimately show "([(x, y)] ∙ p ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
          by(rule outputSwapFrameSubject)
      qed
    qed
  }
  note Goal = this
  obtain q::"name prm" where "(q ∙ xvec) ♯* yvec" and "(q ∙ xvec) ♯* zvec" and "(q ∙ xvec) ♯* xvec" 
                         and "(q ∙ xvec) ♯* N" and "(q ∙ xvec) ♯* P'" and "(q ∙ xvec) ♯* M" 
                         and Sq: "(set q) ⊆ (set xvec) × (set(q ∙ xvec))"
    by(rule_tac xvec=xvec and c="(P, xvec, yvec, zvec, N, M, P')" in name_list_avoiding) auto
  with ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› have "Ψ ⊳ P ⟼M⦇ν*(q ∙ xvec)⦈⟨(q ∙ N)⟩ ≺ (q ∙ P')"
    by(simp add: boundOutputChainAlpha'' residualInject)
  hence "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*(q ∙ xvec)⦈⟨(q ∙ N)⟩ ≺ (q ∙ P')"
    using ‹(q ∙ xvec) ♯* M› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* zvec›
    by(rule Goal)
  with ‹(q ∙ xvec) ♯* N› ‹(q ∙ xvec) ♯* P'› Sq show ?thesis
    by(simp add: boundOutputChainAlpha'' residualInject)
qed   

lemma outputSwapSubject:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   x    :: name
  and   y    :: name

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     "x ♯ P"
  and     "y ♯ P"
  and     "x ♯ Ψ"
  and     "y ♯ Ψ"

  shows "Ψ ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹xvec ♯* M› ‹x ♯ P› ‹y ♯ P›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
    by(rule outputSwapFrameSubject)
  with ‹x ♯ Ψ› ‹y ♯ Ψ› show ?thesis
    by simp
qed

lemma outputPermSubject:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   p    :: "name prm"
  and   yvec :: "name list"
  and   zvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     S: "set p ⊆ set yvec × set zvec"
  and     "yvec ♯* P"
  and     "zvec ♯* P"
  and     "yvec ♯* Ψ"
  and     "zvec ♯* Ψ"

  shows "Ψ ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
proof -
  from assms have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
   by(rule_tac outputPermFrameSubject)
  with S ‹yvec ♯* Ψ› ‹zvec ♯* Ψ› show ?thesis
    by simp
qed
 
lemma outputSwapFrame:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   x    :: name
  and   y    :: name

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "xvec ♯* M"
  and     "x ♯ P"
  and     "y ♯ P"
  and     "x ♯ M"
  and     "y ♯ M"

  shows "([(x, y)] ∙ Ψ) ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
proof -
  from ‹Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹xvec ♯* M› ‹x ♯ P› ‹y ♯ P›
  have "([(x, y)] ∙ Ψ) ⊳ P ⟼([(x, y)] ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
    by(rule outputSwapFrameSubject)
  with ‹x ♯ M› ‹y ♯ M› show ?thesis
    by simp
qed

lemma outputPermFrame:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   B    :: "('a, 'b, 'c) boundOutput"
  and   p    :: "name prm"
  and   yvec :: "name list"
  and   zvec :: "name list"

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     S: "set p ⊆ set yvec × set zvec"
  and     "yvec ♯* P"
  and     "zvec ♯* P"
  and     "yvec ♯* M"
  and     "zvec ♯* M"

  shows "(p ∙ Ψ) ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
proof -
  from assms have "(p ∙ Ψ) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
    by(rule_tac outputPermFrameSubject)
  with S ‹yvec ♯* M› ‹zvec ♯* M› show ?thesis
    by simp
qed

lemma Comm1:
  fixes Ψ    :: 'b
  and   Ψ⇩Q  :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P  :: 'b
  and   Q    :: "('a, 'b, 'c) psi"
  and   K    :: 'a
  and   xvec :: "name list"
  and   Q'   :: "('a, 'b, 'c) psi"
  and   A⇩Q   :: "name list"
  
  assumes "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'"
  and     "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
  and     "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* Q"
  and     "A⇩P ♯* M"
  and     "A⇩P ♯* A⇩Q"
  and     "A⇩Q ♯* Ψ"
  and     "A⇩Q ♯* P"
  and     "A⇩Q ♯* Q"
  and     "A⇩Q ♯* K"
  and     "xvec ♯* P"

  shows "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
proof -
  {
    fix Ψ    :: 'b
    and Ψ⇩Q  :: 'b
    and P    :: "('a, 'b, 'c) psi"
    and M    :: 'a
    and N    :: 'a
    and P'   :: "('a, 'b, 'c) psi"
    and A⇩P   :: "name list"
    and Ψ⇩P  :: 'b
    and Q    :: "('a, 'b, 'c) psi"
    and K    :: 'a
    and xvec :: "name list"
    and Q'   :: "('a, 'b, 'c) psi"
    and A⇩Q   :: "name list"
 
    assume "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'"
    and    "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
    and    "distinct A⇩P"
    and    "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'"
    and    "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
    and    "distinct A⇩Q"
    and    "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K"
    and    "A⇩P ♯* Ψ"
    and    "A⇩P ♯* P"
    and    "A⇩P ♯* Q"
    and    "A⇩P ♯* M"
    and    "A⇩P ♯* A⇩Q"
    and    "A⇩Q ♯* Ψ"
    and    "A⇩Q ♯* P"
    and    "A⇩Q ♯* Q"
    and    "A⇩Q ♯* K"
    and    "xvec ♯* P"

    have "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
    proof -

      obtain r::"name prm" where "(r ∙ xvec) ♯* Ψ" and "(r ∙ xvec) ♯* P" and "(r ∙ xvec) ♯* Q" and "(r ∙ xvec) ♯* M"
                             and "(r ∙ xvec) ♯* K" and "(r ∙ xvec) ♯* N" and "(r ∙ xvec) ♯* A⇩P" and "(r ∙ xvec) ♯* A⇩Q"
                             and "(r ∙ xvec) ♯* P'" and "(r ∙ xvec) ♯* Q'" and "(r ∙ xvec) ♯* Ψ⇩P" and "(r ∙ xvec) ♯* Ψ⇩Q"
                             and Sr: "(set r) ⊆ (set xvec) × (set(r ∙ xvec))" and "distinctPerm r"
        by(rule_tac xvec=xvec and c="(Ψ, P, Q, M, K, N, A⇩P, A⇩Q, Ψ⇩P, Ψ⇩Q, P', Q')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)
      obtain q::"name prm" where "(q ∙ A⇩Q) ♯* Ψ" and "(q ∙ A⇩Q) ♯* P" and "(q ∙ A⇩Q) ♯* Q" and "(q ∙ A⇩Q) ♯* K"
                             and "(q ∙ A⇩Q) ♯* (r ∙ N)" and "(q ∙ A⇩Q) ♯* (r ∙ xvec)" and "(q ∙ A⇩Q) ♯* (r ∙ Q')"
                             and "(q ∙ A⇩Q) ♯* (r ∙ P')" and "(q ∙ A⇩Q) ♯* Ψ⇩P" and "(q ∙ A⇩Q) ♯* A⇩P" and "(q ∙ A⇩Q) ♯* Ψ⇩Q"
                             and Sq: "set q ⊆ set A⇩Q × set(q ∙ A⇩Q)"
        by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, K, r ∙ N, r ∙ xvec, Ψ⇩Q, A⇩P, Ψ⇩P, r ∙ Q', r ∙ P')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)
      obtain p::"name prm" where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" and "(p ∙ A⇩P) ♯* M"
                             and "(p ∙ A⇩P) ♯* (r ∙ N)" and "(p ∙ A⇩P) ♯* (r ∙ xvec)" and "(p ∙ A⇩P) ♯* (r ∙ Q')" 
                             and "(p ∙ A⇩P) ♯* (r ∙ P')" and "(p ∙ A⇩P) ♯* Ψ⇩P" and "(p ∙ A⇩P) ♯* Ψ⇩Q" and "(p ∙ A⇩P) ♯* A⇩Q"
                             and "(p ∙ A⇩P) ♯* (q ∙ A⇩Q)" and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))"
        by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, M, r ∙ N, r ∙ xvec, A⇩Q, q ∙ A⇩Q, Ψ⇩Q, Ψ⇩P, r ∙ Q', r ∙ P')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)

      have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
      have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
      
      from ‹A⇩P ♯* Q› FrQ ‹A⇩P ♯* A⇩Q› have "A⇩P ♯* Ψ⇩Q"
        by(drule_tac extractFrameFreshChain) auto
      from ‹A⇩Q ♯* P› FrP ‹A⇩P ♯* A⇩Q› have "A⇩Q ♯* Ψ⇩P"
        by(drule_tac extractFrameFreshChain) auto
      from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* A⇩P› Sp have "(r ∙ xvec) ♯* (p ∙ A⇩P)"
        by(simp add: freshChainSimps)

      from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› Sr ‹distinctPerm r› ‹xvec ♯* P› ‹(r ∙ xvec) ♯* P›
      have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇(r ∙ N)⦈ ≺ (r ∙ P')"
        by(rule inputAlpha)
      hence "(q ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼(q ∙ M)⦇(r ∙ N)⦈ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* P› ‹(q ∙ A⇩Q) ♯* P›
        by(rule_tac inputPermFrameSubject) (assumption | simp)+
      hence PTrans: "Ψ ⊗ (q ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ M)⦇(r ∙ N)⦈ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ›
        by(simp add: eqvts)
  
      moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩›  Sp ‹(p ∙ A⇩P) ♯* Ψ⇩P›
      have FrP: "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
        by(simp add: frameChainAlpha)
      moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)"  by simp
      
      moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› Sr ‹(r ∙ xvec) ♯* N› ‹(r ∙ xvec) ♯* Q'›
      have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')"
        by(simp add: boundOutputChainAlpha'' create_residual.simps)
      hence "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼(p ∙ K)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Q› ‹(p ∙ A⇩P) ♯* Q› ‹(r ∙ xvec) ♯* K› ‹(r ∙ xvec) ♯* A⇩P› ‹(r ∙ xvec) ♯* (p ∙ A⇩P)›
        by(rule_tac outputPermFrameSubject) (assumption | auto)
      hence QTrans: "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(p ∙ K)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ›
        by(simp add: eqvts)
      moreover hence "distinct(r ∙ xvec)" by(force dest: boundOutputDistinct)
      moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›  Sq ‹(q ∙ A⇩Q) ♯* Ψ⇩Q›
      have FrQ: "extractFrame Q = ⟨(q ∙ A⇩Q), (q ∙ Ψ⇩Q)⟩"
        by(simp add: frameChainAlpha)
      moreover from ‹distinct A⇩Q› have "distinct(q ∙ A⇩Q)"  by simp
  
      moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(p ∙ q ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q)) ⊢ (p ∙ q ∙ M) ↔ (p ∙ q ∙ K)"
        by(rule_tac chanEqClosed)+
      with ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹(q ∙ A⇩Q) ♯* Ψ⇩P›
           ‹A⇩P ♯* Ψ⇩Q› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› ‹A⇩P ♯* M› ‹(p ∙ A⇩P) ♯* M› ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
           ‹A⇩Q ♯* K› ‹(q ∙ A⇩Q) ♯* K› ‹A⇩P ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* A⇩Q›  Sp Sq
      have "Ψ ⊗ (p ∙ Ψ⇩P) ⊗ (q ∙ Ψ⇩Q) ⊢ (q ∙ M) ↔ (p ∙ K)" by(simp add: eqvts freshChainSimps)
      moreover note ‹(p ∙ A⇩P) ♯* Ψ›
      moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› Sq have "(p ∙ A⇩P) ♯* (q ∙ Ψ⇩Q)" 
        by(simp add: freshChainSimps)
      moreover note ‹(p ∙ A⇩P) ♯* P› 
      moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* M› Sq have "(p ∙ A⇩P) ♯* (q ∙ M)"
        by(simp add: freshChainSimps)
      moreover note  ‹(p ∙ A⇩P) ♯* (r ∙ N)› ‹(p ∙ A⇩P) ♯* (r ∙ P')› ‹(p ∙ A⇩P) ♯* Q› ‹(p ∙ A⇩P) ♯* (r ∙ Q')› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
                     ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Ψ›
      moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* Ψ⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)"
        by(simp add: freshChainSimps)
      moreover note ‹(q ∙ A⇩Q) ♯* P› ‹(q ∙ A⇩Q) ♯* (r ∙ N)›‹(q ∙ A⇩Q) ♯* (r ∙ P')› ‹(q ∙ A⇩Q) ♯* Q› 
      moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* K› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ K)"
        by(simp add: freshChainSimps)
      moreover note  ‹(q ∙ A⇩Q) ♯* (r ∙ Q')› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ›
      moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩P› Sp have "(r ∙ xvec) ♯* (p ∙ Ψ⇩P)"
        by(simp add: freshChainSimps)
      moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩Q› Sq have "(r ∙ xvec) ♯* (q ∙ Ψ⇩Q)"
        by(simp add: freshChainSimps)
      moreover note ‹(r ∙ xvec) ♯* P› 
      moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* M› Sq have "(r ∙ xvec) ♯* (q ∙ M)"
      by(simp add: freshChainSimps)
      moreover note ‹(r ∙ xvec) ♯* Q›
      moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* K› Sp have "(r ∙ xvec) ♯* (p ∙ K)"  
        by(simp add: freshChainSimps)
      ultimately have "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*(r ∙ xvec)⦈((r ∙ P') ∥ (r ∙ Q'))"
        by(rule_tac cComm1)
      with ‹(r ∙ xvec) ♯* P'› ‹(r ∙ xvec) ♯* Q'› Sr 
      show ?thesis
        by(subst resChainAlpha) auto
    qed
  }
  note Goal = this
  note ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K›
  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* M› ‹A⇩P ♯* A⇩Q›
  obtain A⇩P' where "extractFrame P = ⟨A⇩P', Ψ⇩P⟩" and "distinct A⇩P'" and "A⇩P' ♯* Ψ" and "A⇩P' ♯* P" and "A⇩P' ♯* Q" and "A⇩P' ♯* M" and "A⇩P' ♯* A⇩Q"
    by(rule_tac C="(Ψ, P, Q, M, A⇩Q)" in distinctFrame) auto
  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩P' ♯* A⇩Q›
  obtain A⇩Q' where "extractFrame Q = ⟨A⇩Q', Ψ⇩Q⟩" and "distinct A⇩Q'" and "A⇩Q' ♯* Ψ" and "A⇩Q' ♯* P" and "A⇩Q' ♯* Q" and "A⇩Q' ♯* K" and "A⇩P' ♯* A⇩Q'"
    apply(rule_tac C="(Ψ, P, Q, K, A⇩P')" in distinctFrame) by auto
  ultimately show ?thesis using ‹xvec ♯* P›
    by(rule_tac Goal) 
qed
 
lemma Comm2:
  fixes Ψ    :: 'b
  and   Ψ⇩Q  :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P  :: 'b
  and   Q    :: "('a, 'b, 'c) psi"
  and   K    :: 'a
  and   Q'   :: "('a, 'b, 'c) psi"
  and   A⇩Q   :: "name list"
  
  assumes "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'"
  and     "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
  and     "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* Q"
  and     "A⇩P ♯* M"
  and     "A⇩P ♯* A⇩Q"
  and     "A⇩Q ♯* Ψ"
  and     "A⇩Q ♯* P"
  and     "A⇩Q ♯* Q"
  and     "A⇩Q ♯* K"
  and     "xvec ♯* Q"

  shows "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
proof -
  {
    fix Ψ    :: 'b
    and Ψ⇩Q  :: 'b
    and P    :: "('a, 'b, 'c) psi"
    and M    :: 'a
    and xvec :: "name list"
    and N    :: 'a
    and P'   :: "('a, 'b, 'c) psi"
    and A⇩P   :: "name list"
    and Ψ⇩P  :: 'b
    and Q    :: "('a, 'b, 'c) psi"
    and K    :: 'a
    and Q'   :: "('a, 'b, 'c) psi"
    and A⇩Q   :: "name list"
 
    assume "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
    and    "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
    and    "distinct A⇩P"
    and    "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'"
    and    "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
    and    "distinct A⇩Q"
    and    "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K"
    and    "A⇩P ♯* Ψ"
    and    "A⇩P ♯* P"
    and    "A⇩P ♯* Q"
    and    "A⇩P ♯* M"
    and    "A⇩P ♯* A⇩Q"
    and    "A⇩Q ♯* Ψ"
    and    "A⇩Q ♯* P"
    and    "A⇩Q ♯* Q"
    and    "A⇩Q ♯* K"
    and    "xvec ♯* Q"

    have "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*xvec⦈(P' ∥ Q')"
    proof -

      obtain r::"name prm" where "(r ∙ xvec) ♯* Ψ" and "(r ∙ xvec) ♯* P" and "(r ∙ xvec) ♯* Q" and "(r ∙ xvec) ♯* M"
                             and "(r ∙ xvec) ♯* K" and "(r ∙ xvec) ♯* N" and "(r ∙ xvec) ♯* A⇩P" and "(r ∙ xvec) ♯* A⇩Q"
                             and "(r ∙ xvec) ♯* P'" and "(r ∙ xvec) ♯* Q'" and "(r ∙ xvec) ♯* Ψ⇩P" and "(r ∙ xvec) ♯* Ψ⇩Q"
                             and Sr: "(set r) ⊆ (set xvec) × (set(r ∙ xvec))" and "distinctPerm r"
        by(rule_tac xvec=xvec and c="(Ψ, P, Q, M, K, N, A⇩P, A⇩Q, Ψ⇩P, Ψ⇩Q, P', Q')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)
      obtain q::"name prm" where "(q ∙ A⇩Q) ♯* Ψ" and "(q ∙ A⇩Q) ♯* P" and "(q ∙ A⇩Q) ♯* Q" and "(q ∙ A⇩Q) ♯* K"
                             and "(q ∙ A⇩Q) ♯* (r ∙ N)" and "(q ∙ A⇩Q) ♯* (r ∙ xvec)" and "(q ∙ A⇩Q) ♯* (r ∙ Q')"
                             and "(q ∙ A⇩Q) ♯* (r ∙ P')" and "(q ∙ A⇩Q) ♯* Ψ⇩P" and "(q ∙ A⇩Q) ♯* A⇩P" and "(q ∙ A⇩Q) ♯* Ψ⇩Q"
                             and Sq: "set q ⊆ set A⇩Q × set(q ∙ A⇩Q)"
        by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, K, r ∙ N, r ∙ xvec, Ψ⇩Q, A⇩P, Ψ⇩P, r ∙ Q', r ∙ P')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)
      obtain p::"name prm" where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" and "(p ∙ A⇩P) ♯* M"
                             and "(p ∙ A⇩P) ♯* (r ∙ N)" and "(p ∙ A⇩P) ♯* (r ∙ xvec)" and "(p ∙ A⇩P) ♯* (r ∙ Q')" 
                             and "(p ∙ A⇩P) ♯* (r ∙ P')" and "(p ∙ A⇩P) ♯* Ψ⇩P" and "(p ∙ A⇩P) ♯* Ψ⇩Q" and "(p ∙ A⇩P) ♯* A⇩Q"
                             and "(p ∙ A⇩P) ♯* (q ∙ A⇩Q)" and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))"
        by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, M, r ∙ N, r ∙ xvec, A⇩Q, q ∙ A⇩Q, Ψ⇩Q, Ψ⇩P, r ∙ Q', r ∙ P')" in name_list_avoiding)
          (auto simp add: eqvts fresh_star_prod)

      have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
      have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
      
      from ‹A⇩P ♯* Q› FrQ ‹A⇩P ♯* A⇩Q› have "A⇩P ♯* Ψ⇩Q"
        by(drule_tac extractFrameFreshChain) auto
      from ‹A⇩Q ♯* P› FrP ‹A⇩P ♯* A⇩Q› have "A⇩Q ♯* Ψ⇩P"
        by(drule_tac extractFrameFreshChain) auto

      from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* A⇩Q› Sq have "(r ∙ xvec) ♯* (q ∙ A⇩Q)"
        by(simp add: freshChainSimps)
  
      from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› Sr ‹(r ∙ xvec) ♯* N› ‹(r ∙ xvec) ♯* P'›
      have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')"
        by(simp add: boundOutputChainAlpha'' create_residual.simps)
      hence "(q ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼(q ∙ M)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* P› ‹(q ∙ A⇩Q) ♯* P› ‹(r ∙ xvec) ♯* M› ‹(r ∙ xvec) ♯* A⇩Q› ‹(r ∙ xvec) ♯* (q ∙ A⇩Q)›
        by(rule_tac outputPermFrameSubject) (assumption | auto)
      hence PTrans: "Ψ ⊗ (q ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ M)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ›
        by(simp add: eqvts)
      moreover hence "distinct(r ∙ xvec)" by(force dest: boundOutputDistinct)
  
      moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩›  Sp ‹(p ∙ A⇩P) ♯* Ψ⇩P›
      have FrP: "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
        by(simp add: frameChainAlpha)
      moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)"  by simp
      
      moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› Sr ‹distinctPerm r› ‹xvec ♯* Q› ‹(r ∙ xvec) ♯* Q›
      have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇(r ∙ N)⦈ ≺ (r ∙ Q')"
        by(rule inputAlpha)
      hence "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼(p ∙ K)⦇(r ∙ N)⦈ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Q› ‹(p ∙ A⇩P) ♯* Q›
        by(rule_tac inputPermFrameSubject) (assumption | simp)+
      hence QTrans: "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(p ∙ K)⦇(r ∙ N)⦈ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ›
        by(simp add: eqvts)
  
      moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›  Sq ‹(q ∙ A⇩Q) ♯* Ψ⇩Q›
      have FrQ: "extractFrame Q = ⟨(q ∙ A⇩Q), (q ∙ Ψ⇩Q)⟩"
        by(simp add: frameChainAlpha)
      moreover from ‹distinct A⇩Q› have "distinct(q ∙ A⇩Q)"  by simp
  
      moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(p ∙ q ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q)) ⊢ (p ∙ q ∙ M) ↔ (p ∙ q ∙ K)"
        by(rule_tac chanEqClosed)+
      with ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹(q ∙ A⇩Q) ♯* Ψ⇩P›
           ‹A⇩P ♯* Ψ⇩Q› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› ‹A⇩P ♯* M› ‹(p ∙ A⇩P) ♯* M› ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
           ‹A⇩Q ♯* K› ‹(q ∙ A⇩Q) ♯* K› ‹A⇩P ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* A⇩Q›  Sp Sq
      have "Ψ ⊗ (p ∙ Ψ⇩P) ⊗ (q ∙ Ψ⇩Q) ⊢ (q ∙ M) ↔ (p ∙ K)"
        by(simp add: eqvts freshChainSimps)
      moreover note ‹(p ∙ A⇩P) ♯* Ψ›
      moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› Sq have "(p ∙ A⇩P) ♯* (q ∙ Ψ⇩Q)" 
        by(simp add: freshChainSimps)
      moreover note ‹(p ∙ A⇩P) ♯* P› 
      moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* M› Sq have "(p ∙ A⇩P) ♯* (q ∙ M)" 
        by(simp add: freshChainSimps)
      moreover note  ‹(p ∙ A⇩P) ♯* (r ∙ N)› ‹(p ∙ A⇩P) ♯* (r ∙ P')› ‹(p ∙ A⇩P) ♯* Q› ‹(p ∙ A⇩P) ♯* (r ∙ Q')› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
                     ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Ψ›
      moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* Ψ⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)"
        by(simp add: freshChainSimps)
      moreover note ‹(q ∙ A⇩Q) ♯* P› ‹(q ∙ A⇩Q) ♯* (r ∙ N)›‹(q ∙ A⇩Q) ♯* (r ∙ P')› ‹(q ∙ A⇩Q) ♯* Q› 
      moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* K› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ K)"
        by(simp add: freshChainSimps)
      moreover note  ‹(q ∙ A⇩Q) ♯* (r ∙ Q')› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ›
      moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩P› Sp have "(r ∙ xvec) ♯* (p ∙ Ψ⇩P)" 
        by(simp add: freshChainSimps)
      moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩Q› Sq have "(r ∙ xvec) ♯* (q ∙ Ψ⇩Q)"
        by(simp add: freshChainSimps)
      moreover note ‹(r ∙ xvec) ♯* P›
      moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* M› Sq have "(r ∙ xvec) ♯* (q ∙ M)"  
        by(simp add: freshChainSimps)
      moreover note ‹(r ∙ xvec) ♯* Q›
      moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* K› Sp have "(r ∙ xvec) ♯* (p ∙ K)"
        by(simp add: freshChainSimps)
      ultimately have "Ψ ⊳ P ∥ Q ⟼τ ≺ ⦇ν*(r ∙ xvec)⦈((r ∙ P') ∥ (r ∙ Q'))"
        by(rule_tac cComm2)
      with ‹(r ∙ xvec) ♯* P'› ‹(r ∙ xvec) ♯* Q'› Sr 
      show ?thesis
        by(subst resChainAlpha) auto
    qed
  }
  note Goal = this
  note ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K›
  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* M› ‹A⇩P ♯* A⇩Q›
  obtain A⇩P' where "extractFrame P = ⟨A⇩P', Ψ⇩P⟩" and "distinct A⇩P'" and "A⇩P' ♯* Ψ" and "A⇩P' ♯* P" and "A⇩P' ♯* Q" and "A⇩P' ♯* M" and "A⇩P' ♯* A⇩Q"
    by(rule_tac C="(Ψ, P, Q, M, A⇩Q)" in distinctFrame) auto
  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩P' ♯* A⇩Q›
  obtain A⇩Q' where "extractFrame Q = ⟨A⇩Q', Ψ⇩Q⟩" and "distinct A⇩Q'" and "A⇩Q' ♯* Ψ" and "A⇩Q' ♯* P" and "A⇩Q' ♯* Q" and "A⇩Q' ♯* K" and "A⇩P' ♯* A⇩Q'"
    by(rule_tac C="(Ψ, P, Q, K, A⇩P')" in distinctFrame) auto
  ultimately show ?thesis using ‹xvec ♯* Q›
    by(rule_tac Goal) 
qed

lemma semanticsCasesAux[consumes 1, case_names cInput cOutput cCase cPar1 cPar2 cComm1 cComm2 cOpen cScope cBang]:
  fixes Ψ  :: 'b
  and   cP  :: "('a, 'b, 'c) psi"
  and   cRs :: "('a, 'b, 'c) residual"
  and   C   :: "'d::fs_name"
  and   x   :: name

  assumes "Ψ ⊳ cP ⟼ cRs"
  and     rInput: "⋀M K xvec N Tvec P. ⟦cP = M⦇λ*xvec N⦈.P;  cRs = K⦇(N[xvec::=Tvec])⦈ ≺ P[xvec::=Tvec];
                                            Ψ ⊢ M ↔ K; distinct xvec; set xvec ⊆ supp N; length xvec=length Tvec;
                                            xvec ♯* Tvec; xvec ♯* Ψ; xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹ Prop"
  and     rOutput: "⋀M K N P. ⟦cP = M⟨N⟩.P; cRs = K⟨N⟩ ≺ P; Ψ ⊢ M ↔ K⟧ ⟹ Prop"
  and     rCase: "⋀Cs P φ. ⟦cP = Cases Cs; Ψ ⊳ P ⟼ cRs; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ Prop"

  and  rPar1: "⋀Ψ⇩Q P α P' Q A⇩Q. ⟦cP = P ∥ Q; cRs = α ≺ (P' ∥ Q);
               (Ψ ⊗ Ψ⇩Q) ⊳ P ⟼ (α ≺ P'); extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
               A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* Ψ; A⇩Q ♯* α; A⇩Q ♯* C; A⇩Q ♯* P'; bn α ♯* Ψ; bn α  ♯* Ψ⇩Q; 
               bn α  ♯* Q; bn α  ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹
               Prop"
  and     rPar2:   "⋀Ψ⇩P Q α Q' P A⇩P. ⟦cP = P ∥ Q; cRs = α ≺ (P ∥ Q');
                      (Ψ ⊗ Ψ⇩P) ⊳ Q ⟼α ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
             A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* Ψ; A⇩P ♯* α; A⇩P ♯* C;
             A⇩P ♯* Q'; bn α ♯* Ψ; bn α ♯* Ψ⇩P; bn α ♯* P; bn α ♯* Q; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹ Prop"
             
  and     rComm1: "⋀Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q.
                   ⟦cP = P ∥ Q; cRs = τ ≺ ⦇ν*xvec⦈P' ∥ Q';
                    Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N;
                    A⇩P ♯* P'; A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P;
                    A⇩Q ♯* P; A⇩Q ♯* K; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* Q'; A⇩Q ♯* xvec;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* Q;
                    xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C; distinct xvec⟧ ⟹ Prop"
  and     rComm2: "⋀Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q.
                   ⟦cP = P ∥ Q; cRs = τ ≺ ⦇ν*xvec⦈P' ∥ Q';
                    Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N;
                    A⇩P ♯* P'; A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P;
                    A⇩Q ♯* P; A⇩Q ♯* K; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* Q'; A⇩Q ♯* xvec;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* Q;
                    xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C; distinct xvec⟧ ⟹ Prop"
  and    rOpen: "⋀P M xvec yvec N P' x.
                ⟦cP = ⦇νx⦈P; cRs = M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'; 
                 Ψ ⊳ P ⟼ M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; x ∈ supp N; x ♯ xvec; x ♯ yvec; x ♯ M; x ♯ Ψ; distinct xvec; distinct yvec;
                 xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* yvec; yvec ♯* Ψ; yvec ♯* P; yvec ♯* M; xvec ♯* C; x ♯ C; yvec ♯* C⟧ ⟹
                 Prop"
  and    rScope: "⋀P α P' x. ⟦cP = ⦇νx⦈P; cRs = α ≺ ⦇νx⦈P';
                                 Ψ ⊳ P ⟼α ≺ P'; x ♯ Ψ; x ♯ α; x ♯ C; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹ Prop"
  and    rBang:  "⋀P. ⟦cP = !P; Ψ ⊳ P ∥ !P ⟼ cRs; guarded P⟧ ⟹ Prop"
  shows Prop
using ‹Ψ ⊳ cP ⟼ cRs›
proof(cases rule: semantics.cases)
  case(cInput M K xvec N Tvec P)
  obtain p::"name prm" where "(p ∙ xvec) ♯* Ψ" and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* K"
                         and "(p ∙ xvec) ♯* Tvec" and "(p ∙ xvec) ♯* P" and "(p ∙ xvec) ♯* C"
                         and S: "(set p) ⊆ (set xvec) × (set(p ∙ xvec))" and "distinctPerm p"
    by(rule_tac xvec=xvec and c="(Ψ, M, K, N, P, C, Tvec)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)
    from ‹cP = M⦇λ*xvec N⦈.P› ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P› S
    have "cP = M⦇λ*(p ∙ xvec) (p ∙ N)⦈.(p ∙ P)"
      by(simp add: inputChainAlpha')
    moreover from ‹cRs = K⦇(N[xvec::=Tvec])⦈ ≺ P[xvec::=Tvec]› ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P› S ‹length xvec = length Tvec› ‹distinctPerm p›
    have "cRs = K⦇((p ∙ N)[(p ∙ xvec)::=Tvec])⦈ ≺ (p ∙ P)[(p ∙ xvec)::=Tvec]"
      by(auto simp add: substTerm.renaming renaming residualInject)
    
    moreover note ‹Ψ ⊢ M ↔ K›
    moreover from ‹distinct xvec› have "distinct(p ∙ xvec)"
      by simp
    moreover from ‹(set xvec) ⊆ (supp N)› have "(p ∙ (set xvec)) ⊆ (p ∙ (supp N))"
      by simp
    hence "set(p ∙ xvec) ⊆ supp(p ∙ N)"
      by(simp add: eqvts)
    moreover from ‹length xvec = length Tvec› have "length(p ∙ xvec) = length Tvec"
      by simp
  ultimately show ?thesis using ‹(p ∙ xvec) ♯* Tvec› ‹(p ∙ xvec) ♯* Ψ› ‹(p ∙ xvec) ♯* M› ‹(p ∙ xvec) ♯* K›
                                ‹(p ∙ xvec) ♯* C›
    by(rule rInput)
next
  case(Output M K N P)
  thus ?thesis by(rule rOutput)
next
  case(Case P φ Cs)
  thus ?thesis by(rule rCase)
next
  case(cPar1 Ψ⇩Q P α P' Q A⇩Q)
  obtain q::"name prm" where "(bn(q ∙ α)) ♯* Ψ" and "(bn(q ∙ α)) ♯* P" and "(bn(q ∙ α)) ♯* Q" 
                         and "(bn(q ∙ α)) ♯* α" and "(bn(q ∙ α)) ♯* A⇩Q" and "(bn(q ∙ α)) ♯* P'" and "(bn(q ∙ α)) ♯* Ψ⇩Q"
                         and "distinctPerm q"
                         and "(bn(q ∙ α)) ♯* C" and Sq: "(set q) ⊆ set(bn α) × (set(bn(q ∙ α)))"
    by(rule_tac xvec="bn α" and c="(Ψ, P, Q, α, A⇩Q, Ψ⇩Q, P', C)" in name_list_avoiding) (auto simp add: eqvts)
  obtain p::"name prm" where "(p ∙ A⇩Q) ♯* Ψ" and "(p ∙ A⇩Q) ♯* P" and "(p ∙ A⇩Q) ♯* Q" 
                         and "(p ∙ A⇩Q) ♯* α" and "(p ∙ A⇩Q) ♯* (q ∙ α)" and "(p ∙ A⇩Q) ♯* P'" 
                         and "(p ∙ A⇩Q) ♯* (q ∙ P')" and "(p ∙ A⇩Q) ♯* Ψ⇩Q" and "(p ∙ A⇩Q) ♯* C" 
                         and Sp: "(set p) ⊆ (set A⇩Q) × (set(p ∙ A⇩Q))" and "distinctPerm p"
    by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, α, q ∙ α, P', (q ∙ P'), Ψ⇩Q, C)" in name_list_avoiding) auto
  from ‹A⇩Q ♯* α› ‹bn(q ∙ α) ♯* A⇩Q› Sq ‹distinctPerm q› have "A⇩Q ♯* (q ∙ α)"
    by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
  from ‹bn α ♯* subject α› ‹distinctPerm q› have "bn(q ∙ α) ♯* subject(q ∙ α)"
    by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
  from ‹distinct(bn α)› ‹distinctPerm q› have "distinct(bn(q ∙ α))" 
    by(subst distinctClosed[symmetric, of _ q]) (simp add: eqvts)
  note ‹cP = P ∥ Q›

  moreover from ‹cRs = α ≺ (P' ∥ Q)› ‹bn α ♯* subject α› ‹(bn(q ∙ α)) ♯* α› ‹(bn(q ∙ α)) ♯* P'› ‹(bn(q ∙ α)) ♯* Q› ‹bn α ♯* Q› Sq
  have "cRs = (q ∙ α) ≺ (q ∙ P') ∥ Q"
    by(force simp add: residualAlpha)
  moreover from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› ‹bn α ♯* subject α› ‹(bn(q ∙ α)) ♯* α› ‹(bn(q ∙ α)) ♯* P'› Sq
  have Trans: "Ψ ⊗ Ψ⇩Q ⊳ P ⟼(q ∙ α) ≺ (q ∙ P')"
    by(force simp add: residualAlpha)
  hence "A⇩Q ♯* (q ∙ P')" using ‹bn(q ∙ α) ♯* subject(q ∙ α)› ‹distinct(bn(q ∙ α))› ‹A⇩Q ♯* P› ‹A⇩Q ♯* (q ∙ α)›
    by(drule_tac freeFreshChainDerivative) auto

  from Trans have "(p ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ (p ∙ P) ⟼p ∙ ((q ∙ α) ≺ (q ∙ P'))"
    by(rule semantics.eqvt)
  with ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* (q ∙ α)› ‹A⇩Q ♯* (q ∙ P')› ‹(bn(q ∙ α)) ♯* A⇩Q›  ‹(p ∙ A⇩Q) ♯* (q ∙ α)›
       ‹(p ∙ A⇩Q) ♯* Ψ› ‹(p ∙ A⇩Q) ♯* P›  ‹(p ∙ A⇩Q) ♯* (q ∙ P')› Sp
  have "Ψ ⊗ (p ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ α) ≺ (q ∙ P')" by(simp add: eqvts)
  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹(p ∙ A⇩Q) ♯* Ψ⇩Q› Sp have  "extractFrame Q = ⟨(p ∙ A⇩Q), (p ∙ Ψ⇩Q)⟩"
    by(simp add: frameChainAlpha' eqvts)
  moreover from ‹(bn(q ∙ α)) ♯* Ψ⇩Q› ‹(bn(q ∙ α)) ♯* A⇩Q› ‹(p ∙ A⇩Q) ♯* (q ∙ α)› Sp have "(bn(q ∙ α)) ♯* (p ∙ Ψ⇩Q)"
    by(simp add: freshAlphaPerm)
  moreover from ‹distinct A⇩Q› have "distinct(p ∙ A⇩Q)" by simp
  ultimately show ?thesis
    using ‹(p ∙ A⇩Q) ♯* P› ‹(p ∙ A⇩Q) ♯* Q› ‹(p ∙ A⇩Q) ♯* Ψ› ‹(p ∙ A⇩Q) ♯* (q ∙ α)›
          ‹(p ∙ A⇩Q) ♯* (q ∙ P')› ‹(bn(q ∙ α)) ♯* Ψ› ‹(bn(q ∙ α)) ♯* Q› ‹(bn(q ∙ α)) ♯* P›
          ‹(bn(q ∙ α)) ♯* C› ‹(p ∙ A⇩Q) ♯* C› ‹bn (q ∙ α) ♯* subject (q ∙ α)› ‹distinct(bn(q ∙ α))›
    by(rule_tac rPar1)
next
  case(cPar2 Ψ⇩P Q α Q' P A⇩P)
  obtain q::"name prm" where "(bn(q ∙ α)) ♯* Ψ" and "(bn(q ∙ α)) ♯* P" and "(bn(q ∙ α)) ♯* Q" 
                         and "(bn(q ∙ α)) ♯* α" and "(bn(q ∙ α)) ♯* A⇩P" and "(bn(q ∙ α)) ♯* Q'" and "(bn(q ∙ α)) ♯* Ψ⇩P"
                         and "distinctPerm q"
                         and "(bn(q ∙ α)) ♯* C" and Sq: "(set q) ⊆ set(bn α) × (set(bn(q ∙ α)))"
    by(rule_tac xvec="bn α" and c="(Ψ, P, Q, α, A⇩P, Ψ⇩P, Q', C)" in name_list_avoiding) (auto simp add: eqvts)
  obtain p::"name prm" where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" 
                         and "(p ∙ A⇩P) ♯* α" and "(p ∙ A⇩P) ♯* (q ∙ α)" and "(p ∙ A⇩P) ♯* Q'" 
                         and "(p ∙ A⇩P) ♯* (q ∙ Q')" and "(p ∙ A⇩P) ♯* Ψ⇩P" and "(p ∙ A⇩P) ♯* C" 
                         and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))" and "distinctPerm p"
    by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, α, q ∙ α, Q', (q ∙ Q'), Ψ⇩P, C)" in name_list_avoiding) auto
  from ‹A⇩P ♯* α› ‹bn(q ∙ α) ♯* A⇩P› Sq ‹distinctPerm q› have "A⇩P ♯* (q ∙ α)"
    by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
  from ‹bn α ♯* subject α› ‹distinctPerm q› have "bn(q ∙ α) ♯* subject(q ∙ α)"
    by(subst fresh_star_bij[symmetric, of _ _  q]) (simp add: eqvts)
  from ‹distinct(bn α)› ‹distinctPerm q› have "distinct(bn(q ∙ α))" 
    by(subst distinctClosed[symmetric, of _ q]) (simp add: eqvts)
  note ‹cP = P ∥ Q›

  moreover from ‹cRs = α ≺ (P ∥ Q')› ‹bn α ♯* subject α› ‹(bn(q ∙ α)) ♯* α› ‹(bn(q ∙ α)) ♯* Q'› ‹(bn(q ∙ α)) ♯* P› ‹bn α ♯* P› Sq
  have "cRs = (q ∙ α) ≺ P ∥  (q ∙ Q')"
    by(force simp add: residualAlpha)
  moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› ‹bn α ♯* subject α› ‹(bn(q ∙ α)) ♯* α› ‹(bn(q ∙ α)) ♯* Q'› Sq
  have Trans: "Ψ ⊗ Ψ⇩P ⊳ Q ⟼(q ∙ α) ≺ (q ∙ Q')"
    by(force simp add: residualAlpha)
  hence "A⇩P ♯* (q ∙ Q')" using ‹bn(q ∙ α) ♯* subject(q ∙ α)› ‹distinct(bn(q ∙ α))› ‹A⇩P ♯* Q› ‹A⇩P ♯* (q ∙ α)›
    by(drule_tac freeFreshChainDerivative) auto

  from Trans have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ (p ∙ Q) ⟼p ∙ ((q ∙ α) ≺ (q ∙ Q'))"
    by(rule semantics.eqvt)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Q› ‹A⇩P ♯* (q ∙ α)› ‹A⇩P ♯* (q ∙ Q')› ‹(bn(q ∙ α)) ♯* A⇩P›  ‹(p ∙ A⇩P) ♯* (q ∙ α)›
       ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* Q›  ‹(p ∙ A⇩P) ♯* (q ∙ Q')› Sp
  have "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(q ∙ α) ≺ (q ∙ Q')" by(simp add: eqvts)
  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹(p ∙ A⇩P) ♯* Ψ⇩P› Sp have  "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
    by(simp add: frameChainAlpha' eqvts)
  moreover from ‹(bn(q ∙ α)) ♯* Ψ⇩P› ‹(bn(q ∙ α)) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ α)› Sp have "(bn(q ∙ α)) ♯* (p ∙ Ψ⇩P)"
    by(simp add: freshAlphaPerm)
  moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)" by simp
  ultimately show ?thesis
    using ‹(p ∙ A⇩P) ♯* P› ‹(p ∙ A⇩P) ♯* Q› ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* (q ∙ α)›
          ‹(p ∙ A⇩P) ♯* (q ∙ Q')› ‹(bn(q ∙ α)) ♯* Ψ› ‹(bn(q ∙ α)) ♯* Q› ‹(bn(q ∙ α)) ♯* P›
          ‹(bn(q ∙ α)) ♯* C› ‹(p ∙ A⇩P) ♯* C› ‹bn (q ∙ α) ♯* subject (q ∙ α)› ‹distinct(bn(q ∙ α))›
    by(rule_tac rPar2)
next
  case(cComm1 Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q)
  obtain r::"name prm" where "(r ∙ xvec) ♯* Ψ" and "(r ∙ xvec) ♯* P" and "(r ∙ xvec) ♯* Q" and "(r ∙ xvec) ♯* M"
                         and "(r ∙ xvec) ♯* K" and "(r ∙ xvec) ♯* N" and "(r ∙ xvec) ♯* A⇩P" and "(r ∙ xvec) ♯* A⇩Q"
                         and "(r ∙ xvec) ♯* P'" and "(r ∙ xvec) ♯* Q'" and "(r ∙ xvec) ♯* Ψ⇩P" and "(r ∙ xvec) ♯* Ψ⇩Q"
                         and "(r ∙ xvec) ♯* C" and Sr: "(set r) ⊆ (set xvec) × (set(r ∙ xvec))" and "distinctPerm r"
    by(rule_tac xvec=xvec and c="(Ψ, P, Q, M, K, N, A⇩P, A⇩Q, Ψ⇩P, Ψ⇩Q, P', Q', C)" in name_list_avoiding)
      (auto simp add: eqvts)

  obtain q::"name prm" where "(q ∙ A⇩Q) ♯* Ψ" and "(q ∙ A⇩Q) ♯* P" and "(q ∙ A⇩Q) ♯* Q" and "(q ∙ A⇩Q) ♯* K"
                         and "(q ∙ A⇩Q) ♯* N" and "(q ∙ A⇩Q) ♯* xvec" and "(q ∙ A⇩Q) ♯* Q'" and "(q ∙ A⇩Q) ♯* P'"
                         and "(q ∙ A⇩Q) ♯* Ψ⇩P" and  "(q ∙ A⇩Q) ♯* A⇩P" and "(q ∙ A⇩Q) ♯* Ψ⇩Q" and "(q ∙ A⇩Q) ♯* (r ∙ xvec)"
                         and "(q ∙ A⇩Q) ♯* C" and Sq: "(set q) ⊆ (set A⇩Q) × (set(q ∙ A⇩Q))"
    by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, K, N, xvec, r ∙ xvec, Ψ⇩Q, A⇩P, Ψ⇩P, Q', P', C)" in name_list_avoiding) clarsimp
  
  obtain p::"name prm"  where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" and "(p ∙ A⇩P) ♯* M"
                          and "(p ∙ A⇩P) ♯* N" and "(p ∙ A⇩P) ♯* xvec" and "(p ∙ A⇩P) ♯* Q'" and "(p ∙ A⇩P) ♯* A⇩Q"
                          and "(p ∙ A⇩P) ♯* P'" and "(p ∙ A⇩P) ♯* Ψ⇩P" and "(p ∙ A⇩P) ♯* Ψ⇩Q" and "(p ∙ A⇩P) ♯* (q ∙ A⇩Q)"
                          and "(p ∙ A⇩P) ♯* C" and "(p ∙ A⇩P) ♯* (r ∙ xvec)" and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))"
    by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, M, N, xvec, r ∙ xvec, A⇩Q, q ∙ A⇩Q, Ψ⇩Q, Ψ⇩P, Q', P', C)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  
  from ‹A⇩P ♯* Q› FrQ ‹A⇩P ♯* A⇩Q› have "A⇩P ♯* Ψ⇩Q"
    by(drule_tac extractFrameFreshChain) auto
  from ‹A⇩Q ♯* P› FrP ‹A⇩P ♯* A⇩Q› have "A⇩Q ♯* Ψ⇩P"
    by(drule_tac extractFrameFreshChain) auto
  note ‹cP = P ∥ Q›
  moreover from ‹(r ∙ xvec) ♯* P'› ‹(r ∙ xvec) ♯* Q'› have "(r ∙ xvec) ♯* (P' ∥ Q')"
    by simp
  with ‹cRs = τ ≺ ⦇ν*xvec⦈(P' ∥ Q')› ‹(r ∙ xvec) ♯* N› Sr
  have "cRs = τ ≺ ⦇ν*(r ∙ xvec)⦈(r ∙ (P' ∥ Q'))" by(simp add: resChainAlpha residualInject)
  hence "cRs = τ ≺ ⦇ν*(r ∙ xvec)⦈((r ∙ P') ∥ (r ∙ Q'))" by simp
  
  moreover from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› Sr ‹distinctPerm r› ‹xvec ♯* P› ‹(r ∙ xvec) ♯* P›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇(r ∙ N)⦈ ≺ (r ∙ P')"
    by(rule inputAlpha)
  hence "(q ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼(q ∙ M)⦇(r ∙ N)⦈ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* P› ‹(q ∙ A⇩Q) ♯* P›
    by(rule_tac inputPermFrameSubject) (assumption | simp)+
  hence PTrans: "Ψ ⊗ (q ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ M)⦇(r ∙ N)⦈ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ›
    by(simp add: eqvts)
  
  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩›  Sp ‹(p ∙ A⇩P) ♯* Ψ⇩P›
  have FrP: "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
    by(simp add: frameChainAlpha)
  moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)"  by simp

  moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› Sr ‹(r ∙ xvec) ♯* N› ‹(r ∙ xvec) ♯* Q'›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')"
    by(simp add: boundOutputChainAlpha'' residualInject)
  hence "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼(p ∙ K)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Q› ‹(p ∙ A⇩P) ♯* Q› ‹(r ∙ xvec) ♯* K›‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* A⇩P›
    by(rule_tac outputPermFrameSubject) (assumption | auto)

  hence QTrans: "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(p ∙ K)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ›
    by(simp add: eqvts)
  
  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›  Sq ‹(q ∙ A⇩Q) ♯* Ψ⇩Q›
  have FrQ: "extractFrame Q = ⟨(q ∙ A⇩Q), (q ∙ Ψ⇩Q)⟩"
    by(simp add: frameChainAlpha)
  moreover from ‹distinct A⇩Q› have "distinct(q ∙ A⇩Q)"  by simp
  
  moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(p ∙ q ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q)) ⊢ (p ∙ q ∙ M) ↔ (p ∙ q ∙ K)"
    by(rule_tac chanEqClosed)+
  with ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹(q ∙ A⇩Q) ♯* Ψ⇩P›
       ‹A⇩P ♯* Ψ⇩Q› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› ‹A⇩P ♯* M› ‹(p ∙ A⇩P) ♯* M› ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
       ‹A⇩Q ♯* K› ‹(q ∙ A⇩Q) ♯* K› ‹A⇩P ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* A⇩Q›  Sp Sq
  have "Ψ ⊗ (p ∙ Ψ⇩P) ⊗ (q ∙ Ψ⇩Q) ⊢ (q ∙ M) ↔ (p ∙ K)"
    by(simp add: eqvts freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* Ψ›
  moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› Sq have "(p ∙ A⇩P) ♯* (q ∙ Ψ⇩Q)"
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* P› 
  moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* M› Sq have "(p ∙ A⇩P) ♯* (q ∙ M)" 
    by(simp add: freshChainSimps)
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* N› Sr have "(p ∙ A⇩P) ♯* (r ∙ N)" 
    by(simp add: freshChainSimps)
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* P'› Sr have "(p ∙ A⇩P) ♯* (r ∙ P')" 
    by(simp add: freshChainSimps)
  moreover note  ‹(p ∙ A⇩P) ♯* Q›
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* Q'› Sr have "(p ∙ A⇩P) ♯* (r ∙ Q')"
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Ψ›
  moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* Ψ⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* P› 
  moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* K› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ K)"
    by(simp add: freshChainSimps)
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* N› Sr have "(q ∙ A⇩Q) ♯* (r ∙ N)" 
    by(simp add: freshChainSimps)
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* P'› Sr have "(q ∙ A⇩Q) ♯* (r ∙ P')"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* Q› 
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Q'› Sr have "(q ∙ A⇩Q) ♯* (r ∙ Q')"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ›
  moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩P› Sp have "(r ∙ xvec) ♯* (p ∙ Ψ⇩P)"  
    by(simp add: freshChainSimps)
  moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩Q› Sq have "(r ∙ xvec) ♯* (q ∙ Ψ⇩Q)"  
    by(simp add: freshChainSimps)
  moreover note ‹(r ∙ xvec) ♯* P›
  moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* M› Sq have "(r ∙ xvec) ♯* (q ∙ M)"  
    by(simp add: freshChainSimps)
  moreover note ‹(r ∙ xvec) ♯* Q›
  moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* K› Sp have "(r ∙ xvec) ♯* (p ∙ K)"  
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* C› ‹(q ∙ A⇩Q) ♯* C› ‹(r ∙ xvec) ♯* C› 
  moreover from ‹distinct xvec› have "distinct(r ∙ xvec)" by simp
  ultimately show ?thesis by(rule rComm1) 
next
  case(cComm2 Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q)
  obtain r::"name prm" where "(r ∙ xvec) ♯* Ψ" and "(r ∙ xvec) ♯* P" and "(r ∙ xvec) ♯* Q" and "(r ∙ xvec) ♯* M"
    and "(r ∙ xvec) ♯* K" and "(r ∙ xvec) ♯* N" and "(r ∙ xvec) ♯* A⇩P" and "(r ∙ xvec) ♯* A⇩Q"
                         and "(r ∙ xvec) ♯* P'" and "(r ∙ xvec) ♯* Q'" and "(r ∙ xvec) ♯* Ψ⇩P" and "(r ∙ xvec) ♯* Ψ⇩Q"
                         and "(r ∙ xvec) ♯* C" and Sr: "(set r) ⊆ (set xvec) × (set(r ∙ xvec))" and "distinctPerm r"
    by(rule_tac xvec=xvec and c="(Ψ, P, Q, M, K, N, A⇩P, A⇩Q, Ψ⇩P, Ψ⇩Q, P', Q', C)" in name_list_avoiding)
      (auto simp add: eqvts)

  obtain q::"name prm" where "(q ∙ A⇩Q) ♯* Ψ" and "(q ∙ A⇩Q) ♯* P" and "(q ∙ A⇩Q) ♯* Q" and "(q ∙ A⇩Q) ♯* K"
                         and "(q ∙ A⇩Q) ♯* N" and "(q ∙ A⇩Q) ♯* xvec" and "(q ∙ A⇩Q) ♯* Q'" and "(q ∙ A⇩Q) ♯* P'"
                         and "(q ∙ A⇩Q) ♯* Ψ⇩P" and  "(q ∙ A⇩Q) ♯* A⇩P" and "(q ∙ A⇩Q) ♯* Ψ⇩Q" and "(q ∙ A⇩Q) ♯* (r ∙ xvec)"
                         and "(q ∙ A⇩Q) ♯* C" and Sq: "(set q) ⊆ (set A⇩Q) × (set(q ∙ A⇩Q))"
    by(rule_tac xvec=A⇩Q and c="(Ψ, P, Q, K, N, xvec, r ∙ xvec, Ψ⇩Q, A⇩P, Ψ⇩P, Q', P', C)" in name_list_avoiding) clarsimp
  
  obtain p::"name prm"  where "(p ∙ A⇩P) ♯* Ψ" and "(p ∙ A⇩P) ♯* P" and "(p ∙ A⇩P) ♯* Q" and "(p ∙ A⇩P) ♯* M"
                          and "(p ∙ A⇩P) ♯* N" and "(p ∙ A⇩P) ♯* xvec" and "(p ∙ A⇩P) ♯* Q'" and "(p ∙ A⇩P) ♯* A⇩Q"
                          and "(p ∙ A⇩P) ♯* P'" and "(p ∙ A⇩P) ♯* Ψ⇩P" and "(p ∙ A⇩P) ♯* Ψ⇩Q" and "(p ∙ A⇩P) ♯* (q ∙ A⇩Q)"
                          and "(p ∙ A⇩P) ♯* C" and "(p ∙ A⇩P) ♯* (r ∙ xvec)" and Sp: "(set p) ⊆ (set A⇩P) × (set(p ∙ A⇩P))"
    by(rule_tac xvec=A⇩P and c="(Ψ, P, Q, M, N, xvec, r ∙ xvec, A⇩Q, q ∙ A⇩Q, Ψ⇩Q, Ψ⇩P, Q', P', C)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  
  from ‹A⇩P ♯* Q› FrQ ‹A⇩P ♯* A⇩Q› have "A⇩P ♯* Ψ⇩Q"
    by(drule_tac extractFrameFreshChain) auto
  from ‹A⇩Q ♯* P› FrP ‹A⇩P ♯* A⇩Q› have "A⇩Q ♯* Ψ⇩P"
    by(drule_tac extractFrameFreshChain) auto
  
  note ‹cP = P ∥ Q›
  moreover from ‹(r ∙ xvec) ♯* P'› ‹(r ∙ xvec) ♯* Q'› have "(r ∙ xvec) ♯* (P' ∥ Q')"
    by simp
  with ‹cRs = τ ≺ ⦇ν*xvec⦈(P' ∥ Q')› ‹(r ∙ xvec) ♯* N› Sr
  have "cRs = τ ≺ ⦇ν*(r ∙ xvec)⦈(r ∙ (P' ∥ Q'))" by(simp add: resChainAlpha residualInject)
  hence "cRs = τ ≺ ⦇ν*(r ∙ xvec)⦈((r ∙ P') ∥ (r ∙ Q'))"
    by simp
  
  moreover from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› Sr ‹(r ∙ xvec) ♯* N› ‹(r ∙ xvec) ♯* P'›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')" by(simp add: boundOutputChainAlpha'' residualInject)
  hence "(q ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼(q ∙ M)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* P› ‹(q ∙ A⇩Q) ♯* P› ‹(r ∙ xvec) ♯* M› ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)›
    by(rule_tac outputPermFrameSubject) (assumption | auto)
  hence PTrans: "Ψ ⊗ (q ∙ Ψ⇩Q) ⊳ P ⟼(q ∙ M)⦇ν*(r ∙ xvec)⦈⟨(r ∙ N)⟩ ≺ (r ∙ P')" using Sq ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ›
    by(simp add: eqvts)
  
  moreover from ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩›  Sp ‹(p ∙ A⇩P) ♯* Ψ⇩P›
  have FrP: "extractFrame P = ⟨(p ∙ A⇩P), (p ∙ Ψ⇩P)⟩"
    by(simp add: frameChainAlpha)
  moreover from ‹distinct A⇩P› have "distinct(p ∙ A⇩P)"  by simp

  moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› Sr  ‹distinctPerm r› ‹xvec ♯* Q› ‹(r ∙ xvec) ♯* Q›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇(r ∙ N)⦈ ≺ (r ∙ Q')" by(rule inputAlpha)
  hence "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼(p ∙ K)⦇(r ∙ N)⦈ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Q› ‹(p ∙ A⇩P) ♯* Q›
    by(rule_tac inputPermFrameSubject) (assumption | simp)+
  hence QTrans: "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼(p ∙ K)⦇(r ∙ N)⦈ ≺ (r ∙ Q')" using Sp ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ›
    by(simp add: eqvts)
  
  moreover from ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩›  Sq ‹(q ∙ A⇩Q) ♯* Ψ⇩Q›
  have FrQ: "extractFrame Q = ⟨(q ∙ A⇩Q), (q ∙ Ψ⇩Q)⟩"
    by(simp add: frameChainAlpha)
  moreover from ‹distinct A⇩Q› have "distinct(q ∙ A⇩Q)"  by simp
  
  moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(p ∙ q ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q)) ⊢ (p ∙ q ∙ M) ↔ (p ∙ q ∙ K)"
    by(rule_tac chanEqClosed)+
  with ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ› ‹A⇩Q ♯* Ψ› ‹(q ∙ A⇩Q) ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹(q ∙ A⇩Q) ♯* Ψ⇩P›
       ‹A⇩P ♯* Ψ⇩Q› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› ‹A⇩P ♯* M› ‹(p ∙ A⇩P) ♯* M› ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)›
       ‹A⇩Q ♯* K› ‹(q ∙ A⇩Q) ♯* K› ‹A⇩P ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* A⇩Q›  Sp Sq
  have "Ψ ⊗ (p ∙ Ψ⇩P) ⊗ (q ∙ Ψ⇩Q) ⊢ (q ∙ M) ↔ (p ∙ K)"
    by(simp add: eqvts freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* Ψ›
  moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* Ψ⇩Q› Sq have "(p ∙ A⇩P) ♯* (q ∙ Ψ⇩Q)" 
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* P› 
  moreover from ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* M› Sq have "(p ∙ A⇩P) ♯* (q ∙ M)" 
    by(simp add: freshChainSimps)
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* N› Sr have "(p ∙ A⇩P) ♯* (r ∙ N)" 
    by(simp add: freshChainSimps)
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* P'› Sr have "(p ∙ A⇩P) ♯* (r ∙ P')"
    by(simp add: freshChainSimps)
  moreover note  ‹(p ∙ A⇩P) ♯* Q›
  moreover from ‹(p ∙ A⇩P) ♯* xvec› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(p ∙ A⇩P) ♯* Q'› Sr have "(p ∙ A⇩P) ♯* (r ∙ Q')"
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Ψ›
  moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* Ψ⇩P› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* P› 
  moreover from ‹(q ∙ A⇩Q) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* K› ‹(p ∙ A⇩P) ♯* (q ∙ A⇩Q)› Sp Sq have "(q ∙ A⇩Q) ♯* (p ∙ K)"
    by(simp add: freshChainSimps)
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* N› Sr have "(q ∙ A⇩Q) ♯* (r ∙ N)"
    by(simp add: freshChainSimps)
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* P'› Sr have "(q ∙ A⇩Q) ♯* (r ∙ P')"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* Q› 
  moreover from ‹(q ∙ A⇩Q) ♯* xvec› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(q ∙ A⇩Q) ♯* Q'› Sr have "(q ∙ A⇩Q) ♯* (r ∙ Q')"
    by(simp add: freshChainSimps)
  moreover note ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ›
  moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩P› Sp have "(r ∙ xvec) ♯* (p ∙ Ψ⇩P)"  
    by(simp add: freshChainSimps)
  moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* Ψ⇩Q› Sq have "(r ∙ xvec) ♯* (q ∙ Ψ⇩Q)"
    by(simp add: freshChainSimps)
  moreover note ‹(r ∙ xvec) ♯* P›
  moreover from ‹(r ∙ xvec) ♯* A⇩Q› ‹(q ∙ A⇩Q) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* M› Sq have "(r ∙ xvec) ♯* (q ∙ M)"  
    by(simp add: freshChainSimps)
  moreover note ‹(r ∙ xvec) ♯* Q›
  moreover from ‹(r ∙ xvec) ♯* A⇩P› ‹(p ∙ A⇩P) ♯* (r ∙ xvec)› ‹(r ∙ xvec) ♯* K› Sp have "(r ∙ xvec) ♯* (p ∙ K)"  
    by(simp add: freshChainSimps)
  moreover note ‹(p ∙ A⇩P) ♯* C› ‹(q ∙ A⇩Q) ♯* C› ‹(r ∙ xvec) ♯* C›
  moreover from ‹distinct xvec› have "distinct(r ∙ xvec)" by simp
  ultimately show ?thesis by(rule rComm2) 
next
  case(cOpen P M xvec yvec N P' x)
  from ‹Ψ ⊳ P ⟼ M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'›  have "distinct(xvec@yvec)" by(force dest: boundOutputDistinct)
  hence "xvec ♯* yvec" by(induct xvec) auto
  obtain p where "(p ∙ yvec) ♯* Ψ" and "(p ∙ yvec) ♯* P"  and "(p ∙ yvec) ♯* M"
             and "(p ∙ yvec) ♯* yvec" and "(p ∙ yvec) ♯* N" and "(p ∙ yvec) ♯* P'"
             and "x ♯ (p ∙ yvec)" and "(p ∙ yvec) ♯* xvec"
             and "(p ∙ yvec) ♯* C" and Sp: "(set p) ⊆ (set yvec) × (set(p ∙ yvec))"
    by(rule_tac xvec=yvec and c="(Ψ, P, M, xvec, yvec, N, P', x, C)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod) 
  obtain q where "(q ∙ xvec) ♯* Ψ" and "(q ∙ xvec) ♯* P"  and "(q ∙ xvec) ♯* M"
             and "(q ∙ xvec) ♯* xvec" and "(q ∙ xvec) ♯* N" and "(q ∙ xvec) ♯* P'"
             and "x ♯ (q ∙ xvec)" and "(q ∙ xvec) ♯* yvec" 
             and "(q ∙ xvec) ♯* p" and "(q ∙ xvec) ♯* (p ∙ yvec)"
             and "(q ∙ xvec) ♯* C" and Sq: "(set q) ⊆ (set xvec) × (set(q ∙ xvec))"
    by(rule_tac xvec=xvec and c="(Ψ, P, M, xvec, yvec, p ∙ yvec, N, P', x, p, C)" in name_list_avoiding)
      (auto simp add: eqvts fresh_star_prod)
  obtain y::name where "y ♯ P" and "y ♯ C" and "y ♯ xvec" and "y ♯ yvec" and "y ≠ x" and "y ♯ N" 
                   and "y ♯ (q ∙ xvec)" and "y ♯ (p ∙ yvec)" and "y ♯ M" and "y ♯ Ψ" and "y ♯ P'"
    by(generate_fresh "name") (auto simp add: freshChainSimps)

  from ‹cP = ⦇νx⦈P› ‹y ♯ P› have "cP = ⦇νy⦈([(x, y)] ∙ P)" by(simp add: alphaRes)
  moreover have "cRs = M⦇ν*((q ∙ xvec)@y#(p ∙ yvec))⦈⟨((q@(x, y)#p) ∙ N)⟩ ≺ ((q@(x, y)#p) ∙ P')"
  proof -
    note ‹cRs = M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'›
    moreover have "⦇ν*(xvec@x#yvec)⦈N ≺' P' = ⦇ν*xvec⦈(⦇νx⦈(⦇ν*yvec⦈N ≺' P'))" by(simp add: boundOutputApp)
    moreover from ‹(p ∙ yvec) ♯* N› ‹(p ∙ yvec) ♯* P'› Sp have "… = ⦇ν*xvec⦈(⦇νx⦈(⦇ν*(p ∙ yvec)⦈(p ∙ N) ≺' (p ∙ P')))"
      by(simp add: boundOutputChainAlpha'')
    moreover with ‹y ♯ N› ‹y ♯ P'› ‹y ♯ (p ∙ yvec)› ‹y ♯ yvec› ‹x ♯ yvec› ‹x ♯ (p ∙ yvec)› Sp
    have "… = ⦇ν*xvec⦈(⦇νy⦈(⦇ν*(p ∙ yvec)⦈(([(x, y)] ∙ p ∙ N) ≺' ([(x, y)] ∙ p ∙ P'))))"
      by(subst alphaBoundOutput[where y=y]) (simp add: freshChainSimps eqvts)+
    moreover hence "… = ⦇ν*xvec⦈(⦇νy⦈(⦇ν*(p ∙ yvec)⦈((((x, y)#p) ∙ N) ≺' (((x, y)#p) ∙ P'))))"
      by simp
    moreover from ‹(q ∙ xvec) ♯* N› ‹(q ∙ xvec) ♯* P'› ‹xvec ♯* yvec› ‹(p ∙ yvec) ♯* xvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› 
                  ‹y ♯ xvec› ‹y ♯ (q ∙ xvec)› ‹x ♯ xvec› ‹x ♯ (q ∙ xvec)› Sp Sq
    have "… = ⦇ν*(q ∙ xvec)⦈(⦇νy⦈(⦇ν*(p ∙ yvec)⦈((q ∙ ((x, y)#p) ∙ N) ≺' (q ∙ ((x, y)#p) ∙ P'))))"
      apply(subst boundOutputChainAlpha[where p=q and xvec=xvec and yvec="xvec"])
      defer
      apply assumption
      apply simp
      apply(simp add: eqvts)
      apply(simp add: eqvts)
      apply(simp add: boundOutputFreshSet(4))
      apply(rule conjI)
      apply(simp add: freshChainSimps)
      apply(simp add: freshChainSimps)
      done
    moreover hence "… = ⦇ν*(q ∙ xvec@y#(p ∙ yvec))⦈((q@(x, y)#p) ∙ N) ≺' ((q@(x, y)#p) ∙ P')"
      by(simp only: pt2[OF pt_name_inst] boundOutputApp BOresChain.simps)
    ultimately show ?thesis
      by(simp only: residualInject)
  qed
  moreover have "Ψ ⊳ ([(x, y)] ∙ P) ⟼M⦇ν*((q ∙ xvec)@(p ∙ yvec))⦈⟨((q@(x, y)#p) ∙ N)⟩ ≺ ((q@(x, y)#p) ∙ P')"
  proof -
    note‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'›
    moreover from ‹(p ∙ yvec) ♯* N› ‹(q ∙ xvec) ♯* N› ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec› Sp Sq 
    have "((q@p) ∙ (xvec @ yvec)) ♯* N" apply(simp only: eqvts) apply(simp only: pt2[OF pt_name_inst])
      by simp
    moreover from ‹(p ∙ yvec) ♯* P'› ‹(q ∙ xvec) ♯* P'› ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec› Sp Sq 
    have "((q@p) ∙ (xvec @ yvec)) ♯* P'" by(simp del: freshAlphaPerm add: eqvts pt2[OF pt_name_inst])
    moreover from Sp Sq ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec›
    have Spq: "set(q@p) ⊆ set(xvec@yvec) × set((q@p) ∙ (xvec@yvec))"
      by(simp add: pt2[OF pt_name_inst] eqvts) blast
    ultimately have "Ψ ⊳ P ⟼M⦇ν*((q@p) ∙ (xvec@yvec))⦈⟨((q@p) ∙ N)⟩ ≺ ((q@p) ∙ P')"
      apply(simp only: residualInject)
      by(erule_tac rev_mp) (subst boundOutputChainAlpha, auto)
    with  Sp Sq ‹xvec ♯* yvec› ‹(q ∙ xvec) ♯* yvec› ‹(q ∙ xvec) ♯* (p ∙ yvec)› ‹(p ∙ yvec) ♯* xvec›
    have "Ψ ⊳ P ⟼M⦇ν*((q ∙ xvec)@(p ∙ yvec))⦈⟨((q@p) ∙ N)⟩ ≺ ((q@p) ∙ P')"
      by(simp add: eqvts pt2[OF pt_name_inst] del: freshAlphaPerm)
    hence "([(x, y)] ∙ Ψ) ⊳ ([(x, y)] ∙ P) ⟼ [(x, y)] ∙ (M⦇ν*((q ∙ xvec)@(p ∙ yvec))⦈⟨((q@p) ∙ N)⟩ ≺ ((q@p) ∙ P'))"
      by(rule semantics.eqvt)
    with ‹x ♯ Ψ› ‹y ♯ Ψ› ‹x ♯ M› ‹y ♯ M› ‹x ♯ xvec› ‹y ♯ xvec› ‹x ♯ (q ∙ xvec)› ‹y ♯ (q ∙ xvec) ›‹x ♯ yvec› ‹y ♯ yvec› ‹x ♯ (p ∙ yvec)› ‹y ♯ (p ∙ yvec)› Sp Sq
    show ?thesis 
      apply(simp add: eqvts pt2[OF pt_name_inst])
      by(subst perm_compose[of q], simp)+
  qed
  moreover from ‹x ∈ supp N› have "((q@(x, y)#p) ∙ x) ∈ ((q@(x, y)#p) ∙ (supp N))"
    by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
  with ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ (q ∙ xvec)› ‹x ♯ (p ∙ yvec)› ‹y ♯ xvec› ‹y ♯ (q ∙ xvec)› Sp Sq
  have "y ∈ supp((q@(x, y)#p)∙ N)" by(simp add: pt2[OF pt_name_inst] calc_atm eqvts)
  moreover from ‹distinct xvec› have "distinct(q ∙ xvec)" by simp
  moreover from ‹distinct yvec› have "distinct(p ∙ yvec)" by simp
  moreover note ‹x ♯ (q ∙ xvec)› ‹x ♯ (p ∙ yvec)› ‹x ♯ M› ‹x ♯ Ψ› 
                ‹(q ∙ xvec) ♯* Ψ› ‹(q ∙ xvec) ♯* P› ‹(q ∙ xvec) ♯* M› ‹(q ∙ xvec) ♯* (p ∙ yvec)›
                ‹(p ∙ yvec) ♯* Ψ› ‹(p ∙ yvec) ♯* P› ‹(p ∙ yvec) ♯* M› ‹y ♯ (q ∙ xvec)› ‹y ♯ (p ∙ yvec)› ‹y ♯ M› ‹y ♯ C› ‹y ♯ Ψ›
                 ‹(p ∙ yvec) ♯* C› ‹(q ∙ xvec) ♯* C›
  ultimately show Prop by(rule_tac rOpen) (assumption | simp)+
next
  case(cScope P α P' x)
  obtain p::"name prm" where "(bn(p ∙ α)) ♯* Ψ" and "(bn(p ∙ α)) ♯* P"
                         and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'" and "x ♯ bn(p ∙ α)"
                         and "distinctPerm p"
                         and "(bn(p ∙ α)) ♯* C" and Sp: "(set p) ⊆ set(bn α) × (set(bn(p ∙ α)))"
    by(rule_tac xvec="bn α" and c="(Ψ, P, α, x, P', C)" in name_list_avoiding) (auto simp add: eqvts)
  obtain y::name where "y ♯ Ψ" and "y ♯ P" and "y ♯ (p ∙ P')" and "y ♯ (p ∙ α)" and "y ♯ C"
    by(generate_fresh "name") (auto simp add: freshChainSimps simp del: actionFresh)
  from ‹bn α ♯* subject α› ‹distinctPerm p› have "bn(p ∙ α) ♯* subject(p ∙ α)"
    by(subst fresh_star_bij[symmetric, of _ _  p]) (simp add: eqvts)
  from ‹distinct(bn α)› ‹distinctPerm p› have "distinct(bn(p ∙ α))" 
    by(subst distinctClosed[symmetric, of _ p]) (simp add: eqvts)
  from ‹x ♯ α› ‹x ♯ (bn(p ∙ α))› ‹distinctPerm p› Sp have "x ♯ (p ∙ α)"
    by(subst fresh_bij[symmetric, of _ _ p]) (simp add: eqvts freshChainSimps)

  moreover from ‹cP = ⦇νx⦈P› ‹y ♯ P› have "cP = ⦇νy⦈([(x, y)] ∙ P)" by(simp add: alphaRes)
  moreover from ‹cRs = α ≺ ⦇νx⦈P'› ‹bn α ♯* subject α› ‹(bn(p ∙ α)) ♯* α› ‹x ♯ bn(p ∙ α)› ‹(bn(p ∙ α)) ♯* P'› ‹x ♯ α› Sp
  have "cRs = (p ∙ α) ≺ ⦇νx⦈(p ∙ P')"
    by(force simp add: residualAlpha)
  with ‹y ♯ (p ∙ P')› have "cRs = (p ∙ α) ≺ ⦇νy⦈([(x, y)] ∙ p ∙ P')"
    by(simp add: alphaRes)
  moreover from ‹Ψ ⊳ P ⟼α ≺ P'› ‹bn α ♯* subject α› ‹(bn(p ∙ α)) ♯* α› ‹(bn(p ∙ α)) ♯* P'› Sp
  have "Ψ ⊳ P ⟼(p ∙ α) ≺ (p ∙ P')" by(force simp add: residualAlpha)
  hence"([(x, y)] ∙ Ψ) ⊳ ([(x, y)] ∙ P) ⟼[(x, y)] ∙ ((p ∙ α) ≺ (p ∙ P'))"
    by(rule eqvts)
  with ‹x ♯ Ψ› ‹y ♯ Ψ› ‹y ♯ (p ∙ α)› ‹x ♯ (p ∙ α)› Sp ‹distinctPerm p›
  have "Ψ ⊳ ([(x, y)] ∙ P) ⟼(p ∙ α) ≺ ([(x, y)] ∙ p ∙ P')" 
    by(simp add: eqvts)
  moreover from ‹bn(p ∙ α) ♯* P› ‹y ♯ (p ∙ α)› ‹y ♯ P› have "bn(p ∙ α) ♯* ([(x, y)] ∙ P)"
    by(auto simp add: fresh_star_def fresh_left calc_atm) (simp add: fresh_def name_list_supp)
  moreover from ‹distinct(bn α)› have "distinct(p ∙ bn α)" by simp
  hence "distinct(bn(p ∙ α))" by(simp add: eqvts)
  ultimately show ?thesis
    using ‹y ♯ Ψ› ‹y ♯ (p ∙ α)› ‹y ♯ C› ‹bn(p ∙ α) ♯* Ψ› ‹bn(p ∙ α) ♯* subject(p ∙ α)› ‹bn(p ∙ α) ♯* C›
    by(rule_tac rScope)
next
  case(Bang P)
  thus ?thesis by(rule_tac rBang) 
qed

nominal_primrec
  inputLength :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psi ⇒ nat"
  and inputLength'  :: "('a::fs_name, 'b::fs_name, 'c::fs_name) input ⇒ nat"
  and inputLength'' :: "('a::fs_name, 'b::fs_name, 'c::fs_name) psiCase ⇒ nat"

where
  "inputLength (𝟬) = 0"
| "inputLength (M⟨N⟩.P) = 0"
| "inputLength (M⦇I) = inputLength' I"
| "inputLength (Case C) = 0"
| "inputLength (P ∥ Q) = 0"
| "inputLength (⦇νx⦈P) = 0"
| "inputLength (⦃Ψ⦄) = 0"
| "inputLength (!P) = 0"

| "inputLength' (Trm M P) = 0"
| "inputLength' (ν y I) = 1 + (inputLength' I)"

| "inputLength'' (⊥⇩c) = 0"
| "inputLength'' (□Φ ⇒ P C) = 0"
apply(finite_guess)+
apply(rule TrueI)+
by(fresh_guess add: fresh_nat)+

nominal_primrec boundOutputLength :: "('a, 'b, 'c) boundOutput ⇒ nat"
where
  "boundOutputLength (BOut M P) = 0"
| "boundOutputLength (BStep x B) = (boundOutputLength B) + 1"
apply(finite_guess)+
apply(rule TrueI)+
by(fresh_guess add: fresh_nat)+
  
nominal_primrec residualLength :: "('a, 'b, 'c) residual ⇒ nat"
where
  "residualLength (RIn M N P) = 0"
| "residualLength (ROut M B) = boundOutputLength B"
| "residualLength (RTau P) = 0"
by(rule TrueI)+

lemma inputLengthProc[simp]:
  shows "inputLength(M⦇λ*xvec N⦈.P) = length xvec"
by(induct xvec) auto

lemma boundOutputLengthSimp[simp]:
  shows "residualLength(M⦇ν*xvec⦈⟨N⟩ ≺ P) = length xvec"
by(induct xvec) (auto simp add: residualInject)

lemma boundOuputLengthSimp2[simp]:
  shows "residualLength(α ≺ P) = length(bn α)"
by(nominal_induct α rule: action.strong_induct, auto) (auto simp add: residualInject)

lemmas [simp del] = inputLength_inputLength'_inputLength''.simps residualLength.simps boundOutputLength.simps

lemma constructPerm:
  fixes xvec :: "name list"
  and   yvec :: "name list"
  
  assumes "length xvec = length yvec"
  and     "xvec ♯* yvec"
  and     "distinct xvec"
  and     "distinct yvec"

  obtains p where "set p ⊆ set xvec × set(p ∙ xvec)" and "distinctPerm p" and "yvec = p ∙ xvec"
proof -
  assume "⋀p. ⟦set p ⊆ set xvec × set (p ∙ xvec); distinctPerm p; yvec = p ∙ xvec⟧ ⟹ thesis"
  moreover obtain n where "n = length xvec" by auto
  with assms have "∃p. (set p) ⊆ (set xvec) × set (yvec) ∧ distinctPerm p ∧  yvec = p ∙ xvec"
  proof(induct n arbitrary: xvec yvec)
    case(0 xvec yvec)
    thus ?case by simp
  next
    case(Suc n xvec yvec)
    from ‹Suc n = length xvec›
    obtain x xvec' where "xvec = x#xvec'" and "length xvec' = n"
      by(case_tac xvec) auto
    from ‹length xvec = length yvec› ‹xvec = x # xvec'›
    obtain y yvec' where "length xvec' = length yvec'" and "yvec = y#yvec'"
      by(case_tac yvec) auto
    from ‹xvec = x#xvec'› ‹yvec=y#yvec'› ‹xvec ♯* yvec›
    have "x ≠ y" and "xvec' ♯* yvec'" and "x ♯ yvec'" and "y ♯ xvec'"
      by(auto simp add: fresh_list_cons)
    from ‹distinct xvec› ‹distinct yvec› ‹xvec=x#xvec'› ‹yvec=y#yvec'› have "x ♯ xvec'" and "y ♯ yvec'" and "distinct xvec'" and "distinct yvec'"
      by simp+
    from ‹Suc n = length xvec› ‹xvec=x#xvec'› have "n = length xvec'" by simp
    with ‹length xvec' = length yvec'› ‹xvec' ♯* yvec'› ‹distinct xvec'› ‹distinct yvec'›
    obtain p where S: "set p ⊆ set xvec' × set yvec'" and "distinctPerm p" and "yvec' = p ∙ xvec'"
      by(drule_tac Suc) auto
    from S have "set((x, y)#p) ⊆ set(x#xvec') × set(y#yvec')" by auto
    moreover from ‹x ♯ xvec'› ‹x ♯ yvec'› ‹y ♯ xvec'› ‹y ♯ yvec'› S have "x ♯ p" and "y ♯ p"
      apply(induct p)
      by(auto simp add: fresh_list_nil fresh_list_cons fresh_prod name_list_supp) (auto simp add: fresh_def) 

    with S ‹distinctPerm p› ‹x ≠ y› have "distinctPerm((x, y)#p)" by auto
    moreover from ‹yvec' = p ∙ xvec'› ‹x ♯ p› ‹y ♯ p› ‹x ♯ xvec'› ‹y ♯ xvec'› have "(y#yvec') = ((x, y)#p) ∙ (x#xvec')"
      by(simp add: calc_atm freshChainSimps)
    ultimately show ?case using ‹xvec=x#xvec'› ‹yvec=y#yvec'›
      by blast
  qed
  ultimately show ?thesis by blast
qed

lemma distinctApend[simp]:
  fixes xvec :: "name list"
  and   yvec :: "name list"

  shows "(set xvec ∩ set yvec = {}) = xvec ♯* yvec"
by(auto simp add: fresh_star_def name_list_supp fresh_def)

lemma lengthAux:
  fixes xvec :: "name list"
  and   y    :: name
  and   yvec :: "name list"

  assumes "length xvec = length(y#yvec)"

  obtains z zvec where "xvec = z#zvec" and "length zvec = length yvec"
using assms
by(induct xvec arbitrary: yvec y) auto

lemma lengthAux2:
  fixes xvec :: "name list"
  and   yvec :: "name list"
  and   zvec :: "name list"

  assumes "length xvec = length(yvec@y#zvec)"

  obtains xvec1 x xvec2 where "xvec=xvec1@x#xvec2" and "length xvec1 = length yvec" and "length xvec2 = length zvec"
proof -
  assume "⋀xvec1 x xvec2.
        ⟦xvec = xvec1 @ x # xvec2; length xvec1 = length yvec;
         length xvec2 = length zvec⟧
        ⟹ thesis"
  moreover from assms have "∃xvec1 x xvec2. xvec=xvec1@x#xvec2 ∧ length xvec1 = length yvec ∧ length xvec2 = length zvec"
    apply(rule_tac x="take (length yvec) xvec" in exI)
    apply(rule_tac x="hd(drop (length yvec) xvec)" in exI)
    apply(rule_tac x="tl(drop (length yvec) xvec)" in exI)
    by auto
  ultimately show ?thesis by blast
qed

lemma semanticsCases[consumes 11, case_names cInput cCase cPar1 cPar2 cComm1 cComm2 cScope cBang]:
  fixes Ψ  :: 'b
  and   cP  :: "('a, 'b, 'c) psi"
  and   cRs :: "('a, 'b, 'c) residual"
  and   C   :: "'d::fs_name"
  and   x1   :: name
  and   x2   :: name
  and   xvec1 :: "name list"
  and   xvec2 :: "name list"
  and   xvec3 :: "name list"
  and   xvec4 :: "name list"
  and   xvec5 :: "name list"

  assumes "Ψ ⊳ cP ⟼cRs"
  and     "length xvec1 = inputLength cP" and "distinct xvec1"
  and     "length xvec2 = residualLength cRs" and "distinct xvec2"
  and     "length xvec3 = residualLength cRs" and "distinct xvec3"
  and     "length xvec4 = residualLength cRs" and "distinct xvec4"
  and     "length xvec5 = residualLength cRs" and "distinct xvec5"
  and     rInput: "⋀M K N Tvec P. (⟦xvec1 ♯* Ψ; xvec1 ♯* cP; xvec1 ♯* cRs⟧ ⟹ cP = M⦇λ*xvec1 N⦈.P ∧  cRs = K⦇(N[xvec1::=Tvec])⦈ ≺ P[xvec1::=Tvec] ∧
                                            Ψ ⊢ M ↔ K ∧ distinct xvec1 ∧ set xvec1 ⊆ supp N ∧ length xvec1=length Tvec ∧
                                            xvec1 ♯* Tvec ∧ xvec1 ♯* Ψ ∧ xvec1 ♯* M ∧ xvec1 ♯* K) ⟹ Prop"
  and     rOutput: "⋀M K N P. ⟦cP = M⟨N⟩.P; cRs = K⟨N⟩ ≺ P; Ψ ⊢ M ↔ K⟧ ⟹ Prop"
  and     rCase: "⋀Cs P φ. ⟦cP = Cases Cs; Ψ ⊳ P ⟼ cRs; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ Prop"
  and     rPar1: "⋀Ψ⇩Q P α P' Q A⇩Q. (⟦xvec2 ♯* Ψ; xvec2 ♯* cP; xvec2 ♯* cRs⟧ ⟹ 
                                         cP = P ∥ Q ∧ cRs = α ≺ (P' ∥ Q) ∧ xvec2 = bn α ∧
                                          Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P' ∧ extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩ ∧ distinct A⇩Q ∧
                                          A⇩Q ♯* P ∧ A⇩Q ♯* Q ∧ A⇩Q ♯* Ψ ∧ A⇩Q ♯* α ∧ A⇩Q ♯* P' ∧ A⇩Q ♯* C) ⟹ Prop"
  and     rPar2: "⋀Ψ⇩P Q α Q' P A⇩P. (⟦xvec3 ♯* Ψ; xvec3 ♯* cP; xvec3 ♯* cRs⟧ ⟹ 
                                         cP = P ∥ Q ∧ cRs = α ≺ (P ∥ Q') ∧ xvec3 = bn α ∧
                                          Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q' ∧ extractFrame P = ⟨A⇩P, Ψ⇩P⟩ ∧ distinct A⇩P ∧
                                          A⇩P ♯* P ∧ A⇩P ♯* Q ∧ A⇩P ♯* Ψ ∧ A⇩P ♯* α ∧ A⇩P ♯* Q' ∧ A⇩P ♯* C) ⟹ Prop"
  and     rComm1: "⋀Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q.
                   ⟦cP = P ∥ Q; cRs = τ ≺ ⦇ν*xvec⦈P' ∥ Q';
                    Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N;
                    A⇩P ♯* P'; A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P;
                    A⇩Q ♯* P; A⇩Q ♯* K; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* Q'; A⇩Q ♯* xvec;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* Q;
                    xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C; distinct xvec⟧ ⟹ Prop"
  and     rComm2: "⋀Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q.
                   ⟦cP = P ∥ Q; cRs = τ ≺ ⦇ν*xvec⦈P' ∥ Q';
                    Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                    Ψ ⊗ Ψ⇩P ⊳ Q ⟼ K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                    Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* Ψ⇩Q; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* N;
                    A⇩P ♯* P'; A⇩P ♯* Q; A⇩P ♯* Q'; A⇩P ♯* A⇩Q; A⇩P ♯* xvec; A⇩Q ♯* Ψ; A⇩Q ♯* Ψ⇩P;
                    A⇩Q ♯* P; A⇩Q ♯* K; A⇩Q ♯* N; A⇩Q ♯* P'; A⇩Q ♯* Q; A⇩Q ♯* Q'; A⇩Q ♯* xvec;
                    xvec ♯* Ψ; xvec ♯* Ψ⇩P; xvec ♯* Ψ⇩Q; xvec ♯* P; xvec ♯* M; xvec ♯* Q;
                    xvec ♯* K; A⇩P ♯* C; A⇩Q ♯* C; xvec ♯* C; distinct xvec⟧ ⟹ Prop"
  and    rOpen:  "⋀P  M xvec y yvec N P'. 
                   (⟦xvec4 ♯* Ψ; xvec4 ♯* cP; xvec4 ♯* cRs; x1 ♯ Ψ; x1 ♯ cP; x1 ♯ cRs; x1 ♯ xvec4⟧ ⟹
                    cP = ⦇νx1⦈P ∧ cRs = M⦇ν*(xvec@x1#yvec)⦈⟨N⟩ ≺ P' ∧ xvec4=xvec@y#yvec ∧
                    Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P' ∧ x1 ∈ supp N ∧ x1 ♯ xvec ∧ x1 ♯ yvec ∧
                    distinct xvec ∧ distinct yvec ∧ xvec ♯* Ψ ∧ xvec ♯* P ∧ xvec ♯* M ∧ xvec ♯* yvec ∧
                    yvec ♯* Ψ ∧ yvec ♯* P ∧ yvec ♯* M) ⟹ Prop"
  and     rScope: "⋀P α P'. (⟦xvec5 ♯* Ψ; xvec5 ♯* cP; xvec5 ♯* cRs; x2 ♯ Ψ; x2 ♯ cP; x2 ♯ cRs; x2 ♯ xvec5⟧ ⟹ 
                              cP = ⦇νx2⦈P ∧ cRs = α ≺ ⦇νx2⦈P' ∧  xvec5 = bn α ∧
                              Ψ ⊳ P ⟼α ≺ P' ∧ x2 ♯ Ψ ∧ x2 ♯ α ∧ bn α ♯* subject α ∧ distinct(bn α)) ⟹ Prop"
  and    rBang:  "⋀P. ⟦cP = !P; Ψ ⊳ P ∥ !P ⟼ cRs; guarded P⟧ ⟹ Prop"
  shows Prop
using ‹Ψ ⊳ cP ⟼cRs›
proof(cases rule: semanticsCasesAux[where C="(xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)"])
  case(cInput M K xvec N Tvec P)
  have B: "cP = M⦇λ*xvec N⦈.P" and C: "cRs = K⦇(N[xvec::=Tvec])⦈ ≺ (P[xvec::=Tvec])" 
    by fact+
  from ‹xvec ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "xvec ♯* xvec1" by simp
  
  from ‹length xvec1 = inputLength cP› B have "length xvec1 = length xvec"
    by simp
  then obtain p where S: "set p ⊆ set xvec × set(p ∙ xvec)" and "distinctPerm p" and "xvec1 = p ∙ xvec"
    using ‹xvec ♯* xvec1› ‹distinct xvec› ‹distinct xvec1›
    by(rule_tac constructPerm[where xvec=xvec and yvec=xvec1]) auto
  show ?thesis
  proof(rule rInput[where M=M and K=K and N = "p ∙ N" and Tvec=Tvec and P="p ∙ P"], goal_cases)
    case 1
    from B ‹xvec ♯* xvec1› ‹xvec1 ♯* cP› have "xvec1 ♯* N" and "xvec1 ♯* P"
      by(auto simp add: fresh_star_def inputChainFresh name_list_supp) (auto simp add: fresh_def)

    from ‹cP = M⦇λ*xvec N⦈.P› S ‹xvec1 ♯* N› ‹xvec1 ♯* P› ‹xvec1 = p ∙ xvec›
    have "cP = M⦇λ*xvec1 (p ∙ N)⦈.(p ∙ P)"
      apply simp
      by(subst inputChainAlpha) auto
    moreover from ‹cRs = K⦇(N[xvec::=Tvec])⦈ ≺ P[xvec::=Tvec]› S ‹xvec1 ♯* N› ‹xvec1 ♯* P› ‹xvec1 = p ∙ xvec› ‹length xvec = length Tvec› ‹distinctPerm p›
    have "cRs =  K⦇((p ∙ N)[xvec1::=Tvec])⦈ ≺ (p ∙ P)[xvec1::=Tvec]"
      by(simp add: renaming substTerm.renaming)
    moreover note ‹Ψ ⊢ M ↔ K›
    moreover from ‹distinct xvec› ‹xvec1 = p ∙ xvec› have "distinct xvec1" by simp
    moreover from ‹set xvec ⊆ supp N› have "(p ∙ set xvec) ⊆ (p ∙ (supp N))"
      by(simp add: eqvts)
    with ‹xvec1 = p ∙ xvec› have "set xvec1 ⊆ supp(p ∙ N)" by(simp add: eqvts)
    moreover from ‹length xvec = length Tvec› ‹xvec1 = p ∙ xvec› have "length xvec1 = length Tvec"
      by simp

    moreover from ‹xvec1 ♯* cRs› C ‹length xvec = length Tvec› ‹distinct xvec› ‹set xvec ⊆ supp N›
    have "(set xvec1) ♯* Tvec"
      by(rule_tac substTerm.subst3Chain[where T=N]) auto
    hence "xvec1 ♯* Tvec" by simp
    moreover from ‹xvec ♯* Tvec› have "(p ∙ xvec) ♯* (p ∙ Tvec)" by(simp add: fresh_star_bij)
    with S ‹xvec ♯* Tvec› ‹xvec1 ♯* Tvec› ‹xvec1 = p ∙ xvec› have "xvec1 ♯* Tvec" by simp
    moreover from ‹xvec ♯* M› have "(p ∙ xvec) ♯* (p ∙ M)" by(simp add: fresh_star_bij)
    with S ‹xvec ♯* M› ‹xvec1 ♯* cP› B ‹xvec1 = p ∙ xvec› have "xvec1 ♯* M" by simp
    moreover from ‹xvec ♯* K› have "(p ∙ xvec) ♯* (p ∙ K)" by(simp add: fresh_star_bij)
    with S ‹xvec ♯* K› ‹xvec1 ♯* cRs› C ‹xvec1 = p ∙ xvec› have "xvec1 ♯* K" by simp
    ultimately show ?case using ‹xvec1 ♯* Ψ› by blast 
  qed
next
  case(cOutput M K N P)
  thus ?thesis by(rule rOutput) 
next
  case(cCase Cs P φ)
  thus ?thesis by(rule rCase) 
next
  case(cPar1 Ψ⇩Q P α P' Q A⇩Q)
  have B: "cP = P ∥ Q" and C: "cRs = α ≺ P' ∥ Q"
    by fact+
  from ‹bn α ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "bn α ♯* xvec2" by simp
  from ‹A⇩Q ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "A⇩Q ♯* xvec2" and "A⇩Q ♯* C" by simp+
  
  from ‹length xvec2 = residualLength cRs› C have "length xvec2 = length(bn α)"
    by simp
  then obtain p where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "xvec2= bn(p ∙ α)"
    using ‹bn α ♯* xvec2› ‹distinct(bn α)› ‹distinct xvec2›
    by(rule_tac constructPerm[where xvec="bn α" and yvec=xvec2]) (auto simp add: eqvts)
  show ?thesis
  proof(rule rPar1[where P=P and Q=Q and α="p ∙ α" and P'="p ∙ P'" and A⇩Q=A⇩Q and Ψ⇩Q=Ψ⇩Q], goal_cases)
    case 1
    note ‹cP = P ∥ Q›
    moreover from B C S ‹bn α ♯* xvec2› ‹xvec2 ♯* cRs› ‹xvec2 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec2 ♯* cP› ‹bn α ♯* Q›
    have "cRs = (p ∙ α) ≺ (p ∙ P') ∥ Q"
      apply auto
      by(subst residualAlpha[where p=p]) auto
    moreover note ‹xvec2 = bn(p ∙ α)›
    moreover from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'› S B C S ‹bn α ♯* xvec2› ‹xvec2 ♯* cRs› ‹xvec2 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec2 ♯* cP›
    have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼(p ∙ α) ≺ (p ∙ P')"
      by(subst residualAlpha[symmetric]) auto
    moreover note ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* α›
    moreover from ‹A⇩Q ♯* α› ‹A⇩Q ♯* xvec2› S ‹xvec2 = bn(p ∙ α)› ‹distinctPerm p› have "A⇩Q ♯* (p ∙ α)"
      by(subst fresh_star_bij[symmetric, where pi=p]) simp
    moreover from ‹A⇩Q ♯* P'› ‹A⇩Q ♯* α› ‹A⇩Q ♯* xvec2› S ‹xvec2 = bn(p ∙ α)› ‹distinctPerm p› have "A⇩Q ♯* (p ∙ P')"
      by(subst fresh_star_bij[symmetric, where pi=p]) simp
    moreover note ‹A⇩Q ♯* C›
    ultimately show ?case by blast
  qed
next
  case(cPar2 Ψ⇩P Q α Q' P A⇩P)
  have B: "cP = P ∥ Q" and C: "cRs = α ≺ P ∥ Q'"
    by fact+
  from ‹bn α ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "bn α ♯* xvec3" by simp
  from ‹A⇩P ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "A⇩P ♯* xvec3" and "A⇩P ♯* C" by simp+
  
  from ‹length xvec3 = residualLength cRs› C have "length xvec3 = length(bn α)"
    by simp
  then obtain p where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "xvec3 = bn(p ∙ α)"
    using ‹bn α ♯* xvec3› ‹distinct(bn α)› ‹distinct xvec3›
    by(rule_tac constructPerm[where xvec="bn α" and yvec=xvec3]) (auto simp add: eqvts)
  show ?thesis
  proof(rule rPar2[where P=P and Q=Q and α="p ∙ α" and Q'="p ∙ Q'" and A⇩P=A⇩P and Ψ⇩P=Ψ⇩P], goal_cases)
    case 1
    note ‹cP = P ∥ Q›
    moreover from B C S ‹bn α ♯* xvec3› ‹xvec3 ♯* cRs› ‹xvec3 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec3 ♯* cP› ‹bn α ♯* P›
    have "cRs = (p ∙ α) ≺ P ∥ (p ∙ Q')"
      apply auto
      by(subst residualAlpha[where p=p]) auto
    moreover note ‹xvec3 = bn(p ∙ α)›
    moreover from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'› S B C S ‹bn α ♯* xvec3› ‹xvec3 ♯* cRs› ‹xvec3 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec3 ♯* cP›
    have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼(p ∙ α) ≺ (p ∙ Q')"
      by(subst residualAlpha[symmetric]) auto
    moreover note ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* α›
    moreover from ‹A⇩P ♯* α› ‹A⇩P ♯* xvec3› S ‹xvec3 = bn(p ∙ α)› ‹distinctPerm p› have "A⇩P ♯* (p ∙ α)"
      by(subst fresh_star_bij[symmetric, where pi=p]) simp
    moreover from ‹A⇩P ♯* Q'› ‹A⇩P ♯* α› ‹A⇩P ♯* xvec3› S ‹xvec3 = bn(p ∙ α)› ‹distinctPerm p› have "A⇩P ♯* (p ∙ Q')"
      by(subst fresh_star_bij[symmetric, where pi=p]) simp
    moreover note ‹A⇩P ♯* C›
    ultimately show ?case by blast
  qed
next
  case(cComm1 Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q)
  thus ?thesis by(rule_tac rComm1[where P=P and Q=Q]) (assumption | simp)+
next
  case(cComm2 Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q)
  thus ?thesis by(rule_tac rComm2[where P=P and Q=Q]) (assumption | simp)+
next
  case(cOpen P M xvec yvec N P' x)
  have B: "cP = ⦇νx⦈P" and C: "cRs = M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'"
    by fact+
  from ‹xvec ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "xvec ♯* xvec4" and "xvec ♯* cP" and "xvec ♯* cRs" and "x1 ♯ xvec" by simp+
  from ‹x ♯ (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "x ♯ xvec4" and "x ♯ cP" and "x ♯ cRs" and "x ≠ x1" by simp+
  from ‹yvec ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "yvec ♯* xvec4" and "yvec ♯* cP"  and "yvec ♯* cRs" and "x1 ♯ yvec" by simp+

  from ‹xvec ♯* cRs› ‹x ♯ cRs› ‹yvec ♯* cRs› C have "(xvec@x#yvec) ♯* M" by simp
  from ‹xvec ♯* Ψ› ‹x ♯ Ψ› ‹yvec ♯* Ψ› have "(xvec@x#yvec) ♯* Ψ" by simp
  from ‹length xvec4 = residualLength cRs› C obtain xvec' y yvec' where D: "xvec4 = xvec'@y#yvec'" and "length xvec' = length xvec" and "length yvec' = length yvec"
    by(rule_tac lengthAux2) auto
  with ‹distinct xvec› ‹distinct yvec› ‹x ♯ xvec› ‹x ♯ yvec› ‹xvec ♯* yvec› ‹xvec ♯* xvec4› ‹yvec ♯* xvec4› ‹x ♯ xvec4› ‹distinct xvec4›
  have "distinct xvec'" and "distinct yvec'" and "xvec' ♯* yvec'" and "x ≠ y" and "y ♯ xvec'" and "y ♯ yvec'" 
   and "x ♯ xvec'" and "x ♯ yvec'" and "y ♯ xvec" and "y ♯ yvec" and "xvec ♯* xvec'" and "yvec ♯* yvec'"
    by auto
  from ‹length xvec' = length xvec› ‹xvec ♯* xvec'› ‹distinct xvec› ‹distinct xvec'› 
  obtain p where Sp: "set p ⊆ set xvec × set(p ∙ xvec)" and "distinctPerm p" and E: "xvec' = p ∙ xvec"
    by(metis constructPerm)
  from ‹length yvec' = length yvec› ‹yvec ♯* yvec'› ‹distinct yvec› ‹distinct yvec'› 
  obtain q where Sq: "set q ⊆ set yvec × set(q ∙ yvec)" and "distinctPerm q" and F: "yvec' = q ∙ yvec"
    by(metis constructPerm)

  show ?thesis
  proof(rule rOpen[where P="([(x, x1)] ∙ P)" and xvec="p ∙ xvec" and y="y" and yvec="q ∙ yvec" and N="(p@(x1, x)#q) ∙ N" and P'="(p@(x1, x)#q) ∙ P'" and M=M], goal_cases)
    case 1
    from ‹xvec ♯* xvec4› ‹x ♯ xvec4› ‹x1 ♯ xvec4› ‹yvec ♯* xvec4› D E F
    have "x ≠ y" and "x1 ≠ y" and "x1 ♯ p ∙ xvec" and "x1 ♯ q ∙ yvec" by simp+
    from ‹xvec4 ♯* cRs› ‹x1 ♯ cRs› C have "xvec4 ♯* M" and "x1 ♯ M" by simp+
    from ‹cP = ⦇νx⦈P› ‹x ♯ cP› ‹x ≠ x1› have "([(x, x1)] ∙ cP) = [(x, x1)] ∙ ⦇νx⦈P"
      by simp
    with ‹x ♯ cP› ‹x1 ♯ cP› have "cP = ⦇νx1⦈([(x, x1)] ∙ P)" by(simp add: eqvts calc_atm)
    moreover from C have "((p@(x1, x)#q) ∙ cRs) = (p@(x1, x)#q) ∙ (M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P')" by(simp add: fresh_star_bij)
    with Sp Sq ‹xvec4 ♯* cRs› D E F ‹xvec ♯* cRs› ‹x ♯ cRs› ‹yvec ♯* cRs› ‹xvec4 ♯* M› ‹(xvec@x#yvec) ♯* M› ‹xvec ♯* xvec4› ‹x ♯ xvec4› ‹yvec ♯* xvec4› ‹xvec ♯* yvec› ‹x ♯ xvec› ‹x ♯ yvec› ‹y ♯ xvec'› ‹y ♯ yvec'› ‹xvec' ♯* yvec'› ‹x1 ♯ xvec› ‹x1 ♯ yvec› ‹x1 ≠ y› ‹x1 ♯ xvec4› ‹x1 ♯ cRs› ‹x1 ♯ cRs› ‹x ≠ x1› ‹x1 ♯ M›
    have "cRs = M⦇ν*((p ∙ xvec)@x1#(q ∙ yvec))⦈⟨((p@(x1, x)#q) ∙ N)⟩ ≺ ((p@(x1, x)#q) ∙ P')"
      by(simp add: eqvts pt2[OF pt_name_inst] calc_atm)
    moreover from D E F have "xvec4 = (p ∙ xvec)@y#(q ∙ yvec)" by simp
    moreover from ‹Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'› have "((p@(x1, x)#q) ∙ Ψ) ⊳ ((p@(x1, x)#q) ∙ P) ⟼((p@(x1, x)#q) ∙ (M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'))"
      by(intro eqvts)
    with Sp Sq B C D E F ‹xvec4 ♯* Ψ› ‹(xvec@x#yvec) ♯* Ψ› ‹xvec4 ♯* cRs› ‹x ♯ xvec4› C D ‹x ♯ cRs› ‹yvec ♯* cRs› ‹xvec4 ♯* M› ‹(xvec@x#yvec) ♯* M› ‹x ♯ M› ‹x1 ♯ cRs› ‹x ≠ x1› ‹x1 ♯ xvec› ‹x1 ♯ yvec› ‹xvec ♯* xvec4› ‹yvec ♯* xvec4› ‹x1 ♯ xvec4› ‹x ♯ xvec› ‹x ♯ yvec› ‹x1 ♯ Ψ› ‹xvec4 ♯* cP› ‹xvec ♯* P› ‹yvec ♯* P› ‹xvec' ♯* yvec'› ‹x1 ♯ xvec4› ‹xvec4 ♯* cP› ‹yvec ♯* xvec4› ‹xvec ♯* xvec4› ‹x ≠ x1› ‹xvec ♯* yvec›
    have "Ψ ⊳ ([(x, x1)] ∙ P) ⟼M⦇ν*((p ∙ xvec)@(q ∙ yvec))⦈⟨((p@(x1, x)#q) ∙ N)⟩ ≺ ((p@(x1, x)#q) ∙ P')" 
      by(simp add: eqvts  pt_fresh_bij[OF pt_name_inst, OF at_name_inst] pt2[OF pt_name_inst] name_swap)
    
    moreover from ‹x ∈ supp N› have "((p@(x1, x)#q) ∙ x) ∈ ((p@(x1, x)#q) ∙ supp N)"
      by(simp add: pt_set_bij[OF pt_name_inst, OF at_name_inst])
    hence "x1 ∈ supp((p@(x1, x)#q) ∙ N)"
      using ‹x ♯ xvec› ‹x ♯ yvec› ‹x1 ♯ xvec› ‹x1 ♯ yvec› ‹x ♯ xvec4› ‹x1 ♯ xvec4› ‹xvec ♯* xvec4› ‹yvec ♯* xvec4› ‹xvec' ♯* yvec'› D E F Sp Sq ‹x ≠ x1›
      by(simp add: eqvts pt2[OF pt_name_inst] calc_atm)
    moreover from ‹x1 ♯ xvec4› D E F have "x1 ♯ (p ∙ xvec)" and "x1 ♯ (q ∙ yvec)" by simp+
    moreover from ‹distinct xvec'› ‹distinct yvec'› E F have "distinct(p ∙ xvec)" and "distinct(q ∙ yvec)" by simp+
    moreover from ‹xvec' ♯* yvec'› E F have "(p ∙ xvec) ♯* (q ∙ yvec)" by auto
    moreover from ‹xvec ♯* Ψ› have "(p ∙ xvec) ♯* (p ∙ Ψ)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
    with Sp D E ‹xvec4 ♯* Ψ› ‹xvec ♯* Ψ› have "(p ∙ xvec) ♯* Ψ" by(simp add: eqvts)
    moreover from ‹yvec ♯* Ψ› have "(p ∙ yvec) ♯* (p ∙ Ψ)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
    with Sq D F ‹xvec4 ♯* Ψ› ‹yvec ♯* Ψ› have "(q ∙ yvec) ♯* Ψ" by(simp add: eqvts)
    moreover from ‹xvec4 ♯* cP› ‹x ♯ xvec4› ‹x1 ♯ xvec4› B D E F have "(p ∙ xvec) ♯* ([(x, x1)] ∙ P)" and "(q ∙ yvec) ♯* ([(x, x1)] ∙ P)"
      by simp+
    moreover from ‹xvec4 ♯* M› C D E F have "(p ∙ xvec) ♯* M" and "(q ∙ yvec) ♯* M" by simp+
    ultimately show ?case
      by blast
  qed
next
  case(cScope P α P' x)
  have B: "cP = ⦇νx⦈P" and C: "cRs = α ≺ ⦇νx⦈P'"
    by fact+
  from ‹bn α ♯* (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "bn α ♯* xvec5" and "x2 ♯ bn α" by simp+
  from ‹x ♯ (xvec1, xvec2, xvec3, xvec4, xvec5, x1, x2, cP, cRs, C)› have "x ♯ xvec5" and "x ≠ x2" and "x ♯ cRs" by simp+
  
  from ‹length xvec5 = residualLength cRs› C have "length xvec5 = length(bn α)"
    by simp
  then obtain p where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "xvec5= bn(p ∙ α)"
    using ‹bn α ♯* xvec5› ‹distinct(bn α)› ‹distinct xvec5›
    by(rule_tac constructPerm[where xvec="bn α" and yvec=xvec5]) (auto simp add: eqvts)
  show ?thesis
  proof(rule rScope[where P="[(x, x2)] ∙ P" and α="[(x, x2)] ∙ p ∙ α" and P'="[(x, x2)] ∙ p ∙ P'"], goal_cases)
    case 1
    from ‹x2 ♯ cRs› C ‹x2 ♯ bn α› ‹x ≠ x2› have "x2 ♯ α" and "x2 ♯ P'" by(auto simp add: abs_fresh)
    from ‹cP = ⦇νx⦈P› ‹x2 ♯ cP› ‹x ≠ x2› have "cP = ⦇νx2⦈([(x, x2)] ∙ P)"
      by(simp add: alphaRes abs_fresh)
    moreover from B C S ‹bn α ♯* xvec5› ‹xvec5 ♯* cRs› ‹xvec5 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec5 ♯* cP› ‹x ♯ α› ‹x ♯ xvec5› 
    have "cRs = (p ∙ α) ≺ ⦇νx⦈(p ∙ P')"
      apply auto
      by(subst residualAlpha[where p=p] alphaRes) (auto simp del: actionFresh)
    hence "([(x, x2)] ∙ cRs) = [(x, x2)] ∙ ((p ∙ α) ≺ ⦇νx⦈(p ∙ P'))"
      by simp
    with ‹x2 ♯ cRs› ‹x ♯ cRs› have "cRs = ([(x, x2)] ∙ p ∙ α) ≺ ⦇νx2⦈([(x, x2)] ∙ p ∙ P')"
      by(simp add: eqvts calc_atm)
    moreover from ‹xvec5= bn(p ∙ α)› have "([(x, x2)] ∙ xvec5) = ([(x, x2)] ∙ bn(p ∙ α))"
      by simp
    with ‹x ♯ xvec5› ‹x2 ♯ xvec5› have "xvec5 = bn([(x, x2)] ∙ p ∙ α)"
      by(simp add: eqvts)
    moreover from ‹Ψ ⊳ P ⟼α ≺ P'› S B C S ‹bn α ♯* xvec5› ‹xvec5 ♯* cRs› ‹xvec5 = bn(p ∙ α)› ‹bn α ♯* subject α› ‹xvec5 ♯* cP› ‹x ♯ xvec5›
    have "Ψ ⊳ P ⟼(p ∙ α) ≺ (p ∙ P')"
      by(subst residualAlpha[symmetric]) auto
    hence "([(x, x2)] ∙ Ψ) ⊳ ([(x, x2)] ∙ P) ⟼([(x, x2)] ∙ ((p ∙ α) ≺ (p ∙ P')))"
      by(rule eqvt)
    with ‹x ♯ Ψ› ‹x2 ♯ Ψ› have "Ψ ⊳ ([(x, x2)] ∙ P) ⟼([(x, x2)] ∙ p ∙ α) ≺ ([(x, x2)] ∙ p ∙ P')"
      by(simp add: eqvts)
    moreover note ‹x2 ♯ Ψ›
    moreover from ‹x ♯ α› ‹x2 ♯ α› ‹x ♯ xvec5› ‹x2 ♯ xvec5› S ‹x ≠ x2› ‹xvec5 = bn(p ∙ α)› have "x2 ♯ [(x, x2)] ∙ p ∙ α"
      apply(subgoal_tac "x ♯ p ∧ x2 ♯ p")
      apply(simp add: perm_compose freshChainSimps del: actionFresh)
      by(auto dest: freshAlphaSwap)
    moreover from ‹bn α ♯* subject α› have "([(x, x2)] ∙ p ∙ (bn α)) ♯* ([(x, x2)] ∙ p ∙ (subject α))"
      by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
    hence "bn([(x, x2)] ∙ p ∙ α) ♯* subject([(x, x2)] ∙ p ∙ α)"
      by(simp add: eqvts)
    moreover from ‹distinct(bn α)› have "distinct([(x, x2)] ∙ p ∙ (bn α))" by simp
    hence "distinct(bn([(x, x2)] ∙ p ∙ α))" by(simp add: eqvts)
    ultimately show ?case  by blast
  qed
next
  case(cBang P)
  thus ?thesis by(rule_tac rBang) auto
qed

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

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼α ≺ T"
  and     "bn α ♯* Ψ"
  and     "bn α ♯* P"
  and     "bn α ♯* Q"
  and     "bn α ♯* subject α"
  and     rPar1: "⋀P' A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P';  extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                                  A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* α; A⇩Q ♯* P'; A⇩Q ♯* C⟧ ⟹ Prop α (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q';  extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                                 A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* α; A⇩P ♯* Q'; A⇩P ♯* C⟧ ⟹ Prop α (P ∥ Q')"
  and     rComm1: "⋀Ψ⇩Q M N P' A⇩P Ψ⇩P K xvec Q' A⇩Q.
           ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
            Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
            Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
            A⇩P ♯* Ψ;  A⇩P ♯* Ψ⇩Q;  A⇩P ♯* P;  A⇩P ♯* M;  A⇩P ♯* N;  A⇩P ♯* P';  A⇩P ♯* Q;  A⇩P ♯* xvec;  A⇩P ♯* Q'; A⇩P ♯* A⇩Q;  A⇩P ♯* C; 
            A⇩Q ♯* Ψ;  A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P;  A⇩Q ♯* K;  A⇩Q ♯* N;  A⇩Q ♯* P';  A⇩Q ♯* Q;  A⇩Q ♯* xvec;  A⇩Q ♯* Q'; A⇩Q ♯* C; 
            xvec ♯* Ψ;  xvec ♯* Ψ⇩P; xvec ♯* P;  xvec ♯* M;  xvec ♯* K; xvec ♯* Q;  xvec ♯* Ψ⇩Q;  xvec ♯* C⟧ ⟹
            Prop (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rComm2: "⋀Ψ⇩Q M xvec N P' A⇩P Ψ⇩P K Q' A⇩Q.
           ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
            Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
            Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; distinct xvec;
            A⇩P ♯* Ψ;  A⇩P ♯* Ψ⇩Q;  A⇩P ♯* P;  A⇩P ♯* M;  A⇩P ♯* N;  A⇩P ♯* P';  A⇩P ♯* Q;  A⇩P ♯* xvec;  A⇩P ♯* Q'; A⇩P ♯* A⇩Q;  A⇩P ♯* C; 
            A⇩Q ♯* Ψ;  A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P;  A⇩Q ♯* K;  A⇩Q ♯* N;  A⇩Q ♯* P';  A⇩Q ♯* Q;  A⇩Q ♯* xvec;  A⇩Q ♯* Q'; A⇩Q ♯* C; 
            xvec ♯* Ψ;  xvec ♯* Ψ⇩P; xvec ♯* P;  xvec ♯* M;  xvec ♯* K;  xvec ♯* Q;  xvec ♯* Ψ⇩Q;  xvec ♯* C⟧ ⟹
            Prop (τ) (⦇ν*xvec⦈(P' ∥ Q'))"

  shows "Prop α T"
proof -
  from Trans have "distinct(bn α)" by(auto dest: boundOutputDistinct)
  have "length(bn α) = residualLength(α ≺ T)" by simp
  note Trans
  moreover have "length [] = inputLength(P ∥ Q)" and "distinct []"
    by(auto simp add: inputLength_inputLength'_inputLength''.simps)
  moreover note ‹length(bn α) = residualLength(α ≺ T)› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ T)› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ T)› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ T)› ‹distinct(bn α)›
  moreover obtain x::name where "x ♯ Ψ" and "x ♯ P" and "x ♯ Q" and "x ♯ α" and "x ♯ T"
    by(generate_fresh "name") auto
  ultimately show ?thesis using ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α›
    apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x x])
    apply(auto simp add: psi.inject)
    apply(force simp add: residualInject residualInject' intro: rPar1)
    apply(force simp add: residualInject residualInject' intro: rPar2)
    apply(fastforce simp add: residualInject residualInject' intro: rComm1)
    by(fastforce simp add: residualInject residualInject' intro: rComm2)
qed

lemma parInputCases[consumes 1, case_names cPar1 cPar2]:
  fixes Ψ :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   M :: 'a
  and   N :: 'a
  and   R :: "('a, 'b, 'c) psi"
  and   C :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼M⦇N⦈ ≺ R"
  and     rPar1: "⋀P' A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P';  extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                       A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; A⇩Q ♯* N; A⇩Q ♯* C⟧ ⟹ Prop (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇N⦈ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                       A⇩P ♯* Ψ; A⇩P ♯* P;  A⇩P ♯* Q; A⇩P ♯* M; A⇩P ♯* N; A⇩P ♯* C⟧ ⟹ Prop (P ∥ Q')"
  shows "Prop R"
proof -
  from Trans obtain α where "Ψ ⊳ P ∥ Q ⟼α ≺ R" and "bn α ♯* Ψ" and "bn α ♯* P" and "bn α ♯* Q" and "bn α ♯* subject α" and "α = M⦇N⦈" by auto
  thus ?thesis using rPar1 rPar2
    by(induct rule: parCases) (auto simp add: residualInject)
qed

lemma parOutputCases[consumes 5, case_names cPar1 cPar2]:
  fixes Ψ :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   M :: 'a
  and   xvec :: "name list"
  and   N :: 'a
  and   R :: "('a, 'b, 'c) psi"
  and   C :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ R"
  and            "xvec ♯* Ψ"
  and            "xvec ♯* P"
  and            "xvec ♯* Q"
  and            "xvec ♯* M"
  and     rPar1: "⋀P' A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P';  extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                       A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; A⇩Q ♯* xvec; A⇩Q ♯* N; A⇩Q ♯* C; A⇩Q ♯* xvec; distinct xvec⟧ ⟹ Prop (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                       A⇩P ♯* Ψ; A⇩P ♯* P;  A⇩P ♯* Q; A⇩P ♯* M; A⇩P ♯* xvec; A⇩P ♯* N; A⇩P ♯* C; A⇩P ♯* xvec; distinct xvec⟧ ⟹ Prop (P ∥ Q')"
  shows "Prop R"
proof -
  from Trans have "distinct xvec" by(auto dest: boundOutputDistinct)
  obtain α where "α=M⦇ν*xvec⦈⟨N⟩" by simp
  with Trans ‹xvec ♯* Ψ› ‹xvec ♯* P› ‹xvec ♯* Q› ‹xvec ♯* M›
  have "Ψ ⊳ P ∥ Q ⟼α ≺ R" and "bn α ♯* Ψ" and "bn α ♯* P" and "bn α ♯* Q" "bn α ♯* subject α"
    by simp+
  thus ?thesis using ‹α=M⦇ν*xvec⦈⟨N⟩› rPar1 rPar2 ‹distinct xvec›
    by(induct rule: parCases[where C="(xvec, C)"]) (auto simp add: residualInject)
qed

lemma theEqvt[eqvt_force]:
  fixes p :: "name prm"
  and   α :: "'a action"

  assumes "α ≠ τ"

  shows "(p ∙ the(subject α)) = the(p ∙ (subject α))"
using assms
by(induct rule: actionCases[where α=α]) auto

lemma theSubjectFresh[simp]:
  fixes α :: "'a action"
  and   x :: name

  assumes "α ≠ τ"

  shows "x ♯ the(subject α) = x ♯ subject α"
using assms
by(cases rule: actionCases) auto

lemma theSubjectFreshChain[simp]:
  fixes α    :: "'a action"
  and   xvec :: "name list"

  assumes "α ≠ τ"

  shows "xvec ♯* the(subject α) = xvec ♯* subject α"
using assms
by(cases rule: actionCases) auto

lemma obtainPrefix:
  fixes Ψ :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   α   :: "'a action"
  and   P'  :: "('a, 'b, 'c) psi"
  and   A⇩P  :: "name list"
  and   Ψ⇩P :: 'b
  and   B   :: "name list"

  assumes "Ψ ⊳ P ⟼α ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     "α ≠ τ"
  and     "B ♯* P"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* B"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* subject α"

  obtains M where "Ψ ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M"
using assms
proof(nominal_induct avoiding: B arbitrary: thesis rule: semanticsFrameInduct')
  case(cAlpha Ψ P α P' p A⇩P Ψ⇩P B)
  then obtain M where subjEq: "Ψ ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M"
    by(rule_tac cAlpha) auto
  from ‹set p ⊆ set(bn α) × set(bn(p ∙ α))› ‹bn α ♯* subject α› ‹bn(p ∙ α) ♯* α› subjEq
  have "Ψ ⊗ Ψ⇩P ⊢ the(subject(p ∙ α)) ↔ M"
    by(simp add: subjectEqvt[symmetric])
  thus ?case using cAlpha ‹B ♯* M›
    by auto
next
  case(cFrameAlpha Ψ P A⇩P Ψ⇩P p α P' B)
  then obtain M where subjEq: "Ψ ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M" 
    by(rule_tac cFrameAlpha) auto
  have S: "set p ⊆ set A⇩P × set (p ∙ A⇩P)" by fact
  from subjEq have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊢ (p ∙ the(subject α)) ↔ (p ∙ M)"
    by(rule chanEqClosed)
  with ‹A⇩P ♯* Ψ› ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* subject α› S ‹α ≠ τ› ‹A⇩P ♯* α›
  have "Ψ ⊗ (p ∙ Ψ⇩P) ⊢ the(subject α) ↔ (p ∙ M)"
    by(simp add: eqvts del: subjectEqvt)
  moreover from ‹B ♯* M› have "(p ∙ B) ♯* (p ∙ M)"
    by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  with ‹A⇩P ♯* B› ‹(p ∙ A⇩P) ♯* B› S have "B ♯* (p ∙ M)" by(simp add: eqvts)
  ultimately show ?case by(rule cFrameAlpha)
next
  case(cInput Ψ M K xvec N Tvec P B)
  from ‹Ψ ⊢ M ↔ K› have "Ψ ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt AssertionStatEqSym[OF Identity])
  hence "Ψ ⊗ 𝟭 ⊢ K ↔ M" by(rule chanEqSym)
  moreover from ‹B ♯* (M⦇λ*xvec N⦈.P)› have "B ♯* M" by simp
  ultimately show ?case by(rule_tac cInput) auto
next
  case(cOutput Ψ M K N P B)
  from ‹Ψ ⊢ M ↔ K› have "Ψ ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt AssertionStatEqSym[OF Identity])
  hence "Ψ ⊗ 𝟭 ⊢ K ↔ M"
    by(rule chanEqSym)
  moreover from ‹B ♯* (M⟨N⟩.P)› have "B ♯* M" by simp
  ultimately show ?case by(rule_tac cOutput) auto
next
  case(cCase Ψ P α P' φ Cs  A⇩P Ψ⇩P B)
  then obtain M where "Ψ ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M"
    by(rule_tac cCase) (auto dest: memFreshChain)
  with ‹Ψ⇩P ≃ 𝟭› show ?case by(blast intro: cCase statEqEnt compositionSym Identity)
next
  case(cPar1 Ψ Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P B)
  then obtain M where "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M"
    apply(rule_tac cPar1) by assumption auto
  thus ?case
    by(metis cPar1 statEqEnt Associativity Commutativity AssertionStatEqTrans Composition)
next
  case(cPar2 Ψ Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q B)
  then obtain M where "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ the(subject α) ↔ M" and "B ♯* M"
    by(rule_tac cPar2) auto
  thus ?case by(metis cPar2 statEqEnt Associativity)
next
  case cComm1
  thus ?case by simp
next
  case cComm2
  thus ?case by simp
next
  case(cOpen Ψ P M xvec yvec N P' x A⇩P Ψ⇩P B)  
  then obtain K where "Ψ ⊗ Ψ⇩P ⊢ M ↔ K" and "B ♯* K"
    apply(rule_tac cOpen) by force auto
  thus ?case by(fastforce intro: cOpen)
next
  case(cScope Ψ P α P' x A⇩P Ψ⇩P B)  
  then obtain M where "Ψ ⊗ Ψ⇩P ⊢ the(subject α) ↔ M" and "B ♯* M"
    by(rule_tac cScope) auto
  thus ?case by(fastforce intro: cScope)
next
  case(cBang Ψ P α P' A⇩P Ψ⇩P B)
  then obtain K where "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ the(subject α) ↔ K" and "B ♯* K"
    by(rule_tac cBang) auto
  with ‹Ψ⇩P ≃ 𝟭› show ?case by(metis cBang statEqEnt compositionSym Identity)
qed

lemma inputRenameSubject:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   M  :: 'a
  and   N  :: 'a
  and   P' :: "('a, 'b, 'c) psi"
  and   A⇩P :: "name list"
  and   Ψ⇩P :: 'b

  assumes "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "Ψ ⊗ Ψ⇩P ⊢ M ↔ K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* M"
  and     "A⇩P ♯* K"
    
  shows "Ψ ⊳ P ⟼K⦇N⦈ ≺ P'"
using assms
proof(nominal_induct avoiding: K rule: inputFrameInduct)
  case(cAlpha Ψ P M N P' A⇩P Ψ⇩P  p K)
  have S: "set p ⊆ set A⇩P × set (p ∙ A⇩P)" by fact
  from ‹Ψ ⊗ (p ∙ Ψ⇩P) ⊢ M ↔ K› have "(p ∙ (Ψ ⊗ (p ∙ Ψ⇩P))) ⊢ (p ∙ M) ↔ (p ∙ K)" 
    by(rule chanEqClosed)
  with S ‹distinctPerm p› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* M› ‹A⇩P ♯* K› ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* M› ‹(p ∙ A⇩P) ♯* K›
  have "Ψ ⊗ Ψ⇩P ⊢ M ↔ K" by(simp add: eqvts)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K› 
       ‹⟦Ψ ⊗ Ψ⇩P ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊳ P ⟼K⦇N⦈ ≺ P'›
  show ?case by blast
next
  case(cInput Ψ M K xvec N Tvec P K')
  from ‹Ψ ⊗ 𝟭 ⊢ K ↔ K'› have "Ψ ⊢ K ↔ K'"
    by(blast intro: statEqEnt Identity)
  with ‹Ψ ⊢ M ↔ K› have "Ψ ⊢ M ↔ K'"
    by(rule chanEqTrans)
  thus ?case using ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec›
    by(rule Input)
next
  case(cCase Ψ P M N P' φ Cs A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K›
    ‹⋀K. ⟦Ψ ⊗ Ψ⇩P ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊳ P ⟼K⦇N⦈ ≺ P'›
  have "Ψ ⊳ P ⟼K⦇N⦈ ≺ P'" by force
  thus ?case using ‹(φ, P) mem Cs› ‹Ψ ⊢ φ› ‹guarded P› by(rule Case)
next
  case(cPar1 Ψ Ψ⇩Q P M N P' A⇩Q Q A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K"
    by(metis statEqEnt Associativity Composition AssertionStatEqTrans Commutativity)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K› 
       ‹⋀K. ⟦(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K; A⇩P ♯* (Ψ ⊗ Ψ⇩Q); A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊗ Ψ⇩Q ⊳ P ⟼K⦇N⦈ ≺ P'›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼K⦇N⦈ ≺ P'" by force
  thus ?case using ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* K› ‹A⇩Q ♯* N›
    by(rule_tac Par1) auto
next
  case(cPar2 Ψ Ψ⇩P Q M N Q' A⇩P P A⇩Q Ψ⇩Q K)
  from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ M ↔ K"
    by(rule statEqEnt[OF AssertionStatEqSym[OF Associativity]])
  with ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M› ‹A⇩Q ♯* K› 
       ‹⋀K. ⟦(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩Q ♯* (Ψ ⊗ Ψ⇩P); A⇩Q ♯* Q; A⇩Q ♯* M; A⇩Q ♯* K⟧ ⟹ Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'" by force
  thus ?case using ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Q› ‹A⇩P ♯* K› ‹A⇩P ♯* N›
    by(rule_tac Par2) auto
next
  case(cScope Ψ P M N P' x A⇩P Ψ⇩P)
  hence "Ψ ⊳ P ⟼K⦇N⦈ ≺ P'" by force
  with ‹x ♯ Ψ› ‹x ♯ K› ‹x ♯ N› show ?case
    by(rule_tac Scope) auto
next
  case(cBang Ψ P M N P' A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K›
    ‹⋀K. ⟦Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* (P ∥ !P); A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊳ P ∥ !P ⟼K⦇N⦈ ≺ P'›
  have "Ψ ⊳ P ∥ !P ⟼K⦇N⦈ ≺ P'" by force
  thus ?case using ‹guarded P› by(rule Bang)
qed

lemma outputRenameSubject:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b

  assumes "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "Ψ ⊗ Ψ⇩P ⊢ M ↔ K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* M"
  and     "A⇩P ♯* K"
    
  shows "Ψ ⊳ P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P'"
using assms
apply(simp add: residualInject)
proof(nominal_induct avoiding: K rule: outputFrameInduct)
  case(cAlpha Ψ P M A⇩P Ψ⇩P p B K)
  have S: "set p ⊆ set A⇩P × set(p ∙ A⇩P)" by fact
  from ‹Ψ ⊗ (p ∙ Ψ⇩P) ⊢ M ↔ K› have "(p ∙ (Ψ ⊗ (p ∙ Ψ⇩P))) ⊢ (p ∙ M) ↔ (p ∙ K)" 
    by(rule chanEqClosed)
  with S ‹distinctPerm p› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* M› ‹A⇩P ♯* K› ‹(p ∙ A⇩P) ♯* Ψ› ‹(p ∙ A⇩P) ♯* M› ‹(p ∙ A⇩P) ♯* K›
  have "Ψ ⊗ Ψ⇩P ⊢ M ↔ K" by(simp add: eqvts)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K› 
  show ?case by(blast intro: cAlpha)
next
  case(cOutput Ψ M K N P K')
  from ‹Ψ ⊗ 𝟭 ⊢ K ↔ K'› have "Ψ ⊢ K ↔ K'"
    by(blast intro: statEqEnt Identity)
  with ‹Ψ ⊢ M ↔ K› have "Ψ ⊢ M ↔ K'"
    by(rule chanEqTrans)
  thus ?case using Output by(force simp add: residualInject)
next
  case(cCase Ψ P M B φ Cs A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K›
    ‹⋀K. ⟦Ψ ⊗ Ψ⇩P ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊳ P ⟼(ROut K B)›
  have "Ψ ⊳ P ⟼ROut K B" by force
  thus ?case using ‹(φ, P) mem Cs› ‹Ψ ⊢ φ› ‹guarded P› by(rule Case)
next
  case(cPar1 Ψ Ψ⇩Q P M xvec N P' A⇩Q Q A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K"
    by(metis statEqEnt Associativity Composition AssertionStatEqTrans Commutativity)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K› 
       ‹⋀K. ⟦(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K; A⇩P ♯* (Ψ ⊗ Ψ⇩Q); A⇩P ♯* P; A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊗ Ψ⇩Q ⊳ P ⟼(ROut K (⦇ν*xvec⦈N ≺' P'))›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P'" by(force simp add: residualInject)
  thus ?case using ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹xvec ♯* Q› ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* P› ‹A⇩Q ♯* K›  ‹A⇩Q ♯* xvec›  ‹A⇩Q ♯* N› Par1[where α="K⦇ν*xvec⦈⟨N⟩"]
    by(auto simp add: residualInject)
next
  case(cPar2 Ψ Ψ⇩P Q M xvec N Q' A⇩P P A⇩Q Ψ⇩Q K)
  from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K› have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ M ↔ K"
    by(rule statEqEnt[OF AssertionStatEqSym[OF Associativity]])
  with ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M› ‹A⇩Q ♯* K› 
       ‹⋀K. ⟦(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ M ↔ K; A⇩Q ♯* (Ψ ⊗ Ψ⇩P); A⇩Q ♯* Q; A⇩Q ♯* M; A⇩Q ♯* K⟧ ⟹ Ψ ⊗ Ψ⇩P ⊳ Q ⟼ROut K (⦇ν*xvec⦈N ≺' Q')›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼ROut K (⦇ν*xvec⦈N ≺' Q')" by force
  thus ?case using ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹xvec ♯* P› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Q› ‹A⇩P ♯* K› ‹A⇩P ♯* xvec› ‹A⇩P ♯* N› Par2[where α="K⦇ν*xvec⦈⟨N⟩"]
    by(auto simp add: residualInject)
next
  case(cOpen Ψ P M xvec yvec N P' x A⇩P Ψ⇩P)
  hence "Ψ ⊳ P ⟼K⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'" by(force simp add: residualInject)
  with ‹x ∈ supp N› ‹x ♯ Ψ› ‹x ♯ K› ‹x ♯ xvec› ‹x ♯ yvec› Open show ?case
    by(auto simp add: residualInject)
next
  case(cScope Ψ P M xvec N P' x A⇩P Ψ⇩P)
  hence "Ψ ⊳ P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P'" by(force simp add: residualInject)
  with ‹x ♯ Ψ› ‹x ♯ K› ‹x ♯ xvec› ‹x ♯ N› Scope[where α="K⦇ν*xvec⦈⟨N⟩"] show ?case
    by(auto simp add: residualInject)
next
  case(cBang Ψ P M B A⇩P Ψ⇩P K)
  from ‹Ψ ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity compositionSym AssertionStatEqSym)
  with ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K›
    ‹⋀K. ⟦Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K; A⇩P ♯* Ψ; A⇩P ♯* (P ∥ !P); A⇩P ♯* M; A⇩P ♯* K⟧ ⟹ Ψ ⊳ P ∥ !P ⟼ROut K B›
  have "Ψ ⊳ P ∥ !P ⟼ROut K B" by force
  thus ?case using ‹guarded P› by(rule Bang)
qed

lemma parCasesSubject[consumes 7, case_names cPar1 cPar2 cComm1 cComm2]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   R    :: "('a, 'b, 'c) psi"
  and   C    :: "'d::fs_name"
  and   yvec :: "name list"

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼α ≺ R"
  and            "bn α ♯* Ψ"
  and            "bn α ♯* P"
  and            "bn α ♯* Q"
  and            "bn α ♯* subject α"
  and            "yvec ♯* P"
  and            "yvec ♯* Q"
  and     rPar1: "⋀P' A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P';  extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
                       A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* α; A⇩Q ♯* C⟧ ⟹ Prop α (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
                       A⇩P ♯* Ψ; A⇩P ♯* Q; A⇩P ♯* α; A⇩P ♯* C⟧ ⟹ Prop α (P ∥ Q')"
  and     rComm1: "⋀Ψ⇩Q M N P' A⇩P Ψ⇩P K xvec Q' A⇩Q.
           ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
            Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
            Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; yvec ♯* M; yvec ♯* K; distinct xvec;
            A⇩P ♯* Ψ;  A⇩P ♯* Ψ⇩Q;  A⇩P ♯* P;  A⇩P ♯* M;  A⇩P ♯* N;  A⇩P ♯* P';  A⇩P ♯* Q;  A⇩P ♯* xvec;  A⇩P ♯* Q'; A⇩P ♯* A⇩Q;  A⇩P ♯* C; 
            A⇩Q ♯* Ψ;  A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P;  A⇩Q ♯* K;  A⇩Q ♯* N;  A⇩Q ♯* P';  A⇩Q ♯* Q;  A⇩Q ♯* xvec;  A⇩Q ♯* Q'; A⇩Q ♯* C; 
            xvec ♯* Ψ;  xvec ♯* Ψ⇩P; xvec ♯* P;  xvec ♯* M;  xvec ♯* K; xvec ♯* Q;  xvec ♯* Ψ⇩Q;  xvec ♯* C⟧ ⟹
            Prop (τ) (⦇ν*xvec⦈(P' ∥ Q'))"
  and     rComm2: "⋀Ψ⇩Q M xvec N P' A⇩P Ψ⇩P K Q' A⇩Q.
           ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; distinct A⇩P;
            Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; distinct A⇩Q;
            Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K; yvec ♯* M; yvec ♯* K; distinct xvec;
            A⇩P ♯* Ψ;  A⇩P ♯* Ψ⇩Q;  A⇩P ♯* P;  A⇩P ♯* M;  A⇩P ♯* N;  A⇩P ♯* P';  A⇩P ♯* Q;  A⇩P ♯* xvec;  A⇩P ♯* Q'; A⇩P ♯* A⇩Q;  A⇩P ♯* C; 
            A⇩Q ♯* Ψ;  A⇩Q ♯* Ψ⇩P; A⇩Q ♯* P;  A⇩Q ♯* K;  A⇩Q ♯* N;  A⇩Q ♯* P';  A⇩Q ♯* Q;  A⇩Q ♯* xvec;  A⇩Q ♯* Q'; A⇩Q ♯* C; 
            xvec ♯* Ψ;  xvec ♯* Ψ⇩P; xvec ♯* P;  xvec ♯* M;  xvec ♯* K;  xvec ♯* Q;  xvec ♯* Ψ⇩Q;  xvec ♯* C⟧ ⟹
            Prop (τ) (⦇ν*xvec⦈(P' ∥ Q'))"

  shows "Prop α R"
using Trans ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* Q› ‹bn α ♯* subject α›
proof(induct rule: parCases[where C="(C, yvec)"])
  case(cPar1 P' A⇩Q Ψ⇩Q)
  thus ?case by(rule_tac rPar1) auto 
next
  case(cPar2 Q' A⇩P Ψ⇩P)
  thus ?case by(rule_tac rPar2) auto
next
  case(cComm1 Ψ⇩Q M N P' A⇩P Ψ⇩P K xvec Q' A⇩Q)
  from ‹A⇩P ♯* (C, yvec)› ‹A⇩Q ♯* (C, yvec)› ‹xvec ♯* (C, yvec)› 
  have "A⇩P ♯* C" and "A⇩Q ♯* C" and "xvec ♯* C" and "A⇩P ♯* yvec" and "A⇩Q ♯* yvec" and "xvec ♯* yvec"
    by simp+

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" 
   and MeqK: "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K" by fact+

  from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› FrP ‹distinct A⇩P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹yvec ♯* P› ‹A⇩P ♯* Ψ›
       ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* yvec› ‹A⇩P ♯* xvec› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹xvec ♯* P› ‹A⇩P ♯* Ψ⇩Q›
  obtain M' where MeqM': "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ M'" and "xvec ♯* M'" and "yvec ♯* M'" and "A⇩Q ♯* M'"
    by(rule_tac B="xvec@yvec@A⇩Q" in obtainPrefix) (assumption | force)+ 
  from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› FrQ ‹distinct A⇩Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹yvec ♯* Q› ‹A⇩Q ♯* Ψ›
       ‹A⇩P ♯* A⇩Q› ‹A⇩Q ♯* yvec› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹xvec ♯* Q› ‹A⇩Q ♯* Ψ⇩P› ‹xvec ♯* K› ‹distinct xvec›
  obtain K' where KeqK': "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ K'" and "xvec ♯* K'" and "yvec ♯* K'" and "A⇩P ♯* K'"
    by(rule_tac B="xvec@yvec@A⇩P" in obtainPrefix) (assumption | force | metis freshChainSym)+

  from MeqK KeqK' have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans)
  with ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› FrP ‹distinct A⇩P›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼K'⦇N⦈ ≺ P'" using ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K'›
    by(rule_tac inputRenameSubject) (assumption | force)+
  moreover note FrP ‹distinct A⇩P›
  moreover from MeqK MeqM' have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ M'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
  with ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› FrQ ‹distinct A⇩Q›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼M'⦇ν*xvec⦈⟨N⟩ ≺ Q'" using ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩Q ♯* M'›
    by(rule_tac outputRenameSubject) (assumption | force)+
  moreover note FrQ ‹distinct A⇩Q›
  moreover from MeqM' KeqK' MeqK have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* K'› ‹A⇩P ♯* N› ‹A⇩P ♯* P'› ‹A⇩P ♯* Q› ‹A⇩P ♯* xvec› ‹A⇩P ♯* Q'› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* C›
                ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M'› ‹A⇩Q ♯* N› ‹A⇩Q ♯* Q'› ‹A⇩Q ♯* P› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* C›
                ‹xvec ♯* Ψ› ‹xvec ♯* Ψ⇩P› ‹xvec ♯* P› ‹xvec ♯* M'› ‹xvec ♯* K'› ‹xvec ♯* Q› ‹xvec ♯* Ψ⇩Q› ‹xvec ♯* C› ‹yvec ♯* M'› ‹yvec ♯* K'› ‹distinct xvec›
  ultimately show ?case
    by(rule_tac rComm1)
next
  case(cComm2 Ψ⇩Q M xvec N P' A⇩P Ψ⇩P K Q' A⇩Q)
  from ‹A⇩P ♯* (C, yvec)› ‹A⇩Q ♯* (C, yvec)› ‹xvec ♯* (C, yvec)› 
  have "A⇩P ♯* C" and "A⇩Q ♯* C" and "xvec ♯* C" and "A⇩P ♯* yvec" and "A⇩Q ♯* yvec" and "xvec ♯* yvec"
    by simp+

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" 
   and MeqK: "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K" by fact+

  from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› FrP ‹distinct A⇩P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹yvec ♯* P› ‹A⇩P ♯* Ψ›
       ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* yvec› ‹A⇩P ♯* xvec› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹xvec ♯* P› ‹A⇩P ♯* Ψ⇩Q› ‹xvec ♯* M› ‹distinct xvec›
  obtain M' where MeqM': "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ M'" and "xvec ♯* M'" and "yvec ♯* M'" and "A⇩Q ♯* M'"
    by(rule_tac B="xvec@yvec@A⇩Q" in obtainPrefix) (assumption | force)+ 
  from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› FrQ ‹distinct A⇩Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹yvec ♯* Q› ‹A⇩Q ♯* Ψ›
       ‹A⇩P ♯* A⇩Q› ‹A⇩Q ♯* yvec› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹xvec ♯* Q› ‹A⇩Q ♯* Ψ⇩P› 
  obtain K' where KeqK': "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ K'" and "xvec ♯* K'" and "yvec ♯* K'" and "A⇩P ♯* K'"
    by(rule_tac B="xvec@yvec@A⇩P" in obtainPrefix) (assumption | force | metis freshChainSym)+

  from MeqK KeqK' have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans)
  with ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› FrP ‹distinct A⇩P›
  have "Ψ ⊗ Ψ⇩Q ⊳ P ⟼K'⦇ν*xvec⦈⟨N⟩ ≺ P'" using ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K'›
    by(rule_tac outputRenameSubject) (assumption | force)+
  moreover note FrP ‹distinct A⇩P›
  moreover from MeqK MeqM' have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ M'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
  with ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› FrQ ‹distinct A⇩Q›
  have "Ψ ⊗ Ψ⇩P ⊳ Q ⟼M'⦇N⦈ ≺ Q'" using ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩Q ♯* M'›
    by(rule_tac inputRenameSubject) (assumption | force)+
  moreover note FrQ ‹distinct A⇩Q›
  moreover from MeqM' KeqK' MeqK have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'"
    by(metis statEqEnt Associativity Commutativity Composition chanEqTrans chanEqSym)
  moreover note ‹A⇩P ♯* Ψ› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* K'› ‹A⇩P ♯* N› ‹A⇩P ♯* P'› ‹A⇩P ♯* Q› ‹A⇩P ♯* xvec› ‹A⇩P ♯* Q'› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* C›
                ‹A⇩Q ♯* Ψ› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M'› ‹A⇩Q ♯* N› ‹A⇩Q ♯* Q'› ‹A⇩Q ♯* P› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* P'› ‹A⇩Q ♯* C›
                ‹xvec ♯* Ψ› ‹xvec ♯* Ψ⇩P› ‹xvec ♯* P› ‹xvec ♯* M'› ‹xvec ♯* K'› ‹xvec ♯* Q› ‹xvec ♯* Ψ⇩Q› ‹xvec ♯* C› ‹yvec ♯* M'› ‹yvec ♯* K'› ‹distinct xvec›
  ultimately show ?case
    by(rule_tac rComm2)
qed

lemma inputCases[consumes 1, case_names cInput]:
  fixes Ψ   :: 'b
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P    :: "('a, 'b, 'c) psi"  
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  
  assumes Trans: "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼α ≺ P'"  
  and     rInput: "⋀K Tvec. ⟦Ψ ⊢ M ↔ K; set xvec ⊆ supp N; length xvec = length Tvec; distinct xvec⟧ ⟹ Prop (K⦇N[xvec::=Tvec]⦈) (P[xvec::=Tvec])"

  shows "Prop α P'"
proof -
  {
    fix xvec N P
    assume Trans: "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼α ≺ P'"
       and "xvec ♯* Ψ" and "xvec ♯* M" and "xvec ♯* α" and "xvec ♯* P'" and "distinct xvec"
       and rInput: "⋀K Tvec. ⟦Ψ ⊢ M ↔ K; set xvec ⊆ supp N; length xvec = length Tvec; distinct xvec⟧ ⟹ Prop (K⦇N[xvec::=Tvec]⦈) (P[xvec::=Tvec])"

    from Trans have "bn α = []"
      apply -
      by(ind_cases "Ψ ⊳ M⦇λ*xvec N⦈.P ⟼α ≺ P'") (auto simp add: residualInject)
    from Trans have "distinct(bn α)" by(auto dest: boundOutputDistinct)
    have "length(bn α) = residualLength(α ≺ P')" by simp
    note Trans
    moreover have "length xvec = inputLength(M⦇λ*xvec N⦈.P)" by auto
    moreover note ‹distinct xvec›
    moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
    moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
    moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
    moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
    moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
    moreover obtain x::name where "x ♯ Ψ" and "x ♯ P" and "x ♯ M" and "x ♯ xvec" and "x ♯ α" and "x ♯ P'" and "x ♯ N"
      by(generate_fresh "name") auto
    ultimately have "Prop α P'" using ‹bn α = []› ‹xvec ♯* Ψ›‹xvec ♯* M› ‹xvec ♯* α› ‹xvec ♯* P'›
      apply(cases rule: semanticsCases[of _ _ _ _ _ _ _ _ _ C x])  
      apply(force simp add: residualInject psi.inject rInput)
      by(fastforce simp add: residualInject psi.inject inputChainFresh)+
  }
  note Goal = this
  moreover obtain p :: "name prm" where "(p ∙ xvec) ♯* Ψ" and "(p ∙ xvec) ♯* M" and "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* P"
                                    and "(p ∙ xvec) ♯* α" and "(p ∙ xvec) ♯* P'" and S: "set p ⊆ set xvec × set(p ∙ xvec)"
                                    and "distinctPerm p"
    by(rule_tac xvec=xvec and c="(Ψ, M, N, P, α, P')" in name_list_avoiding) auto
  from Trans ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P› S have "Ψ ⊳ M⦇λ*(p ∙ xvec) (p ∙ N)⦈.(p ∙ P) ⟼α ≺ P'"
    by(simp add: inputChainAlpha')
  moreover {
    fix K Tvec
    assume "Ψ ⊢ M ↔ K"
    moreover assume "set(p ∙ xvec) ⊆ supp(p ∙ N)"
    hence "(p ∙ set(p ∙ xvec)) ⊆ (p ∙ supp(p ∙ N))" by simp
    with ‹distinctPerm p› have "set xvec ⊆ supp N" by(simp add: eqvts)
    moreover assume "length(p ∙ xvec) = length(Tvec::'a list)"
    hence "length xvec = length Tvec" by simp
    moreover assume "distinct xvec"
    ultimately have "Prop (K⦇N[xvec::=Tvec]⦈) (P[xvec::=Tvec])" 
      by(rule rInput)
    with ‹length xvec = length Tvec› S ‹distinctPerm p› ‹(p ∙ xvec) ♯* N› ‹(p ∙ xvec) ♯* P›
    have "Prop (K⦇(p ∙ N)[(p ∙ xvec)::=Tvec]⦈) ((p ∙ P)[(p ∙ xvec)::=Tvec])"
      by(simp add: renaming substTerm.renaming)
  }
  moreover from Trans have "distinct xvec" by(rule inputDistinct)
  hence "distinct(p ∙ xvec)" by simp
  ultimately show ?thesis using ‹(p ∙ xvec) ♯* Ψ› ‹(p ∙ xvec) ♯* M› ‹(p ∙ xvec) ♯* α› ‹(p ∙ xvec) ♯* P'› ‹distinct xvec›
    by(rule_tac Goal) assumption+
qed

lemma outputCases[consumes 1, case_names cOutput]:
  fixes Ψ :: 'b
  and   M  :: 'a
  and   N  :: 'a
  and   P  :: "('a, 'b, 'c) psi"  
  and   α  :: "'a action"
  and   P' :: "('a, 'b, 'c) psi"
  
  assumes "Ψ ⊳ M⟨N⟩.P ⟼α ≺ P'"
  and     "⋀K. Ψ ⊢ M ↔ K ⟹ Prop (K⟨N⟩) P"

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

lemma caseCases[consumes 1, case_names cCase]:
  fixes Ψ :: 'b
  and   Cs :: "('c × ('a, 'b, 'c) psi) list"
  and   α  :: "'a action"
  and   P' :: "('a, 'b, 'c) psi"
  
  assumes Trans: "Ψ ⊳ (Cases Cs) ⟼ Rs"
  and     rCase: "⋀φ P. ⟦Ψ ⊳ P ⟼ Rs; (φ, P) mem Cs; Ψ ⊢ φ; guarded P⟧ ⟹ Prop"

  shows "Prop"
using assms
by(cases rule: semantics.cases) (auto simp add: residualInject psi.inject)

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

  assumes Trans: "Ψ ⊳ ⦇νx⦈P ⟼α ≺ P'"
  and     "x ♯ Ψ"
  and     "x ♯ α"
  and     "x ♯ P'"
  and     "bn α ♯* Ψ"
  and     "bn α ♯* P"
  and     "bn α ♯* subject α"
  and     rOpen: "⋀M xvec yvec y N P'. ⟦Ψ ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨([(x, y)] ∙ N)⟩ ≺ ([(x, y)] ∙ P'); y ∈ supp N;
                                         x ♯ N; x ♯ P'; x ≠ y; y ♯ xvec; y ♯ yvec; y ♯ M; distinct xvec; distinct yvec;
                                         xvec ♯* Ψ; y ♯ Ψ; yvec ♯* Ψ; xvec ♯* P; y ♯ P; yvec ♯* P; xvec ♯* M; y ♯ M;
                                         yvec ♯* M; xvec ♯* yvec⟧ ⟹
                                         Prop (M⦇ν*(xvec@y#yvec)⦈⟨N⟩) P'"
  and     rScope:  "⋀P'. ⟦Ψ ⊳ P ⟼α ≺ P'⟧ ⟹ Prop α (⦇νx⦈P')"

  shows "Prop α P'"
proof -
  from Trans have "distinct(bn α)" by(auto dest: boundOutputDistinct)
  have "length(bn α) = residualLength(α ≺ P')" by simp
  note Trans
  moreover have "length [] = inputLength(⦇νx⦈P)" and "distinct []"
    by(auto simp add: inputLength_inputLength'_inputLength''.simps)
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  ultimately show ?thesis using ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹x ♯ Ψ› ‹x ♯ α› ‹x ♯ P'› ‹distinct(bn α)›
    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 ∈ supp Na")
    apply(rule_tac rOpen)
    apply(auto simp add: residualInject boundOutputApp)
    apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
    apply(simp add: calc_atm eqvts)
    by(rule rScope)
qed

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

  assumes Trans: "Ψ ⊳ ⦇νx⦈P ⟼α ≺ P'"
  and     "x ♯ Ψ"
  and     "x ♯ α"
  and     "x ♯ P'"
  and     "bn α ♯* Ψ"
  and     "bn α ♯* P"
  and     "bn α ♯* subject α"
  and     rOpen: "⋀M xvec yvec y N P'. ⟦Ψ ⊳ ([(x, y)] ∙ P) ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'; y ∈ supp N;
                                         x ♯ N; x ♯ P'; x ≠ y; y ♯ xvec; y ♯ yvec; y ♯ M; distinct xvec; distinct yvec;
                                         xvec ♯* Ψ; y ♯ Ψ; yvec ♯* Ψ; xvec ♯* P; y ♯ P; yvec ♯* P; xvec ♯* M; y ♯ M;
                                         yvec ♯* M; xvec ♯* yvec⟧ ⟹
                                         Prop (M⦇ν*(xvec@y#yvec)⦈⟨N⟩) P'"
  and     rScope:  "⋀P'. ⟦Ψ ⊳ P ⟼α ≺ P'⟧ ⟹ Prop α (⦇νx⦈P')"

  shows "Prop α P'"
proof -
  from Trans have "distinct(bn α)" by(auto dest: boundOutputDistinct)
  have "length(bn α) = residualLength(α ≺ P')" by simp
  note Trans
  moreover have "length [] = inputLength(⦇νx⦈P)" and "distinct []"
    by(auto simp add: inputLength_inputLength'_inputLength''.simps)
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  moreover note ‹length(bn α) = residualLength(α ≺ P')› ‹distinct(bn α)›
  ultimately show ?thesis using ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹x ♯ Ψ› ‹x ♯ α› ‹x ♯ P'› ‹distinct(bn α)›
    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 ∈ supp Na")
    apply(rule_tac rOpen)
    apply(auto simp add: residualInject boundOutputApp)
    apply(drule_tac pi="[(x, y)]" in semantics.eqvt)
    apply(simp add: calc_atm eqvts)
    apply(drule_tac pi="[(x, y)]" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
    apply(simp add: calc_atm eqvts)
    by(rule rScope)
qed

abbreviation
  statImpJudge ("_ ↪ _" [80, 80] 80)
  where "Ψ ↪ Ψ' ≡ AssertionStatImp Ψ Ψ'"

lemma statEqTransition:
  fixes Ψ  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   Rs :: "('a, 'b, 'c) residual"
  and   Ψ' :: 'b

  assumes "Ψ ⊳ P ⟼ Rs"
  and     "Ψ ≃ Ψ'"

  shows "Ψ' ⊳ P ⟼ Rs"
using assms
proof(nominal_induct avoiding: Ψ' rule: semantics.strong_induct)
  case(cInput Ψ M K xvec N Tvec P Ψ')
  from ‹Ψ ≃ Ψ'› ‹Ψ ⊢ M ↔ K› have "Ψ' ⊢ M ↔ K"
    by(simp add: AssertionStatImp_def AssertionStatEq_def)
  thus ?case using ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec›
    by(rule Input)
next
  case(Output Ψ M K N P Ψ')
  from ‹Ψ ≃ Ψ'› ‹Ψ ⊢ M ↔ K› have "Ψ' ⊢ M ↔ K"
    by(simp add: AssertionStatImp_def AssertionStatEq_def) 
  thus ?case by(rule semantics.Output)
next
  case(Case Ψ P Rs φ Cs Ψ')
  then have "Ψ' ⊳ P ⟼ Rs" by(rule_tac Case)
  moreover note ‹(φ, P) mem Cs›
  moreover from ‹Ψ ≃ Ψ'› ‹Ψ ⊢ φ› have "Ψ' ⊢ φ"
    by(simp add: AssertionStatImp_def AssertionStatEq_def)
  ultimately show ?case using ‹guarded P› by(rule semantics.Case)
next
  case(cPar1 Ψ ΨQ P α P' xvec Q Ψ')
  thus ?case
    by(rule_tac Par1) (auto intro: Composition)
next
  case(cPar2 Ψ ΨP Q α Q' xvec P Ψ')
  thus ?case
    by(rule_tac Par2) (auto intro: Composition)
next
  case(cComm1 Ψ ΨQ P M N P' xvec ΨP Q K zvec Q' yvec Ψ')
  thus ?case
    by(clarsimp, rule_tac Comm1) (blast intro: Composition statEqEnt)+
next
  case(cComm2 Ψ ΨQ P M zvec N P' xvec ΨP Q K Q' yvec Ψ')
  thus ?case
    by(clarsimp, rule_tac Comm2) (blast intro: Composition statEqEnt)+
next
  case(cOpen Ψ P M xvec N P' x yvec Ψ')
  thus ?case by(force intro: Open)
next
  case(cScope Ψ P α P' x Ψ')
  thus ?case by(force intro: Scope)
next
  case(Bang Ψ P Rs Ψ')
  thus ?case by(force intro: semantics.Bang)
qed

lemma actionPar1Dest':
  fixes α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   β :: "('a::fs_name) action"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ (Q ∥ R)"
  and     "bn α ♯* R"
  and     "bn β ♯* R"

  obtains T where "P = T ∥ R" and "α ≺ T = β ≺ Q"
using assms
apply(cases rule: actionCases[where α=α])
apply(auto simp add: residualInject)
by(drule_tac boundOutputPar1Dest) auto

lemma actionPar2Dest':
  fixes α :: "('a::fs_name) action"
  and   P :: "('a, 'b::fs_name, 'c::fs_name) psi"
  and   β :: "('a::fs_name) action"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes "α ≺ P = β ≺ (Q ∥ R)"
  and     "bn α ♯* Q"
  and     "bn β ♯* Q"

  obtains T where "P = Q ∥ T" and "α ≺ T = β ≺ R"
using assms
apply(cases rule: actionCases[where α=α])
apply(auto simp add: residualInject)
by(drule_tac boundOutputPar2Dest) auto

lemma expandNonTauFrame:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P  :: 'b
  and   C    :: "'d::fs_name"
  and   C'   :: "'e::fs_name"
  
  assumes Trans: "Ψ ⊳ P ⟼α ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "bn α ♯* subject α"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* α"
  and     "A⇩P ♯* C"
  and     "A⇩P ♯* C'"
  and     "bn α ♯* P"
  and     "bn α ♯* C'"
  and     "α ≠ τ"

  obtains p Ψ' A⇩P' Ψ⇩P' where "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "(p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinctPerm p" and
                              "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (p ∙ α)" and
                              "A⇩P' ♯* C" and "(bn(p ∙ α)) ♯* C'" and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'" and "distinct A⇩P'"
proof -
  assume A: "⋀p Ψ' Ψ⇩P' A⇩P'.
        ⟦set p ⊆ set(bn α) × set(bn(p ∙ α)); (p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'; distinctPerm p;
                              extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩; A⇩P' ♯* P'; A⇩P' ♯* α; A⇩P' ♯* (p ∙ α);
                              A⇩P' ♯* C; (bn(p ∙ α)) ♯* C'; (bn(p ∙ α)) ♯* α; (bn(p ∙ α)) ♯* P'; distinct A⇩P'⟧
        ⟹ thesis"

  from Trans have "distinct(bn α)" by(auto dest: boundOutputDistinct)

  with Trans ‹bn α ♯* subject α› ‹A⇩P ♯* P› ‹A⇩P ♯* α› have "A⇩P ♯* P'"
    by(drule_tac freeFreshChainDerivative) auto
  {
    fix X :: "name list"
    and Y :: "'b list"
    and Z :: "('a, 'b, 'c) psi list"

    assume "bn α ♯* X" and "bn α ♯* Y" and "bn α ♯* Z" and "A⇩P ♯* X" and "A⇩P ♯* Y" and "A⇩P ♯* Z" 

    with assms obtain p Ψ' A⇩P' Ψ⇩P' where "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "(p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinctPerm p"
                                      and "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (p ∙ α)"
                                      and "A⇩P' ♯* C" and "(bn(p ∙ α)) ♯* C'" and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'"
                                      and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" and "distinct A⇩P'"
                                      and "(bn(p ∙ α)) ♯* X" and "(bn(p ∙ α)) ♯* Y" and "(bn(p ∙ α)) ♯* Z"
      using ‹A⇩P ♯* P'› ‹distinct(bn α)›
    proof(nominal_induct Ψ P Rs=="α ≺ P'" A⇩P Ψ⇩P avoiding: C C' α P' X Y Z arbitrary: thesis rule: semanticsFrameInduct)
      case(cAlpha Ψ P A⇩P Ψ⇩P p C C' α P' X Y Z)
      then obtain q Ψ' A⇩P' Ψ⇩P' where Sq: "set q ⊆ set(bn α) × set(bn(q ∙ α))" and PeqP': "(q ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinctPerm q"
                                  and FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (q ∙ α)"
                                  and "A⇩P' ♯* C" and "(bn(q ∙ α)) ♯* C'" and "(bn(q ∙ α)) ♯* α" and "(bn(q ∙ α)) ♯* P'"
                                  and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" and "distinct A⇩P'"
                                  and "(bn(q ∙ α)) ♯* X" and "(bn(q ∙ α)) ♯* Y" and "(bn(q ∙ α)) ♯* Z"
        by metis

      have Sp: "set p ⊆ set A⇩P × set (p ∙ A⇩P)" by fact

      from Sq have "(p ∙ set q) ⊆ p ∙ (set(bn α) × set(bn(q ∙ α)))"
        by(simp add: subsetClosed)
      hence "set(p ∙ q) ⊆ set(bn(p ∙ α)) × set(p ∙ bn(q ∙ α))"
        by(simp add: eqvts)
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› Sp have "set(p ∙ q) ⊆ set(bn α) × set(bn((p ∙ q) ∙ α))"
        by(simp add: perm_compose bnEqvt[symmetric])
      moreover from PeqP' have "(p ∙ (q ∙ Ψ⇩P) ⊗ Ψ') ≃ (p ∙ Ψ⇩P')"
        by(simp add: AssertionStatEqClosed)
      hence "((p ∙ q) ∙ p ∙ Ψ⇩P) ⊗ (p ∙ Ψ') ≃ (p ∙ Ψ⇩P')"
        apply(subst perm_compose[symmetric])
        by(simp add: eqvts)
      moreover from ‹distinctPerm q› have "distinctPerm (p ∙ q)"
        by simp
      moreover from ‹(bn(q ∙ α)) ♯* C'› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ C')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* C'› ‹(p ∙ A⇩P) ♯* C'› Sp have "bn((p ∙ q) ∙ α) ♯* C'"
        by(simp add: perm_compose bnEqvt[symmetric])
      moreover from FrP' have "(p ∙ extractFrame P') = p ∙ ⟨A⇩P', Ψ⇩P'⟩" by simp
      with ‹A⇩P ♯* P'› ‹(p ∙ A⇩P) ♯* P'› Sp have "extractFrame P' = ⟨p ∙ A⇩P', p ∙ Ψ⇩P'⟩"
        by(simp add: eqvts)
      moreover from ‹A⇩P' ♯* P'› have "(p ∙ A⇩P') ♯* (p ∙ P')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* P'› ‹(p ∙ A⇩P) ♯* P'› Sp have "(p ∙ A⇩P') ♯* P'" by simp
      moreover from ‹A⇩P' ♯* α› have "(p ∙ A⇩P') ♯* (p ∙ α)"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› Sp have "(p ∙ A⇩P') ♯* α" by simp
      moreover from ‹A⇩P' ♯* C› have "(p ∙ A⇩P') ♯* (p ∙ C)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* C› ‹(p ∙ A⇩P) ♯* C› Sp have "(p ∙ A⇩P') ♯* C" by simp
      moreover from ‹(bn(q ∙ α)) ♯* α› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ α)"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› Sp have "bn((p ∙ q) ∙ α) ♯* α"
        by(simp add: perm_compose eqvts)
      moreover from ‹(bn(q ∙ α)) ♯* P'› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ P')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* P'› ‹(p ∙ A⇩P) ♯* P'› Sp have "bn((p ∙ q) ∙ α) ♯* P'"
        by(simp add: perm_compose eqvts)
      moreover from ‹A⇩P' ♯* (q ∙ α)› have "(p ∙ A⇩P') ♯* (p ∙ q ∙ α)"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with Sp ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› have "(p ∙ A⇩P') ♯* ((p ∙ q) ∙ α)"
        by(simp add: perm_compose)
      moreover from ‹A⇩P' ♯* X› have "(p ∙ A⇩P') ♯* (p ∙ X)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* X› ‹(p ∙ A⇩P) ♯* X› Sp have "(p ∙ A⇩P') ♯* X" by simp
      moreover from ‹A⇩P' ♯* Y› have "(p ∙ A⇩P') ♯* (p ∙ Y)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* Y› ‹(p ∙ A⇩P) ♯* Y› Sp have "(p ∙ A⇩P') ♯* Y" by simp
      moreover from ‹A⇩P' ♯* Z› have "(p ∙ A⇩P') ♯* (p ∙ Z)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* Z› ‹(p ∙ A⇩P) ♯* Z› Sp have "(p ∙ A⇩P') ♯* Z" by simp
      moreover from ‹(bn(q ∙ α)) ♯* X› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ X)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* X› ‹(p ∙ A⇩P) ♯* X› Sp have "bn((p ∙ q) ∙  α) ♯* X"
        by(simp add: perm_compose eqvts)
      moreover from ‹(bn(q ∙ α)) ♯* Y› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ Y)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* Y› ‹(p ∙ A⇩P) ♯* Y› Sp have "bn((p ∙ q) ∙ α) ♯* Y"
        by(simp add: perm_compose eqvts)
      moreover from ‹(bn(q ∙ α)) ♯* Z› have "(p ∙ bn(q ∙ α)) ♯* (p ∙ Z)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* α› ‹(p ∙ A⇩P) ♯* α› ‹A⇩P ♯* Z› ‹(p ∙ A⇩P) ♯* Z› Sp have "bn((p ∙ q) ∙ α) ♯* Z"
        by(simp add: perm_compose eqvts)
      moreover from ‹distinct A⇩P'› have "distinct(p ∙ A⇩P')" by simp
      ultimately show ?case
        by(rule_tac cAlpha)
    next
      case(cInput Ψ M K xvec N Tvec P C C' α P' X Y Z)
      moreover obtain A⇩P Ψ⇩P where "extractFrame(P[xvec::=Tvec]) = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                      and "A⇩P ♯* (C, P[xvec::=Tvec], α, P', X, Y, Z, N)"
        by(rule freshFrame)
      moreover have "𝟭 ⊗ Ψ⇩P ≃ Ψ⇩P"
        by(blast intro: Identity Commutativity AssertionStatEqTrans)
      ultimately show ?case
        by(rule_tac cInput) (assumption | simp add: residualInject)+
    next
      case(cOutput Ψ M K N P C C' α P' X Y Z)
      moreover obtain A⇩P Ψ⇩P where "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                               and "A⇩P ♯* (C, C', P, α, N, P', X, Y, Z)"
        by(rule freshFrame)
      moreover have "𝟭 ⊗ Ψ⇩P ≃ Ψ⇩P"
        by(blast intro: Identity Commutativity AssertionStatEqTrans)
      ultimately show ?case by(simp add: residualInject)
    next
      case(cCase Ψ P φ Cs A⇩P Ψ⇩P C C' α P' X Y Z)
      moreover from ‹bn α ♯* (Cases Cs)› ‹(φ, P) mem Cs› have "bn α ♯* P" by(auto dest: memFreshChain)
      ultimately obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))"
                                         and FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" 
                                         and PeqP': "(p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinct A⇩P'"
                                         and "A⇩P' ♯* C" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (p ∙ α)"
                                         and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z"
                                         and "distinctPerm p" and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'"
                                         and "(bn(p ∙ α)) ♯* C'" and "(bn(p ∙ α)) ♯* X" and "(bn(p ∙ α)) ♯* Y" and "(bn(p ∙ α)) ♯* Z"
        by(rule_tac cCase) (assumption | simp (no_asm_use))+
      moreover from ‹Ψ⇩P ≃ 𝟭› have "(p ∙ Ψ⇩P) ≃ (p ∙ 𝟭)"
        by(simp add: AssertionStatEqClosed)
      hence "(p ∙ Ψ⇩P) ≃ 𝟭" by(simp add: permBottom)
      with PeqP' have "(𝟭 ⊗ Ψ') ≃ Ψ⇩P'"
        by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
      ultimately show ?case using cCase ‹bn α ♯* P›
        by(rule_tac cCase(20)) (assumption | simp)+
    next
      case(cPar1 Ψ Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P C C' α' PQ' X Y Z)
      have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and  FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
        by fact+

      note ‹bn α' ♯* subject α'›
      moreover from ‹bn α' ♯* (P ∥ Q)› have "bn α' ♯* P" and "bn α' ♯* Q" by simp+    
      moreover with FrP FrQ ‹A⇩P ♯* α'› ‹A⇩Q ♯* α'› have "bn α' ♯* Ψ⇩P" and "bn α' ♯* Ψ⇩Q" 
        by(force dest: extractFrameFreshChain)+
 
      moreover from ‹bn α' ♯* X› ‹A⇩Q ♯* α'› have "bn α' ♯* (X@A⇩Q)" by simp
      moreover from ‹bn α' ♯* Y› ‹bn α' ♯* Ψ⇩Q› have "bn α' ♯* (Ψ⇩Q#Y)" by simp
      moreover from ‹bn α' ♯* Z› ‹bn α' ♯* Q› have "bn α' ♯* (Q#Z)" by simp
      moreover from ‹A⇩P ♯* X› ‹A⇩P ♯* A⇩Q› have "A⇩P ♯* (X@A⇩Q)" by simp
      moreover from ‹A⇩P ♯* Y› ‹A⇩P ♯* Ψ⇩Q› have "A⇩P ♯* (Ψ⇩Q#Y)" by force
      moreover from ‹A⇩P ♯* Z› ‹A⇩P ♯* Q› have "A⇩P ♯* (Q#Z)" by simp
      moreover from ‹α ≺ (P' ∥ Q) = α' ≺ PQ'› ‹bn α ♯* Q› ‹bn α' ♯* Q› ‹bn α ♯* α'›
      obtain P'' where A: "α ≺ P' = α' ≺ P''" and "PQ' = P'' ∥ Q"
        by(metis actionPar1Dest')
      moreover from ‹A⇩P ♯* PQ'› ‹PQ' = P'' ∥ Q› have "A⇩P ♯* P''" by simp
      ultimately obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set(bn α') × set (bn(p ∙ α'))" and PeqP': "((p ∙ Ψ⇩P) ⊗ Ψ') ≃ Ψ⇩P'"
                                        and "distinctPerm p" and "(bn(p ∙ α')) ♯* C'" and FrP': "extractFrame P'' = ⟨A⇩P', Ψ⇩P'⟩"
                                        and "A⇩P' ♯* P''" and "A⇩P' ♯* α'" "A⇩P' ♯* (p ∙ α')" and "A⇩P' ♯* C" 
                                        and "(bn(p ∙ α')) ♯* α'" and "(bn(p ∙ α')) ♯* P''" and "distinct A⇩P'"
                                        and "A⇩P' ♯* (X @ A⇩Q)" and "A⇩P' ♯* (Ψ⇩Q#Y)"
                                        and "A⇩P' ♯* (Q#Z)" and "(bn(p ∙ α')) ♯* (X @ A⇩Q)" and "(bn(p ∙ α')) ♯* (Ψ⇩Q#Y)"
                                        and "(bn(p ∙ α')) ♯* (Q#Z)" using cPar1
        by(rule_tac cPar1)

      then have "A⇩P' ♯* Q" and "A⇩P' ♯* Z" and "A⇩P' ♯* A⇩Q" and "A⇩P' ♯* X" and "A⇩P' ♯* Ψ⇩Q"  and "A⇩P' ♯* Y" 
            and "(bn(p ∙ α')) ♯* A⇩Q" and "(bn(p ∙ α')) ♯* X" and "(bn(p ∙ α')) ♯* Y" and "(bn(p ∙ α')) ♯* Z" and "(bn(p ∙ α')) ♯* Ψ⇩Q"
            and "(bn(p ∙ α')) ♯* Q"
        by(simp del: freshChainSimps)+

      from ‹A⇩Q ♯* PQ'› ‹PQ' = P'' ∥ Q› ‹A⇩P' ♯* A⇩Q› FrP' have "A⇩Q ♯* Ψ⇩P'"
        by(force dest: extractFrameFreshChain)
      note S
      moreover from PeqP' have "((p ∙ (Ψ⇩P ⊗ Ψ⇩Q)) ⊗ Ψ') ≃ Ψ⇩P' ⊗ (p ∙ Ψ⇩Q)"
        by(simp add: eqvts) (metis Composition Associativity AssertionStatEqTrans AssertionStatEqSym Commutativity)
      with ‹(bn(p ∙ α')) ♯* Ψ⇩Q› ‹bn α' ♯* Ψ⇩Q› S have "((p ∙ (Ψ⇩P ⊗ Ψ⇩Q)) ⊗ Ψ') ≃ Ψ⇩P' ⊗ Ψ⇩Q"
        by simp
      moreover from ‹PQ' = P'' ∥ Q› ‹A⇩P' ♯* A⇩Q› ‹A⇩P' ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P'› ‹A⇩Q ♯* PQ'› FrP' FrQ have "extractFrame PQ' = ⟨(A⇩P'@A⇩Q), Ψ⇩P' ⊗ Ψ⇩Q⟩"
        by simp
      moreover note ‹distinctPerm p› ‹(bn(p ∙ α')) ♯* C'›
      moreover from ‹A⇩P' ♯* P''› ‹A⇩P' ♯* Q› ‹PQ' = P'' ∥ Q› have "A⇩P' ♯* PQ'" by simp
      moreover note ‹A⇩Q ♯* PQ'› ‹A⇩P' ♯* α'› ‹A⇩Q ♯* α'› ‹A⇩P' ♯* C› ‹A⇩Q ♯* C› ‹(bn(p ∙ α')) ♯* α'›
      moreover from ‹bn α' ♯* Q› have "(bn(p ∙ α')) ♯* (p ∙ Q)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
      with ‹bn α ♯* Q› ‹(bn(p ∙ α')) ♯* Q› S have "(bn(p ∙ α')) ♯* Q" by simp
      with ‹(bn(p ∙ α')) ♯* P''› ‹PQ' = P'' ∥ Q› have "(bn(p ∙ α')) ♯* PQ'" by simp
      moreover from ‹A⇩P' ♯* α'› ‹A⇩Q ♯* α'› have "(A⇩P'@A⇩Q) ♯* α'" by simp
      moreover from ‹A⇩P' ♯* C› ‹A⇩Q ♯* C› have "(A⇩P'@A⇩Q) ♯* C" by simp
      moreover from ‹A⇩P' ♯* X› ‹A⇩Q ♯* X› have "(A⇩P'@A⇩Q) ♯* X" by simp
      moreover from ‹A⇩P' ♯* Y› ‹A⇩Q ♯* Y› have "(A⇩P'@A⇩Q) ♯* Y" by simp
      moreover from ‹A⇩P' ♯* Z› ‹A⇩Q ♯* Z› have "(A⇩P'@A⇩Q) ♯* Z" by simp
      moreover from ‹A⇩P' ♯* PQ'› ‹A⇩Q ♯* PQ'› have "(A⇩P'@A⇩Q) ♯* PQ'" by simp
      moreover from ‹A⇩P' ♯* α'› ‹A⇩Q ♯* α'› have "(A⇩P'@A⇩Q) ♯* α'" by simp
      moreover from ‹A⇩Q ♯* α'› have "(p ∙ A⇩Q) ♯* (p ∙ α')"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
      with S ‹A⇩Q ♯* α'› ‹bn(p ∙ α') ♯* A⇩Q› have "A⇩Q ♯* (p ∙ α')"
        by simp
      with ‹A⇩P' ♯* (p ∙ α')› ‹A⇩Q ♯* α'› ‹bn(p ∙ α') ♯* A⇩Q› S have "(A⇩P'@A⇩Q) ♯* (p ∙ α')"
        by simp
      moreover from ‹A⇩P' ♯* A⇩Q› ‹distinct A⇩P'› ‹distinct A⇩Q› have "distinct(A⇩P'@A⇩Q)" by auto
      moreover note ‹(bn(p ∙ α')) ♯* X› ‹(bn(p ∙ α')) ♯* Y› ‹(bn(p ∙ α')) ♯* Z›
      ultimately show ?case using cPar1
        by metis
    next
      case(cPar2 Ψ Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q C C' α' PQ' X Y Z)
      have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and  FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
        by fact+

      note ‹bn α' ♯* subject α'›
      moreover from ‹bn α' ♯* (P ∥ Q)› have "bn α' ♯* Q" and "bn α' ♯* P" by simp+    
      moreover with FrP FrQ ‹A⇩P ♯* α'› ‹A⇩Q ♯* α'› have "bn α' ♯* Ψ⇩P" and "bn α' ♯* Ψ⇩Q" 
        by(force dest: extractFrameFreshChain)+
 
      moreover from ‹bn α' ♯* X› ‹A⇩P ♯* α'› have "bn α' ♯* (X@A⇩P)" by simp
      moreover from ‹bn α' ♯* Y› ‹bn α' ♯* Ψ⇩P› have "bn α' ♯* (Ψ⇩P#Y)" by simp
      moreover from ‹bn α' ♯* Z› ‹bn α' ♯* P› have "bn α' ♯* (P#Z)" by simp
      moreover from ‹A⇩Q ♯* X› ‹A⇩P ♯* A⇩Q› have "A⇩Q ♯* (X@A⇩P)" by simp
      moreover from ‹A⇩Q ♯* Y› ‹A⇩Q ♯* Ψ⇩P› have "A⇩Q ♯* (Ψ⇩P#Y)" by force
      moreover from ‹A⇩Q ♯* Z› ‹A⇩Q ♯* P› have "A⇩Q ♯* (P#Z)" by simp
      moreover from ‹α ≺ (P ∥ Q') = α' ≺ PQ'› ‹bn α ♯* P› ‹bn α' ♯* P› ‹bn α ♯* α'›
      obtain Q'' where A: "α ≺ Q' = α' ≺ Q''" and "PQ' = P ∥ Q''"
        by(metis actionPar2Dest')
      moreover from ‹A⇩Q ♯* PQ'› ‹PQ' = P ∥ Q''› have "A⇩Q ♯* Q''" by simp
      ultimately obtain p Ψ' A⇩Q' Ψ⇩Q' where S: "set p ⊆ set(bn α') × set (bn(p ∙ α'))" and QeqQ': "((p ∙ Ψ⇩Q) ⊗ Ψ') ≃ Ψ⇩Q'"
                                        and "distinctPerm p" and "(bn(p ∙ α')) ♯* C'" and FrQ': "extractFrame Q'' = ⟨A⇩Q', Ψ⇩Q'⟩"
                                        and "A⇩Q' ♯* Q''" and "A⇩Q' ♯* α'" "A⇩Q' ♯* (p ∙ α')" and "A⇩Q' ♯* C" 
                                        and "(bn(p ∙ α')) ♯* α'" and "(bn(p ∙ α')) ♯* Q''" and "distinct A⇩Q'"
                                        and "A⇩Q' ♯* (X @ A⇩P)" and "A⇩Q' ♯* (Ψ⇩P#Y)"
                                        and "A⇩Q' ♯* (P#Z)" and "(bn(p ∙ α')) ♯* (X @ A⇩P)" and "(bn(p ∙ α')) ♯* (Ψ⇩P#Y)"
                                        and "(bn(p ∙ α')) ♯* (P#Z)" using cPar2
        by(rule_tac cPar2)

      then have "A⇩Q' ♯* P" and "A⇩Q' ♯* Z" and "A⇩Q' ♯* A⇩P" and "A⇩Q' ♯* X" and "A⇩Q' ♯* Ψ⇩P"  and "A⇩Q' ♯* Y" 
            and "(bn(p ∙ α')) ♯* A⇩P" and "(bn(p ∙ α')) ♯* X" and "(bn(p ∙ α')) ♯* Y" and "(bn(p ∙ α')) ♯* Z" and "(bn(p ∙ α')) ♯* Ψ⇩P"
            and "(bn(p ∙ α')) ♯* P"
        by(simp del: freshChainSimps)+

      from ‹A⇩P ♯* PQ'› ‹PQ' = P ∥ Q''› ‹A⇩Q' ♯* A⇩P› FrQ' have "A⇩P ♯* Ψ⇩Q'"
        by(force dest: extractFrameFreshChain)
      note S
      moreover from QeqQ' have "((p ∙ (Ψ⇩P ⊗ Ψ⇩Q)) ⊗ Ψ') ≃ (p ∙ Ψ⇩P) ⊗ Ψ⇩Q'"
        by(simp add: eqvts) (metis Composition Associativity AssertionStatEqTrans AssertionStatEqSym Commutativity)
      with ‹(bn(p ∙ α')) ♯* Ψ⇩P› ‹bn α' ♯* Ψ⇩P› S have "((p ∙ (Ψ⇩P ⊗ Ψ⇩Q)) ⊗ Ψ') ≃ Ψ⇩P ⊗ Ψ⇩Q'"
        by simp
      moreover from ‹PQ' = P ∥ Q''› ‹A⇩Q' ♯* A⇩P› ‹A⇩Q' ♯* Ψ⇩P› ‹A⇩P ♯* Ψ⇩Q'› ‹A⇩P ♯* PQ'› FrQ' FrP have "extractFrame PQ' = ⟨(A⇩P@A⇩Q'), Ψ⇩P ⊗ Ψ⇩Q'⟩"
        by simp
      moreover note ‹distinctPerm p› ‹(bn(p ∙ α')) ♯* C'›
      moreover from ‹A⇩Q' ♯* Q''› ‹A⇩Q' ♯* P› ‹PQ' = P ∥ Q''› have "A⇩Q' ♯* PQ'" by simp
      moreover note ‹A⇩Q ♯* PQ'› ‹A⇩Q' ♯* α'› ‹A⇩Q ♯* α'› ‹A⇩Q' ♯* C› ‹A⇩Q ♯* C› ‹(bn(p ∙ α')) ♯* α'›
      moreover from ‹bn α' ♯* Q› have "(bn(p ∙ α')) ♯* (p ∙ Q)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
      with ‹bn α ♯* P› ‹(bn(p ∙ α')) ♯* P› S have "(bn(p ∙ α')) ♯* P" by simp
      with ‹(bn(p ∙ α')) ♯* Q''› ‹PQ' = P ∥ Q''› have "(bn(p ∙ α')) ♯* PQ'" by simp
      moreover from ‹A⇩Q' ♯* α'› ‹A⇩P ♯* α'› have "(A⇩P@A⇩Q') ♯* α'" by simp
      moreover from ‹A⇩Q' ♯* C› ‹A⇩P ♯* C› have "(A⇩P@A⇩Q') ♯* C" by simp
      moreover from ‹A⇩Q' ♯* X› ‹A⇩P ♯* X› have "(A⇩P@A⇩Q') ♯* X" by simp
      moreover from ‹A⇩Q' ♯* Y› ‹A⇩P ♯* Y› have "(A⇩P@A⇩Q') ♯* Y" by simp
      moreover from ‹A⇩Q' ♯* Z› ‹A⇩P ♯* Z› have "(A⇩P@A⇩Q') ♯* Z" by simp
      moreover from ‹A⇩Q' ♯* PQ'› ‹A⇩P ♯* PQ'› have "(A⇩P@A⇩Q') ♯* PQ'" by simp
      moreover from ‹A⇩Q' ♯* α'› ‹A⇩P ♯* α'› have "(A⇩P@A⇩Q') ♯* α'" by simp
      moreover from ‹A⇩P ♯* α'› have "(p ∙ A⇩P) ♯* (p ∙ α')"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst] bnEqvt[symmetric])
      with S ‹A⇩P ♯* α'› ‹bn(p ∙ α') ♯* A⇩P› have "A⇩P ♯* (p ∙ α')"
        by simp
      with ‹A⇩Q' ♯* (p ∙ α')› ‹A⇩P ♯* α'› ‹bn(p ∙ α') ♯* A⇩P› S have "(A⇩P@A⇩Q') ♯* (p ∙ α')"
        by simp
      moreover note ‹(bn(p ∙ α')) ♯* X› ‹(bn(p ∙ α')) ♯* Y› ‹(bn(p ∙ α')) ♯* Z›
      moreover from ‹A⇩Q' ♯* A⇩P› ‹distinct A⇩P› ‹distinct A⇩Q'› have "distinct(A⇩P@A⇩Q')" by auto
      ultimately show ?case using cPar2
        by metis
    next
      case cComm1
      thus ?case by(simp add: residualInject)
    next
      case cComm2
      thus ?case by(simp add: residualInject)
    next
      case(cOpen Ψ P M xvec1 xvec2 N P' x A⇩P Ψ⇩P C C' α P'' X Y Z)
      from ‹M⦇ν*(xvec1@x#xvec2)⦈⟨N⟩ ≺ P' = α ≺ P''› ‹x ♯ xvec1› ‹x ♯ xvec2› ‹x ♯ α› ‹x ♯ P''› ‹distinct(bn α)› ‹A⇩P ♯* α› ‹x ♯ α›
      obtain yvec1 y yvec2 N' where yvecEq: "bn α = yvec1@y#yvec2" and P'eqP'': "⦇ν*(xvec1@xvec2)⦈N ≺' P' = ⦇ν*(yvec1@yvec2)⦈([(x, y)] ∙ N') ≺' ([(x, y)] ∙ P'')" and "A⇩P ♯* N'" and Subj: "subject α = Some M" and "x ♯ N'" and αeq: "α = M⦇ν*(yvec1@y#yvec2)⦈⟨N'⟩"
        apply(cases rule: actionCases[where α=α])
        apply(auto simp add: residualInject)
        apply(rule boundOutputOpenDest)
        by assumption auto
      note ‹A⇩P ♯* P› ‹A⇩P ♯* M›
      moreover from Subj yvecEq ‹bn α ♯* subject α› have "yvec1 ♯* M" "yvec2 ♯* M" by simp+
      moreover from yvecEq ‹A⇩P ♯* α› have "A⇩P ♯* (yvec1@yvec2)" by simp
      moreover note ‹A⇩P ♯* C›
      moreover from yvecEq  ‹bn α ♯* ⦇νx⦈P› ‹x ♯ α› have "(yvec1@yvec2) ♯* P" by simp
      moreover from yvecEq ‹bn α ♯* C'› ‹bn α ♯* X› ‹bn α ♯* Y› ‹bn α ♯* Z› ‹distinct(bn α)› ‹x ♯ α›
      have "(yvec1@yvec2) ♯* C'" and "(yvec1@yvec2) ♯* (x#y#X)" and "(yvec1@yvec2) ♯* Y" and "(yvec1@yvec2) ♯* Z"
        by simp+
      moreover from ‹A⇩P ♯* X› ‹x ♯ A⇩P› ‹A⇩P ♯* α› yvecEq have "A⇩P ♯* (x#y#X)" by simp
      moreover note ‹A⇩P ♯* Y› ‹A⇩P ♯* Z›
      moreover from ‹A⇩P ♯* N'› ‹A⇩P ♯* P''› ‹x ♯ A⇩P› ‹A⇩P ♯* α› yvecEq have "A⇩P ♯* ([(x, y)] ∙ N')" and  "A⇩P ♯* ([(x, y)] ∙ P'')"
        by simp+
      moreover from yvecEq ‹distinct(bn α)› have "distinct(yvec1@yvec2)" by simp
      moreover from P'eqP'' have "M⦇ν*(xvec1@xvec2)⦈⟨N⟩ ≺ P' = M⦇ν*(yvec1@yvec2)⦈⟨([(x, y)] ∙ N')⟩ ≺ ([(x, y)] ∙ P'')"
        by(simp add: residualInject)
      ultimately obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set (yvec1@yvec2) × set (p ∙ (yvec1@yvec2))" and PeqP': "((p ∙ Ψ⇩P) ⊗ Ψ') ≃ Ψ⇩P'"
                                        and "distinctPerm p" and "(p ∙ (yvec1@yvec2)) ♯* C'" and FrP': "extractFrame([(x, y)] ∙ P'') = ⟨A⇩P', Ψ⇩P'⟩"
                                        and "A⇩P' ♯* ([(x, y)] ∙ P'')" and "A⇩P' ♯* ([(x, y)] ∙ N')" and "A⇩P' ♯* C" and "(p ∙ (yvec1@yvec2)) ♯* ([(x, y)] ∙ N')" and "A⇩P' ♯* M" and "(p ∙ (yvec1@yvec2)) ♯* (yvec1@yvec2)" and "(p ∙ (yvec1@yvec2)) ♯* M" and "distinct A⇩P'"
                                        and "(p ∙ (yvec1@yvec2)) ♯* ([(x, y)] ∙ P'')" and "(yvec1@yvec2) ♯* A⇩P'" and "(p ∙ (yvec1@yvec2)) ♯* A⇩P'"
                                        and "A⇩P' ♯* (x#y#X)" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" and "(p ∙ (yvec1@yvec2)) ♯* (x#y#X)"
                                        and "(p ∙ (yvec1@yvec2)) ♯* Y" and "(p ∙ (yvec1@yvec2)) ♯* Z" using ‹A⇩P ♯* C'›
        by(rule_tac cOpen(4)[where bd="x#y#X"]) (assumption | simp_all)+

      from ‹A⇩P' ♯* (x#y#X)› have "x ♯ A⇩P'" and "y ♯ A⇩P'" and "A⇩P' ♯* X" by simp+
      from ‹(p ∙ (yvec1@yvec2)) ♯* (x#y#X)› have "x ♯ (p ∙ (yvec1@yvec2))" and  "y ♯ (p ∙ (yvec1@yvec2))" and  "(p ∙ (yvec1@yvec2)) ♯* X" by simp+

      from ‹x ♯ α› yvecEq have "x ♯ yvec1" and "x ≠ y" and "x ♯ yvec2" by simp+
      from ‹distinct(bn α)› yvecEq have "yvec1 ♯* yvec2" and "y ♯ yvec1" and "y ♯ yvec2" by simp+
      from ‹bn α ♯* C'› yvecEq have "yvec1 ♯* C'" and "y ♯ C'" and "yvec2 ♯* C'" by simp+

      from S ‹x ♯ α› ‹x ♯ p ∙ (yvec1@yvec2)› yvecEq have "x ♯ p" by(rule_tac freshAlphaSwap) (assumption | simp)+
      from S ‹distinct(bn α)› ‹y ♯ p ∙ (yvec1@yvec2)› yvecEq have "y ♯ p" by(rule_tac freshAlphaSwap) (assumption | simp)+

      from yvecEq S ‹x ♯ yvec1› ‹x ♯ yvec2› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p ∙ (yvec1@yvec2)› ‹y ♯ p ∙ (yvec1@yvec2)›
      have "set ((y, x)#p) ⊆ set(bn α) × set(bn(((y, x)#p) ∙ α))"
        apply(simp add: bnEqvt[symmetric])
        by(auto simp add: eqvts calc_atm)

      moreover from PeqP' have "([(y, x)] ∙ ((p ∙ Ψ⇩P) ⊗ Ψ')) ≃ [(y, x)] ∙ Ψ⇩P'"
        by(simp add: AssertionStatEqClosed)
      hence "(((y, x)#p) ∙ Ψ⇩P) ⊗ ([(y, x)] ∙ Ψ') ≃ ([(y, x)] ∙ Ψ⇩P')"
        by(simp add: eqvts)
      moreover from ‹distinctPerm p› S ‹x ≠ y› ‹x ♯ p› ‹y ♯ p› have "distinctPerm((y, x)#p)"
        by simp
      moreover from FrP' have "([(x, y)] ∙ (extractFrame([(x, y)] ∙ P''))) = ([(x, y)] ∙ ⟨A⇩P', Ψ⇩P'⟩)"
        by simp
      with ‹x ♯ A⇩P'› ‹y ♯ A⇩P'› have "extractFrame P'' = ⟨A⇩P', ([(y, x)] ∙ Ψ⇩P')⟩"
        by(simp add: eqvts name_swap)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ N'› ‹(p ∙ (yvec1@yvec2)) ♯* ([(x, y)] ∙ N')› have "([(y, x)] ∙ p ∙ (yvec1@yvec2)) ♯* ([(y, x)] ∙ [(x, y)] ∙ N')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      hence "(((y, x)#p) ∙ (yvec1@yvec2)) ♯* N'" by(simp add: name_swap) 
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ C› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹x ♯ N'› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* N'" by(simp add: bnEqvt[symmetric]) (simp add: eqvts perm_compose calc_atm freshChainSimps)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ N'› ‹(p ∙ (yvec1@yvec2)) ♯* ([(x, y)] ∙ P'')› have "([(y, x)] ∙ p ∙ (yvec1@yvec2)) ♯* ([(y, x)] ∙ [(x, y)] ∙ P'')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      hence "(((y, x)#p) ∙ (yvec1@yvec2)) ♯* P''" by(simp add: name_swap) 
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹x ♯ P''› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* P''" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps) 
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ A⇩P'› ‹(p ∙ (yvec1@yvec2)) ♯* A⇩P'› have "(p ∙ (yvec1@x#yvec2)) ♯* A⇩P'"
        by(simp add: eqvts freshChainSimps)
      hence "([(y, x)] ∙ p ∙ (yvec1@x#yvec2)) ♯* ([(y, x)] ∙ A⇩P')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ A⇩P'› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹y ♯ A⇩P'› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* A⇩P'" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ C'› ‹(p ∙ (yvec1@yvec2)) ♯* C'› have "(p ∙ (yvec1@x#yvec2)) ♯* C'"
        by(simp add: eqvts freshChainSimps)
      hence "([(y, x)] ∙ p ∙ (yvec1@x#yvec2)) ♯* ([(y, x)] ∙ C')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ C'› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹y ♯ C'› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* C'"  by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ X› ‹(p ∙ (yvec1@yvec2)) ♯* X› have "(p ∙ (yvec1@x#yvec2)) ♯* X"
        by(simp add: eqvts freshChainSimps)
      hence "([(y, x)] ∙ p ∙ (yvec1@x#yvec2)) ♯* ([(y, x)] ∙ X)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ X› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹bn α ♯* X› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* X" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ Y› ‹(p ∙ (yvec1@yvec2)) ♯* Y› have "(p ∙ (yvec1@x#yvec2)) ♯* Y"
        by(simp add: eqvts freshChainSimps)
      hence "([(y, x)] ∙ p ∙ (yvec1@x#yvec2)) ♯* ([(y, x)] ∙ Y)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ Y› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹bn α ♯* Y› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* Y" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
      moreover from ‹x ♯ p› ‹y ♯ p› ‹x ♯ Z› ‹(p ∙ (yvec1@yvec2)) ♯* Z› have "(p ∙ (yvec1@x#yvec2)) ♯* Z"
        by(simp add: eqvts freshChainSimps)
      hence "([(y, x)] ∙ p ∙ (yvec1@x#yvec2)) ♯* ([(y, x)] ∙ Z)"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ yvec1› ‹x ♯ yvec2› ‹x ≠ y› ‹x ♯ Z› ‹y ♯ yvec1› ‹y ♯ yvec2› ‹x ♯ p› ‹y ♯ p› ‹bn α ♯* Z› yvecEq
      have "bn(((y, x)#p) ∙ α) ♯* Z" by(simp add: bnEqvt[symmetric]) (simp add: perm_compose calc_atm eqvts freshChainSimps)
      moreover from ‹(yvec1@yvec2) ♯* A⇩P'› ‹y ♯ A⇩P'› yvecEq have "bn α ♯* A⇩P'"
        by simp
      moreover from ‹A⇩P' ♯* ([(x, y)] ∙ N')› have "([(x, y)] ∙ A⇩P') ♯* ([(x, y)] ∙ [(x, y)] ∙ N')"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ A⇩P'› ‹y ♯ A⇩P'› have "A⇩P' ♯* N'" by simp
      with ‹A⇩P' ♯* M› ‹(yvec1@yvec2) ♯* A⇩P'› ‹y ♯ A⇩P'› αeq have "A⇩P' ♯* α" by simp
      moreover hence "(((y, x)#p) ∙ A⇩P') ♯* (((y, x)#p) ∙ α)"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ A⇩P'› ‹y ♯ A⇩P'› S ‹(yvec1@yvec2) ♯* A⇩P'› ‹(p ∙ (yvec1@yvec2)) ♯* A⇩P'›
      have "A⇩P' ♯* (((y, x)#p) ∙ α)" by(simp add: eqvts)
      moreover from ‹A⇩P' ♯* ([(x, y)] ∙ P'')› have "([(x, y)] ∙ A⇩P') ♯* ([(x, y)] ∙ [(x, y)] ∙ P'')"
        by(simp only: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹x ♯ A⇩P'› ‹y ♯ A⇩P'› have "A⇩P' ♯* P''" by simp
      moreover from yvecEq αeq ‹(p ∙ (yvec1@yvec2)) ♯* (yvec1@yvec2)› ‹y ♯ p› ‹x ♯ α› S ‹(p ∙ (yvec1@yvec2)) ♯* M›‹(p ∙ (yvec1@yvec2)) ♯* ([(x, y)] ∙ N')› ‹y ♯ yvec1›‹y ♯ yvec2› ‹x ♯ p›
      have "bn(((y, x)#p) ∙ α) ♯* α"
      apply(simp add: eqvts del: set_append) 
      apply(intro conjI)
      apply(simp add: perm_compose eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(simp add: perm_compose eqvts del: set_append)
      apply(simp add: perm_compose eqvts swapStarFresh del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) swapStarFresh calc_atm eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(subst pt_fresh_star_bij[symmetric, OF pt_name_inst, OF at_name_inst, where pi="[(x, y)]"])
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      apply(subst pt_fresh_star_bij[symmetric, OF pt_name_inst, OF at_name_inst, where pi="[(x, y)]"])
      by(simp add: perm_compose freshChainSimps(6) calc_atm eqvts del: set_append)
      moreover note ‹A⇩P' ♯* C› ‹A⇩P' ♯* X› ‹A⇩P' ♯* Y› ‹A⇩P' ♯* Z› ‹distinct A⇩P'›

      ultimately show ?case
        by(rule_tac cOpen)
    next
      case(cScope Ψ P α P' x A⇩P Ψ⇩P C C' α' P'' X Y Z)
      from ‹α ≺ ⦇νx⦈P' = α' ≺ P''› ‹x ♯ α› ‹x ♯ α'›
      obtain P''' where "α ≺ P' = α' ≺ P'''" and "P'' = ⦇νx⦈P'''"
        apply(cases rule: actionCases[where α=α])
        apply(auto simp add: residualInject)
        by(metis boundOutputScopeDest)
      then obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set(bn α') × set(bn(p ∙ α'))" and PeqP': "((p ∙ Ψ⇩P) ⊗ Ψ') ≃ Ψ⇩P'"
                                  and "distinctPerm p" and "bn(p ∙ α') ♯* C'" and FrP': "extractFrame P''' = ⟨A⇩P', Ψ⇩P'⟩"
                                  and "A⇩P' ♯* P'''" and "A⇩P' ♯* α'" and "A⇩P' ♯* (p ∙ α')" and "A⇩P' ♯* C" and "distinct A⇩P'"
                                  and "bn(p ∙ α') ♯* P'''" and "A⇩P' ♯* (x#X)" and "A⇩P' ♯* Y" and "bn(p ∙ α') ♯* α'"
                                  and "A⇩P' ♯* Z" and "bn(p ∙ α') ♯* (x#X)" and "bn(p ∙ α') ♯* Y"
                                  and "bn(p ∙ α') ♯* Z" using cScope
        by(rule_tac cScope) (assumption | simp)+
      from ‹A⇩P' ♯* (x#X)› have "x ♯ A⇩P'" and "A⇩P' ♯* X" by simp+
      from ‹bn(p ∙ α') ♯* (x#X)› have "x ♯ bn(p ∙ α')" and "bn(p ∙ α') ♯* X" by simp+

      note S PeqP' ‹distinctPerm p› ‹bn(p ∙ α') ♯* C'›
      moreover from FrP' ‹P'' = ⦇νx⦈P'''› have "extractFrame P'' = ⟨(x#A⇩P'), Ψ⇩P'⟩" by simp
      moreover from ‹A⇩P' ♯* P'''› ‹P'' = ⦇νx⦈P'''› ‹x ♯ A⇩P'› have "(x#A⇩P') ♯* P''" by(simp add: abs_fresh)
      moreover from ‹A⇩P' ♯* α'› ‹A⇩P' ♯* C›  ‹x ♯ α'› ‹x ♯ C› have "(x#A⇩P') ♯* α'"  and "(x#A⇩P') ♯* C" by simp+
      moreover note ‹bn(p ∙ α') ♯* α'›
      moreover from ‹bn(p ∙ α') ♯* P'''› ‹P'' = ⦇νx⦈P'''› ‹x ♯ bn(p ∙ α')› have "bn(p ∙ α') ♯* P''" by simp
      moreover from ‹A⇩P' ♯* α'› ‹x ♯ α'› have "(x#A⇩P') ♯* α'" by simp
      moreover from ‹A⇩P' ♯* (p ∙ α')› ‹x ♯ α'› S ‹x ♯ bn(p ∙ α')› have "(x#A⇩P') ♯* (p ∙ α')" 
        by(simp add: subjectEqvt[symmetric] bnEqvt[symmetric] okjectEqvt[symmetric] freshChainSimps)
      moreover from ‹A⇩P' ♯* X› ‹x ♯ X› have "(x#A⇩P') ♯* X" by simp+
      moreover from ‹A⇩P' ♯* Y› ‹x ♯ Y› have "(x#A⇩P') ♯* Y" by simp+
      moreover from ‹A⇩P' ♯* Z› ‹x ♯ Z› have "(x#A⇩P') ♯* Z" by simp+
      moreover note ‹bn(p ∙ α') ♯* X› ‹bn(p ∙ α') ♯* Y› ‹bn(p ∙ α') ♯* Z›
      moreover from ‹distinct A⇩P'› ‹x ♯ A⇩P'› have "distinct(x#A⇩P')" by simp
      ultimately show ?case by(rule_tac cScope)
    next
      case(cBang Ψ P A⇩P Ψ⇩P C C' α P' X Y Z)
      then obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))"
                                  and FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" 
                                  and PeqP': "(p ∙ (Ψ⇩P ⊗ 𝟭)) ⊗ Ψ' ≃ Ψ⇩P'"
                                  and "A⇩P' ♯* C" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (p ∙ α)"
                                  and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" and "distinct A⇩P'"
                                  and "distinctPerm p" and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'"
                                  and "(bn(p ∙ α)) ♯* C'" and "(bn(p ∙ α)) ♯* X" and "(bn(p ∙ α)) ♯* Y" and "(bn(p ∙ α)) ♯* Z"
        by(rule_tac cBang) (assumption | simp (no_asm_use))+
      moreover from ‹Ψ⇩P ≃ 𝟭› have "(p ∙ Ψ⇩P) ≃ (p ∙ 𝟭)"
        by(simp add: AssertionStatEqClosed)
      hence "(p ∙ Ψ⇩P) ≃ 𝟭" by(simp add: permBottom)
      with PeqP' have "(𝟭 ⊗ Ψ') ≃ Ψ⇩P'"
        by(simp add: eqvts permBottom) (metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
      ultimately show ?case using cBang
        apply(rule_tac cBang(18)) by(assumption | simp)+ 
    qed
    
    with A have ?thesis by blast
  }
  moreover have "bn α ♯* ([]::name list)" and "bn α ♯* ([]::'b list)" and "bn α ♯* ([]::('a, 'b, 'c) psi list)"
           and  "A⇩P ♯* ([]::name list)" and "A⇩P ♯* ([]::'b list)" and "A⇩P ♯* ([]::('a, 'b, 'c) psi list)" 
    by simp+
  ultimately show ?thesis by blast
qed

lemma expandTauFrame:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b,'c) psi"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   C    :: "'d::fs_name"

  assumes "Ψ ⊳ P ⟼τ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* C"

  obtains Ψ' A⇩P' Ψ⇩P' where "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩"  and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "A⇩P' ♯* C" and "A⇩P' ♯* P'" and "distinct A⇩P'"
proof -
  assume A: "⋀A⇩P' Ψ⇩P' Ψ'.
        ⟦extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩; Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'; A⇩P' ♯* C; A⇩P' ♯* P'; distinct A⇩P'⟧
        ⟹ thesis"

  from ‹Ψ ⊳ P ⟼τ ≺P'› ‹A⇩P ♯* P› have "A⇩P ♯* P'" by(rule tauFreshChainDerivative)

  {
    fix X :: "name list"
    and Y :: "'b list"
    and Z :: "('a, 'b, 'c) psi list"

    assume "A⇩P ♯* X"
    and    "A⇩P ♯* Y"
    and    "A⇩P ♯* Z"
    
    with assms ‹A⇩P ♯* P'› obtain Ψ' A⇩P' Ψ⇩P' where "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "A⇩P' ♯* C"
                                               and "A⇩P' ♯* P'" and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" and "distinct A⇩P'"
    proof(nominal_induct avoiding: C X Y Z arbitrary: thesis rule: tauFrameInduct)
      case(cAlpha Ψ P P' A⇩P Ψ⇩P p C X Y Z)
      then obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "distinct A⇩P'"
                                and "A⇩P' ♯* C" and "A⇩P' ♯* P'" and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z"
        by metis

      have S: "set p ⊆ set A⇩P × set(p ∙ A⇩P)" by fact

      from FrP' have "(p ∙ extractFrame P') = p ∙ ⟨A⇩P', Ψ⇩P'⟩" by simp
      with ‹A⇩P ♯* P'› ‹(p ∙ A⇩P) ♯* P'› S have "extractFrame P' = ⟨(p ∙ A⇩P'), (p ∙ Ψ⇩P')⟩" by(simp add: eqvts)
      moreover from ‹Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'› have "(p ∙ (Ψ⇩P ⊗ Ψ')) ≃ (p ∙ Ψ⇩P')" by(rule AssertionStatEqClosed)
      hence "(p ∙ Ψ⇩P) ⊗ (p ∙ Ψ') ≃ (p ∙ Ψ⇩P')" by(simp add: eqvts)
      moreover from ‹A⇩P' ♯* C› have "(p ∙ A⇩P') ♯* (p ∙ C)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* C› ‹(p ∙ A⇩P) ♯* C› S have "(p ∙ A⇩P') ♯* C" by simp
      moreover from ‹A⇩P' ♯* P'› have "(p ∙ A⇩P') ♯* (p ∙ P')" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* P'› ‹(p ∙ A⇩P) ♯* P'› S have "(p ∙ A⇩P') ♯* P'" by simp
      moreover from ‹A⇩P' ♯* X› have "(p ∙ A⇩P') ♯* (p ∙ X)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* X› ‹(p ∙ A⇩P) ♯* X› S have "(p ∙ A⇩P') ♯* X" by simp
      moreover from ‹A⇩P' ♯* Y› have "(p ∙ A⇩P') ♯* (p ∙ Y)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* Y› ‹(p ∙ A⇩P) ♯* Y› S have "(p ∙ A⇩P') ♯* Y" by simp
      moreover from ‹A⇩P' ♯* Z› have "(p ∙ A⇩P') ♯* (p ∙ Z)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩P ♯* Z› ‹(p ∙ A⇩P) ♯* Z› S have "(p ∙ A⇩P') ♯* Z" by simp
      moreover from ‹distinct A⇩P'› have "distinct(p ∙ A⇩P')" by simp
      ultimately show ?case by(rule cAlpha)
    next
      case(cCase Ψ P P' φ Cs A⇩P Ψ⇩P C B Y Z thesis)
      then obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" 
                                and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "distinct A⇩P'"
                                and "A⇩P' ♯* C" and "A⇩P' ♯* P'"
                                and "A⇩P' ♯* B" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z"
        by(rule_tac cCase) (assumption | simp (no_asm_use))+
      with ‹Ψ⇩P ≃ 𝟭› ‹Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'› have "𝟭 ⊗ Ψ' ≃ Ψ⇩P'"
        by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
      thus ?case using FrP' ‹A⇩P' ♯* P'› ‹A⇩P' ♯* C› ‹A⇩P' ♯* B› ‹A⇩P' ♯* Y› ‹A⇩P' ♯* Z› ‹distinct A⇩P'› using cCase
        by force
    next
      case(cPar1 Ψ Ψ⇩Q P P' A⇩Q Q A⇩P Ψ⇩P C X Y Z)
      moreover from ‹A⇩P ♯* X› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Y› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* Q› ‹A⇩P ♯* Z›
      have "A⇩P ♯* (X@A⇩Q)" and  "A⇩P ♯* (Ψ⇩Q#Y)" and  "A⇩P ♯* (Q#Z)"
        by simp+
      ultimately obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "distinct A⇩P'"
                                      and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "A⇩P ♯* P" and "A⇩P ♯* C" and "A⇩P' ♯* C" and "A⇩P' ♯* P'" 
                                      and "A⇩P' ♯* (X@A⇩Q)" and "A⇩P' ♯* (Ψ⇩Q#Y)" and "A⇩P' ♯* (Q#Z)"
        by metis

      hence "A⇩P' ♯* X" and "A⇩P' ♯* A⇩Q" and "A⇩P' ♯* Y" and "A⇩P' ♯* Ψ⇩Q" and "A⇩P' ♯* Q" and "A⇩P' ♯* Z"
        by simp+

      from ‹A⇩P' ♯* A⇩Q› ‹A⇩Q ♯* P'› FrP' have "A⇩Q ♯* Ψ⇩P'" by(force dest: extractFrameFreshChain)
      with ‹A⇩P' ♯* Ψ⇩Q› ‹A⇩P' ♯* A⇩Q› ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› FrP'
      have "extractFrame(P' ∥ Q) = ⟨(A⇩P'@A⇩Q), Ψ⇩P' ⊗ Ψ⇩Q⟩" by simp

      moreover from ‹Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'›have "(Ψ⇩P ⊗ Ψ⇩Q) ⊗ Ψ' ≃ Ψ⇩P' ⊗ Ψ⇩Q" 
        by(metis Associativity Commutativity Composition AssertionStatEqTrans AssertionStatEqSym)

      moreover from ‹A⇩P' ♯* C› ‹A⇩Q ♯* C› have "(A⇩P'@A⇩Q) ♯* C" by simp
      moreover from ‹A⇩P' ♯* P'› ‹A⇩Q ♯* P'› ‹A⇩P' ♯* Q› ‹A⇩Q ♯* Q› have "(A⇩P'@A⇩Q) ♯* (P' ∥ Q)" by simp
      moreover from ‹A⇩P' ♯* X› ‹A⇩Q ♯* X› have "(A⇩P'@A⇩Q) ♯* X" by simp
      moreover from ‹A⇩P' ♯* Y› ‹A⇩Q ♯* Y› have "(A⇩P'@A⇩Q) ♯* Y" by simp
      moreover from ‹A⇩P' ♯* Z› ‹A⇩Q ♯* Z› have "(A⇩P'@A⇩Q) ♯* Z" by simp
      moreover from ‹A⇩P' ♯* A⇩Q› ‹distinct A⇩P'› ‹distinct A⇩Q› have "distinct(A⇩P'@A⇩Q)" by simp
      ultimately show ?case by(rule cPar1)
    next
      case(cPar2 Ψ Ψ⇩P Q Q' A⇩P P A⇩Q Ψ⇩Q C X Y Z)
      moreover from ‹A⇩Q ♯* X› ‹A⇩P ♯* A⇩Q› ‹A⇩Q ♯* Y› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Z›
      have "A⇩Q ♯* (X@A⇩P)" and  "A⇩Q ♯* (Ψ⇩P#Y)" and  "A⇩Q ♯* (P#Z)"
        by(simp add: freshChainSimps)+
      ultimately obtain Ψ' A⇩Q' Ψ⇩Q' where FrQ': "extractFrame Q' = ⟨A⇩Q', Ψ⇩Q'⟩" and "distinct A⇩Q'"
                                       and "Ψ⇩Q ⊗ Ψ' ≃ Ψ⇩Q'"and "A⇩Q' ♯* C" and "A⇩Q' ♯* Q'" 
                                       and "A⇩Q' ♯* (X@A⇩P)" and "A⇩Q' ♯* (Ψ⇩P#Y)" and "A⇩Q' ♯* (P#Z)"
        by metis

      hence "A⇩Q' ♯* X" and "A⇩Q' ♯* A⇩P" and "A⇩Q' ♯* Y" and "A⇩Q' ♯* Ψ⇩P" and "A⇩Q' ♯* P" and "A⇩Q' ♯* Z"
        by simp+

      from ‹A⇩Q' ♯* A⇩P› ‹A⇩P ♯* Q'› FrQ' have "A⇩P ♯* Ψ⇩Q'" by(force dest: extractFrameFreshChain)
      with ‹A⇩Q' ♯* Ψ⇩P› ‹A⇩Q' ♯* A⇩P› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› FrQ'
      have "extractFrame(P ∥ Q') = ⟨(A⇩P@A⇩Q'), Ψ⇩P ⊗ Ψ⇩Q'⟩" by simp

      moreover from ‹Ψ⇩Q ⊗ Ψ' ≃ Ψ⇩Q'›have "(Ψ⇩P ⊗ Ψ⇩Q) ⊗ Ψ' ≃ Ψ⇩P ⊗ Ψ⇩Q'" 
        by(metis Associativity Commutativity Composition AssertionStatEqTrans AssertionStatEqSym)
      moreover from ‹A⇩P ♯* C› ‹A⇩Q' ♯* C› have "(A⇩P@A⇩Q') ♯* C" by simp
      moreover from ‹A⇩P ♯* P› ‹A⇩Q' ♯* P› ‹A⇩P ♯* Q'› ‹A⇩Q' ♯* Q'› have "(A⇩P@A⇩Q') ♯* (P ∥ Q')" by simp
      moreover from ‹A⇩P ♯* X› ‹A⇩Q' ♯* X› have "(A⇩P@A⇩Q') ♯* X" by simp
      moreover from ‹A⇩P ♯* Y› ‹A⇩Q' ♯* Y› have "(A⇩P@A⇩Q') ♯* Y" by simp
      moreover from ‹A⇩P ♯* Z› ‹A⇩Q' ♯* Z› have "(A⇩P@A⇩Q') ♯* Z" by simp
      moreover from ‹A⇩Q' ♯* A⇩P› ‹distinct A⇩P› ‹distinct A⇩Q'› have "distinct(A⇩P@A⇩Q')" by simp
      ultimately show ?case by(rule cPar2)
    next
      case(cComm1 Ψ Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q C X Y Z)
      have PTrans: "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'" and QTrans: "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'" by fact+
      from PTrans ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹A⇩P ♯* P› ‹A⇩P ♯* N› ‹A⇩P ♯* M›
           ‹A⇩P ♯* Q'› ‹A⇩P ♯* C› ‹A⇩P ♯* X› ‹A⇩P ♯* Y› ‹A⇩P ♯* Z› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* xvec›
      obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and PeqP': "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'"
                           and "A⇩P' ♯* Q'" and "A⇩P' ♯* C" and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "distinct A⇩P'"
                           and "A⇩P' ♯* Z" and "A⇩P' ♯* A⇩Q" and "A⇩P' ♯* xvec" and "A⇩P' ♯* P'"
        by(rule_tac C="(Q', C, X, Y, Z, A⇩Q, xvec)" and C'="(Q', C, X, Y, Z, A⇩Q, xvec)" in expandNonTauFrame) auto
      moreover from QTrans  have "distinct xvec" by(auto dest: boundOutputDistinct)
      from QTrans ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q› ‹A⇩Q ♯* P› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* K› ‹xvec ♯* K› ‹distinct xvec›
           ‹A⇩P' ♯* A⇩Q› ‹A⇩P' ♯* xvec› ‹A⇩Q ♯* Q› ‹xvec ♯* Q› ‹A⇩Q ♯* Ψ⇩P› ‹xvec ♯* Ψ⇩P› ‹A⇩Q ♯* N› 
           ‹A⇩Q ♯* C› ‹A⇩Q ♯* X› ‹A⇩Q ♯* Y› ‹A⇩Q ♯* Z› ‹xvec ♯* P› ‹xvec ♯* C› ‹xvec ♯* X› ‹xvec ♯* Y› ‹xvec ♯* Z›
      obtain p Ψ'' A⇩Q' Ψ⇩Q' where S: "set p ⊆ set xvec × set(p ∙ xvec)" and QeqQ': "(p ∙ Ψ⇩Q) ⊗ Ψ'' ≃ Ψ⇩Q'" and FrQ': "extractFrame Q' = ⟨A⇩Q', Ψ⇩Q'⟩"
                             and "A⇩Q' ♯* A⇩P'" and "A⇩Q' ♯* C" and "A⇩Q' ♯* X" and "A⇩Q' ♯* Y" and "A⇩Q' ♯* Z" and "A⇩Q' ♯* P" and "A⇩Q' ♯* N" and "distinct A⇩Q'"
                             and "(p ∙ xvec) ♯* A⇩P'" and "(p ∙ xvec) ♯* C" and "(p ∙ xvec) ♯* X" and "(p ∙ xvec) ♯* Y" and "(p ∙ xvec) ♯* P"
                             and "(p ∙ xvec) ♯* Z" and "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* Ψ⇩P" and "(p ∙ xvec) ♯* A⇩Q'"and "(p ∙ xvec) ♯* Q'"
                             and "distinctPerm p" and "A⇩Q' ♯* xvec" and "A⇩Q' ♯* Q'"
        by(rule_tac C="(P, C, X, Y, Z, A⇩P', Ψ⇩P)" and C'="(P, C, X, Y, Z, A⇩P', Ψ⇩P)" in expandNonTauFrame) (assumption | simp)+

      from PTrans ‹A⇩Q' ♯* P› ‹A⇩Q' ♯* N› ‹(p ∙ xvec) ♯* P› ‹(p ∙ xvec) ♯* N› 
      have "A⇩Q' ♯* P'" and "(p ∙ xvec) ♯* P'" by(force dest: inputFreshChainDerivative)+
      with FrP' ‹A⇩Q' ♯* A⇩P'› ‹(p ∙ xvec) ♯* A⇩P'› have "A⇩Q' ♯* Ψ⇩P'" and "(p ∙ xvec) ♯* Ψ⇩P'" by(force dest: extractFrameFreshChain)+
      from FrQ' ‹A⇩Q' ♯* A⇩P'› ‹A⇩P' ♯* Q'› ‹(p ∙ xvec) ♯* A⇩Q'› ‹(p ∙ xvec) ♯* Q'› have "A⇩P' ♯* Ψ⇩Q'" and "(p ∙ xvec) ♯* Ψ⇩Q'"
        by(force dest: extractFrameFreshChain)+
      
      have "extractFrame(⦇ν*xvec⦈(P' ∥ Q')) = ⟨((p ∙ xvec)@A⇩P'@A⇩Q'), (p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q')⟩"
      proof -
        from FrP' FrQ' ‹A⇩P' ♯* Ψ⇩Q'› ‹A⇩Q' ♯* A⇩P'› ‹A⇩Q' ♯* Ψ⇩P'› have "extractFrame(P' ∥ Q') = ⟨(A⇩P'@A⇩Q'), Ψ⇩P' ⊗ Ψ⇩Q'⟩"
          by simp
        hence "extractFrame(⦇ν*xvec⦈(P' ∥ Q')) = ⟨(xvec@A⇩P'@A⇩Q'), Ψ⇩P' ⊗ Ψ⇩Q'⟩"
          by(induct xvec) auto
        moreover from ‹(p ∙ xvec) ♯* Ψ⇩P'› ‹(p ∙ xvec) ♯* Ψ⇩Q'› S 
        have "⦇ν*xvec⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert (Ψ⇩P' ⊗ Ψ⇩Q'))) = ⦇ν*(p ∙ xvec)⦈(p ∙ ⦇ν*(A⇩P'@A⇩Q')⦈(FAssert(Ψ⇩P' ⊗ Ψ⇩Q')))"
          by(rule_tac frameChainAlpha) (auto simp add: fresh_star_def frameResChainFresh)
        hence "⦇ν*xvec⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert (Ψ⇩P' ⊗ Ψ⇩Q'))) = ⦇ν*(p ∙ xvec)⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert((p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q'))))"
          using ‹A⇩P' ♯* xvec› ‹(p ∙ xvec) ♯* A⇩P'› ‹A⇩Q' ♯* xvec› ‹(p ∙ xvec) ♯* A⇩Q'› S
          by(fastforce simp add: eqvts)
        ultimately show ?thesis
          by(simp add: frameChainAppend)
      qed
          
      moreover have "(Ψ⇩P ⊗ Ψ⇩Q) ⊗ ((p ∙ Ψ') ⊗ (p ∙ Ψ'')) ≃ (p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q')"
      proof -
        have "(Ψ⇩P ⊗ (p ∙ Ψ⇩Q)) ⊗ (Ψ' ⊗ Ψ'') ≃ (Ψ⇩P ⊗ Ψ') ⊗ ((p ∙ Ψ⇩Q) ⊗ Ψ'')"
          by(metis Associativity Commutativity Composition AssertionStatEqTrans)
        moreover from PeqP' QeqQ' have "(Ψ⇩P ⊗ Ψ') ⊗ ((p ∙ Ψ⇩Q) ⊗ Ψ'') ≃ Ψ⇩P' ⊗ Ψ⇩Q'"
          by(metis Associativity Commutativity Composition AssertionStatEqTrans)
        ultimately have "(Ψ⇩P ⊗ (p ∙ Ψ⇩Q)) ⊗ (Ψ' ⊗ Ψ'') ≃ Ψ⇩P' ⊗ Ψ⇩Q'"
          by(metis AssertionStatEqTrans)
        hence "(p ∙ ((Ψ⇩P ⊗ (p ∙ Ψ⇩Q)) ⊗ (Ψ' ⊗ Ψ''))) ≃ (p ∙ (Ψ⇩P' ⊗ Ψ⇩Q'))"
          by(rule AssertionStatEqClosed)
        with ‹xvec ♯* Ψ⇩P› ‹(p ∙ xvec) ♯* Ψ⇩P› S ‹distinctPerm p› show ?thesis
          by(simp add: eqvts)
      qed

      moreover from ‹(p ∙ xvec) ♯* C› ‹A⇩P' ♯* C› ‹A⇩Q' ♯* C› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* C" by simp
      moreover from ‹(p ∙ xvec) ♯* X› ‹A⇩P' ♯* X› ‹A⇩Q' ♯* X› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* X" by simp
      moreover from ‹(p ∙ xvec) ♯* Y› ‹A⇩P' ♯* Y› ‹A⇩Q' ♯* Y› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* Y" by simp
      moreover from ‹(p ∙ xvec) ♯* Z› ‹A⇩P' ♯* Z› ‹A⇩Q' ♯* Z› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* Z" by simp
      moreover from ‹(p ∙ xvec) ♯* P'› ‹(p ∙ xvec) ♯* Q'› ‹A⇩P' ♯* P'› ‹A⇩P' ♯* Q' ›‹A⇩Q' ♯* P'› ‹A⇩Q' ♯* Q'›
      have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* (⦇ν*xvec⦈(P' ∥ Q'))" by(auto simp add: resChainFresh fresh_star_def)
      moreover from ‹(p ∙ xvec) ♯* A⇩P'› ‹(p ∙ xvec) ♯* A⇩Q'› ‹A⇩Q' ♯* A⇩P'› ‹distinct xvec› ‹distinct A⇩P'› ‹distinct A⇩Q'›
       have "distinct((p ∙ xvec)@A⇩P'@A⇩Q')"
         by auto (simp add: name_list_supp fresh_star_def fresh_def)+

      ultimately show ?case using cComm1
        by metis
    next
      case(cComm2 Ψ Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q C X Y Z)
      have PTrans: "Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" and QTrans: "Ψ ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'" by fact+
      from PTrans have "distinct xvec" by(auto dest: boundOutputDistinct)
      from PTrans ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹xvec ♯* Q› ‹distinct xvec› ‹xvec ♯* M›
                  ‹A⇩P ♯* C› ‹A⇩P ♯* X› ‹A⇩P ♯* Y› ‹A⇩P ♯* Z› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* xvec› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* M› ‹A⇩P ♯* N›
                  ‹xvec ♯* P› ‹xvec ♯* C› ‹xvec ♯* X› ‹xvec ♯* Y› ‹xvec ♯* Z› ‹A⇩Q ♯* xvec› ‹xvec ♯* Ψ⇩Q›
      obtain p Ψ' A⇩P' Ψ⇩P' where S: "set p ⊆ set xvec × set(p ∙ xvec)"
                           and FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and PeqP': "(p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinct A⇩P'"
                           and "A⇩P' ♯* C" and "A⇩P' ♯* X" and "A⇩P' ♯* Y" and "A⇩P' ♯* N" and "A⇩P' ♯* Q" and "(p ∙ xvec) ♯* Q"
                           and "A⇩P' ♯* Z" and "A⇩P' ♯* A⇩Q" and "A⇩P' ♯* xvec" and "A⇩P' ♯* P'" and "(p ∙ xvec) ♯* N" and "(p ∙ xvec) ♯* Ψ⇩Q"
                           and "(p ∙ xvec) ♯* A⇩P'" and "(p ∙ xvec) ♯* C" and "(p ∙ xvec) ♯* X" and "(p ∙ xvec) ♯* A⇩Q" 
                           and "(p ∙ xvec) ♯* Y" and "(p ∙ xvec) ♯* Z" and "(p ∙ xvec) ♯* P'" and "distinctPerm p"
        by(rule_tac C="(C, X, Y, Z, A⇩Q, Q, Ψ⇩Q)" and C'="(C, X, Y, Z, A⇩Q, Q, Ψ⇩Q)" in expandNonTauFrame) (assumption | simp)+

      from QTrans ‹extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩› ‹distinct A⇩Q› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* xvec› ‹A⇩Q ♯* P'› ‹(p ∙ xvec) ♯* A⇩Q›
           ‹A⇩P' ♯* A⇩Q› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* C› ‹A⇩Q ♯* X› ‹A⇩Q ♯* Y› ‹A⇩Q ♯* Z› ‹A⇩Q ♯* N›  ‹A⇩Q ♯* K› 
      obtain Ψ'' A⇩Q' Ψ⇩Q' where QeqQ': "Ψ⇩Q ⊗ Ψ'' ≃ Ψ⇩Q'" and FrQ': "extractFrame Q' = ⟨A⇩Q', Ψ⇩Q'⟩" and "distinct A⇩Q'"
                             and "A⇩Q' ♯* xvec" and "A⇩Q' ♯* Q'" and "A⇩Q' ♯* xvec" and "A⇩Q' ♯* P'" and "A⇩Q' ♯* (p ∙ xvec)"
                             and "A⇩Q' ♯* A⇩P'" and "A⇩Q' ♯* C" and "A⇩Q' ♯* X" and "A⇩Q' ♯* Y" and "A⇩Q' ♯* Z" and "A⇩Q' ♯* P"
        by(rule_tac C="(P, C, P', X, Y, Z, A⇩P', xvec, (p ∙ xvec), Ψ⇩P)" and C'="(P, C, P', X, Y, Z, A⇩P', xvec, (p ∙ xvec), Ψ⇩P)" in expandNonTauFrame) (assumption | simp)+

      from QTrans ‹A⇩P' ♯* Q› ‹A⇩P' ♯* N› ‹(p ∙ xvec) ♯* Q› ‹(p ∙ xvec) ♯* N› 
      have "A⇩P' ♯* Q'" and "(p ∙ xvec) ♯* Q'" by(force dest: inputFreshChainDerivative)+
      with FrQ' ‹A⇩Q' ♯* A⇩P'› ‹A⇩Q' ♯* (p ∙ xvec)› have "A⇩P' ♯* Ψ⇩Q'" and "(p ∙ xvec) ♯* Ψ⇩Q'" by(force dest: extractFrameFreshChain)+
      from FrP' ‹A⇩Q' ♯* A⇩P'› ‹A⇩Q' ♯* P'› ‹(p ∙ xvec) ♯* A⇩P'› ‹(p ∙ xvec) ♯* P'› have "A⇩Q' ♯* Ψ⇩P'" and "(p ∙ xvec) ♯* Ψ⇩P'"
        by(force dest: extractFrameFreshChain)+

      have "extractFrame(⦇ν*xvec⦈(P' ∥ Q')) = ⟨((p ∙ xvec)@A⇩P'@A⇩Q'), (p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q')⟩"
      proof -
        from FrP' FrQ' ‹A⇩P' ♯* Ψ⇩Q'› ‹A⇩Q' ♯* A⇩P'› ‹A⇩Q' ♯* Ψ⇩P'› have "extractFrame(P' ∥ Q') = ⟨(A⇩P'@A⇩Q'), Ψ⇩P' ⊗ Ψ⇩Q'⟩"
          by simp
        hence "extractFrame(⦇ν*xvec⦈(P' ∥ Q')) = ⟨(xvec@A⇩P'@A⇩Q'), Ψ⇩P' ⊗ Ψ⇩Q'⟩"
          by(induct xvec) auto
        moreover from ‹(p ∙ xvec) ♯* Ψ⇩P'› ‹(p ∙ xvec) ♯* Ψ⇩Q'› S 
        have "⦇ν*xvec⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert (Ψ⇩P' ⊗ Ψ⇩Q'))) = ⦇ν*(p ∙ xvec)⦈(p ∙ ⦇ν*(A⇩P'@A⇩Q')⦈(FAssert(Ψ⇩P' ⊗ Ψ⇩Q')))"
          by(rule_tac frameChainAlpha) (auto simp add: fresh_star_def frameResChainFresh)
        hence "⦇ν*xvec⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert (Ψ⇩P' ⊗ Ψ⇩Q'))) = ⦇ν*(p ∙ xvec)⦈(⦇ν*(A⇩P'@A⇩Q')⦈(FAssert((p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q'))))"
          using ‹A⇩P' ♯* xvec› ‹(p ∙ xvec) ♯* A⇩P'› ‹A⇩Q' ♯* xvec› ‹A⇩Q' ♯* (p ∙ xvec)› S
          by(fastforce simp add: eqvts)
        ultimately show ?thesis
          by(simp add: frameChainAppend)
      qed
          
      moreover have "(Ψ⇩P ⊗ Ψ⇩Q) ⊗ ((p ∙ Ψ') ⊗ (p ∙ Ψ'')) ≃ (p ∙ Ψ⇩P') ⊗ (p ∙ Ψ⇩Q')"
      proof -
        have "((p ∙ Ψ⇩P) ⊗ Ψ⇩Q) ⊗ (Ψ' ⊗ Ψ'') ≃ ((p ∙ Ψ⇩P) ⊗ Ψ') ⊗ (Ψ⇩Q ⊗ Ψ'')"
          by(metis Associativity Commutativity Composition AssertionStatEqTrans)
        moreover from PeqP' QeqQ' have "((p ∙ Ψ⇩P) ⊗ Ψ') ⊗ (Ψ⇩Q ⊗ Ψ'') ≃ Ψ⇩P' ⊗ Ψ⇩Q'"
          by(metis Associativity Commutativity Composition AssertionStatEqTrans)
        ultimately have "((p ∙ Ψ⇩P) ⊗ Ψ⇩Q) ⊗ (Ψ' ⊗ Ψ'') ≃ Ψ⇩P' ⊗ Ψ⇩Q'"
          by(metis AssertionStatEqTrans)
        hence "(p ∙ ((p ∙ Ψ⇩P) ⊗ Ψ⇩Q) ⊗ (Ψ' ⊗ Ψ'')) ≃ (p ∙ (Ψ⇩P' ⊗ Ψ⇩Q'))"
          by(rule AssertionStatEqClosed)
        with ‹xvec ♯* Ψ⇩Q› ‹(p ∙ xvec) ♯* Ψ⇩Q› S ‹distinctPerm p› show ?thesis
          by(simp add: eqvts)
      qed

      moreover from ‹(p ∙ xvec) ♯* C› ‹A⇩P' ♯* C› ‹A⇩Q' ♯* C› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* C" by simp
      moreover from ‹(p ∙ xvec) ♯* X› ‹A⇩P' ♯* X› ‹A⇩Q' ♯* X› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* X" by simp
      moreover from ‹(p ∙ xvec) ♯* Y› ‹A⇩P' ♯* Y› ‹A⇩Q' ♯* Y› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* Y" by simp
      moreover from ‹(p ∙ xvec) ♯* Z› ‹A⇩P' ♯* Z› ‹A⇩Q' ♯* Z› have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* Z" by simp
      moreover from ‹(p ∙ xvec) ♯* P'› ‹(p ∙ xvec) ♯* Q'› ‹A⇩P' ♯* P'› ‹A⇩P' ♯* Q' ›‹A⇩Q' ♯* P'› ‹A⇩Q' ♯* Q'›
      have "((p ∙ xvec)@A⇩P'@A⇩Q') ♯* (⦇ν*xvec⦈(P' ∥ Q'))" by(auto simp add: resChainFresh fresh_star_def)
      moreover from ‹(p ∙ xvec) ♯* A⇩P'› ‹ A⇩Q' ♯* (p ∙ xvec)› ‹A⇩Q' ♯* A⇩P'› ‹distinct xvec› ‹distinct A⇩P'› ‹distinct A⇩Q'›
       have "distinct((p ∙ xvec)@A⇩P'@A⇩Q')"
         by auto (simp add: name_list_supp fresh_star_def fresh_def)+

      ultimately show ?case using cComm2 by metis
    next
      case(cScope Ψ P P' x A⇩P Ψ⇩P C X Y Z)
      then obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "distinct A⇩P'"
                                and "Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'" and "A⇩P' ♯* C" and "A⇩P' ♯* P'"
                                and "A⇩P' ♯* (x#X)" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z" 
        by(rule_tac cScope(4)[where ba="x#X"]) auto
      from ‹A⇩P' ♯* (x#X)› have "x ♯ A⇩P'" and "A⇩P' ♯* X" by simp+
      moreover from FrP' have "extractFrame(⦇νx⦈P') = ⟨(x#A⇩P'), Ψ⇩P'⟩" by simp
      moreover note ‹Ψ⇩P ⊗ Ψ' ≃ Ψ⇩P'›
      moreover from ‹x ♯ C› ‹A⇩P' ♯* C› have "(x#A⇩P') ♯* C" by simp
      moreover from  ‹A⇩P' ♯* P'› have "(x#A⇩P') ♯* (⦇νx⦈P')" by(simp add: abs_fresh fresh_star_def)
      moreover from ‹x ♯ X› ‹A⇩P' ♯* X› have "(x#A⇩P') ♯* X" by simp
      moreover from ‹x ♯ Y› ‹A⇩P' ♯* Y› have "(x#A⇩P') ♯* Y" by simp
      moreover from ‹x ♯ Z› ‹A⇩P' ♯* Z› have "(x#A⇩P') ♯* Z" by simp
      moreover from ‹x ♯ A⇩P'› ‹distinct A⇩P'› have "distinct(x#A⇩P')" by simp
      ultimately show ?case by(rule_tac cScope)
    next
      case(cBang Ψ P P' A⇩P Ψ⇩P C B Y Z)
      then obtain Ψ' A⇩P' Ψ⇩P' where FrP': "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" 
                                and "(Ψ⇩P ⊗ 𝟭) ⊗ Ψ' ≃ Ψ⇩P'"
                                and "A⇩P' ♯* C" and "A⇩P' ♯* P'" and "distinct A⇩P'"
                                and "A⇩P' ♯* B" and "A⇩P' ♯* Y" and "A⇩P' ♯* Z"
        by(rule_tac cBang) (assumption | simp)+
      with ‹Ψ⇩P ≃ 𝟭› ‹(Ψ⇩P ⊗ 𝟭) ⊗ Ψ' ≃ Ψ⇩P'› have "𝟭 ⊗ Ψ' ≃ Ψ⇩P'"
        by(metis Identity AssertionStatEqTrans composition' Commutativity Associativity AssertionStatEqSym)
      thus ?case using FrP' ‹A⇩P' ♯* P'› ‹A⇩P' ♯* C› ‹A⇩P' ♯* B› ‹A⇩P' ♯* Y› ‹A⇩P' ♯* Z› ‹distinct A⇩P'›
        by(rule_tac cBang)
    qed
    with A have ?thesis by simp
  }
  moreover have "A⇩P ♯* ([]::name list)" and "A⇩P ♯* ([]::'b list)" and "A⇩P ♯* ([]::('a, 'b, 'c) psi list)" by simp+
  ultimately show ?thesis by blast
qed

lemma expandFrame:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α   :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P  :: 'b
  and   C    :: "'d::fs_name"
  and   C'   :: "'e::fs_name"
  
  assumes Trans: "Ψ ⊳ P ⟼α ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "bn α ♯* subject α"
  and     "distinct(bn α)"
  and     "A⇩P ♯* α"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* C"
  and     "A⇩P ♯* C'"
  and     "bn α ♯* P"
  and     "bn α ♯* C'"

  obtains p Ψ' A⇩P' Ψ⇩P' where "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "(p ∙ Ψ⇩P) ⊗ Ψ' ≃ Ψ⇩P'" and "distinctPerm p" and
                              "extractFrame P' = ⟨A⇩P', Ψ⇩P'⟩" and "A⇩P' ♯* P'" and "A⇩P' ♯* α" and "A⇩P' ♯* (p ∙ α)" and
                              "A⇩P' ♯* C" and "(bn(p ∙ α)) ♯* C'" and "(bn(p ∙ α)) ♯* α" and "(bn(p ∙ α)) ♯* P'" and "distinct A⇩P'"
using assms
apply(cases "α=τ")
by(auto intro: expandTauFrame[where C=C] expandNonTauFrame[where C=C and C'=C'])

abbreviation
  frameImpJudge ("_ ↪⇩F _" [80, 80] 80)
  where "F ↪⇩F G ≡ FrameStatImp F G"

lemma FrameStatEqImpCompose:
  fixes F :: "'b frame"
  and   G :: "'b frame"
  and   H :: "'b frame"
  and   I :: "'b frame"

  assumes "F ≃⇩F G"
  and     "G ↪⇩F H"
  and     "H ≃⇩F I"

  shows "F ↪⇩F I"
using assms
by(auto simp add: FrameStatEq_def) (blast intro: FrameStatImpTrans)

lemma transferNonTauFrame:
  fixes Ψ⇩F  :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩F   :: "name list"
  and   A⇩G   :: "name list"
  and   Ψ⇩G   :: 'b

  assumes "Ψ⇩F ⊳ P ⟼α ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "distinct(bn α)"
  and     "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
  and     "A⇩F ♯* P"
  and     "A⇩G ♯* P"
  and     "A⇩F ♯* subject α"
  and     "A⇩G ♯* subject α"
  and     "A⇩P ♯* A⇩F"
  and     "A⇩P ♯* A⇩G"
  and     "A⇩P ♯* Ψ⇩F"
  and     "A⇩P ♯* Ψ⇩G"
  and     "α ≠ τ"

  shows "Ψ⇩G ⊳ P ⟼α ≺ P'"
using assms
proof(nominal_induct Ψ⇩F P Rs=="α ≺ P'" A⇩P Ψ⇩P avoiding: α P' Ψ⇩G A⇩F A⇩G rule: semanticsFrameInduct)
  case(cAlpha Ψ⇩F P A⇩P Ψ⇩P p α P' Ψ⇩G A⇩F A⇩G)
  from ‹⟨A⇩F, Ψ⇩F ⊗ (p ∙ Ψ⇩P)⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ (p ∙ Ψ⇩P)⟩›
  have "(p ∙ (⟨A⇩F, Ψ⇩F ⊗ (p ∙ Ψ⇩P)⟩)) ↪⇩F (p ∙ (⟨A⇩G, Ψ⇩G ⊗ (p ∙ Ψ⇩P)⟩))"
    by(rule FrameStatImpClosed)
  with ‹A⇩P ♯* A⇩F› ‹(p ∙ A⇩P) ♯* A⇩F› ‹A⇩P ♯* Ψ⇩F› ‹(p ∙ A⇩P) ♯* Ψ⇩F› ‹A⇩P ♯* A⇩G› ‹(p ∙ A⇩P) ♯* A⇩G› ‹A⇩P ♯* Ψ⇩G› ‹(p ∙ A⇩P) ♯* Ψ⇩G›
    ‹distinctPerm p› ‹set p ⊆ set A⇩P × set (p ∙ A⇩P)› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(simp add: eqvts)
  with cAlpha show ?case by force
next
  case(cInput Ψ⇩F M K xvec N Tvec P α P' Ψ⇩G A⇩F A⇩G)
  from cInput have "A⇩F ♯* K" and "A⇩G ♯* K" by(auto simp add: residualInject)

  from ‹A⇩F ♯* (M⦇λ*xvec N⦈.P)› ‹A⇩G ♯* (M⦇λ*xvec N⦈.P)› have "A⇩F ♯* M" and "A⇩G ♯* M" by simp+
  from ‹Ψ⇩F ⊢ M ↔ K›
  have "Ψ⇩F ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity AssertionStatEqSym)
  with ‹A⇩F ♯* M› ‹A⇩F ♯* K›
  have "(⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩) ⊢⇩F M ↔ K"
    by(force intro: frameImpI)
  with ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  have "(⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩) ⊢⇩F M ↔ K"
    by(simp add: FrameStatEq_def FrameStatImp_def)
  with ‹A⇩G ♯* M› ‹A⇩G ♯* K›
  have "Ψ⇩G ⊗ 𝟭 ⊢ M ↔ K" by(force dest: frameImpE)
  hence "Ψ⇩G ⊢ M ↔ K" by(blast intro: statEqEnt Identity)
  thus ?case using ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec› using cInput Input
    by(force simp add: residualInject)
next
  case(cOutput Ψ⇩F M K N P α P' Ψ⇩G A⇩F A⇩G)
  from cOutput have "A⇩F ♯* K" and "A⇩G ♯* K" by(auto simp add: residualInject)

  from ‹A⇩F ♯* (M⟨N⟩.P)› ‹A⇩G ♯* (M⟨N⟩.P)› have "A⇩F ♯* M" and "A⇩G ♯* M" by simp+
  from ‹Ψ⇩F ⊢ M ↔ K›
  have "Ψ⇩F ⊗ 𝟭 ⊢ M ↔ K"
    by(blast intro: statEqEnt Identity AssertionStatEqSym)
  with ‹A⇩F ♯* M› ‹A⇩F ♯* K›
  have "(⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩) ⊢⇩F M ↔ K"
    by(force intro: frameImpI)
  with ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  have "(⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩) ⊢⇩F M ↔ K"
    by(simp add: FrameStatImp_def) 
  with ‹A⇩G ♯* M› ‹A⇩G ♯* K›
  have "Ψ⇩G ⊗ 𝟭 ⊢ M ↔ K" by(force dest: frameImpE)
  hence "Ψ⇩G ⊢ M ↔ K" by(blast intro: statEqEnt Identity) 
  thus ?case using cOutput Output by(force simp add: residualInject) 
next
  case(cCase Ψ⇩F P φ Cs A⇩P Ψ⇩P α P' Ψ⇩G A⇩F A⇩G)
  from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  moreover from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩ ≃⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
  ultimately have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(rule FrameStatEqImpCompose)
  with cCase have "Ψ⇩G ⊳ P ⟼ α ≺ P'" by(fastforce dest: memFreshChain)
  moreover note ‹(φ, P) mem Cs› 
  moreover from ‹A⇩F ♯* (Cases Cs)›‹A⇩G ♯* (Cases Cs)› ‹(φ, P) mem Cs› have "A⇩F ♯* φ" and "A⇩G ♯* φ"
    by(auto dest: memFreshChain)
  from ‹Ψ⇩F ⊢ φ› have "Ψ⇩F ⊗ 𝟭 ⊢ φ" by(blast intro: statEqEnt Identity AssertionStatEqSym)
  with ‹A⇩F ♯* φ› have "(⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩) ⊢⇩F φ" by(force intro: frameImpI)
  with ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩› have "(⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩) ⊢⇩F φ"
    by(simp add: FrameStatImp_def)
  with ‹A⇩G ♯* φ› have "Ψ⇩G ⊗ 𝟭 ⊢ φ" by(force dest: frameImpE)
  hence "Ψ⇩G ⊢ φ" by(blast intro: statEqEnt Identity)
  ultimately show ?case using ‹guarded P› cCase Case by(force intro: residualInject)
next
  case(cPar1 Ψ⇩F Ψ⇩Q P α P' A⇩Q Q A⇩P Ψ⇩P α' PQ' Ψ⇩G A⇩F A⇩G)
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
    by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩›
  moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ "
    by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
  ultimately have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩"
    by(rule FrameStatEqImpCompose)
  moreover from ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› FrQ ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› have "A⇩F ♯* Ψ⇩Q" and  "A⇩G ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  moreover note ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩F ♯* subject α'› ‹A⇩G ♯* subject α'› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩G›
  moreover from ‹α ≺ P' ∥ Q = α' ≺ PQ'› ‹bn α ♯* α'› 
  obtain p P'' where "α ≺ P' = α' ≺ P''" and "set p ⊆ set(bn α') × set(bn α)" and "PQ' = P'' ∥ (p ∙ Q)"
    apply(drule_tac sym)
    by(rule_tac actionPar1Dest) (assumption | simp | blast dest: sym)+
  ultimately have  "Ψ⇩G ⊗ Ψ⇩Q ⊳ P ⟼α ≺ P'" using ‹α' ≠ τ› by(force intro: cPar1)
  thus ?case using FrQ ‹(bn α) ♯* Q› ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* P› ‹A⇩Q ♯* α› using cPar1
    by(metis Par1)
next
  case(cPar2 Ψ⇩F Ψ⇩P Q α Q' A⇩P P A⇩Q Ψ⇩Q α' PQ' Ψ⇩G A⇩F A⇩G)
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
    by(metis Associativity frameResChainPres frameNilStatEq)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩›
  moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ "
    by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
  ultimately have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩"
    by(rule FrameStatEqImpCompose)
  moreover from ‹A⇩F ♯* P› ‹A⇩G ♯* P› FrP ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› have "A⇩F ♯* Ψ⇩P" and  "A⇩G ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)+
  moreover note ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩F ♯* subject α'› ‹A⇩G ♯* subject α'› ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩G›
  moreover from ‹α ≺ P ∥ Q' = α' ≺ PQ'› ‹bn α ♯* α'› 
  obtain p Q'' where "α ≺ Q' = α' ≺ Q''" and "set p ⊆ set(bn α') × set(bn α)" and "PQ' = (p ∙ P) ∥ Q''"
    apply(drule_tac sym)
    by(rule_tac actionPar2Dest) (assumption | simp | blast dest: sym)+
  ultimately have  "Ψ⇩G ⊗ Ψ⇩P ⊳ Q ⟼α ≺ Q'" using ‹α' ≠ τ› by(force intro: cPar2)
  thus ?case using FrP ‹(bn α) ♯* P› ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* Q› ‹A⇩P ♯* α› using cPar2
    by(metis Par2)
next
  case cComm1
  thus ?case by(simp add: residualInject)
next
  case cComm2
  thus ?case by(simp add: residualInject)
next
  case(cOpen Ψ⇩F P M xvec yvec N P' x A⇩P Ψ⇩P α P'' Ψ⇩G A⇩F A⇩G)
  from ‹M⦇ν*(xvec @ x # yvec)⦈⟨N⟩ ≺ P' = α ≺ P''› ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ α› ‹x ♯ P''› ‹distinct(bn α)›
  obtain xvec' x' yvec' N' where "M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P' =  M⦇ν*(xvec'@yvec')⦈⟨([(x, x')] ∙ N')⟩ ≺ ([(x, x')] ∙ P'')" 
                             and "α = M⦇ν*(xvec'@x'#yvec')⦈⟨N'⟩"
    apply(cases rule: actionCases[where α=α])
    apply(auto simp add: residualInject)
    apply(rule boundOutputOpenDest) by assumption auto

  then have "Ψ⇩G ⊳ P ⟼M⦇ν*(xvec@yvec)⦈⟨N⟩ ≺ P'" using cOpen
    by(rule_tac cOpen) (assumption | simp)+
  with ‹x ∈ supp N› ‹x ♯ Ψ⇩G› ‹x ♯ M› ‹x ♯ xvec› ‹x ♯ yvec›
  have "Ψ⇩G ⊳ ⦇νx⦈P ⟼M⦇ν*(xvec@x#yvec)⦈⟨N⟩ ≺ P'" 
    by(rule_tac Open)
  thus ?case using ‹α = M⦇ν*(xvec'@x'#yvec')⦈⟨N'⟩› ‹M⦇ν*(xvec @ x # yvec)⦈⟨N⟩ ≺ P' = α ≺ P''›
    by simp
next
  case(cScope Ψ⇩F P α P' x A⇩P Ψ⇩P α' xP Ψ⇩G A⇩F A⇩G)
  from ‹α ≺ ⦇νx⦈P' = α' ≺ xP› ‹x ♯ α› ‹x ♯ α'› obtain P'' where "xP = ⦇νx⦈P''" and "α ≺ P' = α' ≺ P''"
    by(drule_tac sym) (force intro: actionScopeDest)
  then have "Ψ⇩G ⊳ P ⟼α ≺ P'" using cScope by auto
  with ‹x ♯ Ψ⇩G› ‹x ♯ α'› ‹α ≺ P' = α' ≺ P''› ‹xP = ⦇νx⦈P''› show ?case
    by(metis Scope)
next
  case(cBang Ψ⇩F P A⇩P Ψ⇩P α P' Ψ⇩G A⇩F A⇩G)
  from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ 𝟭⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  moreover from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩ ≃⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
  ultimately have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ 𝟭⟩"
    by(rule FrameStatEqImpCompose)
  with cBang have "Ψ⇩G ⊳ P ∥ !P ⟼ α ≺ P'" by force
  thus ?case using ‹guarded P› using cBang by(metis Bang)
qed

lemma transferTauFrame:
  fixes Ψ⇩F  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩F   :: "name list"
  and   A⇩G   :: "name list"
  and   Ψ⇩G   :: 'b

  assumes "Ψ⇩F ⊳ P ⟼τ ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
  and     "A⇩F ♯* P"
  and     "A⇩G ♯* P"
  and     "A⇩P ♯* A⇩F"
  and     "A⇩P ♯* A⇩G"
  and     "A⇩P ♯* Ψ⇩F"
  and     "A⇩P ♯* Ψ⇩G"

  shows "Ψ⇩G ⊳ P ⟼τ ≺ P'"
using assms
proof(nominal_induct avoiding: Ψ⇩G A⇩F A⇩G rule: tauFrameInduct)
  case(cAlpha Ψ⇩F P P' A⇩P Ψ⇩P p Ψ⇩G A⇩F A⇩G)
  from ‹⟨A⇩F, Ψ⇩F ⊗ (p ∙ Ψ⇩P)⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ (p ∙ Ψ⇩P)⟩›
  have "(p ∙ (⟨A⇩F, Ψ⇩F ⊗ (p ∙ Ψ⇩P)⟩)) ↪⇩F (p ∙ (⟨A⇩G, Ψ⇩G ⊗ (p ∙ Ψ⇩P)⟩))"
    by(rule FrameStatImpClosed)
  with ‹A⇩P ♯* A⇩F› ‹(p ∙ A⇩P) ♯* A⇩F› ‹A⇩P ♯* Ψ⇩F› ‹(p ∙ A⇩P) ♯* Ψ⇩F› ‹A⇩P ♯* A⇩G› ‹(p ∙ A⇩P) ♯* A⇩G› ‹A⇩P ♯* Ψ⇩G› ‹(p ∙ A⇩P) ♯* Ψ⇩G›
    ‹distinctPerm p› ‹set p ⊆ set A⇩P × set (p ∙ A⇩P)› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(simp add: eqvts)
  with cAlpha show ?case by blast
next
  case(cCase Ψ⇩F P P' φ Cs A⇩P Ψ⇩P Ψ⇩G A⇩F A⇩G)
  from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  moreover from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩ ≃⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
  ultimately have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
    by(rule FrameStatEqImpCompose)
  with cCase have "Ψ⇩G ⊳ P ⟼τ ≺ P'" by(fastforce dest: memFreshChain)
  moreover note ‹(φ, P) mem Cs› 
  moreover from ‹A⇩F ♯* (Cases Cs)›‹A⇩G ♯* (Cases Cs)› ‹(φ, P) mem Cs› have "A⇩F ♯* φ" and "A⇩G ♯* φ"
    by(auto dest: memFreshChain)
  from ‹Ψ⇩F ⊢ φ› have "Ψ⇩F ⊗ 𝟭 ⊢ φ" by(blast intro: statEqEnt Identity AssertionStatEqSym)
  with ‹A⇩F ♯* φ› have "(⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩) ⊢⇩F φ" by(force intro: frameImpI)
  with ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩› have "(⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩) ⊢⇩F φ"
    by(simp add: FrameStatImp_def)
  with ‹A⇩G ♯* φ› have "Ψ⇩G ⊗ 𝟭 ⊢ φ" by(force dest: frameImpE)
  hence "Ψ⇩G ⊢ φ" by(blast intro: statEqEnt Identity)
  ultimately show ?case using ‹guarded P› by(rule Case)
next
  case(cPar1 Ψ⇩F Ψ⇩Q P P' A⇩Q Q A⇩P Ψ⇩P Ψ⇩G A⇩F A⇩G)
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have IH: "⋀Ψ A⇩F A⇩G. ⟦⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ ⊗ Ψ⇩P⟩; A⇩F ♯* P; A⇩G ♯* P;
                           A⇩P ♯* A⇩F; A⇩P ♯* A⇩G; A⇩P ♯* (Ψ⇩F ⊗ Ψ⇩Q); A⇩P ♯* Ψ⟧ ⟹ Ψ ⊳ P ⟼τ ≺ P'"
    by fact
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
    by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩›
  moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ "
    by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
  ultimately have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩"
    by(rule FrameStatEqImpCompose)
  moreover from ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› FrQ ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› have "A⇩F ♯* Ψ⇩Q" and  "A⇩G ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  moreover note ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩G›
  ultimately have  "Ψ⇩G ⊗ Ψ⇩Q ⊳ P ⟼τ ≺ P'" by(rule_tac IH) (assumption | auto)+
  thus ?case using FrQ ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* P›
    by(rule_tac Par1) auto
next
  case(cPar2 Ψ⇩F Ψ⇩P Q Q' A⇩P P A⇩Q Ψ⇩Q Ψ⇩G A⇩F A⇩G)
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have IH: "⋀Ψ A⇩F A⇩G. ⟦⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ ⊗ Ψ⇩Q⟩; A⇩F ♯* Q; A⇩G ♯* Q;
                           A⇩Q ♯* A⇩F; A⇩Q ♯* A⇩G; A⇩Q ♯* (Ψ⇩F ⊗ Ψ⇩P); A⇩Q ♯* Ψ⟧ ⟹ Ψ ⊳ Q ⟼τ ≺ Q'"
    by fact
  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
    by(metis Associativity frameResChainPres frameNilStatEq)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩›
  moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ "
    by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
  ultimately have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩"
    by(rule FrameStatEqImpCompose)
  moreover from ‹A⇩F ♯* P› ‹A⇩G ♯* P› FrP ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› have "A⇩F ♯* Ψ⇩P" and  "A⇩G ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)+
  moreover note ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩G›
  ultimately have  "Ψ⇩G ⊗ Ψ⇩P ⊳ Q ⟼τ ≺ Q'" by(rule_tac IH) (assumption | auto)+
  thus ?case using FrP ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* Q›
    by(rule_tac Par2) auto
next
  case(cComm1 Ψ⇩F Ψ⇩Q P M N P' A⇩P Ψ⇩P Q K xvec Q' A⇩Q Ψ⇩G A⇩F A⇩G)
  have FimpG: "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩" by fact
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  from ‹A⇩F ♯* P› ‹A⇩G ♯* P› FrP ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› have "A⇩F ♯* Ψ⇩P" and  "A⇩G ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)+
  from ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› FrQ ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› have "A⇩F ♯* Ψ⇩Q" and  "A⇩G ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  from ‹Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› FrQ ‹distinct A⇩Q› 
  obtain K' where KeqK': "(Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ K'" and "A⇩P ♯* K'" and "A⇩F ♯* K'" and "A⇩G ♯* K'" 
    using ‹A⇩P ♯* Q› ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩P ♯* A⇩Q› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹xvec ♯* K› ‹distinct xvec›
    by(rule_tac B="A⇩P@A⇩F@A⇩G" in obtainPrefix) force+
  have "Ψ⇩G ⊗ Ψ⇩Q ⊳ P ⟼K'⦇N⦈ ≺ P'"
  proof -
    from KeqK' have "Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ K ↔ K'" by(rule statEqEnt[OF Associativity])
    with ‹Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K› have "Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K'"
      by(rule chanEqTrans)
    hence "(Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K'"
      by(metis statEqEnt AssertionStatEqSym Associativity AssertionStatEqTrans compositionSym Commutativity)
    with ‹Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› FrP ‹distinct A⇩P›
    have "Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼K'⦇N⦈ ≺ P'" using ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K'›
      by(force intro: inputRenameSubject)
    moreover have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩"
    proof -
      have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
        by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
      moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ "
        by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
      ultimately show ?thesis using FimpG
        by(rule_tac FrameStatEqImpCompose)
    qed
    ultimately show ?thesis using ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩F ♯* K'›
                                  ‹A⇩G ♯* K'› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* Ψ⇩Q› FrP ‹distinct A⇩P›
      by(auto intro: transferNonTauFrame)
  qed
  
  moreover from FrP ‹Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› ‹distinct A⇩P›
  obtain M' where MeqM': "(Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ M'" and "A⇩Q ♯* M'" and "A⇩F ♯* M'" and "A⇩G ♯* M'"
    using ‹A⇩Q ♯* P› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M›
    by(rule_tac B="A⇩Q@A⇩F@A⇩G" in obtainPrefix) force+

  have "Ψ⇩G ⊗ Ψ⇩P ⊳ Q ⟼M'⦇ν*xvec⦈⟨N⟩ ≺ Q'"
  proof -
    from MeqM' have "Ψ⇩F ⊗ (Ψ⇩Q ⊗ Ψ⇩P) ⊢ M ↔ M'" by(rule statEqEnt[OF Associativity])
    with ‹Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K› have "Ψ⇩F ⊗ (Ψ⇩Q ⊗ Ψ⇩P) ⊢ K ↔ M'"
      by(blast intro: chanEqTrans chanEqSym compositionSym Commutativity statEqEnt)
    hence "(Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ M'"
      by(blast intro: statEqEnt AssertionStatEqSym Associativity
                      AssertionStatEqTrans compositionSym Commutativity)
    with ‹Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼K⦇ν*xvec⦈⟨N⟩ ≺ Q'› FrQ ‹distinct A⇩Q› 
    have "Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼M'⦇ν*xvec⦈⟨N⟩ ≺ Q'" using ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩Q ♯* M'›
      by(force intro: outputRenameSubject)
    moreover have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩"
    proof -
      have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
        by(metis Associativity frameResChainPres frameNilStatEq)
      moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ "
        by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
      ultimately show ?thesis using FimpG
        by(rule_tac FrameStatEqImpCompose)
    qed

    ultimately show ?thesis using ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩F ♯* M'› ‹A⇩G ♯* M'›
                                  ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* Ψ⇩P› FrQ ‹distinct A⇩Q› ‹distinct xvec› 
      by(auto intro: transferNonTauFrame)
  qed

  moreover have "Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'"
  proof -
    from MeqM' have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M' ↔ M"
      by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
    moreover from KeqK' have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K ↔ K'"
      by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
    ultimately have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'" using ‹Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K›
      by(blast intro: chanEqSym chanEqTrans)
    thus ?thesis using ‹A⇩F ♯* M'› ‹A⇩F ♯* K'› ‹A⇩G ♯* M'› ‹A⇩G ♯* K'› FimpG
      apply(auto simp add: FrameStatImp_def)
      apply(erule_tac x="SChanEq' K' M'" in allE)
      by(force intro: frameImpI dest: frameImpE)
  qed

  ultimately show ?case using ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* K'› ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M'› ‹xvec ♯* P› FrP FrQ
   by(rule_tac Comm1) (assumption | simp)+
next
  case(cComm2 Ψ⇩F Ψ⇩Q P M xvec N P' A⇩P Ψ⇩P Q K Q' A⇩Q Ψ⇩G A⇩F A⇩G)
  have FimpG: "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩" by fact
  from ‹A⇩F ♯* (P ∥ Q)› ‹A⇩G ♯* (P ∥ Q)› have "A⇩F ♯* P" and "A⇩G ♯* P" and "A⇩F ♯* Q" and "A⇩G ♯* Q"
    by simp+
  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact
  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact
  from ‹A⇩F ♯* P› ‹A⇩G ♯* P› FrP ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› have "A⇩F ♯* Ψ⇩P" and  "A⇩G ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)+
  from ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› FrQ ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› have "A⇩F ♯* Ψ⇩Q" and  "A⇩G ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  from ‹Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› FrQ ‹distinct A⇩Q›  
  obtain K' where KeqK': "(Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ K'" and "A⇩P ♯* K'" and "A⇩F ♯* K'" and "A⇩G ♯* K'"
    using ‹A⇩P ♯* Q› ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩P ♯* A⇩Q› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K›
    by(rule_tac B="A⇩P@A⇩F@A⇩G" in obtainPrefix) force+
  have "Ψ⇩G ⊗ Ψ⇩Q ⊳ P ⟼K'⦇ν*xvec⦈⟨N⟩ ≺ P'"
  proof -
    from KeqK' have "Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ K ↔ K'" by(rule statEqEnt[OF Associativity])
    with ‹Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K› have "Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K'"
      by(rule chanEqTrans)
    hence "(Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ K'"
      by(metis statEqEnt AssertionStatEqSym Associativity AssertionStatEqTrans compositionSym Commutativity)
    with ‹Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› FrP ‹distinct A⇩P› 
    have "Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼K'⦇ν*xvec⦈⟨N⟩ ≺ P'" using ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* K'›
      by(force intro: outputRenameSubject)
    moreover have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩"
    proof -
      have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
        by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
      moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩Q) ⊗ Ψ⇩P⟩ "
        by(metis Associativity Composition AssertionStatEqSym AssertionStatEqTrans Commutativity frameResChainPres frameNilStatEq)
      ultimately show ?thesis using FimpG
        by(rule_tac FrameStatEqImpCompose)
    qed
    ultimately show ?thesis using  ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩F ♯* K'›
                                  ‹A⇩G ♯* K'› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* Ψ⇩Q› FrP ‹distinct A⇩P›
                                  ‹distinct xvec›
      by(auto intro: transferNonTauFrame)
  qed

  moreover from FrP ‹Ψ⇩F ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹distinct A⇩P› 
  obtain M' where MeqM': "(Ψ⇩F ⊗ Ψ⇩Q) ⊗ Ψ⇩P ⊢ M ↔ M'" and "A⇩Q ♯* M'" and "A⇩F ♯* M'" and "A⇩G ♯* M'"
    using ‹A⇩Q ♯* P› ‹A⇩P ♯* A⇩F› ‹A⇩P ♯* A⇩G› ‹A⇩F ♯* P› ‹A⇩G ♯* P› ‹A⇩P ♯* Ψ⇩F› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹xvec ♯* M› ‹distinct xvec›
    by(rule_tac B="A⇩Q@A⇩F@A⇩G" in obtainPrefix) force+

  have "Ψ⇩G ⊗ Ψ⇩P ⊳ Q ⟼M'⦇N⦈ ≺ Q'"
  proof -
    from MeqM' have "Ψ⇩F ⊗ (Ψ⇩Q ⊗ Ψ⇩P) ⊢ M ↔ M'" by(rule statEqEnt[OF Associativity])
    with ‹Ψ⇩F ⊗ (Ψ⇩P ⊗ Ψ⇩Q) ⊢ M ↔ K› have "Ψ⇩F ⊗ (Ψ⇩Q ⊗ Ψ⇩P) ⊢ K ↔ M'"
      by(blast intro: chanEqTrans chanEqSym compositionSym Commutativity statEqEnt)
    hence "(Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q ⊢ K ↔ M'"
      by(blast intro: statEqEnt AssertionStatEqSym Associativity
                      AssertionStatEqTrans compositionSym Commutativity)
    with ‹Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼K⦇N⦈ ≺ Q'› FrQ ‹distinct A⇩Q› 
    have "Ψ⇩F ⊗ Ψ⇩P ⊳ Q ⟼M'⦇N⦈ ≺ Q'" using ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* K› ‹A⇩Q ♯* M'›
      by(force intro: inputRenameSubject)
    moreover have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ↪⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩"
    proof -
      have "⟨A⇩F, (Ψ⇩F ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩"
        by(metis Associativity frameResChainPres frameNilStatEq)
      moreover have "⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q⟩ ≃⇩F ⟨A⇩G, (Ψ⇩G ⊗ Ψ⇩P) ⊗ Ψ⇩Q⟩ "
        by(metis Associativity AssertionStatEqSym frameResChainPres frameNilStatEq)
      ultimately show ?thesis using FimpG
        by(rule_tac FrameStatEqImpCompose)
    qed

    ultimately show ?thesis using ‹A⇩F ♯* Q› ‹A⇩G ♯* Q› ‹A⇩F ♯* M'› ‹A⇩G ♯* M'›
                                  ‹A⇩Q ♯* A⇩F› ‹A⇩Q ♯* A⇩G› ‹A⇩Q ♯* Ψ⇩F› ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* Ψ⇩P› FrQ ‹distinct A⇩Q› ‹distinct xvec›
      by(auto intro: transferNonTauFrame)
  qed

  moreover have "Ψ⇩G ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'"
  proof -
    from MeqM' have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M' ↔ M"
      by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
    moreover from KeqK' have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K ↔ K'"
      by(blast intro: chanEqSym Associativity statEqEnt Commutativity compositionSym)
    ultimately have "Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ K' ↔ M'" using ‹Ψ⇩F ⊗ Ψ⇩P ⊗ Ψ⇩Q ⊢ M ↔ K›
      by(blast intro: chanEqSym chanEqTrans)
    thus ?thesis using ‹A⇩F ♯* M'› ‹A⇩F ♯* K'› ‹A⇩G ♯* M'› ‹A⇩G ♯* K'› FimpG
      apply(auto simp add: FrameStatImp_def)
      apply(erule_tac x="SChanEq' K' M'" in allE)
      by(force intro: frameImpI dest: frameImpE)
  qed

  ultimately show ?case using ‹A⇩P ♯* Ψ⇩G› ‹A⇩P ♯* P› ‹A⇩P ♯* Q› ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* K'› ‹A⇩Q ♯* Ψ⇩G› ‹A⇩Q ♯* P› ‹A⇩Q ♯* Q› ‹A⇩Q ♯* M'› ‹xvec ♯* Q› FrP FrQ
    by(rule_tac Comm2) (assumption | simp)+
next
  case(cScope Ψ⇩F P P' x A⇩P Ψ⇩P Ψ⇩G A⇩F A⇩G)
  then have "Ψ⇩G ⊳ P ⟼τ ≺ P'" by auto
  with ‹x ♯ Ψ⇩G› show ?case
    by(rule_tac Scope) auto
next
  case(cBang Ψ⇩F P P' A⇩P Ψ⇩P Ψ⇩G A⇩F A⇩G)
  from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ 𝟭⟩ ≃⇩F ⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans)
  moreover note ‹⟨A⇩F, Ψ⇩F ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩›
  moreover from ‹Ψ⇩P ≃ 𝟭› have "⟨A⇩G, Ψ⇩G ⊗ 𝟭⟩ ≃⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ 𝟭⟩"
    by(metis frameIntCompositionSym Identity AssertionStatEqTrans AssertionStatEqSym)
  ultimately have "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P ⊗ 𝟭⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P ⊗ 𝟭⟩"
    by(rule FrameStatEqImpCompose)
  with cBang have "Ψ⇩G ⊳ P ∥ !P ⟼τ ≺ P'" by force
  thus ?case using ‹guarded P› by(rule Bang)
qed

lemma transferFrame:
  fixes Ψ⇩F  :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩F   :: "name list"
  and   A⇩G   :: "name list"
  and   Ψ⇩G   :: 'b

  assumes "Ψ⇩F ⊳ P ⟼α ≺ P'"
  and     "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     "distinct A⇩P"
  and     "⟨A⇩F, Ψ⇩F ⊗ Ψ⇩P⟩ ↪⇩F ⟨A⇩G, Ψ⇩G ⊗ Ψ⇩P⟩"
  and     "A⇩F ♯* P"
  and     "A⇩G ♯* P"
  and     "A⇩F ♯* subject α"
  and     "A⇩G ♯* subject α"
  and     "A⇩P ♯* A⇩F"
  and     "A⇩P ♯* A⇩G"
  and     "A⇩P ♯* Ψ⇩F"
  and     "A⇩P ♯* Ψ⇩G"

  shows "Ψ⇩G ⊳ P ⟼α ≺ P'"
using assms
proof -
  from ‹Ψ⇩F ⊳ P ⟼α ≺ P'› have "distinct(bn α)" by(auto dest: boundOutputDistinct)
  thus ?thesis using assms
    by(cases "α = τ") (auto intro: transferNonTauFrame transferTauFrame)
qed

lemma parCasesInputFrame[consumes 7, case_names cPar1 cPar2]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   T    :: "('a, 'b, 'c) psi"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼M⦇N⦈ ≺ T"
  and     "extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
  and     "distinct A⇩P⇩Q"
  and     "A⇩P⇩Q ♯* Ψ"
  and     "A⇩P⇩Q ♯* P"
  and     "A⇩P⇩Q ♯* Q"
  and     "A⇩P⇩Q ♯* M"
  and     rPar1: "⋀P' A⇩P Ψ⇩P A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; 
                                      distinct A⇩P; distinct A⇩Q; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* M;  A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; 
                                      A⇩P ♯* Ψ⇩Q; A⇩Q ♯* Ψ⇩P; A⇩P ♯* A⇩Q; A⇩P⇩Q = A⇩P@A⇩Q; Ψ⇩P⇩Q = Ψ⇩P ⊗ Ψ⇩Q⟧ ⟹ Prop (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇N⦈ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; 
                                      distinct A⇩P; distinct A⇩Q; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* M;  A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; 
                                      A⇩P ♯* Ψ⇩Q; A⇩Q ♯* Ψ⇩P; A⇩P ♯* A⇩Q; A⇩P⇩Q = A⇩P@A⇩Q; Ψ⇩P⇩Q = Ψ⇩P ⊗ Ψ⇩Q⟧ ⟹ Prop (P ∥ Q')"
  shows "Prop T"
using Trans
proof(induct rule: parInputCases[of _ _ _ _ _ _ "(A⇩P⇩Q, Ψ⇩P⇩Q)"])
  case(cPar1 P' A⇩Q Ψ⇩Q)
  from ‹A⇩Q ♯* (A⇩P⇩Q, Ψ⇩P⇩Q)› have "A⇩Q ♯* A⇩P⇩Q" and "A⇩Q ♯* Ψ⇩P⇩Q" by simp+
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                           "A⇩P ♯* (P, Q, Ψ, M, A⇩Q, A⇩P⇩Q, Ψ⇩Q)"
    by(rule freshFrame)
  hence "A⇩P ♯* P" and "A⇩P ♯* Q" and "A⇩P ♯* Ψ" and "A⇩P ♯* M" and "A⇩P ♯* A⇩Q" and "A⇩P ♯* A⇩P⇩Q" and "A⇩P ♯* Ψ⇩Q"
    by simp+

  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact

  from ‹A⇩Q ♯* P› ‹A⇩P ♯* A⇩Q› FrP have "A⇩Q ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩" by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "set p ⊆ set(A⇩P@A⇩Q) × set((p ∙ A⇩P)@(p ∙ A⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = (p ∙ Ψ⇩P) ⊗ (p ∙ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = (p ∙ A⇩P)@(p ∙ A⇩Q)"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇N⦈ ≺ P'› S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P⇩Q ♯* M› ‹A⇩P ♯* M› ‹A⇩Q ♯* M› Aeq
  have "(p ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼M⦇N⦈ ≺ P'" 
    by(rule_tac inputPermFrame) auto
  with S ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› Aeq have "Ψ ⊗ (p ∙ Ψ⇩Q) ⊳ P ⟼M⦇N⦈ ≺ P'"  
    by(simp add: eqvts)
  moreover from FrP have "(p ∙ extractFrame P) = p ∙ ⟨A⇩P, Ψ⇩P⟩" by simp
  with S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› Aeq have "extractFrame P = ⟨(p ∙ A⇩P), p ∙ Ψ⇩P⟩"
    by(simp add: eqvts)
  moreover from FrQ have "(p ∙ extractFrame Q) = p ∙ ⟨A⇩Q, Ψ⇩Q⟩" by simp
  with S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› Aeq have "extractFrame Q = ⟨(p ∙ A⇩Q), p ∙ Ψ⇩Q⟩"
    by(simp add: eqvts)
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› have "distinct(p ∙ A⇩P)" and "distinct(p ∙ A⇩Q)"
    by simp+
  moreover from ‹A⇩P ♯* A⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ A⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩P ♯* Ψ⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ Ψ⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩Q ♯* Ψ⇩P› have "(p ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?case using ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P⇩Q ♯* P› ‹A⇩P⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› Aeq Ψeq
    by(rule_tac rPar1) (assumption | simp)+
next
  case(cPar2 Q' A⇩P Ψ⇩P)
  from ‹A⇩P ♯* (A⇩P⇩Q, Ψ⇩P⇩Q)› have "A⇩P ♯* A⇩P⇩Q" and "A⇩P ♯* Ψ⇩P⇩Q" by simp+
  obtain A⇩Q Ψ⇩Q where FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" and "distinct A⇩Q"
                           "A⇩Q ♯* (P, Q, Ψ, M, A⇩P, A⇩P⇩Q, Ψ⇩P)"
    by(rule freshFrame)
  hence "A⇩Q ♯* P" and "A⇩Q ♯* Q" and "A⇩Q ♯* Ψ" and "A⇩Q ♯* M" and "A⇩Q ♯* A⇩P" and "A⇩Q ♯* A⇩P⇩Q" and "A⇩Q ♯* Ψ⇩P"
    by simp+

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact

  from ‹A⇩P ♯* Q› ‹A⇩Q ♯* A⇩P› FrQ have "A⇩P ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain) 

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩Q ♯* A⇩P› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩" by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩Q ♯* A⇩P› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "set p ⊆ set(A⇩P@A⇩Q) × set((p ∙ A⇩P)@(p ∙ A⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = (p ∙ Ψ⇩P) ⊗ (p ∙ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = (p ∙ A⇩P)@(p ∙ A⇩Q)"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇N⦈ ≺ Q'› S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› ‹A⇩P ♯* M› ‹A⇩Q ♯* M› Aeq
  have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼M⦇N⦈ ≺ Q'" 
    by(rule_tac inputPermFrame) auto
  with S ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› Aeq have "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼M⦇N⦈ ≺ Q'"  
    by(simp add: eqvts)
  moreover from FrP have "(p ∙ extractFrame P) = p ∙ ⟨A⇩P, Ψ⇩P⟩" by simp
  with S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› Aeq have "extractFrame P = ⟨(p ∙ A⇩P), p ∙ Ψ⇩P⟩"
    by(simp add: eqvts)
  moreover from FrQ have "(p ∙ extractFrame Q) = p ∙ ⟨A⇩Q, Ψ⇩Q⟩" by simp
  with S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› Aeq have "extractFrame Q = ⟨(p ∙ A⇩Q), p ∙ Ψ⇩Q⟩"
    by(simp add: eqvts)
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› have "distinct(p ∙ A⇩P)" and "distinct(p ∙ A⇩Q)"
    by simp+
  moreover from ‹A⇩Q ♯* A⇩P› have "(p ∙ A⇩P) ♯* (p ∙ A⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩P ♯* Ψ⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ Ψ⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩Q ♯* Ψ⇩P› have "(p ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?case using ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P⇩Q ♯* P› ‹A⇩P⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› Aeq Ψeq
    by(rule_tac rPar2) (assumption | simp)+
qed

lemma parCasesOutputFrame[consumes 11, case_names cPar1 cPar2]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Q    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   T    :: "('a, 'b, 'c) psi"
  and   C    :: "'d::fs_name"

  assumes Trans: "Ψ ⊳ P ∥ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ T"
  and     "xvec ♯* Ψ"
  and     "xvec ♯* P"
  and     "xvec ♯* Q"
  and     "xvec ♯* M"
  and     "extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩"
  and     "distinct A⇩P⇩Q"
  and     "A⇩P⇩Q ♯* Ψ"
  and     "A⇩P⇩Q ♯* P"
  and     "A⇩P⇩Q ♯* Q"
  and     "A⇩P⇩Q ♯* M"
  and     rPar1: "⋀P' A⇩P Ψ⇩P A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; 
                                      distinct A⇩P; distinct A⇩Q; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* M;  A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; 
                                      A⇩P ♯* Ψ⇩Q; A⇩Q ♯* Ψ⇩P; A⇩P ♯* A⇩Q; A⇩P⇩Q = A⇩P@A⇩Q; Ψ⇩P⇩Q = Ψ⇩P ⊗ Ψ⇩Q⟧ ⟹ Prop (P' ∥ Q)"
  and     rPar2: "⋀Q' A⇩P Ψ⇩P A⇩Q Ψ⇩Q. ⟦Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'; extractFrame P = ⟨A⇩P, Ψ⇩P⟩; extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩; 
                                      distinct A⇩P; distinct A⇩Q; A⇩P ♯* Ψ; A⇩P ♯* P; A⇩P ♯* Q; A⇩P ♯* M;  A⇩Q ♯* Ψ; A⇩Q ♯* P; A⇩Q ♯* Q; A⇩Q ♯* M; 
                                      A⇩P ♯* Ψ⇩Q; A⇩Q ♯* Ψ⇩P; A⇩P ♯* A⇩Q; A⇩P⇩Q = A⇩P@A⇩Q; Ψ⇩P⇩Q = Ψ⇩P ⊗ Ψ⇩Q⟧ ⟹ Prop (P ∥ Q')"
  shows "Prop T"
using Trans ‹xvec ♯* Ψ› ‹xvec ♯* P› ‹xvec ♯* Q› ‹xvec ♯* M›
proof(induct rule: parOutputCases[of _ _ _ _ _ _ _ "(A⇩P⇩Q, Ψ⇩P⇩Q)"])
  case(cPar1 P' A⇩Q Ψ⇩Q)
  from ‹A⇩Q ♯* (A⇩P⇩Q, Ψ⇩P⇩Q)› have "A⇩Q ♯* A⇩P⇩Q" and "A⇩Q ♯* Ψ⇩P⇩Q" by simp+
  obtain A⇩P Ψ⇩P where FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" and "distinct A⇩P"
                           "A⇩P ♯* (P, Q, Ψ, M, A⇩Q, A⇩P⇩Q, Ψ⇩Q)"
    by(rule freshFrame)
  hence "A⇩P ♯* P" and "A⇩P ♯* Q" and "A⇩P ♯* Ψ" and "A⇩P ♯* M" and "A⇩P ♯* A⇩Q" and "A⇩P ♯* A⇩P⇩Q" and "A⇩P ♯* Ψ⇩Q"
    by simp+

  have FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" by fact

  from ‹A⇩Q ♯* P› ‹A⇩P ♯* A⇩Q› FrP have "A⇩Q ♯* Ψ⇩P"
    by(force dest: extractFrameFreshChain)

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩P ♯* A⇩Q› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩" by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩P ♯* A⇩Q› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "set p ⊆ set(A⇩P@A⇩Q) × set((p ∙ A⇩P)@(p ∙ A⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = (p ∙ Ψ⇩P) ⊗ (p ∙ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = (p ∙ A⇩P)@(p ∙ A⇩Q)"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  from ‹Ψ ⊗ Ψ⇩Q ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› ‹A⇩P⇩Q ♯* M› ‹A⇩P ♯* M› ‹A⇩Q ♯* M› Aeq
  have "(p ∙ (Ψ ⊗ Ψ⇩Q)) ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" 
    by(rule_tac outputPermFrame) (assumption | simp)+

  with S ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› Aeq have "Ψ ⊗ (p ∙ Ψ⇩Q) ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"  
    by(simp add: eqvts)
  moreover from FrP have "(p ∙ extractFrame P) = p ∙ ⟨A⇩P, Ψ⇩P⟩" by simp
  with S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› Aeq have "extractFrame P = ⟨(p ∙ A⇩P), p ∙ Ψ⇩P⟩"
    by(simp add: eqvts)
  moreover from FrQ have "(p ∙ extractFrame Q) = p ∙ ⟨A⇩Q, Ψ⇩Q⟩" by simp
  with S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› Aeq have "extractFrame Q = ⟨(p ∙ A⇩Q), p ∙ Ψ⇩Q⟩"
    by(simp add: eqvts)
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› have "distinct(p ∙ A⇩P)" and "distinct(p ∙ A⇩Q)"
    by simp+
  moreover from ‹A⇩P ♯* A⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ A⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩P ♯* Ψ⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ Ψ⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩Q ♯* Ψ⇩P› have "(p ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?case using ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P⇩Q ♯* P› ‹A⇩P⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› Aeq Ψeq
    by(rule_tac rPar1) (assumption | simp)+
next
  case(cPar2 Q' A⇩P Ψ⇩P)
  from ‹A⇩P ♯* (A⇩P⇩Q, Ψ⇩P⇩Q)› have "A⇩P ♯* A⇩P⇩Q" and "A⇩P ♯* Ψ⇩P⇩Q" by simp+
  obtain A⇩Q Ψ⇩Q where FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩" and "distinct A⇩Q"
                           "A⇩Q ♯* (P, Q, Ψ, M, A⇩P, A⇩P⇩Q, Ψ⇩P)"
    by(rule freshFrame)
  hence "A⇩Q ♯* P" and "A⇩Q ♯* Q" and "A⇩Q ♯* Ψ" and "A⇩Q ♯* M" and "A⇩Q ♯* A⇩P" and "A⇩Q ♯* A⇩P⇩Q" and "A⇩Q ♯* Ψ⇩P"
    by simp+

  have FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩" by fact

  from ‹A⇩P ♯* Q› ‹A⇩Q ♯* A⇩P› FrQ have "A⇩P ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain) 

  from ‹extractFrame(P ∥ Q) = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩› FrP FrQ ‹A⇩Q ♯* A⇩P› ‹A⇩P ♯* Ψ⇩Q› ‹A⇩Q ♯* Ψ⇩P›
  have "⟨(A⇩P@A⇩Q), Ψ⇩P ⊗ Ψ⇩Q⟩ = ⟨A⇩P⇩Q, Ψ⇩P⇩Q⟩" by simp
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› ‹A⇩Q ♯* A⇩P› have "distinct(A⇩P@A⇩Q)"
    by(auto simp add: fresh_star_def fresh_def name_list_supp)
  ultimately obtain p where S: "set p ⊆ set(A⇩P@A⇩Q) × set((p ∙ A⇩P)@(p ∙ A⇩Q))"  and "distinctPerm p"
                        and Ψeq: "Ψ⇩P⇩Q = (p ∙ Ψ⇩P) ⊗ (p ∙ Ψ⇩Q)" and Aeq: "A⇩P⇩Q = (p ∙ A⇩P)@(p ∙ A⇩Q)"
    using ‹A⇩P ♯* A⇩P⇩Q› ‹A⇩Q ♯* A⇩P⇩Q› ‹distinct A⇩P⇩Q›
    by(rule_tac frameChainEq') (assumption | simp add: eqvts)+

  from ‹Ψ ⊗ Ψ⇩P ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'› S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› ‹A⇩P ♯* M› ‹A⇩Q ♯* M› Aeq
  have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'" 
    by(rule_tac outputPermFrame) (assumption | simp)+
  with S ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P ♯* Ψ› ‹A⇩Q ♯* Ψ› Aeq have "Ψ ⊗ (p ∙ Ψ⇩P) ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ Q'"  
    by(simp add: eqvts)
  moreover from FrP have "(p ∙ extractFrame P) = p ∙ ⟨A⇩P, Ψ⇩P⟩" by simp
  with S ‹A⇩P⇩Q ♯* P› ‹A⇩P ♯* P› ‹A⇩Q ♯* P› Aeq have "extractFrame P = ⟨(p ∙ A⇩P), p ∙ Ψ⇩P⟩"
    by(simp add: eqvts)
  moreover from FrQ have "(p ∙ extractFrame Q) = p ∙ ⟨A⇩Q, Ψ⇩Q⟩" by simp
  with S ‹A⇩P⇩Q ♯* Q› ‹A⇩P ♯* Q› ‹A⇩Q ♯* Q› Aeq have "extractFrame Q = ⟨(p ∙ A⇩Q), p ∙ Ψ⇩Q⟩"
    by(simp add: eqvts)
  moreover from ‹distinct A⇩P› ‹distinct A⇩Q› have "distinct(p ∙ A⇩P)" and "distinct(p ∙ A⇩Q)"
    by simp+
  moreover from ‹A⇩Q ♯* A⇩P› have "(p ∙ A⇩P) ♯* (p ∙ A⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩P ♯* Ψ⇩Q› have "(p ∙ A⇩P) ♯* (p ∙ Ψ⇩Q)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  moreover from ‹A⇩Q ♯* Ψ⇩P› have "(p ∙ A⇩Q) ♯* (p ∙ Ψ⇩P)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?case using ‹A⇩P⇩Q ♯* Ψ› ‹A⇩P⇩Q ♯* P› ‹A⇩P⇩Q ♯* Q› ‹A⇩P⇩Q ♯* M› Aeq Ψeq
    by(rule_tac rPar2) (assumption | simp)+
qed

inductive bangPred :: "('a, 'b, 'c) psi ⇒ ('a, 'b, 'c) psi ⇒ bool"
where
  aux1: "bangPred P (!P)"
| aux2: "bangPred P (P ∥ !P)"

lemma bangInduct[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cBang]:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   Rs   :: "('a, 'b, 'c) residual"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒ ('a, 'b, 'c) residual ⇒ bool"
  and   C    :: 'd

  assumes "Ψ ⊳ !P ⟼ Rs"
  and     rPar1: "⋀α P' C. ⟦Ψ ⊳ P ⟼α ≺ P'; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹ Prop C Ψ (P ∥ !P) (α ≺ (P' ∥ !P))"
  and     rPar2: "⋀α P' C. ⟦Ψ ⊳ !P ⟼α ≺ P'; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α);
                             ⋀C. Prop C Ψ (!P) (α ≺ P')⟧ ⟹ Prop C Ψ (P ∥ !P) (α ≺ (P ∥ P'))"
  and     rComm1: "⋀M N P' K xvec P'' C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; Ψ ⊳ !P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇ν*xvec⦈⟨N⟩ ≺ P''); Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))"
  and     rComm2: "⋀M xvec N P' K P'' C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; Ψ ⊳ !P ⟼K⦇N⦈ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇N⦈ ≺ P''); Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))"
  and     rBang: "⋀Rs C. ⟦Ψ ⊳ P ∥ !P ⟼ Rs; ⋀C. Prop C Ψ (P ∥ !P) Rs; guarded P⟧ ⟹ Prop C Ψ (!P) Rs"
  shows "Prop C Ψ (!P) Rs"
proof -
  from ‹Ψ ⊳ !P ⟼ Rs› have "guarded P"
    by(nominal_induct Ψ P=="!P" Rs rule: semantics.strong_induct) (auto simp add: psi.inject)
  {
    fix Q  :: "('a, 'b, 'c) psi"
    and Ψ' :: 'b

    assume "Ψ' ⊳ Q ⟼ Rs"
    and    "guarded Q"
    and    "bangPred P Q"
    and    "Ψ ≃ Ψ'"

    hence "Prop C Ψ Q Rs" using rPar1 rPar1 rPar2 rPar2 rComm1 rComm2 rBang
    proof(nominal_induct avoiding: Ψ C rule: semantics.strong_induct)
      case(cInput Ψ' M K xvec N Tvec Q Ψ C)
      thus ?case by - (ind_cases "bangPred P (M⦇λ*xvec N⦈.Q)")
    next
      case(Output Ψ' M K N Q Ψ C)
      thus ?case by - (ind_cases "bangPred P (M⟨N⟩.Q)")
    next
      case(Case Ψ' Q Rs φ Cs Ψ C)
      thus ?case by - (ind_cases "bangPred P (Cases Cs)")
    next
      case(cPar1 Ψ' Ψ⇩R Q α P' R A⇩R Ψ C)
      have rPar1: "⋀α P' C. ⟦Ψ ⊳ P ⟼α ≺ P'; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹ Prop C Ψ (P ∥ !P) (α ≺ (P' ∥ !P))"
        by fact
      from ‹bangPred P (Q ∥ R)› have "Q = P" and "R = !P"
        by - (ind_cases "bangPred P (Q ∥ R)", auto simp add: psi.inject)+
      from ‹R = !P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩R = []" and "Ψ⇩R = 𝟭" by auto
      from ‹Ψ' ⊗ Ψ⇩R ⊳ Q ⟼α ≺ P'› ‹Q = P› ‹Ψ ≃ Ψ'› ‹Ψ⇩R = 𝟭› have "Ψ ⊳ P ⟼α ≺ P'"
        by(metis statEqTransition Identity AssertionStatEqSym)
      hence "Prop C Ψ (P ∥ !P) (α ≺ (P' ∥ !P))" using ‹bn α ♯* Ψ› ‹bn α  ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹Q = P› ‹distinct(bn α)›
        by(rule_tac rPar1) auto
      with ‹R = !P› ‹Q = P› show ?case by simp
    next
      case(cPar2 Ψ' Ψ⇩P R α P' Q A⇩P Ψ C)
      have rPar2: "⋀α P' C. ⟦Ψ ⊳ !P ⟼α ≺ P'; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α);
                             ⋀C. Prop C Ψ (!P) (α ≺ P')⟧ ⟹ Prop C Ψ (P ∥ !P) (α ≺ (P ∥ P'))"
        by fact
      from ‹bangPred P (Q ∥ R)› have "Q = P" and "R = !P"
        by - (ind_cases "bangPred P (Q ∥ R)", auto simp add: psi.inject)+
      from ‹Q = P› ‹extractFrame Q = ⟨A⇩P, Ψ⇩P⟩› ‹guarded P› have "Ψ⇩P ≃ 𝟭" and "supp Ψ⇩P = ({}::name set)"
        by(blast dest: guardedStatEq)+
      from ‹Ψ' ⊗ Ψ⇩P ⊳ R ⟼α ≺ P'› ‹R = !P› ‹Ψ ≃ Ψ'› ‹Ψ⇩P ≃ 𝟭› have "Ψ ⊳ !P ⟼α ≺ P'"
        by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
      moreover
      {
        fix C
        have "bangPred P (!P)" by(rule aux1)
        moreover from ‹Ψ ≃ Ψ'› ‹Ψ⇩P ≃ 𝟭› have "Ψ ≃ Ψ' ⊗ Ψ⇩P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
        ultimately have "⋀C. Prop C Ψ (!P) (α ≺ P')" using cPar2 ‹R = !P› ‹guarded P› by simp
      }
      ultimately have "Prop C Ψ (P ∥ !P) (α ≺ (P ∥ P'))" using ‹bn α ♯* Ψ› ‹bn α  ♯* Q› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹Q = P› ‹distinct(bn α)›
        by(rule_tac rPar2) auto
      with ‹R = !P› ‹Q = P› show ?case by simp
    next
      case(cComm1 Ψ' Ψ⇩R Q M N P' A⇩P Ψ⇩P R K xvec P'' A⇩R Ψ C)
      have rComm1: "⋀M N P' K xvec P'' C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; Ψ ⊳ !P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇ν*xvec⦈⟨N⟩ ≺ P''); Ψ ⊢ M ↔ K; 
                                           xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))"
        by fact
      from ‹bangPred P (Q ∥ R)› have "Q = P" and "R = !P"
        by - (ind_cases "bangPred P (Q ∥ R)", auto simp add: psi.inject)+
      from ‹R = !P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩R = []" and "Ψ⇩R = 𝟭" by auto
      from ‹Ψ' ⊗ Ψ⇩R ⊳ Q ⟼M⦇N⦈ ≺ P'› ‹Q = P› ‹Ψ ≃ Ψ'› ‹Ψ⇩R = 𝟭› have "Ψ ⊳ P ⟼M⦇N⦈ ≺ P'"
        by(metis statEqTransition Identity AssertionStatEqSym)
      moreover from ‹Q = P› ‹extractFrame Q = ⟨A⇩P, Ψ⇩P⟩› ‹guarded P› have "Ψ⇩P ≃ 𝟭" and "supp Ψ⇩P = ({}::name set)"
        by(blast dest: guardedStatEq)+
      moreover from ‹Ψ' ⊗ Ψ⇩P ⊳ R ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''› ‹R = !P› ‹Ψ⇩P ≃ 𝟭› ‹Ψ ≃ Ψ'› have "Ψ ⊳ !P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''"
        by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
      moreover 
      {
        fix C
        have "bangPred P (!P)" by(rule aux1)
        moreover from ‹Ψ ≃ Ψ'› ‹Ψ⇩P ≃ 𝟭› have "Ψ ≃ Ψ' ⊗ Ψ⇩P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
        ultimately have "⋀C. Prop C Ψ (!P) (K⦇ν*xvec⦈⟨N⟩ ≺ P'')" using cComm1 ‹R = !P› ‹guarded P› by simp
      }
      moreover from ‹Ψ' ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› ‹Ψ ≃ Ψ'› ‹Ψ⇩R = 𝟭› have "Ψ ⊢ M ↔ K"
        by(metis statEqEnt Identity Composition Commutativity AssertionStatEqSym)
      ultimately have "Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))" using ‹xvec ♯* Ψ› ‹xvec ♯* Q› ‹xvec ♯* M› ‹xvec ♯* K› ‹xvec ♯* C› ‹Q = P› ‹distinct xvec›
        by(rule_tac rComm1) (assumption | auto)+
      with ‹R = !P› ‹Q = P› show ?case by simp
    next
      case(cComm2 Ψ' Ψ⇩R Q M xvec N P' A⇩P Ψ⇩P R K P'' A⇩R Ψ C)
      have rComm2: "⋀M xvec N P' K P'' C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; Ψ ⊳ !P ⟼K⦇N⦈ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇N⦈ ≺ P''); Ψ ⊢ M ↔ K; 
                                           xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))"
        by fact
      from ‹bangPred P (Q ∥ R)› have "Q = P" and "R = !P"
        by - (ind_cases "bangPred P (Q ∥ R)", auto simp add: psi.inject)+
      from ‹R = !P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩R = []" and "Ψ⇩R = 𝟭" by auto
      from ‹Ψ' ⊗ Ψ⇩R ⊳ Q ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹Q = P› ‹Ψ ≃ Ψ'› ‹Ψ⇩R = 𝟭› have "Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
        by(metis statEqTransition Identity AssertionStatEqSym)
      moreover from ‹Q = P› ‹extractFrame Q = ⟨A⇩P, Ψ⇩P⟩› ‹guarded P› have "Ψ⇩P ≃ 𝟭" and "supp Ψ⇩P = ({}::name set)"
        by(blast dest: guardedStatEq)+
      moreover from ‹Ψ' ⊗ Ψ⇩P ⊳ R ⟼K⦇N⦈ ≺ P''› ‹R = !P› ‹Ψ⇩P ≃ 𝟭› ‹Ψ ≃ Ψ'› have "Ψ ⊳ !P ⟼K⦇N⦈ ≺ P''"
        by(metis statEqTransition Identity Composition Commutativity AssertionStatEqSym)
      moreover 
      {
        fix C
        have "bangPred P (!P)" by(rule aux1)
        moreover from ‹Ψ ≃ Ψ'› ‹Ψ⇩P ≃ 𝟭› have "Ψ ≃ Ψ' ⊗ Ψ⇩P" by(metis Composition Identity Commutativity AssertionStatEqSym AssertionStatEqTrans)
        ultimately have "⋀C. Prop C Ψ (!P) (K⦇N⦈ ≺ P'')" using cComm2 ‹R = !P› ‹guarded P› by simp
      }
      moreover from ‹Ψ' ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K› ‹Ψ⇩P ≃ 𝟭› ‹Ψ ≃ Ψ'› ‹Ψ⇩R = 𝟭› have "Ψ ⊢ M ↔ K"
        by(metis statEqEnt Identity Composition Commutativity AssertionStatEqSym)
      ultimately have "Prop C Ψ (P ∥ !P) (τ ≺ ⦇ν*xvec⦈(P' ∥ P''))" using ‹xvec ♯* Ψ› ‹xvec ♯* Q› ‹xvec ♯* M› ‹xvec ♯* K› ‹xvec ♯* C› ‹Q = P› ‹distinct xvec›
        by(rule_tac rComm2) (assumption | auto)+
      with ‹R = !P› ‹Q = P› show ?case by simp
    next
      case(cOpen Ψ Q M xvec yvec N P' x C)
      thus ?case by - (ind_cases "bangPred P (⦇νx⦈Q)")
    next
      case(cScope Ψ Q α P' x C)
      thus ?case by - (ind_cases "bangPred P (⦇νx⦈Q)")
    next
      case(Bang Ψ' Q Rs Ψ C)
      have rBang: "⋀Rs C. ⟦Ψ ⊳ P ∥ !P ⟼ Rs; ⋀C. Prop C Ψ (P ∥ !P) Rs; guarded P⟧ ⟹ Prop C Ψ (!P) Rs"
        by fact
      from ‹bangPred P (!Q)› have "P = Q" 
        by - (ind_cases "bangPred P (!Q)", auto simp add: psi.inject)
      with ‹Ψ' ⊳ Q ∥ !Q ⟼ Rs› ‹Ψ ≃ Ψ'› have "Ψ ⊳ P ∥ !P ⟼ Rs" by(metis statEqTransition AssertionStatEqSym) 
      moreover 
      {
        fix C
        have "bangPred P (P ∥ !P)" by(rule aux2)
        with Bang ‹P = Q› have "⋀C. Prop C Ψ (P ∥ !P) Rs" by simp
      }
      moreover from ‹guarded Q› ‹P = Q› have "guarded P" by simp
      ultimately have "Prop C Ψ (!P) Rs" by(rule rBang)
      with ‹P = Q› show ?case by simp
    qed
  }
  with ‹guarded P› ‹Ψ ⊳ !P ⟼ Rs›
  show ?thesis by(force intro: aux1)
qed

lemma bangInputInduct[consumes 1, case_names cPar1 cPar2 cBang]:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'b ⇒ ('a, 'b, 'c) psi ⇒ 'a ⇒ 'a ⇒ ('a, 'b, 'c) psi ⇒ bool"

  assumes "Ψ ⊳ !P ⟼M⦇N⦈ ≺ P'"
  and     rPar1: "⋀P'. Ψ ⊳ P ⟼M⦇N⦈ ≺ P' ⟹ Prop Ψ (P ∥ !P) M N (P' ∥ !P)"
  and     rPar2: "⋀P'. ⟦Ψ ⊳ !P ⟼M⦇N⦈ ≺ P'; Prop Ψ (!P) M N P'⟧ ⟹ Prop Ψ (P ∥ !P) M N (P ∥ P')"
  and     rBang: "⋀P'. ⟦Ψ ⊳ P ∥ !P ⟼M⦇N⦈ ≺ P'; Prop Ψ (P ∥ !P) M N P'; guarded P⟧ ⟹ Prop Ψ (!P) M N P'"
  shows "Prop Ψ (!P) M N P'"
using ‹Ψ ⊳ !P ⟼M⦇N⦈ ≺ P'›
by(nominal_induct Ψ P Rs=="M⦇N⦈ ≺ P'" arbitrary: P' rule: bangInduct)
  (auto simp add: residualInject intro: rPar1 rPar2 rBang)

lemma bangOutputInduct[consumes 1, case_names cPar1 cPar2 cBang]:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒ 'a ⇒ ('a, 'b, 'c) boundOutput ⇒ bool"
  and   C    :: 'd

  assumes "Ψ ⊳ !P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     rPar1: "⋀xvec N P' C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) M (⦇ν*xvec⦈N ≺' (P' ∥ !P))"
  and     rPar2: "⋀xvec N P' C. ⟦Ψ ⊳ !P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; ⋀C. Prop C Ψ (!P) M (⦇ν*xvec⦈N ≺' P'); xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* C; distinct xvec⟧ ⟹ 
                                  Prop C Ψ (P ∥ !P) M (⦇ν*xvec⦈N ≺' (P ∥ P'))"
  and     rBang: "⋀B C. ⟦Ψ ⊳ P ∥ !P ⟼(ROut M B); ⋀C. Prop C Ψ (P ∥ !P) M B; guarded P⟧ ⟹ Prop C Ψ (!P) M B"

  shows "Prop C Ψ (!P) M (⦇ν*xvec⦈N ≺' P')"
using ‹Ψ ⊳ !P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'›
apply(auto simp add: residualInject)
by(nominal_induct Ψ P Rs=="ROut M (⦇ν*xvec⦈N ≺' P')" avoiding: C arbitrary: xvec N P' rule: bangInduct)
  (force simp add: residualInject intro: rPar1 rPar2 rBang)+

lemma bangTauInduct[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cBang]:
  fixes Ψ   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒ ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: 'd

  assumes "Ψ ⊳ !P ⟼τ ≺ P'"
  and     rPar1: "⋀P' C. Ψ ⊳ P ⟼τ ≺ P' ⟹ Prop C Ψ (P ∥ !P) (P' ∥ !P)"
  and     rPar2: "⋀P' C. ⟦Ψ ⊳ !P ⟼τ ≺ P'; ⋀C. Prop C Ψ (!P) P'⟧ ⟹ Prop C Ψ (P ∥ !P) (P ∥ P')"
  and     rComm1: "⋀M N P' K xvec P'' C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; Ψ ⊳ !P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''; Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹ Prop C Ψ (P ∥ !P) (⦇ν*xvec⦈(P' ∥ P''))"
  and     rComm2: "⋀M N P' K xvec P'' C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; Ψ ⊳ !P ⟼K⦇N⦈ ≺ P''; Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C⟧ ⟹ Prop C Ψ (P ∥ !P) (⦇ν*xvec⦈(P' ∥ P''))"
  and     rBang: "⋀P' C. ⟦Ψ ⊳ P ∥ !P ⟼τ ≺ P'; ⋀C. Prop C Ψ (P ∥ !P) P'; guarded P⟧ ⟹ Prop C Ψ (!P) P'"

  shows "Prop C Ψ (!P) P'"
using ‹Ψ ⊳ !P ⟼τ ≺ P'›
by(nominal_induct Ψ P Rs=="τ ≺ P'" avoiding: C arbitrary: P' rule: bangInduct)
  (auto simp add: residualInject intro: rPar1 rPar2 rComm1 rComm2 rBang)

lemma bangInduct'[consumes 2, case_names cAlpha cPar1 cPar2 cComm1 cComm2 cBang]:
  fixes Ψ    :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   α    :: "'a action"
  and   P'   :: "('a, 'b, 'c) psi"
  and   Prop :: "'d::fs_name ⇒ 'b ⇒ ('a, 'b, 'c) psi ⇒ 'a action ⇒ ('a, 'b, 'c) psi ⇒ bool"
  and   C    :: "'d::fs_name"

  assumes "Ψ ⊳ !P ⟼α ≺ P'"
  and     "bn α ♯* subject α"
  and     rAlpha: "⋀α P' p C. ⟦bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α;  bn α ♯* C;
                                set p ⊆ set(bn α) × set(bn(p ∙ α)); distinctPerm p;
                                bn(p ∙ α) ♯* α; bn(p ∙ α) ♯* P'; Prop C Ψ (P ∥ !P) α P'⟧ ⟹
                                Prop C Ψ (P ∥ !P) (p ∙ α) (p ∙ P')"
  and     rPar1: "⋀α P' C.
                   ⟦Ψ ⊳ P ⟼α ≺ P'; bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹
                    Prop C Ψ (P ∥ !P) α (P' ∥ !P)"
  and     rPar2: "⋀α P' C.
                   ⟦Ψ ⊳ !P ⟼α ≺ P'; ⋀C. Prop C Ψ (!P) α P';
                    bn α ♯* Ψ; bn α ♯* P; bn α ♯* subject α; bn α ♯* C; distinct(bn α)⟧ ⟹
                    Prop C Ψ (P ∥ !P) α (P ∥ P')"
  and     rComm1: "⋀M N P' K xvec P'' C. ⟦Ψ ⊳ P ⟼M⦇N⦈ ≺ P'; Ψ ⊳ !P ⟼K⦇ν*xvec⦈⟨N⟩ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇ν*xvec⦈⟨N⟩) P''; Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ) (⦇ν*xvec⦈(P' ∥ P''))"
  and     rComm2: "⋀M xvec N P' K P'' C. ⟦Ψ ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'; Ψ ⊳ !P ⟼K⦇N⦈ ≺ P''; ⋀C. Prop C Ψ (!P) (K⦇N⦈) P''; Ψ ⊢ M ↔ K; 
                                             xvec ♯* Ψ; xvec ♯* P; xvec ♯* M; xvec ♯* K; xvec ♯* C; distinct xvec⟧ ⟹ Prop C Ψ (P ∥ !P) (τ) (⦇ν*xvec⦈(P' ∥ P''))"
  and     rBang:    "⋀α P' C.
                     ⟦Ψ ⊳ P ∥ !P ⟼α ≺ P'; guarded P; ⋀C. Prop C Ψ (P ∥ !P) α P'; guarded P; distinct(bn α)⟧ ⟹
                      Prop C Ψ (!P) α P'"
  shows "Prop C Ψ (!P) α P'"
proof -
  from ‹Ψ ⊳ !P ⟼α ≺ P'› have "distinct(bn α)" by(rule boundOutputDistinct)
  with ‹Ψ ⊳ !P ⟼α ≺ P'› ‹bn α ♯* subject α› show ?thesis
  proof(nominal_induct Ψ P Rs=="α ≺ P'" avoiding: C α P' rule: bangInduct)
    case(cPar1 α P' C α' P'')
    note  ‹α ≺ (P' ∥ !P) = α' ≺ P''›
    moreover from ‹bn α ♯* α'› have "bn α ♯* bn α'" by simp
    moreover note ‹distinct(bn α)› ‹distinct(bn α')›
    moreover from ‹bn α ♯* subject α› have "bn α ♯* (α ≺ P' ∥ !P)" by simp
    moreover from ‹bn α' ♯* subject α'› have "bn α' ♯* (α' ≺ P'')" by simp
    ultimately obtain p where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "α' = p ∙ α"
                    and  P'eq: "P'' = p ∙ (P' ∥ !P)" and "bn(p ∙ α) ♯* α" and "bn(p ∙ α) ♯* (P' ∥ !P)"
      by(rule_tac residualEq)

    from ‹Ψ ⊳ P ⟼α ≺ P'› ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C› ‹distinct(bn α)› 
    have "Prop C Ψ (P ∥ !P) α (P' ∥ !P)"
      by(rule rPar1)
    with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C› S ‹distinctPerm p› ‹bn α ♯* α'› ‹bn α ♯* P''› ‹α' = (p ∙ α)› P'eq ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P' ∥ !P)›
    have "Prop C Ψ (P ∥ !P) (p ∙ α) (p ∙ (P' ∥ !P))"
      by(rule_tac rAlpha) 
    with P'eq ‹α' = p ∙ α› ‹distinctPerm p› show ?case  by simp
  next
    case(cPar2 α P' C α' P'')
    note  ‹α ≺ (P ∥ P') = α' ≺ P''›
    moreover from ‹bn α ♯* α'› have "bn α ♯* bn α'" by simp
    moreover note ‹distinct(bn α)› ‹distinct(bn α')›
    moreover from ‹bn α ♯* subject α› have "bn α ♯* (α ≺ P ∥ P')" by simp
    moreover from ‹bn α' ♯* subject α'› have "bn α' ♯* (α' ≺ P'')" by simp
    ultimately obtain p where S: "set p ⊆ set(bn α) × set(bn(p ∙ α))" and "distinctPerm p" and "α' = p ∙ α"
                    and  P'eq: "P'' = p ∙ (P ∥ P')" and "bn(p ∙ α) ♯* α" and "bn(p ∙ α) ♯* (P ∥ P')"
      by(rule_tac residualEq)
    
    note ‹Ψ ⊳ !P ⟼α ≺ P'›
    moreover from ‹bn α ♯* subject α› ‹distinct(bn α)› have "⋀C. Prop C Ψ (!P) α P'" by(rule_tac cPar2) auto
    moreover note ‹bn α ♯* Ψ› ‹bn α  ♯* P› ‹bn α  ♯* subject α› ‹bn α  ♯* C› ‹distinct(bn α)›
    ultimately have "Prop C Ψ (P ∥ !P) α (P ∥ P')"
      by(rule rPar2)
    with ‹bn α ♯* Ψ› ‹bn α ♯* P› ‹bn α ♯* subject α› ‹bn α ♯* C› S ‹distinctPerm p› ‹bn α ♯* α'› ‹bn α ♯* P''› ‹α' = (p ∙ α)› P'eq ‹bn(p ∙ α) ♯* α› ‹bn(p ∙ α) ♯* (P ∥ P')›
    have "Prop C Ψ (P ∥ !P) (p ∙ α) (p ∙ (P ∥ P'))"
      by(rule_tac rAlpha) 
    with P'eq ‹α' = p ∙ α› show ?case by simp
  next
    case(cComm1 M N P' K xvec P'' C α P''')
    hence "Prop C Ψ (P ∥ !P) (τ) (⦇ν*xvec⦈(P' ∥ P''))"
      by(rule_tac rComm1) (assumption | simp)+
    thus ?case using ‹τ ≺ ⦇ν*xvec⦈(P' ∥ P'') = α ≺ P'''›
      by(simp add: residualInject)
  next
    case(cComm2 M xvec N P' K P'' C α P''')
    hence "Prop C Ψ (P ∥ !P) (τ) (⦇ν*xvec⦈(P' ∥ P''))"
      by(rule_tac rComm2) (assumption | simp)+
    thus ?case using ‹τ ≺ ⦇ν*xvec⦈(P' ∥ P'') = α ≺ P'''›
      by(simp add: residualInject)
  next
    case(cBang C α P')
    thus ?case by(auto intro: rBang)
  qed
qed

lemma comm1Aux:
  fixes Ψ    :: 'b
  and   Ψ⇩Q   :: 'b
  and   R    :: "('a, 'b, 'c) psi"
  and   K    :: 'a
  and   xvec :: "name list"
  and   N    :: 'a
  and   R'   :: "('a, 'b, 'c) psi"
  and   A⇩R   :: "name list"
  and   Ψ⇩R   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   L    :: 'a
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   A⇩Q   :: "name list"

  assumes RTrans: "Ψ ⊗ Ψ⇩Q ⊳ R ⟼K⦇ν*xvec⦈⟨N⟩ ≺ R'"
  and     FrR: "extractFrame R = ⟨A⇩R, Ψ⇩R⟩"
  and     PTrans: "Ψ ⊗ Ψ⇩R ⊳ P ⟼M⦇L⦈ ≺ P'"
  and     MeqK: "Ψ ⊗ Ψ⇩Q ⊗ Ψ⇩R ⊢ M ↔ K"
  and     PeqQ: "⟨A⇩Q, (Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
  and     "distinct A⇩P"
  and     "distinct A⇩R"
  and     "A⇩R ♯* A⇩P"
  and     "A⇩R ♯* A⇩Q"
  and     "A⇩R ♯* Ψ"
  and     "A⇩R ♯* P"
  and     "A⇩R ♯* Q"
  and     "A⇩R ♯* R"
  and     "A⇩R ♯* K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* R"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* M"
  and     "A⇩Q ♯* R"
  and     "A⇩Q ♯* M"

  obtains K' where "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇ν*xvec⦈⟨N⟩ ≺ R'" and "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "A⇩R ♯* K'"
proof -
  from ‹A⇩R ♯* P› ‹A⇩R ♯* Q› ‹A⇩R ♯* A⇩P› ‹A⇩R ♯* A⇩Q› FrP FrQ have "A⇩R ♯* Ψ⇩P" and "A⇩R ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  assume Assumptions: "⋀K'. ⟦Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇ν*xvec⦈⟨N⟩ ≺ R'; Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'; A⇩R ♯* K'⟧ ⟹ thesis"
  {
    fix Ψ'   ::'b
    and zvec ::"name list"

    assume A: "Ψ ⊗ Ψ⇩Q ≃ Ψ'"
    assume "Ψ' ⊳ R ⟼K⦇ν*xvec⦈⟨N⟩ ≺ R'"
    hence "Ψ' ⊳ R ⟼ROut K (⦇ν*xvec⦈N ≺' R')" by(simp add: residualInject)
    moreover note FrR ‹distinct A⇩R› PTrans
    moreover from ‹Ψ' ⊳ R ⟼K⦇ν*xvec⦈⟨N⟩ ≺ R'› have "distinct xvec" by(auto dest: boundOutputDistinct)
    moreover assume "Ψ' ⊗ Ψ⇩R ⊢ M ↔ K" and "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
                and "A⇩R ♯* zvec" and "A⇩P ♯* zvec" and "zvec ♯* R" and "zvec ♯* P"
                and "A⇩R ♯* Ψ'"
    ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R') ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"
      using FrP ‹A⇩P ♯* R› ‹A⇩Q ♯* R› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* P› ‹distinct A⇩P›  ‹A⇩R ♯* Ψ› ‹A⇩R ♯* P› ‹A⇩R ♯* R› 
            ‹A⇩P ♯* M› ‹A⇩Q ♯* M› ‹A⇩R ♯* K› ‹A⇩R ♯* A⇩P› ‹A⇩R ♯* A⇩Q› ‹A⇩R ♯* Ψ⇩P›
    proof(nominal_induct Ψ' R K B=="⦇ν*xvec⦈N ≺' R'" A⇩R Ψ⇩R avoiding: Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec N R' arbitrary: M rule: outputFrameInduct)
      case(cAlpha Ψ' R K A⇩R Ψ⇩R p Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec N R' M)
      have S: "set p ⊆ set A⇩R × set (p ∙ A⇩R)" by fact
      from ‹Ψ' ⊗ (p ∙ Ψ⇩R) ⊢ M ↔ K› have "(p ∙ (Ψ' ⊗ (p ∙ Ψ⇩R))) ⊢ (p ∙ M) ↔ (p ∙ K)"
        by(rule chanEqClosed)
      with ‹A⇩R ♯* Ψ'› ‹(p ∙ A⇩R) ♯* Ψ'› ‹A⇩R ♯* K› ‹(p ∙ A⇩R) ♯* K› S ‹distinctPerm p›
      have "Ψ' ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K" by(simp add: eqvts)
      moreover from ‹Ψ ⊗ (p ∙ Ψ⇩R) ⊳ P ⟼M⦇L⦈ ≺ P'› S ‹A⇩R ♯* P› ‹(p ∙ A⇩R) ♯* P› have "(p ∙ (Ψ ⊗ (p ∙ Ψ⇩R))) ⊳ P ⟼(p ∙ M)⦇L⦈ ≺ P'"
        by(rule_tac inputPermFrameSubject) auto
      with ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› S ‹distinctPerm p› have "Ψ ⊗ Ψ⇩R ⊳ P ⟼(p ∙ M)⦇L⦈ ≺ P'"
        by(simp add: eqvts)
      moreover from ‹A⇩P ♯* M› have "(p ∙ A⇩P) ♯* (p ∙ M)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* A⇩P› ‹(p ∙ A⇩R) ♯* A⇩P› S have "A⇩P ♯* (p ∙ M)" by simp
      moreover from ‹A⇩Q ♯* M› have "(p ∙ A⇩Q) ♯* (p ∙ M)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* A⇩Q› ‹(p ∙ A⇩R) ♯* A⇩Q› S have "A⇩Q ♯* (p ∙ M)" by simp
      moreover from ‹⟨A⇩Q, Ψ' ⊗ (p ∙ Ψ⇩R)⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ (p ∙ Ψ⇩R)⟩ ›
      have "(p ∙ ⟨A⇩Q, Ψ' ⊗ (p ∙ Ψ⇩R)⟩) ↪⇩F (p ∙ ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ (p ∙ Ψ⇩R)⟩)"
        by(rule FrameStatImpClosed)
      with ‹A⇩R ♯* A⇩P› ‹(p ∙ A⇩R) ♯* A⇩P› ‹A⇩R ♯* Ψ'› ‹(p ∙ A⇩R) ♯* Ψ'› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› ‹A⇩R ♯* A⇩Q›
        ‹(p ∙ A⇩R) ♯* A⇩Q› ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› S ‹distinctPerm p›
      have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩" by(simp add: eqvts)
      ultimately obtain K' where "Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R')" and "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        using cAlpha
        by metis
      from ‹Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R')› S ‹A⇩R ♯* R› ‹(p ∙ A⇩R) ♯* R›
      have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ R ⟼(ROut (p ∙ K') (⦇ν*xvec⦈N ≺' R'))" using outputPermFrameSubject 
        by(auto simp add: residualInject)
      with S ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› have "Ψ ⊗ Ψ⇩P ⊳ R ⟼(ROut (p ∙ K') (⦇ν*xvec⦈N ≺' R'))"
        by(simp add: eqvts)
      moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K'› have "(p ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R))⊢ (p ∙ p ∙ M) ↔ (p ∙ K')"
        by(rule chanEqClosed)
      with S ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› ‹distinctPerm p› have "Ψ ⊗ Ψ⇩P ⊗ (p ∙ Ψ⇩R) ⊢ M ↔ (p ∙ K')"
        by(simp add: eqvts)
      moreover from ‹zvec ♯* K'› have "(p ∙ zvec) ♯* (p ∙ K')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* zvec› ‹(p ∙ A⇩R) ♯* zvec› S have "zvec ♯* (p ∙ K')" by simp
      moreover from ‹A⇩R ♯* K'› have "(p ∙ A⇩R) ♯* (p ∙ K')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      ultimately show ?case by blast
    next
      case(cOutput Ψ' M' K N R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec N' R' M)
      from ‹A⇩P ♯* (M'⟨N⟩.R)› ‹A⇩Q ♯* (M'⟨N⟩.R)› ‹zvec ♯* (M'⟨N⟩.R)›
      have "A⇩P ♯* M'" and "A⇩Q ♯* M'" and "zvec ♯* M'" by simp+
          
      from ‹Ψ' ⊢ M' ↔ K› have "Ψ' ⊗ 𝟭 ⊢ M' ↔ K" by(blast intro: statEqEnt Identity AssertionStatEqSym)
      hence "Ψ' ⊗ 𝟭 ⊢ M' ↔ M'" by(blast intro: chanEqSym chanEqTrans)
      with ‹A⇩Q ♯* M'› have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F M' ↔ M'" by(force intro: frameImpI)
      
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩› have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F M' ↔ M'"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* M'› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ M' ↔ M'"  by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊢ M' ↔ M'" by(blast intro: statEqEnt Identity) hence "Ψ ⊗ Ψ⇩P ⊳ M'⟨N⟩.R ⟼M'⟨N⟩ ≺ R"
        by(rule Output)
      
      moreover from ‹Ψ' ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ' ⊗ 𝟭 ⊢ M' ↔ K›
      have "Ψ' ⊗ 𝟭 ⊢ M ↔ M'" by(metis chanEqSym chanEqTrans)
      with ‹A⇩Q ♯* M› ‹A⇩Q ♯* M'›
      have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F M ↔ M'"
        by(force intro: frameImpI)
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
      have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F M ↔ M'"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* M› ‹A⇩P ♯* M'› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ M ↔ M'" 
        by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity)
      ultimately show ?case using cOutput by(auto simp add: residualInject)
    next
      case(cCase Ψ' R M' φ Cs A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec N R' M)
      from ‹guarded R› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "Ψ⇩R ≃ 𝟭"
        by(metis guardedStatEq)
      with ‹Ψ' ⊗ 𝟭 ⊢ M ↔ M'› have "Ψ' ⊗ Ψ⇩R ⊢ M ↔ M'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
      moreover have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
      proof -
        from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩Q,  Ψ' ⊗ Ψ⇩R⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
        moreover from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩ ≃⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ 𝟭 ⊳ P ⟼M⦇L⦈ ≺ P'› ‹Ψ⇩R ≃ 𝟭›
      have "Ψ ⊗ Ψ⇩R  ⊳ P ⟼M⦇L⦈ ≺ P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
      moreover from ‹zvec ♯* (Cases Cs)› ‹A⇩P ♯* (Cases Cs)›  ‹A⇩Q ♯* (Cases Cs)› ‹(φ, R) mem Cs› 
      have "A⇩P ♯* R" and "A⇩Q ♯* R" and "zvec ♯* R" and "A⇩P ♯* φ" and "A⇩Q ♯* φ"
        by(auto dest: memFreshChain)
      ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R') ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"  using cCase
        by(rule_tac cCase) (assumption | simp)+
      then obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R')"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        by metis
      note RTrans ‹(φ, R) mem Cs›
      moreover from ‹Ψ' ⊢ φ› have "Ψ' ⊗ 𝟭 ⊢ φ" by(blast intro: statEqEnt Identity AssertionStatEqSym)
      with ‹A⇩Q ♯* φ› have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F φ" by(force intro: frameImpI)
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩› have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F φ"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* φ› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ φ"  by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊢ φ" by(blast intro: statEqEnt Identity) 
      ultimately have "Ψ ⊗ Ψ⇩P ⊳ Cases Cs ⟼ROut K' (⦇ν*xvec⦈N ≺' R')" using ‹guarded R› by(rule Case)
      moreover from MeqK' ‹Ψ⇩R ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
      ultimately show ?case using ‹zvec ♯* K'›
        by fastforce
    next
      case(cPar1 Ψ' Ψ⇩R⇩2 R⇩1 M' xvec N' R⇩1' A⇩R⇩2 R⇩2 A⇩R⇩1 Ψ⇩R⇩1 Ψ P A⇩P Ψ⇩P A⇩Q zvec yvec N R' M)
      have FrR2: "extractFrame R⇩2 = ⟨A⇩R⇩2, Ψ⇩R⇩2⟩" by fact
      from ‹Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'› have "(Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity Composition Commutativity)
      moreover have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1⟩ ↪⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1⟩"
      proof -
        have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩›
        moreover have  "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇L⦈ ≺ P'› have "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1 ⊳ P ⟼M⦇L⦈ ≺ P'"
        by(metis statEqTransition Associativity Composition Commutativity)
      moreover from ‹A⇩R⇩1 ♯* A⇩P› ‹A⇩R⇩2 ♯* A⇩P› ‹A⇩P ♯* (R⇩1 ∥ R⇩2)› ‹extractFrame R⇩1 = ⟨A⇩R⇩1, Ψ⇩R⇩1⟩› FrR2 have "A⇩P ♯* Ψ⇩R⇩1" and "A⇩P ♯* Ψ⇩R⇩2"
        by(force dest: extractFrameFreshChain)+

      moreover from ‹⦇ν*xvec⦈N' ≺' (R⇩1' ∥ R⇩2) = ⦇ν*yvec⦈N ≺' R'› ‹xvec ♯* yvec›
      obtain p T where "⦇ν*xvec⦈N' ≺' R⇩1' = ⦇ν*yvec⦈N ≺' T" and "R' = T ∥ (p ∙ R⇩2)" and "set p ⊆ set yvec × set xvec"
        apply(drule_tac sym)
        by(rule_tac boundOutputPar1Dest') (assumption | simp | blast dest: sym)+
      ultimately have "∃K'. (Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊳ R⇩1 ⟼ROut K' (⦇ν*yvec⦈N ≺' T) ∧ (Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊢ M ↔ K' ∧ (A⇩R⇩2@zvec) ♯* K' ∧ A⇩R⇩1 ♯* K'" using cPar1
        apply(rule_tac cPar1(6)) by(assumption | simp | fastforce)+
      then  obtain K' where RTrans: "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊳ R⇩1 ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ R⇩1'"
                        and MeqK': "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊢ M ↔ K'"  and "A⇩R⇩2 ♯* K'" and "A⇩R⇩1 ♯* K'" and "zvec ♯* K'"
        using ‹⦇ν*xvec⦈N' ≺' R⇩1' = ⦇ν*yvec⦈N ≺' T› by(auto simp add: residualInject)
      
      from RTrans have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2 ⊳ R⇩1 ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ R⇩1'"
        by(metis statEqTransition Associativity Composition Commutativity)
      hence "Ψ ⊗ Ψ⇩P ⊳ (R⇩1 ∥ R⇩2) ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ (R⇩1' ∥ R⇩2)" using FrR2 ‹xvec ♯* R⇩2› ‹A⇩R⇩2 ♯* Ψ› ‹A⇩R⇩2 ♯* Ψ⇩P› ‹A⇩R⇩2 ♯* K'› ‹A⇩R⇩2 ♯* R⇩1› ‹A⇩R⇩2 ♯* xvec› ‹A⇩R⇩2 ♯* N'›
        by(force intro: Par1)
      moreover from MeqK' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K'› ‹A⇩R⇩1 ♯* K'› ‹A⇩R⇩2 ♯* K'›  ‹⦇ν*xvec⦈N' ≺' (R⇩1' ∥ R⇩2) = ⦇ν*yvec⦈N ≺' R'›
        by(auto simp add: residualInject)
    next
      case(cPar2 Ψ' Ψ⇩R⇩1 R⇩2 M' xvec N' R⇩2' A⇩R⇩1 R⇩1 A⇩R⇩2 Ψ⇩R⇩2 Ψ P A⇩P Ψ⇩P A⇩Q zvec yvec N R' M)
      have FrR1: "extractFrame R⇩1 = ⟨A⇩R⇩1, Ψ⇩R⇩1⟩" by fact
      from ‹Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'› have "(Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity Composition Commutativity)
      moreover have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2⟩"
      proof -
        have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩›
        moreover have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇L⦈ ≺ P'› have "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇L⦈ ≺ P'"
        by(metis statEqTransition Associativity Composition Commutativity)
      moreover from ‹A⇩R⇩1 ♯* A⇩P› ‹A⇩R⇩2 ♯* A⇩P› ‹A⇩P ♯* (R⇩1 ∥ R⇩2)› FrR1 ‹extractFrame R⇩2 = ⟨A⇩R⇩2, Ψ⇩R⇩2⟩› have "A⇩P ♯* Ψ⇩R⇩1" and "A⇩P ♯* Ψ⇩R⇩2"
        by(force dest: extractFrameFreshChain)+
      moreover from ‹⦇ν*xvec⦈N' ≺' (R⇩1 ∥ R⇩2') = ⦇ν*yvec⦈N ≺' R'› ‹xvec ♯* yvec›
      obtain p T where "⦇ν*xvec⦈N' ≺' R⇩2' = ⦇ν*yvec⦈N ≺' T" and "R' = (p ∙ R⇩1) ∥ T" and "set p ⊆ set yvec × set xvec"
        apply(drule_tac sym)
        by(rule_tac boundOutputPar2Dest') (assumption | simp | blast dest: sym)+
      ultimately have "∃K'. (Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊳ R⇩2 ⟼ROut K' (⦇ν*yvec⦈N ≺' T) ∧ (Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩2 ⊢ M ↔ K' ∧ (A⇩R⇩1@zvec) ♯* K' ∧ A⇩R⇩2 ♯* K'" using cPar2
        by(rule_tac cPar2(6)) (assumption | simp | fastforce)+
      then obtain K' where RTrans: "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊳ R⇩2 ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ R⇩2'"
                        and MeqK': "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"  and "A⇩R⇩1 ♯* K'" and "zvec ♯* K'" and "A⇩R⇩2 ♯* K'" 
        using ‹⦇ν*xvec⦈N' ≺' R⇩2' = ⦇ν*yvec⦈N ≺' T› by(auto simp add: residualInject)
          
      from RTrans have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊳ R⇩2 ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ R⇩2'"
        by(metis statEqTransition Associativity Composition Commutativity)
      hence "Ψ ⊗ Ψ⇩P ⊳ (R⇩1 ∥ R⇩2) ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ (R⇩1 ∥ R⇩2')" using FrR1 ‹xvec ♯* R⇩1› ‹A⇩R⇩1 ♯* Ψ› ‹A⇩R⇩1 ♯* Ψ⇩P› ‹A⇩R⇩1 ♯* K'›‹A⇩R⇩1 ♯* xvec› ‹A⇩R⇩1 ♯* N'› ‹A⇩R⇩1 ♯* R⇩2›
        by(force intro: Par2)
      moreover from MeqK' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K'› ‹A⇩R⇩1 ♯* K'› ‹A⇩R⇩2 ♯* K'› ‹⦇ν*xvec⦈N' ≺' (R⇩1 ∥ R⇩2') = ⦇ν*yvec⦈N ≺' R'›
        by(auto simp add: residualInject)
    next
      case(cOpen Ψ' R M' xvec yvec N' R' x A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec zvec2 N R'' M)
      from ‹⦇ν*(xvec @ x # yvec)⦈N' ≺' R' = ⦇ν*zvec2⦈N ≺' R''› ‹x ♯ xvec› ‹x ♯ yvec› ‹x ♯ zvec2› ‹x ♯ R''› ‹x ♯ N› ‹distinct zvec2›
      obtain xvec' x' yvec' where A: "⦇ν*(xvec@yvec)⦈N' ≺' R' =  ⦇ν*(xvec'@yvec')⦈([(x, x')] ∙ N) ≺' ([(x, x')] ∙ R'')" 
                              and B: "zvec2 = (xvec'@x'#yvec')"
        by(rule_tac boundOutputOpenDest) auto
      then have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*(xvec'@yvec')⦈([(x, x')] ∙ N) ≺' ([(x, x')] ∙ R'')) ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ (zvec) ♯* K' ∧ A⇩R ♯* K'" using cOpen
        by(rule_tac cOpen(4)) (assumption | simp)+
      then  obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇ν*(xvec@yvec)⦈⟨N'⟩ ≺ R'"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        using A by(auto simp add: residualInject)
      from ‹A⇩R ♯* A⇩P› ‹A⇩P ♯* (⦇νx⦈R)› ‹x ♯ A⇩P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩P ♯* Ψ⇩R"
        by(force dest: extractFrameFreshChain)+

      from ‹Ψ ⊗ Ψ⇩R ⊳ P ⟼M⦇L⦈ ≺ P'› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹zvec ♯* P› ‹A⇩P ♯* Ψ⇩R› ‹x ♯ A⇩P› ‹A⇩P ♯* M› ‹A⇩P ♯* P› ‹A⇩P ♯* zvec› ‹A⇩P ♯* Ψ› ‹A⇩P ♯* zvec› ‹A⇩R ♯* P› ‹A⇩R ♯* A⇩P› ‹x ♯ A⇩P› ‹x ♯ P›

      obtain K'' where MeqK'': "(Ψ ⊗ Ψ⇩R) ⊗ Ψ⇩P ⊢ M ↔ K''" and "A⇩R ♯* K''" and "zvec ♯* K''" and "x ♯ K''"
        by(rule_tac B="(x#A⇩R@zvec)" in obtainPrefix) (assumption | simp | force)+
      
      from MeqK'' MeqK' have KeqK'': "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊢ K' ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
      with RTrans ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› ‹distinct A⇩R› ‹A⇩R ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹A⇩R ♯* K'› ‹A⇩R ♯* K''› ‹A⇩R ♯* R›
      have "Ψ ⊗ Ψ⇩P ⊳ R ⟼K''⦇ν*(xvec@yvec)⦈⟨N'⟩ ≺ R'"
        by(rule_tac outputRenameSubject) (assumption | force)+
      hence "Ψ ⊗ Ψ⇩P ⊳ ⦇νx⦈R ⟼K''⦇ν*(xvec@x#yvec)⦈⟨N'⟩ ≺ R'"
        using ‹x ♯ Ψ› ‹x ♯ Ψ⇩P› ‹x ♯ K''› ‹x ♯ xvec› ‹ x ♯ yvec› ‹x ∈ supp N'› ‹xvec ♯* Ψ› ‹xvec ♯* Ψ⇩P› ‹xvec ♯* R› ‹x ♯ K''›
        by(rule_tac Open) (assumption | force)+
      moreover from MeqK'' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K''› ‹x ♯ K''› ‹A⇩R ♯* K''› B ‹⦇ν*(xvec @ x # yvec)⦈N' ≺' R' = ⦇ν*zvec2⦈N ≺' R''›
        by(auto simp add: residualInject)
    next
      case(cScope Ψ' R M' xvec N' R' x A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec yvec N R'' M)
      from ‹⦇ν*xvec⦈N' ≺' ⦇νx⦈R' = ⦇ν*yvec⦈N ≺' R''› ‹x ♯ xvec› ‹x ♯ yvec›
      obtain R''' where "R'' = ⦇νx⦈R'''" and "⦇ν*xvec⦈N' ≺' R' = ⦇ν*yvec⦈N ≺' R'''"
        apply(drule_tac sym)
        by(rule boundOutputScopeDest) (assumption | auto)+
      then have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*yvec⦈N ≺' R''') ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"  using cScope
        by(rule_tac cScope(4)) (assumption | simp)+
      then obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇ν*xvec⦈⟨N'⟩ ≺ R'"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        using ‹⦇ν*xvec⦈N' ≺' R' = ⦇ν*yvec⦈N ≺' R'''›
        by(auto simp add: residualInject)
      from ‹A⇩R ♯* A⇩P› ‹A⇩P ♯* (⦇νx⦈R)› ‹x ♯ A⇩P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩P ♯* Ψ⇩R"
        by(force dest: extractFrameFreshChain)+
      from ‹Ψ ⊗ Ψ⇩R ⊳ P ⟼M⦇L⦈ ≺ P'› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹x ♯ P› ‹zvec ♯* P› ‹A⇩P ♯* Ψ⇩R› ‹x ♯ A⇩P› ‹A⇩P ♯* M› ‹A⇩P ♯* P› ‹A⇩P ♯* zvec›  ‹A⇩P ♯* Ψ› ‹A⇩P ♯* zvec› ‹A⇩R ♯* P› ‹A⇩R ♯* A⇩P›
      obtain K'' where MeqK'': "(Ψ ⊗ Ψ⇩R) ⊗ Ψ⇩P ⊢ M ↔ K''" and "x ♯ K''" and "A⇩R ♯* K''" and "zvec ♯* K''"
        by(rule_tac B="(x#A⇩R@zvec)" in obtainPrefix) (assumption | force)+

      from MeqK'' MeqK' have KeqK'': "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊢ K' ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
      with RTrans ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› ‹distinct A⇩R› ‹A⇩R ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹A⇩R ♯* K'› ‹A⇩R ♯* K''› ‹A⇩R ♯* R›
      have "Ψ ⊗ Ψ⇩P ⊳ R ⟼K''⦇ν*xvec⦈⟨N'⟩ ≺ R'"
        by(rule_tac outputRenameSubject) (assumption | force)+
      hence "Ψ ⊗ Ψ⇩P ⊳ ⦇νx⦈R ⟼K''⦇ν*xvec⦈⟨N'⟩ ≺ ⦇νx⦈R'" using ‹x ♯ Ψ› ‹x ♯ Ψ⇩P› ‹x ♯ K''› ‹x ♯ xvec› ‹x ♯ N'› ‹xvec ♯* Ψ› ‹xvec ♯* Ψ⇩P› ‹xvec ♯* R› ‹x ♯ K''›
        by(rule_tac Scope) (assumption | force)+
      moreover from MeqK'' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K''› ‹x ♯ K''› ‹A⇩R ♯* K''› ‹⦇ν*xvec⦈N' ≺' ⦇νx⦈R' = ⦇ν*yvec⦈N ≺' R''›
        by(auto simp add: residualInject)
    next
      case(cBang Ψ' R M' A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec N R' M)
      from ‹guarded R› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "Ψ⇩R ≃ 𝟭"
        by(metis guardedStatEq)
      with ‹Ψ' ⊗ 𝟭 ⊢ M ↔ M'› have "Ψ' ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ M'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
      moreover have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊗ 𝟭⟩"
      proof -
        from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩Q,  Ψ' ⊗ Ψ⇩R ⊗ 𝟭⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
        moreover from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩ ≃⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ 𝟭 ⊳ P ⟼M⦇L⦈ ≺ P'› ‹Ψ⇩R ≃ 𝟭›
      have "Ψ ⊗ Ψ⇩R ⊗ 𝟭 ⊳ P ⟼M⦇L⦈ ≺ P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
      ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ∥ !R ⟼ROut K' (⦇ν*xvec⦈N ≺' R') ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"  using cBang
        by(rule_tac cBang(5)) (assumption |simp)+
      then  obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ∥ !R ⟼ROut K' (⦇ν*xvec⦈N ≺' R')"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        by metis
      from RTrans ‹guarded R› have "Ψ ⊗ Ψ⇩P ⊳ !R ⟼ROut K' (⦇ν*xvec⦈N ≺' R')" by(rule Bang)
      moreover from MeqK' ‹Ψ⇩R ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
      ultimately show ?case using ‹zvec ♯* K'›
        by force
    qed
  }
  note Goal = this
  have "Ψ ⊗ Ψ⇩Q ≃ Ψ ⊗ Ψ⇩Q" by simp
  moreover note RTrans
  moreover from MeqK have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩R ⊢ M ↔ K"
    by(metis statEqEnt Associativity Commutativity)
  moreover note PeqQ ‹A⇩R ♯* Ψ› ‹A⇩R ♯* Ψ⇩Q›
  ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼ROut K' (⦇ν*xvec⦈N ≺' R') ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ ([]::name list) ♯* K' ∧ A⇩R ♯* K'"
   by(rule_tac Goal) (assumption | force simp add: residualInject)+
  with Assumptions show ?thesis
    by(force simp add: residualInject)
qed

lemma comm2Aux:
  fixes Ψ    :: 'b
  and   Ψ⇩Q   :: 'b
  and   R    :: "('a, 'b, 'c) psi"
  and   K    :: 'a
  and   N    :: 'a
  and   R'   :: "('a, 'b, 'c) psi"
  and   A⇩R   :: "name list"
  and   Ψ⇩R   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   M    :: 'a
  and   xvec :: "name list"
  and   P'   :: "('a, 'b, 'c) psi"
  and   A⇩P   :: "name list"
  and   Ψ⇩P   :: 'b
  and   A⇩Q   :: "name list"

  assumes RTrans: "Ψ ⊗ Ψ⇩Q ⊳ R ⟼K⦇N⦈ ≺ R'"
  and     FrR: "extractFrame R = ⟨A⇩R, Ψ⇩R⟩"
  and     PTrans: "Ψ ⊗ Ψ⇩R ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
  and     MeqK: "Ψ ⊗ Ψ⇩Q ⊗ Ψ⇩R ⊢ M ↔ K"
  and     QimpP: "⟨A⇩Q, (Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
  and     FrP: "extractFrame P = ⟨A⇩P, Ψ⇩P⟩"
  and     FrQ: "extractFrame Q = ⟨A⇩Q, Ψ⇩Q⟩"
  and     "distinct A⇩P"
  and     "distinct A⇩R"
  and     "A⇩R ♯* A⇩P"
  and     "A⇩R ♯* A⇩Q"
  and     "A⇩R ♯* Ψ"
  and     "A⇩R ♯* P"
  and     "A⇩R ♯* Q"
  and     "A⇩R ♯* R"
  and     "A⇩R ♯* K"
  and     "A⇩P ♯* Ψ"
  and     "A⇩P ♯* R"
  and     "A⇩P ♯* P"
  and     "A⇩P ♯* M"
  and     "A⇩Q ♯* R"
  and     "A⇩Q ♯* M"
  and     "A⇩R ♯* xvec"
  and     "xvec ♯* M"

  obtains  K' where "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'" and "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "A⇩R ♯* K'"
proof -
  from ‹A⇩R ♯* P› ‹A⇩R ♯* Q› ‹A⇩R ♯* A⇩P› ‹A⇩R ♯* A⇩Q› FrP FrQ have "A⇩R ♯* Ψ⇩P" and "A⇩R ♯* Ψ⇩Q"
    by(force dest: extractFrameFreshChain)+
  assume Assumptions: "⋀K'. ⟦Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'; Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'; A⇩R ♯* K'⟧ ⟹ thesis"
  {
    fix Ψ'::'b
    fix zvec::"name list"
    assume "A⇩R ♯* Ψ'"
    assume "A⇩R ♯* zvec"
    assume "A⇩P ♯* zvec"
    assume "zvec ♯* R"
    assume "zvec ♯* P"
    
    assume A: "Ψ ⊗ Ψ⇩Q ≃ Ψ'"
    with RTrans have "Ψ' ⊳ R ⟼K⦇N⦈ ≺ R'" 
      by(rule statEqTransition)
    moreover note FrR ‹distinct A⇩R›
    moreover from ‹Ψ ⊗ Ψ⇩Q ⊗ Ψ⇩R ⊢ M ↔ K› have "(Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩R ⊢ M ↔ K"
      by(blast intro: statEqEnt Associativity AssertionStatEqSym)
    with A have "Ψ' ⊗ Ψ⇩R ⊢ M ↔ K" by(rule statEqEnt[OF Composition])
    moreover have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ≃⇩F ⟨A⇩Q, (Ψ ⊗ Ψ⇩Q) ⊗ Ψ⇩R⟩" using A
      by(blast dest: frameIntComposition FrameStatEqTrans FrameStatEqSym)
    with QimpP have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
      by(force intro: FrameStatEqImpCompose)
    moreover from PTrans have "distinct xvec" by(auto dest: boundOutputDistinct)
    ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R' ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"
      using PTrans FrP ‹A⇩R ♯* K› ‹A⇩R ♯* Ψ'› ‹A⇩R ♯* Ψ› ‹A⇩R ♯* P› ‹A⇩R ♯* R› ‹A⇩R ♯* Ψ⇩P› ‹A⇩P ♯* R› ‹A⇩Q ♯* R› ‹A⇩P ♯* Ψ›
                       ‹A⇩P ♯* P› ‹A⇩P ♯* M› ‹A⇩P ♯* zvec› ‹A⇩Q ♯* M› ‹A⇩R ♯* zvec› ‹zvec ♯* R› ‹zvec ♯* P› ‹distinct A⇩P›
                       ‹A⇩R ♯* A⇩P› ‹A⇩R ♯* A⇩Q› ‹A⇩R ♯* xvec› ‹xvec ♯* M›
    proof(nominal_induct avoiding: Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec arbitrary: M rule: inputFrameInduct)
      case(cAlpha Ψ' R K N R' A⇩R Ψ⇩R p Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      have S: "set p ⊆ set A⇩R × set (p ∙ A⇩R)" by fact
      from ‹Ψ' ⊗ (p ∙ Ψ⇩R) ⊢ M ↔ K› have "(p ∙ (Ψ' ⊗ (p ∙ Ψ⇩R))) ⊢ (p ∙ M) ↔ (p ∙ K)"
        by(rule chanEqClosed)
      with ‹A⇩R ♯* Ψ'› ‹(p ∙ A⇩R) ♯* Ψ'› ‹A⇩R ♯* K› ‹(p ∙ A⇩R) ♯* K› S ‹distinctPerm p›
      have "Ψ' ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K" by(simp add: eqvts)
      moreover from ‹Ψ ⊗ (p ∙ Ψ⇩R) ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› S ‹A⇩R ♯* P› ‹(p ∙ A⇩R) ♯* P› ‹A⇩R ♯* xvec› ‹(p ∙ A⇩R) ♯* xvec› ‹xvec ♯* M› 
      have "(p ∙ (Ψ ⊗ (p ∙ Ψ⇩R))) ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"  
        using outputPermFrameSubject by(auto simp add: residualInject)
      with ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› S ‹distinctPerm p› have "Ψ ⊗ Ψ⇩R ⊳ P ⟼(p ∙ M)⦇ν*xvec⦈⟨N⟩ ≺ P'"
        by(simp add: eqvts)
      moreover from ‹A⇩P ♯* M› have "(p ∙ A⇩P) ♯* (p ∙ M)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* A⇩P› ‹(p ∙ A⇩R) ♯* A⇩P› S have "A⇩P ♯* (p ∙ M)" by simp
      moreover from ‹A⇩Q ♯* M› have "(p ∙ A⇩Q) ♯* (p ∙ M)" 
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* A⇩Q› ‹(p ∙ A⇩R) ♯* A⇩Q› S have "A⇩Q ♯* (p ∙ M)" by simp

      moreover from ‹⟨A⇩Q, Ψ' ⊗ (p ∙ Ψ⇩R)⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ (p ∙ Ψ⇩R)⟩›
      have "(p ∙ ⟨A⇩Q, Ψ' ⊗ (p ∙ Ψ⇩R)⟩) ↪⇩F (p ∙ ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ (p ∙ Ψ⇩R)⟩)"
        by(rule FrameStatImpClosed)
      with ‹A⇩R ♯* A⇩P› ‹(p ∙ A⇩R) ♯* A⇩P› ‹A⇩R ♯* Ψ'› ‹(p ∙ A⇩R) ♯* Ψ'› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› ‹A⇩R ♯* A⇩Q›
           ‹(p ∙ A⇩R) ♯* A⇩Q› ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› S ‹distinctPerm p›
      have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩" by(simp add: eqvts)
      moreover from ‹xvec ♯* M› have "(p ∙ xvec) ♯* (p ∙ M)" by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with S ‹A⇩R ♯* xvec› ‹(p ∙ A⇩R) ♯* xvec› have "xvec ♯* (p ∙ M)" by simp
      ultimately obtain K' where "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'" and "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        using cAlpha
        by(fastforce simp del: freshChainSimps)
      from ‹Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'› S ‹A⇩R ♯* R› ‹(p ∙ A⇩R) ♯* R› have "(p ∙ (Ψ ⊗ Ψ⇩P)) ⊳ R ⟼(p ∙ K')⦇N⦈ ≺ R'"
        by(rule_tac inputPermFrameSubject) auto
      with S ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› have "Ψ ⊗ Ψ⇩P ⊳ R ⟼(p ∙ K')⦇N⦈ ≺ R'"
        by(simp add: eqvts)
      moreover from ‹Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ (p ∙ M) ↔ K'› have "(p ∙ (Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R))⊢ (p ∙ p ∙ M) ↔ (p ∙ K')"
        by(rule chanEqClosed)
      with S ‹A⇩R ♯* Ψ› ‹(p ∙ A⇩R) ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹(p ∙ A⇩R) ♯* Ψ⇩P› ‹distinctPerm p› have "Ψ ⊗ Ψ⇩P ⊗ (p ∙ Ψ⇩R) ⊢ M ↔ (p ∙ K')"
        by(simp add: eqvts)
      moreover from ‹zvec ♯* K'› have "(p ∙ zvec) ♯* (p ∙ K')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      with ‹A⇩R ♯* zvec› ‹(p ∙ A⇩R) ♯* zvec› S have "zvec ♯* (p ∙ K')" by simp
      moreover from ‹A⇩R ♯* K'› have "(p ∙ A⇩R) ♯* (p ∙ K')"
        by(simp add: pt_fresh_star_bij[OF pt_name_inst, OF at_name_inst])
      ultimately show ?case by blast
    next
      case(cInput Ψ' M' K xvec N Tvec R Ψ P A⇩P Ψ⇩P A⇩Q zvec yvec M)
      from ‹A⇩P ♯* (M'⦇λ*xvec N⦈.R)› ‹A⇩Q ♯* (M'⦇λ*xvec N⦈.R)› ‹zvec ♯* (M'⦇λ*xvec N⦈.R)›
      have "A⇩P ♯* M'" and "A⇩Q ♯* M'" and "zvec ♯* M'" by simp+
      
      from ‹Ψ' ⊢ M' ↔ K›
      have "Ψ' ⊗ 𝟭 ⊢ M' ↔ K"
        by(blast intro: statEqEnt Identity AssertionStatEqSym)
      hence "Ψ' ⊗ 𝟭 ⊢ M' ↔ M'"
        by(blast intro: chanEqSym chanEqTrans)
      with ‹A⇩Q ♯* M'›
      have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F M' ↔ M'"
        by(force intro: frameImpI)
      
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
      have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F M' ↔ M'"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* M'› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ M' ↔ M'" 
        by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊢ M' ↔ M'" by(blast intro: statEqEnt Identity)
      hence "Ψ ⊗ Ψ⇩P ⊳ M'⦇λ*xvec N⦈.R ⟼M'⦇(N[xvec::=Tvec])⦈ ≺ R[xvec::=Tvec]"
        using ‹distinct xvec› ‹set xvec ⊆ supp N› ‹length xvec = length Tvec›
        by(rule Input)
      
      moreover from ‹Ψ' ⊗ 𝟭 ⊢ M ↔ K› ‹Ψ' ⊗ 𝟭 ⊢ M' ↔ K›
      have "Ψ' ⊗ 𝟭 ⊢ M ↔ M'" by(metis chanEqSym chanEqTrans)
      with ‹A⇩Q ♯* M› ‹A⇩Q ♯* M'›
      have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F M ↔ M'"
        by(force intro: frameImpI)
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩ ›
      have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F M ↔ M'"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* M› ‹A⇩P ♯* M'› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ M ↔ M'" 
        by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity)
      ultimately show ?case using ‹zvec ♯* M'›
        by force
    next
      case(cCase Ψ' R M' N R' φ Cs A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      from ‹guarded R› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "Ψ⇩R ≃ 𝟭"
        by(metis guardedStatEq)
      with ‹Ψ' ⊗ 𝟭 ⊢ M ↔ M'› have "Ψ' ⊗ Ψ⇩R ⊢ M ↔ M'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
      moreover have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
      proof -
        from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩Q,  Ψ' ⊗ Ψ⇩R⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
        moreover from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩ ≃⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ 𝟭 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹Ψ⇩R ≃ 𝟭›
      have "Ψ ⊗ Ψ⇩R  ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
      moreover from ‹zvec ♯* (Cases Cs)› ‹A⇩P ♯* (Cases Cs)›  ‹A⇩Q ♯* (Cases Cs)› ‹(φ, R) mem Cs›
      have "A⇩P ♯* R" and "A⇩Q ♯* R" and "zvec ♯* R" and "A⇩P ♯* φ" and "A⇩Q ♯* φ"
        by(auto dest: memFreshChain)
      ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"  using cCase
        by(rule_tac cCase) (assumption |simp)+
      then  obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        by metis
      note RTrans ‹(φ, R) mem Cs›
      moreover from ‹Ψ' ⊢ φ› have "Ψ' ⊗ 𝟭 ⊢ φ" by(blast intro: statEqEnt Identity AssertionStatEqSym)
      with ‹A⇩Q ♯* φ› have "(⟨A⇩Q, Ψ' ⊗ 𝟭⟩) ⊢⇩F φ" by(force intro: frameImpI)
      with ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩› have "(⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩) ⊢⇩F φ"
        by(simp add: FrameStatImp_def)
      with ‹A⇩P ♯* φ› have "(Ψ ⊗ Ψ⇩P) ⊗ 𝟭 ⊢ φ"  by(force dest: frameImpE)
      hence "Ψ ⊗ Ψ⇩P ⊢ φ" by(blast intro: statEqEnt Identity) 
      ultimately have "Ψ ⊗ Ψ⇩P ⊳ Cases Cs ⟼K'⦇N⦈ ≺ R'"  using ‹guarded R› by(rule Case)
      moreover from MeqK' ‹Ψ⇩R ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
      ultimately show ?case using ‹zvec ♯* K'›
        by force
    next
      case(cPar1 Ψ' Ψ⇩R⇩2 R⇩1 M' N R⇩1' A⇩R⇩2 R⇩2 A⇩R⇩1 Ψ⇩R⇩1 Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      have FrR2: "extractFrame R⇩2 = ⟨A⇩R⇩2, Ψ⇩R⇩2⟩" by fact
      from ‹Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'› have "(Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity Composition Commutativity)
      moreover have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1⟩ ↪⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1⟩"
      proof -
        have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩›
        moreover have  "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› have "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩R⇩1 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
        by(metis statEqTransition Associativity Composition Commutativity)
      moreover from ‹A⇩R⇩1 ♯* A⇩P› ‹A⇩R⇩2 ♯* A⇩P› ‹A⇩P ♯* (R⇩1 ∥ R⇩2)› ‹extractFrame R⇩1 = ⟨A⇩R⇩1, Ψ⇩R⇩1⟩› FrR2 have "A⇩P ♯* Ψ⇩R⇩1" and "A⇩P ♯* Ψ⇩R⇩2"
        by(force dest: extractFrameFreshChain)+
        moreover note ‹distinct xvec›

      ultimately have "∃K'. (Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊳ R⇩1 ⟼K'⦇N⦈ ≺ R⇩1' ∧ (Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊢ M ↔ K' ∧ (A⇩R⇩2@zvec) ♯* K' ∧ A⇩R⇩1 ♯* K'" using cPar1
        by(rule_tac cPar1(6)[where bf=xvec]) (assumption | simp | fastforce)+
      then  obtain K' where RTrans: "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊳ R⇩1 ⟼K'⦇N⦈ ≺ R⇩1'"
                        and MeqK': "(Ψ ⊗ Ψ⇩R⇩2) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊢ M ↔ K'"  and "A⇩R⇩2 ♯* K'" and "zvec ♯* K'" and "A⇩R⇩1 ♯* K'"
        by force
      
      from RTrans have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2 ⊳ R⇩1 ⟼K'⦇N⦈ ≺ R⇩1'"
        by(metis statEqTransition Associativity Composition Commutativity)
      hence "Ψ ⊗ Ψ⇩P ⊳ (R⇩1 ∥ R⇩2) ⟼K'⦇N⦈ ≺ (R⇩1' ∥ R⇩2)" using FrR2 ‹A⇩R⇩2 ♯* Ψ› ‹A⇩R⇩2 ♯* Ψ⇩P› ‹A⇩R⇩2 ♯* K'› ‹A⇩R⇩2 ♯* R⇩1› ‹A⇩R⇩2 ♯* N›
        by(force intro: Par1)
      moreover from MeqK' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K'› ‹A⇩R⇩1 ♯* K'› ‹A⇩R⇩2 ♯* K'›
        by force
    next
      case(cPar2 Ψ' Ψ⇩R⇩1 R⇩2 M' N R⇩2' A⇩R⇩1 R⇩1 A⇩R⇩2 Ψ⇩R⇩2 Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      have FrR1: "extractFrame R⇩1 = ⟨A⇩R⇩1, Ψ⇩R⇩1⟩" by fact
      from ‹Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'› have "(Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2 ⊢ M ↔ M'"
        by(metis statEqEnt Associativity Composition Commutativity)
      moreover have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2⟩"
      proof -
        have "⟨A⇩Q, (Ψ' ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩›
        moreover have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2⟩ ≃⇩F ⟨A⇩P, ((Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩2⟩"
          by(metis Associativity Composition Commutativity AssertionStatEqTrans AssertionStatEqSym frameNilStatEq frameResChainPres)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› have "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩R⇩2 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'"
        by(metis statEqTransition Associativity Composition Commutativity)
      moreover from ‹A⇩R⇩1 ♯* A⇩P› ‹A⇩R⇩2 ♯* A⇩P› ‹A⇩P ♯* (R⇩1 ∥ R⇩2)› FrR1 ‹extractFrame R⇩2 = ⟨A⇩R⇩2, Ψ⇩R⇩2⟩› have "A⇩P ♯* Ψ⇩R⇩1" and "A⇩P ♯* Ψ⇩R⇩2"
        by(force dest: extractFrameFreshChain)+
      ultimately have "∃K'. (Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊳ R⇩2 ⟼K'⦇N⦈ ≺ R⇩2' ∧ (Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩2 ⊢ M ↔ K' ∧ (A⇩R⇩1@zvec) ♯* K' ∧ A⇩R⇩2 ♯* K'" using ‹distinct xvec› cPar2
        by(rule_tac cPar2(6)) (assumption | simp | fastforce)+
      then  obtain K' where RTrans: "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊳ R⇩2 ⟼K'⦇N⦈ ≺ R⇩2'"
                        and MeqK': "(Ψ ⊗ Ψ⇩R⇩1) ⊗ Ψ⇩P ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"  and "A⇩R⇩1 ♯* K'" and "zvec ♯* K'" and "A⇩R⇩2 ♯* K'"
        by force
      
      from RTrans have "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R⇩1 ⊳ R⇩2 ⟼K'⦇N⦈ ≺ R⇩2'"
        by(metis statEqTransition Associativity Composition Commutativity)
      hence "Ψ ⊗ Ψ⇩P ⊳ (R⇩1 ∥ R⇩2) ⟼K'⦇N⦈ ≺ (R⇩1 ∥ R⇩2')" using FrR1 ‹A⇩R⇩1 ♯* Ψ› ‹A⇩R⇩1 ♯* Ψ⇩P› ‹A⇩R⇩1 ♯* K'› ‹A⇩R⇩1 ♯* R⇩2› ‹A⇩R⇩1 ♯* N›
        by(force intro: Par2)
      moreover from MeqK' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R⇩1 ⊗ Ψ⇩R⇩2 ⊢ M ↔ K'"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K'› ‹A⇩R⇩1 ♯* K'› ‹A⇩R⇩2 ♯* K'›
        by force
    next
      case(cScope Ψ' R M' N R' x A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      then have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R' ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'" 
        by(rule_tac cScope(4)) (assumption | simp del: freshChainSimps)+
      then  obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R'"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        by metis
      from ‹A⇩R ♯* A⇩P› ‹A⇩P ♯* (⦇νx⦈R)› ‹x ♯ A⇩P› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "A⇩P ♯* Ψ⇩R"
        by(force dest: extractFrameFreshChain)+
      from ‹Ψ ⊗ Ψ⇩R ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹extractFrame P = ⟨A⇩P, Ψ⇩P⟩› ‹distinct A⇩P› ‹x ♯ P› ‹zvec ♯* P› ‹A⇩P ♯* Ψ⇩R› ‹x ♯ A⇩P› ‹A⇩P ♯* M› ‹A⇩P ♯* P› ‹A⇩P ♯* zvec›  ‹A⇩P ♯* Ψ› ‹A⇩P ♯* zvec› ‹A⇩R ♯* P› ‹A⇩R ♯* A⇩P› ‹xvec ♯* M› ‹distinct xvec›
      obtain K'' where MeqK'': "(Ψ ⊗ Ψ⇩R) ⊗ Ψ⇩P ⊢ M ↔ K''" and "x ♯ K''" and "A⇩R ♯* K''" and "zvec ♯* K''"
        by(rule_tac B="(x#A⇩R@zvec)" in obtainPrefix) (assumption | simp | force | metis freshChainSym)+
      
      from MeqK'' MeqK' have KeqK'': "(Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊢ K' ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity chanEqSym chanEqTrans)
      with RTrans ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› ‹distinct A⇩R› ‹A⇩R ♯* Ψ› ‹A⇩R ♯* Ψ⇩P› ‹A⇩R ♯* K'› ‹A⇩R ♯* K''› ‹A⇩R ♯* R›
      have "Ψ ⊗ Ψ⇩P ⊳ R ⟼K''⦇N⦈ ≺ R'"
        by(rule_tac inputRenameSubject) (assumption | force)+
      hence "Ψ ⊗ Ψ⇩P ⊳ ⦇νx⦈R ⟼K''⦇N⦈ ≺ ⦇νx⦈R'" using ‹x ♯ Ψ› ‹x ♯ Ψ⇩P› ‹x ♯ K''› ‹x ♯ N›
        by(rule_tac Scope) (assumption | force)+
      moreover from MeqK'' have "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K''"
        by(metis statEqEnt Associativity Composition Commutativity)
      ultimately show ?case using ‹zvec ♯* K''› ‹x ♯ K''› ‹A⇩R ♯* K''›
        by force
    next
      case(cBang Ψ' R M' N R' A⇩R Ψ⇩R Ψ P A⇩P Ψ⇩P A⇩Q zvec xvec M)
      from ‹guarded R› ‹extractFrame R = ⟨A⇩R, Ψ⇩R⟩› have "Ψ⇩R ≃ 𝟭"
        by(metis guardedStatEq)
      with ‹Ψ' ⊗ 𝟭 ⊢ M ↔ M'› have "Ψ' ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ M'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition)
      moreover have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊗ 𝟭⟩"
      proof -
        from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩Q, Ψ' ⊗ Ψ⇩R ⊗ 𝟭⟩ ≃⇩F ⟨A⇩Q, Ψ' ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        moreover note ‹⟨A⇩Q, Ψ' ⊗ 𝟭⟩ ↪⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩›
        moreover  from ‹Ψ⇩R ≃ 𝟭› have "⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ 𝟭⟩ ≃⇩F ⟨A⇩P, (Ψ ⊗ Ψ⇩P) ⊗ Ψ⇩R ⊗ 𝟭⟩"
          by(metis Identity Commutativity AssertionStatEqSym Composition frameResChainPres frameNilStatEq AssertionStatEqTrans)
        ultimately show ?thesis by(rule FrameStatEqImpCompose)
      qed
      moreover from ‹Ψ ⊗ 𝟭 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'› ‹Ψ⇩R ≃ 𝟭›
      have "Ψ ⊗ Ψ⇩R ⊗ 𝟭 ⊳ P ⟼M⦇ν*xvec⦈⟨N⟩ ≺ P'" by(metis statEqTransition Identity Commutativity AssertionStatEqSym Composition)
      ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ∥ !R ⟼K'⦇N⦈ ≺ R'∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ K' ∧ zvec ♯* K' ∧ A⇩R ♯* K'"  using cBang
        by(rule_tac cBang(5)) (assumption | simp del: freshChainSimps)+
      then  obtain K' where RTrans: "Ψ ⊗ Ψ⇩P ⊳ R ∥ !R ⟼K'⦇N⦈ ≺ R'"
                        and MeqK': "Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊗ 𝟭 ⊢ M ↔ K'" and "zvec ♯* K'" and "A⇩R ♯* K'"
        by metis
      from RTrans ‹guarded R› have "Ψ ⊗ Ψ⇩P ⊳ !R ⟼K'⦇N⦈ ≺ R'" by(rule Bang)
      moreover from MeqK' ‹Ψ⇩R ≃ 𝟭› have "Ψ ⊗ Ψ⇩P ⊗ 𝟭 ⊢ M ↔ K'"
        by(metis Identity Commutativity statEqEnt AssertionStatEqSym Composition AssertionStatEqTrans)
      ultimately show ?case using ‹zvec ♯* K'›
        by force
    qed
  }
  note Goal = this
  have "Ψ ⊗ Ψ⇩Q ≃ Ψ ⊗ Ψ⇩Q" by(simp add: AssertionStatEqRefl)
  moreover from ‹A⇩R ♯* Ψ› ‹A⇩R ♯* Ψ⇩Q› have "A⇩R ♯* (Ψ ⊗ Ψ⇩Q)" by force
  ultimately have "∃K'. Ψ ⊗ Ψ⇩P ⊳ R ⟼K'⦇N⦈ ≺ R' ∧ Ψ ⊗ Ψ⇩P ⊗ Ψ⇩R ⊢ M ↔ K' ∧ ([]::name list) ♯* K' ∧ A⇩R ♯* K'"
    by(rule_tac Goal) (assumption | force)+
  with Assumptions show ?thesis
    by blast
qed

end

end