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